Listing: 1 IMPLEMENTATION MODULE MemoFunctions; 2 3 (* 4 * ModBase 5 * Release 3.0 6 * (c) Copyright 1986 - 1991 John McMonagle & Donald G. Fletcher 7 * (c) Copyright 1986 - 1991 PMI 8 * P.O. Box 8402 9 * Green Bay Wi 53308 10 * All Rights Reserved 11 *) 12 13 FROM SYSTEM IMPORT ADR,ADDRESS; 14 15 (*Repertoire modules*) 16 FROM HandleIO IMPORT BlockRead, BlockWrite,OpenFile, 17 EndReached, SetFilePtr, GetFilePtr,FileOffSet; 18 FROM StringIO IMPORT ErrorMessage, NoError, PartialRead, PrintMessage; 19 FROM StrConv IMPORT StrToLongInteger, LongIntegerToStr; 20 FROM StrEdit IMPORT Append; 21 FROM M2Strings IMPORT Length,Pos; 22 FROM LowLevel IMPORT Fill; 23 FROM ErrorManager IMPORT WARN; 24 FROM Numbers IMPORT Min; 25 (*ModBase modules*) 26 FROM ModBase3 IMPORT DBFile, GetField,MemoSize, Replace,OpenMemo,MemoHandle; 27 FROM VStorage IMPORT 28 DosAlloc, DosDealloc; 29 30 PROCEDURE DEALLOCATE(VAR loc:ADDRESS;size:CARDINAL); 31 BEGIN 32 DosDealloc(loc,size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 33 END DEALLOCATE; ***** ^ not supported yet 34 35 PROCEDURE ALLOCATE(VAR loc:ADDRESS;size:CARDINAL); 36 BEGIN 37 DosAlloc(loc,size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 38 END ALLOCATE; ***** ^ not supported yet 39 40 CONST 41 EndOfMemo = 32C; 42 MemoBlockSize = 512; 43 MaxMemoSize =4000; 44 45 46 PROCEDURE PadFile( FileHandle: CARDINAL; TheChar: CHAR; 47 HowMany: CARDINAL ); 48 VAR 49 TmpBufPtr: POINTER TO CARDINAL; ***** ^ not supported yet 50 BEGIN 51 ALLOCATE( TmpBufPtr, HowMany ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 52 Fill( TmpBufPtr, HowMany, TheChar ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 53 IF BlockWrite( FileHandle, TmpBufPtr, HowMany ) # NoError THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 54 HALT; ***** ^ undeclared identifier 55 END; 56 DEALLOCATE( TmpBufPtr, HowMany ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 57 END PadFile; ***** ^ not supported yet 58 59 PROCEDURE GetMemoField(VAR alias: DBFile; fieldnum: CARDINAL; VAR 60 memo: ARRAY OF CHAR); ***** ^ not supported yet 61 62 VAR 63 FileError: ErrorMessage; 64 memostr: ARRAY [0..9] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 65 block: ARRAY[0..MemoSize-1] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 66 memopos, memonum: LONGINT; 67 handle,i: CARDINAL; 68 fieldok: BOOLEAN; 69 BEGIN 70 IF NOT OpenMemo(alias) ***** ^ not supported yet ***** ^ not supported yet 71 THEN 72 WARN('Unable to open memo file') ***** ^ not supported yet ***** ^ not supported yet 73 END; 74 handle:=MemoHandle(alias); ***** ^ not supported yet ***** ^ not supported yet 75 GetField(alias, fieldnum, memostr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 76 (* First check to make sure there is a memo to read *) 77 IF (StrToLongInteger(memostr,0, memonum)) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 78 AND (memonum > VAL(LONGINT,0)) THEN ***** ^ undeclared identifier ***** ^ not supported yet 79 memopos := VAL(LONGINT, MemoBlockSize) * memonum; ***** ^ undeclared identifier ***** ^ not supported yet 80 SetFilePtr(handle, FromStart, memopos); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 81 memo[0] := 0C; ***** ^ not supported yet ***** ^ not supported yet 82 block[0] := 0C; ***** ^ not supported yet ***** ^ not supported yet 83 LOOP 84 FileError := BlockRead(handle, ADR(block[0]), MemoSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 85 IF (FileError=NoError) OR (FileError=PartialRead) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 86 i:=Pos(EndOfMemo,block); ***** ^ not supported yet ***** ^ not supported yet 87 IF iHIGH(str2) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 136 THEN 137 RETURN str1[count]=0C ***** ^ not supported yet ***** ^ not supported yet 138 ELSE 139 RETURN TRUE; 140 END; 141 END StrEqual; ***** ^ not supported yet 142 143 BEGIN 144 IF NOT OpenMemo(alias) ***** ^ not supported yet ***** ^ not supported yet 145 THEN 146 WARN('Unable to open memo file') ***** ^ not supported yet ***** ^ not supported yet 147 END; 148 handle:=MemoHandle(alias); ***** ^ not supported yet ***** ^ not supported yet 149 IF memo[0]#0C THEN (* Added to avoid writing a '' Memo !!!! *) ***** ^ not supported yet ***** ^ not supported yet 150 (* check to see if memo changed *) 151 NEW(OldMemo); ***** ^ undeclared identifier ***** ^ not supported yet 152 GetMemoField(alias,fieldnum,OldMemo^); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 153 IF NOT StrEqual(OldMemo^,memo) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 154 THEN 155 SetFilePtr(handle, FromStart, VAL(LONGINT,0)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 156 FileError := BlockRead(handle, ADR(blocknum), 4); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 157 blockpos := blocknum * VAL(LONGINT,MemoBlockSize); ***** ^ undeclared identifier ***** ^ not supported yet 158 SetFilePtr(handle, FromStart, blockpos); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 159 FileError := BlockWrite(handle, ADR(memo), Length(memo)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 160 IF (Length(memo) MOD MemoBlockSize) # 0 THEN ***** ^ not supported yet ***** ^ not supported yet 161 PadFile( handle, EndOfMemo, MemoBlockSize - ***** ^ not supported yet 162 (Length(memo) MOD MemoBlockSize) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 163 END; 164 LongIntegerToStr(blocknum, 10,ptrstr); ***** ^ not supported yet ***** ^ not supported yet 165 Replace(alias, fieldnum, ptrstr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 166 blockpos := GetFilePtr(handle); ***** ^ not supported yet ***** ^ not supported yet 167 (* find what will be the next available block 168 And write it to the first 4 bytes of the file *) 169 blocknum := blockpos DIV VAL(LONGINT,MemoBlockSize); ***** ^ undeclared identifier ***** ^ not supported yet 170 SetFilePtr(handle, FromStart, VAL(LONGINT,0)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 171 FileError := BlockWrite(handle, ADR(blocknum), 4); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 172 END; 173 DISPOSE(OldMemo); ***** ^ undeclared identifier ***** ^ not supported yet 174 ELSE 175 Replace(alias, fieldnum,' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 176 END; 177 END ReplaceM; ***** ^ not supported yet 178 179 BEGIN 180 END MemoFunctions. ***** ^ not supported yet 176 errors