* READ_MEMO.PRG - This procedure attempts to read the segments of a VFP7 Memo file. It assumes
* the structure published in the following MSDN Article:
* http://msdn.microsoft.com/en-us/library/8599s21w(v=VS.71).aspx
CLEAR
* Locate the memo file.
cFilePath = GETFILE("FPT", "Memo File:", "Open", 0)
IF EMPTY(cFilePath)
WAIT "No Memo file was selected." WINDOW NOWAIT
RETURN
ENDIF
* Create a log file.
cLogPath = JUSTSTEM(cFilePath) + [_FPT.LOG]
SET TEXTMERGE TO (cLogPath)
SET TEXTMERGE ON
* Open the file.
\Opening memo file: <<cFilePath>>.
nHandle = FOPEN(cFilePath)
IF nHandle < 0
\Can't open Memo file.
SET TEXTMERGE OFF
SET TEXTMERGE TO
RETURN
ENDIF
\File Handle: <<nHandle>>
* Check the file size.
nSize = FSEEK(nHandle, 0, 2)
\Memo File Size: <<ALLTRIM(STR(nSize))>> <<TRANSFORM(nSize, "@0")>>
IF nSize <= 0
\"Memo file is empty."
=FCLOSE(nHandle)
SET TEXTMERGE OFF
SET TEXTMERGE TO
RETURN
ENDIF
=FSEEK(nHandle, 0, 0)
* Read the header.
\
\
\***** Header Details *********
\Byte offset 0 - 3: Location of the next free block:
cStr = FREAD(nHandle, 4)
cHex = Str2Hex(cStr)
\\<<cHex>>
* Get by Unused bytes.
cStr = FREAD(nHandle, 2)
\Byte offset 4 - 5: Unused
\Byte offset 6 - 7: Block Size (bytes per block):
cStr = FREAD(nHandle, 2)
cHex = [0x] + STRTRAN(Str2Hex(cStr), " ")
nBlockSize = EVALUATE(cHex)
\\<<nBlockSize>>, <<cHex>>
* Get by Unused bytes.
cStr = FREAD(nHandle, 504)
\Byte offset 8 - 511: Unused
\
\
\***** Memo Block Data ********
* Read each block.
lEOF = .F.
*DO WHILE NOT lEOF
FOR i = 1 TO 1050
lEOF = ReadBlock(nSize, 64) && Submit the file size and block size.
IF lEOF
EXIT
ENDIF
ENDFOR
*ENDDO
* Close and exit.
SET TEXTMERGE OFF
SET TEXTMERGE TO
=FCLOSE(nHandle)
MODIFY FILE (cLogPath) NOWAIT
FUNCTION ReadBlock
PARAMETERS nFileSize, nBlockSize
LOCAL nOffset, cStr, cHex, nBlockType, nLen
nOffset = FSEEK(nHandle, 0, 1)
\Address: <<nOffset>>, <<TRANSFORM(nOffset, "@0")>>
* Read the first block.
cStr = FREAD(nHandle, nBlockSize)
* Obtain the block type.
\\Block Type:
cHex = SUBSTR(cStr, 1, 4)
cHex = [0x] + STRTRAN(Str2Hex(cHex), " ")
nBlockType = EVALUATE(cHex)
\\<<nBlockType>>, <<cHex>>
* Check for problems.
IF nBlockType > 1
\Bad Block Signature!
RETURN .T.
ENDIF
* Obtain the memo length.
\\Memo Length:
cHex = SUBSTR(cStr, 5, 4)
cHex = [0x] + STRTRAN(Str2Hex(cHex), " ")
nLen = EVALUATE(cHex)
\\<<STR(nLen, 4)>>, <<cHex>>
* Check for problems.
IF nLen > nFileSize
\Bad Block Length!
RETURN .T.
ENDIF
* Capture the memo content.
cMemo = SUBSTR(cStr, 9)
\\ Content:
IF nBlockType = 1
\\<<cMemo>>
ELSE
\\<<Str2Hex(cMemo)>>
ENDIF
* How many blocks to hold the memo?
nBlocks = CEILING(nLen/64)
FOR i = 2 TO nBlocks
cStr = FREAD(nHandle, nBlockSize)
\ <<REPLICATE(CHR(9), 23)>>
\\<<cStr>>
ENDFOR
nOffset = FSEEK(nHandle, 0, 1)
IF nOffset < nFileSize
RETURN .F.
ELSE
RETURN .T.
ENDIF
ENDFUNC
*..............................................................................
* Function: DEC2BASX
* Purpose: Convert whole number 0-?, to base 2-16
*
* Parameters: nTempNum - number to convert (0-9007199254740992)
* base - base to convert to i.e., 2 4 8 16...
* returns: string
* Usage: cresult=Dec2BasX(nParm1, nParm2)
* STORE Dec2BasX(255, 16) TO cMyString &&... cMyString contains 'ff'
*
* Taken from: http://www.tek-tips.com/faqs.cfm?fid=4461
*..............................................................................
FUNCTION dec2basx
PARAMETERS nTempNum, nNewBase
STORE 0 TO nWorkVal,;
remainder,;
dividend,;
nextnum,;
digit
nWorkVal = nTempNum
ret_str = ''
DO WHILE .T.
digit = MOD(nWorkVal, nNewBase)
dividend = nWorkVal / nNewBase
nWorkVal = INT(dividend)
DO CASE
CASE digit = 10
ret_str = 'a' + ret_str
CASE digit = 11
ret_str = 'b' + ret_str
CASE digit = 12
ret_str = 'c' + ret_str
CASE digit = 13
ret_str = 'd' + ret_str
CASE digit = 14
ret_str = 'e' + ret_str
CASE digit = 15
ret_str = 'f' + ret_str
OTHERWISE
ret_str = LTRIM(STR(digit)) + ret_str
ENDCASE
IF nWorkVal = 0
EXIT
ENDIF ( nWorkVal = 0 )
ENDDO ( .T. )
RETURN ret_str
*: eof dec2basx
FUNCTION Str2Hex
PARAMETERS cStr
LOCAL i, nLen, cByte, cHex
* Converts the contents of the submitted string to Hexidecimal format.
nLen = LEN(cStr)
cHex = ""
FOR i = 1 TO nLen
cByte = SUBSTR(cStr, i, 1)
cHex = cHex + UPPER(Dec2BasX(ASC(cByte), 16)) + " "
ENDFOR
RETURN cHex
ENDFUNC
