| The only reliable /supportable solution to this problem is to
scan the file forwards using $FIND, build a table of RFA's and then
access the records in reverse order using filling in the RFA from
table and using $GET with RAC=RFA. The storage requirements, and
even some performance requirements, can be improved by not storing
every RFA, but only every some many Kb worth of records, determined
by the size of the buffer you are willing to use.
But, I do have this BASIC HACK that actually works on most (all?)
variable lenght sequntial files. Note, this dates from before the
time the BASIC supported RABDEF$, so I define RAB and FAB manually
but that can be removed.
Have fun,
Hein.
1 OPTION TYPE = EXPLICIT !Hein van den Heuvel, Xmas 1985, Valbonne
On error go to hell !
EXTERNAL LONG FUNCTION SYS$OPEN(FAB$TYPE), SYS$CONNECT(RAB$TYPE), &
SYS$READ(RAB$TYPE), SYS$CLOSE(FAB$TYPE)
EXTERNAL LONG CONSTANT RMS$_NORMAL, RMS$_EOF
DECLARE LONG CONSTANT FAB_CODE = 20483, RAB_CODE = 17409
DECLARE LONG CONSTANT M_GET = 2, M_BIO = 32
RECORD FAB$TYPE
long START, long FOP, long STS, long STV &
,long ALQ, word DEQ, byte FAC, byte SHR &
,long CTX, byte RTV, byte ORG, byte RAT &
,byte RFM, long JNL, long XAB, long NAM &
,long FNA, long DNA, byte FNS, byte DNS &
,word MRS, long MRN, word BLS, byte BKS &
,byte FSZ, long DEV, long SDC, word GBC &
,byte ACM, byte RCF, long FILL
END RECORD
RECORD RAB$TYPE
long START, long ROP, long STS, long STV &
,long RFA_VBN,word RFA_ID, word FILL, long CTX &
,word FILL, byte RAC, byte TMO, word USZ &
,word RSZ, long UBF, long RBF, long RHB &
,long KBF, byte KSZ, byte KRF, byte MBF &
,byte MBC, long BKT, long FAB, long XAB
END RECORD
DECLARE STRING FILE_NAME, &
LONG RMS_STATUS, I, THIS_REC, LAST_REC, &
WORD LAST_LEN, LEFT_OVER_LENGHT
MAP (RMS) RAB$TYPE RAB, FAB$TYPE FAB, STRING NAME_BUFFER = 80
MAP (BUF) WORD BUF(255), STRING LEFT_OVER = 255
MAP DYNAMIC (BUF) STRING REC
INPUT 'File name'; FILE_NAME
NAME_BUFFER = FILE_NAME
FAB::START = FAB_CODE !Set FAB$B_BID and FAB$B_BLN
RAB::START = RAB_CODE !Set RAB$B_BID and RAB$B_BLN
RAB::FAB = LOC(FAB::START) !Put Address of Fab in Rab
FAB::FNA = LOC(NAME_BUFFER) !Put Address of name_buf in Fab
FAB::FNS = LEN(FILE_NAME) !Put Lenght of file_name in Fab
FAB::FAC = M_GET + M_BIO !READ access in BLOCK I/O mode
RMS_STATUS = SYS$OPEN(FAB) !Open the file
CALL LIB$STOP(RMS_STATUS BY VALUE) IF RMS_STATUS <> RMS$_NORMAL
RMS_STATUS = SYS$CONNECT(RAB) !Connect a buffer
CALL LIB$STOP(RMS_STATUS BY VALUE) IF RMS_STATUS <> RMS$_NORMAL
RAB::UBF = LOC(BUF(0)) !Put Address of user_buf in Rab
RAB::USZ = 512% !Set User buffer Size
!
! Let's go hunt for a place to start by reading the last block and
! scanning backwards. I guess using a XABFHC could make this cleaner.
!
RAB::BKT = FAB::ALQ !Stuff the VBN into the RAB
RMS_STATUS = SYS$READ(RAB) !Read bucket in buffer
WHILE RMS_STATUS = RMS$_EOF !Beyond EOF?
RAB::BKT = RAB::BKT - 1% !Go back
RMS_STATUS = SYS$READ(RAB) !Read bucket in buffer
NEXT
CALL LIB$STOP(RMS_STATUS BY VALUE) IF RMS_STATUS <> RMS$_NORMAL
LAST_LEN = (RAB::RSZ / 2%) - 1% !Save starting point
LAST_REC = RAB::BKT * 512 + RAB::RSZ !Save starting point
THIS_REC = LAST_REC !Init
!
! Got our starting point, now let's go for it!
!
WHILE RAB::BKT > 0% !Loop through the file
RMS_STATUS = SYS$READ(RAB) UNLESS !Read (previous) bucket unless&
RAB::RFA_VBN = RAB::BKT !..already there (eof)
CALL LIB$STOP(RMS_STATUS BY VALUE) UNLESS (RMS_STATUS=RMS$_NORMAL)
FOR I = LAST_LEN TO 0 STEP -1 !Loop through block
IF LAST_REC = THIS_REC + ((BUF(I) + 1%) AND -2%) THEN !Pointing ok?
!
! Here we point to a word with a value that treated as a record
! length and added to our current position points to the last
! valid record seen. Chances are pretty slim that this is anything
! other then a *** VALID RECORD ***. Grab it while we can.
!
REMAP (BUF) STRING FILL=(I+1%)*2% !Skip the first bit and length&
,REC = BUF(I) !..and put REC were it should be
PRINT REC !Print the record
LAST_REC = THIS_REC - 2% !New address for last record
LAST_LEN = I !New pointer to last length
END IF !
THIS_REC = THIS_REC - 2% !Address of this (trial) record
NEXT I !Walk the Block
LEFT_OVER_LENGHT = LAST_LEN * 2% !Convert word steps to bytes.
REMAP (BUF) REC = LEFT_OVER_LENGHT !Re-map buffer layout
LEFT_OVER = REC !Save last bit from this block
RAB::BKT = RAB::BKT - 1% !Update the VBN into the RAB
LAST_LEN = 255% !Init pointer for full block
NEXT !Loop
GO TO 2 !All done
HELL: PRINT ERT$(ERR) UNLESS ERR = 11
RESUME 2
2 END
|