2013-06-19 07:43

'Allocates blocks of 512 bytes
     CONST   FORCE_UPDATE = -1
     DIM blockCount AS LONG, currentRecID AS LONG
     DIM fs AS QFILESTREAM, __s AS STRING

'*
     SUB dbtCreate( dbtArch AS STRING)
      DIM streamEx AS QMEMORYSTREAM

'print "Creating memo table.." ; dbtArch

      IF fs.OPEN(dbtArch, fmCreate) = FALSE THEN
 'showMessage("Create fail ..  "+dbtArch)
       PRINT "Create fail ..  "+dbtArch
       END
      END IF

      streamEx.writeNUM(1,4)
      streamEx.size = 512      'Reserve rest

      fs.CopyFrom(streamEx, 0)
      fs.CLOSE
'print "Memo done!!"
     END SUB


     SUB dbtClose
      fs.CLOSE
      blockCount = 0
      __s = ""
     END SUB

'*
     SUB dbtOpen(dbtArch AS STRING,  mode AS INTEGER)
      IF fs.OPEN(dbtArch, mode) = FALSE THEN
  'showMessage("It can't be open  " + dbtArch)
       PRINT "It can't be open  " + dbtArch
       END
      END IF

      blockCount = fs.readNUM(4)           '<- First four bytes
      currentRecID = -1
     END SUB

'*
     private SUB readRecord
     Eom = 0   'End of record
     __s = ""

     WHILE Eom=0
      __s = __s + fs.readSTR(512)
      Eom = INSTR(__s, CHR$(&H1A))
     WEND
     END SUB

'*
     FUNCTION MemoAppend(text AS STRING) AS INTEGER
      DIM streamEx AS QMEMORYSTREAM

      IF LEN(text) = 0  THEN
       EXIT FUNCTION
      END IF

      fs.position = fs.size

      IF blockCount = 1 THEN
       streamEx.WriteNUM(&H001A, 2)
       streamEx.size = 512

       fs.copyFrom(streamEx, 0)  'Fill the block
       INC blockCount

      ELSE
       streamEx.size = blockCount*512 - fs.position
       fs.copyFrom(streamEx, 0)    'Reach next block

      END IF

      result = blockCount      'info to send toward the dbf routines

'Write it
'print "About to write" & text
      fs.write(text)
      fs.writeNUM(&H1A, 1)

'Update info
      INC blockCount, 1+LEN(text) / 512
      fs.position = 0
      fs.writeNUM(blockCount, 4)
     END FUNCTION


'*
     FUNCTION Memoget(n AS LONG) AS STRING
'n is the identifier of requested record ("pointer")
      IF n < 0  OR n > blockCount  THEN
       EXIT FUNCTION
      END IF

      currentRecID = n      'Remember

      fs.position = n*512   'Beginning of data
      readRecord            ' Uses __s
      result = LEFT$( __s, INSTR(__s, CHR$(&H1A))-1 )
     END FUNCTION

'*
     FUNCTION memoUpdate(newtext AS STRING) AS LONG
'If the number of 512-byte-blocks to be occupied with the received text is >
'than original number of blocks, then the text will be recorded at end of
'file, and the original record will remains in "place" but without any reference
'to it. Otherwise the original record is used but the end of text mark will be
'updated.

      n& = currentRecID     'This number is a "pointer"!!
'print "Memoupdate....."; "  Current pointer "; n&
      IF n& = -1  THEN
       GOTO leave
      END IF

'Old contents was saved to __s
      l&      = LEN(__s)
      blocks% = l&/512
      rest%   = l& MOD 512

      fs.position = n&*512    'Begin of record
      SELECT CASE LEN(newText)
      CASE IS <= l&
       fs.write(newText)
       fs.writeNUM(&H1A, 1)

      CASE ELSE
       SELECT CASE 1+LEN(newtext) / 512
       CASE blocks%
        SELECT CASE LEN(newtext) MOD 512
        CASE IS > 0       'It doesn't fill the block
         fs.write(newText)
         fs.writeNUM(&H1A, 1)

        CASE 0
         n& = MemoAppend(newtext)
        END SELECT

       CASE ELSE
        n& = MemoAppend(newtext)
       END SELECT
      END SELECT

      currentRecID = -1   'Reset

leave:
      result = n&     'Block count
     END FUNCTION

2013-06-19 07:43