| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794 |
- Listing:
- 1
- 2 IMPLEMENTATION MODULE ModBase3;
- 3
- 4 (*
- 5 * ModBase
- 6 * Release 3.0
- 7 * (c) Copyright 1986 - 1991 Donald G. Fletcher
- 8 * (c) Copyright 1986 - 1991 PMI
- 9 * P.O. Box 8402
- 10 * Green Bay Wi 53308
- 11 * All Rights Reserved
- 12 * August 6, 1987 - modifications to use Logitech 3.0
- 13 *)
- 14
- 15 (* This Module exports a type called DBFile which contains
- 16 pertinent information concerning the structure of the dBase
- 17 file. All operations on a dBase data file must specify this
- 18 parameter usually as an "alias" using the first 2 or 3 letters
- 19 of the dBase Filename. Date of Last Modification: April 16,
- 20 1987. Repertoire Input Output routines used.
- 21 *)
- 22
- 23 (* 5/11/88 added safety to modbase; if TRUE file integrity should
- 24 be preserved as long as the power doesn't fail during a write.
- 25 also added changes concerning memos to be finished later*)
- 26
- 27 (* 6/88 Changed to add transparent handling of memo files *)
- 28
- 29 (* 10/20/88 changes to add following:
- 30 Automatic updating of dbindexes
- 31 Made fieldlist a Pointer and only allocate as needed
- 32 saving quite a bit of memory
- 33 Added appending flag to speed append operations *)
- 34 (* Logitech modules*)
- 35
- 36
- 37 FROM M2Strings IMPORT
- 38 Assign,Pos;
- 39
- 40 FROM StrEdit IMPORT
- 41 Append;
- 42
- 43
- 44 FROM SYSTEM IMPORT
- 45 BYTE,ADDRESS, ADR, TSIZE;
- 46
- 47 (* Repertoire modules *)
- 48
- 49 IMPORT
- 50 EnvironUtils;
- 51 FROM StringIO IMPORT
- 52 ErrorMessage, NoError, PrintMessage;
- 53
- 54 FROM HandleIO IMPORT
- 55 BlockRead, BlockWrite, CloseHandle, OpenFile, SetFilePtr,
- 56 CreateFile,UpdateDisk, FileOffSet,GetFilePtr;
- 57
- 58 FROM LowLevel IMPORT
- 59 Address8086, Fill, Move, AddAddr;
- 60
- 61 FROM MiscFunctions IMPORT FieldNameChar,Alph;
- 62
- 63 FROM Numbers IMPORT
- 64 Min;
- 65
- 66 FROM ErrorManager IMPORT
- 67 WARN;
- 68
- 69 FROM VStorage IMPORT
- 70 DosAlloc, DosDealloc;
- 71
- 72 IMPORT Locks,FAPI;
- 73 IMPORT PosUtils;
- 74
- 75 PROCEDURE DEALLOCATE(VAR loc:ADDRESS;size:CARDINAL);
- 76 BEGIN
- 77 DosDealloc(loc,size);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 78 END DEALLOCATE;
- ***** ^ not supported yet
- 79
- 80 PROCEDURE ALLOCATE(VAR loc:ADDRESS;size:CARDINAL);
- 81 BEGIN
- 82 DosAlloc(loc,size);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 83 END ALLOCATE;
- ***** ^ not supported yet
- 84
- 85
- 86 CONST
- 87 Blank = " ";
- 88 Null = 0C;
- 89 EndOfHeader = 0DH;
- 90 HdrLenPos = 8;
- 91 DatePosition = 1; (* position of the first byte of the last update *)
- 92 RecNumLoPos = 4;
- 93 RecNumHiPos = 6;
- 94 FieldNameLength = 10;
- 95 InitCode =61353;
- 96 one=VAL( LONGINT, 1 );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 97
- 98 (* ************************* EXPORTED PROCEDURES **************************)
- 99 TYPE
- 100
- 101 DBFileRec =
- 102 RECORD
- 103 fileID,
- 104 MemoHandle: CARDINAL;
- 105 open,
- 106 MemoOpen,
- 107 (* will open only if accessed *)
- 108 Safety: BOOLEAN;
- 109 (* if true keeps disk up to date *)
- 110 autolock,
- 111 exclusive,
- 112 appending,
- 113 hasmemo: BOOLEAN;
- 114 recordmode:RecordModeType;
- ***** ^ undeclared identifier
- 115 fixup:FixUpProcedure;
- ***** ^ undeclared identifier
- 116 ErrorCode,
- 117 Init,
- 118 numberoffields: CARDINAL;
- 119 lastupdate: ARRAY[0..2] OF CARDINAL;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 120 length: CARDINAL; (* of records in BYTES *)
- 121 fieldlist: DBFieldPtr;
- ***** ^ undeclared identifier
- 122 numofrecords: LONGINT;
- 123 currentrecnum: LONGINT;
- 124 headerlength: CARDINAL;
- 125 ReReadPtr,SavePtr,currentrec,BufferPtr: POINTER TO ARRAY
- 126 [1..MaxRecLength] OF CHAR;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 127 name,
- 128 MemoName: ARRAY [0..NameLen] OF CHAR;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 129 dbbuffer : ADDRESS;
- 130 buffersize, (* requested size *)
- 131 size : CARDINAL; (* size of buffer in bytes *)
- 132 start : LONGINT; (* first record number *)
- 133 MaxRecords, NumRecords : CARDINAL;
- 134 IndexList:ADDRESS;
- 135 END;
- ***** ^ not supported yet
- 136 DBFile=POINTER TO DBFileRec;
- ***** ^ not supported yet
- 137
- 138 PROCEDURE DBError( alias:DBFile):CARDINAL;
- 139 BEGIN
- 140 RETURN alias^.ErrorCode;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 141 END DBError;
- ***** ^ not supported yet
- 142
- 143 PROCEDURE FileName(alias:DBFile;VAR Name:ARRAY OF CHAR);
- ***** ^ not supported yet
- 144 BEGIN
- 145 Assign(alias^.name,Name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 146 END FileName;
- ***** ^ not supported yet
- 147
- 148 PROCEDURE SafetySet(alias:DBFile):BOOLEAN;
- 149 BEGIN
- 150 RETURN alias^.Safety;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 151 END SafetySet;
- ***** ^ not supported yet
- 152
- 153 PROCEDURE RecordLength(alias:DBFile):CARDINAL;
- 154 BEGIN
- 155 RETURN alias^.length;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 156 END RecordLength;
- ***** ^ not supported yet
- 157
- 158 PROCEDURE HasMemo(alias:DBFile):BOOLEAN;
- 159 BEGIN
- 160 RETURN alias^.hasmemo;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 161 END HasMemo;
- ***** ^ not supported yet
- 162
- 163 PROCEDURE NumberOfFields(alias:DBFile):CARDINAL;
- 164 BEGIN
- 165 RETURN alias^.numberoffields;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 166 END NumberOfFields;
- ***** ^ not supported yet
- 167
- 168 PROCEDURE Appending(alias:DBFile):BOOLEAN;
- 169 BEGIN
- 170 RETURN alias^.appending;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 171 END Appending;
- ***** ^ not supported yet
- 172
- 173 PROCEDURE RecordPtr(alias:DBFile):ADDRESS;
- 174 BEGIN
- 175 RETURN alias^.currentrec;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 176 END RecordPtr;
- ***** ^ not supported yet
- 177
- 178 PROCEDURE IndexList(alias:DBFile):ADDRESS;
- 179 BEGIN
- 180 RETURN alias^.IndexList;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 181 END IndexList;
- ***** ^ not supported yet
- 182
- 183 PROCEDURE SetIndexList(alias:DBFile;ndx:ADDRESS);
- 184 BEGIN
- 185 alias^.IndexList:=ndx;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 186 END SetIndexList;
- ***** ^ not supported yet
- 187
- 188 PROCEDURE Record(alias:DBFile):LONGINT;
- 189 BEGIN
- 190 RETURN alias^.currentrecnum;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 191 END Record;
- ***** ^ not supported yet
- 192
- 193 PROCEDURE FieldList(alias:DBFile):DBFieldPtr;
- ***** ^ undeclared identifier
- 194 BEGIN
- 195 RETURN alias^.fieldlist;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 196 END FieldList;
- ***** ^ not supported yet
- 197
- 198 PROCEDURE BufferSize(alias:DBFile):CARDINAL;
- 199 BEGIN
- 200 RETURN alias^.buffersize;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 201 END BufferSize;
- ***** ^ not supported yet
- 202
- 203 PROCEDURE NumberRecords(alias:DBFile):LONGINT;
- 204 BEGIN
- 205 IF NOT alias^.exclusive THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 206 SetFilePtr( alias^.fileID, FromStart, VAL(LONGINT,4 ));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 207 PrintMessage(Locks.ReadRetry( alias^.fileID, ADR(alias^.numofrecords),
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 208 4,10,alias^.name ));
- ***** ^ not supported yet
- ***** ^ not supported yet
- 209 END;
- 210 RETURN alias^.numofrecords;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 211 END NumberRecords;
- ***** ^ not supported yet
- 212
- 213 PROCEDURE InitDBF(filename: ARRAY OF CHAR; VAR alias:
- ***** ^ not supported yet
- 214 DBFile; BufferSize:CARDINAL; safety,Exclusive,AutoLock:BOOLEAN;
- 215 FixUp:FixUpProcedure );
- ***** ^ undeclared identifier
- 216
- 217
- 218 BEGIN
- 219 NEW(alias);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 220 IF Exclusive THEN
- 221 AutoLock:= FALSE
- 222 END;
- 223 WITH alias^ DO
- ***** ^ not supported yet
- 224 open:=FALSE;
- ***** ^ undeclared identifier
- 225 exclusive:=Exclusive OR Locks.ExclusiveOnly;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 226 autolock:=AutoLock;
- ***** ^ undeclared identifier
- 227 fixup:=FixUp;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 228 MemoOpen:=FALSE;
- ***** ^ undeclared identifier
- 229 Safety:=safety;
- ***** ^ undeclared identifier
- 230 Init:=InitCode;
- ***** ^ undeclared identifier
- 231 Assign(filename,name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 232 fieldlist:=NIL;
- ***** ^ undeclared identifier
- 233 currentrec:=NIL;
- ***** ^ undeclared identifier
- 234 BufferPtr:=NIL;
- ***** ^ undeclared identifier
- 235 SavePtr:=NIL;
- ***** ^ undeclared identifier
- 236 ReReadPtr:=NIL;
- ***** ^ undeclared identifier
- 237 dbbuffer:=NIL;
- ***** ^ undeclared identifier
- 238 IndexList:=NIL;
- ***** ^ not supported yet
- 239 size:=0;
- ***** ^ undeclared identifier
- 240 buffersize:=BufferSize;
- ***** ^ undeclared identifier
- 241 recordmode:=CurrentRec;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 242 END;
- ***** ^ not supported yet
- 243
- 244 END InitDBF;
- ***** ^ not supported yet
- 245
- 246 PROCEDURE NilDBF(VAR alias:DBFile);
- 247 BEGIN
- 248 alias:=NIL;
- ***** ^ not supported yet
- 249 END NilDBF;
- ***** ^ not supported yet
- 250
- 251 PROCEDURE Initialized(alias:DBFile):BOOLEAN;
- 252 BEGIN
- 253 IF alias=NIL THEN RETURN FALSE END;
- ***** ^ not supported yet
- 254 IF alias^.Init=InitCode THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 255 RETURN TRUE
- 256 END;
- 257 RETURN FALSE;
- 258 END Initialized;
- ***** ^ not supported yet
- 259
- 260 PROCEDURE DisposeDBF(VAR alias:DBFile);
- 261 BEGIN
- 262 IF alias=NIL THEN RETURN END;
- ***** ^ not supported yet
- 263 IF alias^.open THEN CloseDBF(alias) END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 264 DISPOSE(alias);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 265 END DisposeDBF;
- ***** ^ not supported yet
- 266
- 267 PROCEDURE OpenMemo(alias:DBFile):BOOLEAN;
- 268 BEGIN
- 269 IF alias^.MemoOpen THEN RETURN TRUE END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 270 alias^.MemoOpen:=OpenFile(alias^.MemoHandle,alias^.MemoName)=0;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 271 RETURN alias^.MemoOpen;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 272 END OpenMemo;
- ***** ^ not supported yet
- 273
- 274 PROCEDURE MemoHandle(alias:DBFile):CARDINAL;
- 275 BEGIN
- 276 RETURN alias^.MemoHandle;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 277 END MemoHandle;
- ***** ^ not supported yet
- 278
- 279 PROCEDURE SetDBSafetyOn( alias: DBFile);
- 280 BEGIN
- 281 UpdateDBFile(alias);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 282 alias^.Safety:=TRUE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 283 END SetDBSafetyOn;
- ***** ^ not supported yet
- 284
- 285 PROCEDURE SetDBSafetyOff( alias: DBFile);
- 286 BEGIN
- 287 alias^.Safety:=FALSE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 288 END SetDBSafetyOff;
- ***** ^ not supported yet
- 289
- 290 PROCEDURE SetRecordMode(alias: DBFile;Mode:RecordModeType);
- ***** ^ undeclared identifier
- 291 BEGIN
- 292 IF alias^.recordmode=Mode THEN RETURN END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 293 IF alias^.recordmode=CurrentRec
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 294 THEN
- 295 alias^.SavePtr:=alias^.currentrec;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 296 END;
- 297 CASE Mode OF
- ***** ^ not supported yet
- 298 CurrentRec: alias^.currentrec:=alias^.SavePtr;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 299 |Buffer: alias^.currentrec:=alias^.BufferPtr;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 300 |ReRead: alias^.currentrec:=alias^.ReReadPtr
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 301 END;
- 302 alias^.recordmode:=Mode;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 303 END SetRecordMode;
- ***** ^ not supported yet
- 304
- 305
- 306 PROCEDURE OpenDBF
- 307 (alias : DBFile ):BOOLEAN;
- 308
- 309
- 310 VAR
- 311 firstbyte : CHAR;
- 312 i :CARDINAL;
- 313 ActionTaken:CARDINAL;
- 314 filemode:BITSET;
- ***** ^ undeclared identifier
- 315
- 316
- 317
- 318 PROCEDURE MakeDBFile;
- 319
- 320 VAR
- 321 dbh : ARRAY[ 0 .. MaxHeaderLen - 1 ] OF CHAR;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 322
- 323
- 324 PROCEDURE ReadDBHeader;
- 325 (* HeaderLength must always be 32n+2 where n is a number equal to one
- 326 more than the number of fields in the record *)
- 327
- 328 BEGIN
- 329 SetFilePtr( alias^.fileID, FromStart, VAL( LONGINT, HdrLenPos ) );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 330 PrintMessage( Locks.ReadRetry( alias^.fileID, ADR( alias^.headerlength ), 2 ,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 331 10,alias^.name));
- ***** ^ not supported yet
- ***** ^ not supported yet
- 332 SetFilePtr( alias^.fileID, FromStart, VAL( LONGINT, 0 ) );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 333 PrintMessage(Locks.ReadRetry( alias^.fileID, ADR( dbh ), alias^.headerlength,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 334 10,alias^.name ));
- ***** ^ not supported yet
- ***** ^ not supported yet
- 335 END ReadDBHeader;
- ***** ^ not supported yet
- 336
- 337
- 338 PROCEDURE GetLastUpdate;
- 339
- 340 VAR
- 341 i : CARDINAL;
- 342
- 343 BEGIN
- 344 FOR i := 0 TO 2 DO
- 345 alias^.lastupdate[i] := ORD( dbh[1 + i] );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 346 END; (* for *)
- 347 END GetLastUpdate;
- ***** ^ not supported yet
- 348
- 349
- 350 PROCEDURE GetNumberOfRecords;
- 351
- 352 BEGIN
- 353 Move( ADR( dbh[4] ), ADR( alias^.numofrecords ), 4 )
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 354 END GetNumberOfRecords;
- ***** ^ not supported yet
- 355
- 356
- 357 PROCEDURE GetHeaderLength;
- 358
- 359 BEGIN
- 360 alias^.headerlength := ( ORD( dbh[9] ) * 100H ) + ORD( dbh[8] );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 361 END GetHeaderLength;
- ***** ^ not supported yet
- 362
- 363
- 364 PROCEDURE GetRecordLength;
- 365
- 366 BEGIN
- 367 alias^.length := ( ORD( dbh[11] ) * 100H ) + ORD( dbh[10] );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 368 END GetRecordLength;
- ***** ^ not supported yet
- 369
- 370
- 371 PROCEDURE GetFieldList;
- 372
- 373 VAR
- 374 j,
- 375 k,
- 376 fieldindex : CARDINAL;
- 377 finished : BOOLEAN;
- 378
- 379
- 380 PROCEDURE InitFieldList;
- 381
- 382 BEGIN
- 383 FOR j := 1 TO alias^.numberoffields DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- 384 Fill( ADR( alias^.fieldlist^[j].name ), FieldNameLength, 0C );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 385 alias^.fieldlist^[j].fldtype := " ";
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 386 alias^.fieldlist^[j].size := 0;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 387 alias^.fieldlist^[j].decplaces := 0;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 388 alias^.fieldlist^[j].offset := 0;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 389 (* index position in CurrentRecord *)
- 390 END; (* FOR *)
- 391 END InitFieldList;
- ***** ^ not supported yet
- 392
- 393 BEGIN
- 394 alias^.numberoffields:= (alias^.headerlength DIV 32)-1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 395 ALLOCATE(alias^.fieldlist,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 396 (TSIZE(DBFieldArray)DIV MaxField)*(alias^.numberoffields));
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 397 InitFieldList;
- ***** ^ not supported yet
- 398 alias^.fieldlist^[1].offset := 2;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 399 finished := FALSE;
- 400 FOR j:=1 TO alias^.numberoffields DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- 401 fieldindex := ( j - 1 ) * 32;
- 402 k := 0;
- 403 Move( ADR( dbh[32 + fieldindex] ), ADR( alias^.fieldlist^[j].name ),
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 404 FieldNameLength );
- ***** ^ not supported yet
- 405 alias^.fieldlist^[j].fldtype := dbh[43 + fieldindex];
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 406 alias^.fieldlist^[j].size := ORD( dbh[48 + fieldindex] );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 407 (* Get fieldsize *)
- 408 alias^.fieldlist^[j].decplaces := ORD( dbh[49 + fieldindex] );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 409 (* Get number of decimal places *)
- 410 IF j > 1
- 411 THEN
- 412 alias^.fieldlist^[j].offset := alias^.fieldlist^[j - 1].offset +
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 413 alias^.fieldlist^[j - 1].size;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 414 END; (* IF *)
- 415 END; (* for *)
- 416 END GetFieldList;
- ***** ^ not supported yet
- 417
- 418 BEGIN (* MakeDBFile *)
- 419 ReadDBHeader;
- ***** ^ not supported yet
- 420 (* Fill out the Record *)
- 421 GetNumberOfRecords;
- ***** ^ not supported yet
- 422 GetLastUpdate;
- ***** ^ not supported yet
- 423 GetRecordLength;
- ***** ^ not supported yet
- 424 GetHeaderLength;
- ***** ^ not supported yet
- 425 GetFieldList;
- ***** ^ not supported yet
- 426 END MakeDBFile;
- ***** ^ not supported yet
- 427
- 428 (* Procedure Description -- OpendBF -- Looks up a file with the parameter
- 429 given as a name -- Checks to see if it is a dBaseIII type file --
- 430 Creates a record of the type DBFile containing the pertinent information
- 431 from the header of the dBase File -- If the file is already opened it
- 432 does nothing *)
- 433
- 434 BEGIN (* OpenDBF *)
- 435 IF alias^.Init=InitCode
- ***** ^ not supported yet
- ***** ^ not supported yet
- 436 THEN
- 437 IF alias^.open
- ***** ^ not supported yet
- ***** ^ not supported yet
- 438 THEN
- 439 RETURN TRUE;
- 440 END;
- 441 ELSE
- 442 WARN('UnInititalized DBFile In OpenDBF');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 443 END;
- 444 IF alias^.exclusive THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 445 filemode:={1,4}
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 446 ELSE
- 447 filemode:={1,6} (* allow all *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 448 END;
- 449 alias^.ErrorCode := FAPI.DOSOPEN( ADR(alias^.name),
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 450 ADR(alias^.fileID), ADR(ActionTaken), VAL(LONGINT,0), FAPI.FILE_NORMAL,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 451 CARDINAL({0}), CARDINAL(filemode), VAL(LONGINT,0) );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 452
- 453 IF alias^.ErrorCode # NoError
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 454 THEN
- 455 RETURN FALSE;
- 456 END;
- 457 IF (NOT alias^.exclusive) AND Locks.NoLocking(alias^.fileID) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 458 alias^.exclusive:=TRUE
- ***** ^ not supported yet
- ***** ^ not supported yet
- 459 END;
- 460
- 461 (* make sure the file is a dBase file *)
- 462 IF NoError # Locks.ReadRetry( alias^.fileID, ADR( firstbyte ), 1,10,alias^.name )
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 463 THEN
- 464 RETURN FALSE
- 465 END;
- 466 IF ( firstbyte = CHR( 03H ) )
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 467 THEN
- 468 alias^.hasmemo := FALSE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 469 alias^.open := TRUE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 470 ELSIF ( firstbyte = CHR( 83H ) )
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 471 THEN
- 472 alias^.hasmemo := TRUE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 473 alias^.open := TRUE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 474 ELSE
- 475 alias^.ErrorCode := CloseHandle( alias^.fileID );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 476 alias^.open := FALSE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 477 RETURN FALSE;
- 478 (* WARN( "File is not a dBase III - type file -- proc-OpenDBF3" );*)
- 479 END; (* IF *)
- 480 (* construct a dBFileDesc *)
- 481 IF alias^.open
- ***** ^ not supported yet
- ***** ^ not supported yet
- 482 THEN
- 483 MakeDBFile;
- ***** ^ not supported yet
- 484 IF alias^.autolock THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 485 ALLOCATE( alias^.ReReadPtr, alias^.length );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 486 END;
- 487 ALLOCATE( alias^.currentrec, alias^.length );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 488 IF alias^.numofrecords=VAL(LONGINT,0)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 489 THEN
- 490 alias^.currentrecnum:=VAL(LONGINT,0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 491 ELSE
- 492 alias^.currentrecnum:=VAL(LONGINT,1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 493 END;
- 494 alias^.NumRecords := 0 ;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 495 alias^.start := VAL( LONGINT, 0 );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 496 alias^.size := 0;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 497 SetDBBuffer(alias,alias^.buffersize);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 498 IF alias^.hasmemo THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 499 alias^.MemoOpen:=FALSE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 500 Assign(alias^.name,alias^.MemoName);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 501 i:=Pos( ".", alias^.MemoName);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 502 IF i<=HIGH(alias^.MemoName) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 503 alias^.MemoName[i]:=0C;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 504 END;
- 505 Append(alias^.MemoName,'.DBT' );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 506 END;
- 507 END; (* IF alias^.open *)
- 508 RETURN TRUE;
- 509 END OpenDBF;
- ***** ^ not supported yet
- 510
- 511 PROCEDURE SetDBBuffer(alias:DBFile ;BufferSize:CARDINAL );
- 512
- 513 BEGIN
- 514 alias^.buffersize:=BufferSize;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 515 IF alias^.open THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 516 IF alias^.size#0
- ***** ^ not supported yet
- ***** ^ not supported yet
- 517 THEN
- 518 DEALLOCATE(alias^.dbbuffer, alias^.size );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 519 END;
- 520 (* calculate buffer size *)
- 521 alias^.MaxRecords := BufferSize DIV alias^.length ;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 522 IF alias^.MaxRecords=0
- ***** ^ not supported yet
- ***** ^ not supported yet
- 523 THEN
- 524 alias^.MaxRecords:=1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 525 END;
- 526 alias^.size := alias^.MaxRecords *
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 527 alias^.length;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 528
- 529 ALLOCATE( alias^.dbbuffer, alias^.size );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 530 alias^.start:=VAL(LONGINT,0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 531 alias^.NumRecords:=0;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 532 IF alias^.numofrecords > VAL( LONGINT, 0 )
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 533 THEN
- 534 ReadDBRec( alias, alias^.currentrecnum );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 535 (* read the currentrecord *)
- 536 ELSE
- 537 alias^.BufferPtr:=alias^.dbbuffer;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 538 Fill( alias^.currentrec, alias^.length, 0C );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 539 Fill( alias^.BufferPtr, alias^.length, 0C );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 540 END (* if alias^.numofrecords *);
- 541 END;
- 542 END SetDBBuffer;
- ***** ^ not supported yet
- 543
- 544 PROCEDURE UpdateDBHeader( alias :DBFile );
- 545 VAR
- 546 month,
- 547 day,
- 548 year : CARDINAL;
- 549 datestr : ARRAY[ 1 .. 3 ] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 550 dumstr : ARRAY[ 0 .. 15 ] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 551 lock:Locks.RangeRec;
- ***** ^ not supported yet
- 552
- 553 BEGIN
- 554 IF NOT alias^.open
- ***** ^ not supported yet
- ***** ^ not supported yet
- 555 THEN
- 556 RETURN;
- 557 END (* if not alias^.open *);
- 558 IF NOT alias^.exclusive THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 559 lock.FileOffset := VAL( LONGINT,0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 560 lock.RangeLength:=VAL(LONGINT,32);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 561 alias^.ErrorCode:=Locks.LockRetry(alias^.fileID,lock,10,alias^.name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 562 IF alias^.ErrorCode#0 THEN WARN('Unable to lock in UpdateDBHeader') END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 563 END;
- 564 EnvironUtils.GetDate( month, day, year, dumstr, dumstr );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 565 alias^.numofrecords := NumberRecords(alias);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 566 SetFilePtr( alias^.fileID, FromStart, VAL( LONGINT, DatePosition ) );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 567 datestr[1] := CHR( year MOD 100 );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 568 datestr[2] := CHR( month );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 569 datestr[3] := CHR( day );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 570 alias^.ErrorCode := BlockWrite( alias^.fileID, ADR( datestr ), 3 );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 571 alias^.ErrorCode := BlockWrite( alias^.fileID, ADR( alias^.numofrecords ), 4 );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 572 alias^.ErrorCode := BlockWrite( alias^.fileID, ADR( alias^.headerlength ), 2 );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 573 IF NOT alias^.exclusive THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 574 alias^.ErrorCode:=Locks.UnLock(alias^.fileID,lock);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 575 IF alias^.ErrorCode#0 THEN WARN('Unable to Unlock in UpdateDBHeader') END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 576 END;
- 577
- 578 END UpdateDBHeader;
- ***** ^ not supported yet
- 579
- 580 PROCEDURE UpdateDBFile(alias :DBFile);
- 581
- 582 BEGIN
- 583 IF alias^.open
- ***** ^ not supported yet
- ***** ^ not supported yet
- 584 THEN
- 585 UpdateDBHeader(alias);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 586 UpdateDisk(alias^.fileID);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 587 IF alias^.MemoOpen
- ***** ^ not supported yet
- ***** ^ not supported yet
- 588 THEN
- 589 UpdateDisk(alias^.MemoHandle);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 590 END;
- 591 END;
- 592 END UpdateDBFile;
- ***** ^ not supported yet
- 593
- 594 PROCEDURE CloseDBF
- 595 ( alias : DBFile );
- 596 (* updates the header and closes the file *)
- 597
- 598 BEGIN
- 599 IF alias = NIL THEN
- ***** ^ not supported yet
- 600 RETURN
- 601 END;
- 602 IF NOT alias^.open
- ***** ^ not supported yet
- ***** ^ not supported yet
- 603 THEN
- 604 RETURN;
- 605 END (* if not alias^.open *);
- 606 UpdateDBHeader(alias);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 607 DEALLOCATE(alias^.fieldlist,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 608 (TSIZE(DBFieldArray)DIV MaxField)*(alias^.numberoffields));
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 609 DEALLOCATE( alias^.dbbuffer, alias^.size );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 610 DEALLOCATE( alias^.currentrec, alias^.length );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 611 IF alias^.autolock THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 612 DEALLOCATE( alias^.ReReadPtr, alias^.length );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 613 END;
- 614 alias^.ErrorCode := CloseHandle( alias^.fileID );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 615 IF alias^.MemoOpen
- ***** ^ not supported yet
- ***** ^ not supported yet
- 616 THEN
- 617 alias^.ErrorCode := CloseHandle( alias^.MemoHandle );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 618 alias^.MemoOpen := FALSE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 619 END;
- 620 alias^.open := FALSE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 621 END CloseDBF;
- ***** ^ not supported yet
- 622
- 623 (*$O- *)
- 624
- 625 PROCEDURE ReadDBRec
- 626 (alias : DBFile;
- 627 recnum : LONGINT );
- 628 (* deposits the fetched string in the currentrec field of alias *)
- 629 CONST
- 630 one=VAL( LONGINT, 1 );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 631
- 632 VAR
- 633 recordpos : LONGINT;
- 634 i,
- 635 temp :CARDINAL;
- 636 long1,long2 :LONGINT;
- 637 test :BOOLEAN;
- 638
- 639 BEGIN
- 640 IF NOT alias^.open
- ***** ^ not supported yet
- ***** ^ not supported yet
- 641 THEN (* check to make sure the file is open *)
- 642 WARN('DBF file not open in ReadDBFile');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 643 END;
- 644 alias^.appending:=FALSE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 645 (* compiler bug forced braking down *)
- 646 long1:= recnum - alias^.start;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 647 long2:=VAL(LONGINT,alias^.NumRecords) - VAL(LONGINT,1);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 648 test:=(long1 >
- 649 long2 );
- 650 IF ( long1<VAL(LONGINT,0) ) OR test
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 651 THEN (* is not in buffer *)
- 652 IF ( recnum > alias^.numofrecords ) OR
- ***** ^ not supported yet
- ***** ^ not supported yet
- 653 (recnum=VAL(LONGINT,0))
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 654 THEN
- 655 WARN( "Record number out of range in ReadDBRec" )
- ***** ^ not supported yet
- ***** ^ not supported yet
- 656 END; (* IF *)
- 657 IF VAL(LONGINT,alias^.MaxRecords) > alias^.numofrecords
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 658 THEN (* underflow *)
- 659 alias^.start := one;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 660 alias^.NumRecords := VAL(CARDINAL,alias^.numofrecords);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 661 ELSE
- 662 alias^.NumRecords := alias^.MaxRecords;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 663 IF recnum < alias^.start
- ***** ^ not supported yet
- ***** ^ not supported yet
- 664 THEN (* currec at top going down *)
- 665 IF recnum > VAL(LONGINT,alias^.MaxRecords)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 666 THEN
- 667 alias^.start := recnum - VAL(LONGINT,alias^.MaxRecords) + one;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 668 (* 2 to give 1 overlap ??*)
- 669 ELSE
- 670 alias^.start := one;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 671 END (* if recnum *);
- 672 ELSE (* recnum at bottom going up*)
- 673 IF ( recnum + VAL(LONGINT,alias^.MaxRecords) - one ) >
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 674 alias^.numofrecords
- ***** ^ not supported yet
- ***** ^ not supported yet
- 675 THEN
- 676 alias^.start := alias^.numofrecords - VAL(LONGINT,alias^.MaxRecords)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 677 + one;
- 678 ELSE
- 679 alias^.start := recnum;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 680 END ;
- 681 END ;
- 682 END;
- 683 recordpos := ( alias^.start - one ) *
- ***** ^ not supported yet
- ***** ^ not supported yet
- 684 VAL( LONGINT,alias^.length ) + VAL( LONGINT, alias^.headerlength );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 685 SetFilePtr( alias^.fileID, FromStart, VAL( LONGINT, recordpos ) );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 686 PrintMessage( Locks.ReadRetry( alias^.fileID, alias^.dbbuffer ,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 687 alias^.length * alias^.NumRecords ,10,alias^.name ));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 688 END (* if *);
- 689 recordpos:=recnum - alias^.start;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 690 i:=VAL( CARDINAL, recordpos );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 691 temp:=alias^.length * i;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 692 alias^.BufferPtr := AddAddr( alias^.dbbuffer, temp);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 693 (* Make copy of buffer *)
- 694 Move(alias^.BufferPtr,alias^.currentrec,alias^.length);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 695
- 696 alias^.currentrecnum := recnum;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 697 alias^.appending:=FALSE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 698 END ReadDBRec;(*$O= *)
- ***** ^ not supported yet
- 699
- 700 PROCEDURE CompareBlock( adr1,adr2:ADDRESS;size:CARDINAL):CARDINAL;
- 701 VAR
- 702 count:CARDINAL;
- 703 p1,p2:Address8086;
- 704 BEGIN
- 705 count:=0;
- 706 p1.a:=adr1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 707 p2.a:=adr2;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 708 WHILE count<size
- 709 DO
- 710 IF p1.b^#p2.b^
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 711 THEN
- 712 RETURN count;
- 713 END;
- 714 INC(count);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 715 INC(p1.off);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 716 INC(p2.off);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 717 END (* while *);
- 718 RETURN count;
- 719 END CompareBlock;
- ***** ^ not supported yet
- 720
- 721
- 722 PROCEDURE WriteDBRec
- 723 ( alias : DBFile );
- 724
- 725 VAR
- 726 lock:Locks.RangeRec;
- ***** ^ not supported yet
- 727 recordpos : LONGINT;
- 728 NeedToWrite:BOOLEAN;
- 729 BEGIN
- 730 IF NOT alias^.open
- ***** ^ not supported yet
- ***** ^ not supported yet
- 731 THEN (* check to make sure the file is open *)
- 732 WARN('DBFile not open in WriteDBRec');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 733 END;
- 734 IF alias^.appending THEN (* if appending we have to prepare*)
- ***** ^ not supported yet
- ***** ^ not supported yet
- 735 IF NOT alias^.exclusive THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 736 lock.FileOffset := VAL( LONGINT,0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 737 lock.RangeLength:=VAL(LONGINT,32);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 738 alias^.ErrorCode:=Locks.LockRetry(alias^.fileID,lock,10,alias^.name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 739 IF alias^.ErrorCode#0 THEN WARN('Unable to lock in Header in WriteDBRec') END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 740 SetFilePtr( alias^.fileID, FromStart, VAL(LONGINT,4 ));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 741 alias^.ErrorCode := BlockRead( alias^.fileID, ADR(alias^.numofrecords),
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 742 4 );
- ***** ^ not supported yet
- 743 END;
- 744 INC( alias^.numofrecords );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 745 alias^.currentrecnum := alias^.numofrecords;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 746 alias^.start:=alias^.numofrecords;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 747 IF NOT alias^.exclusive THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 748 SetFilePtr( alias^.fileID, FromStart, VAL(LONGINT,4 ));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 749 alias^.ErrorCode := BlockWrite( alias^.fileID, ADR(alias^.numofrecords),
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 750 4 );
- ***** ^ not supported yet
- 751 END;
- 752
- 753 IF alias^.Safety
- ***** ^ not supported yet
- ***** ^ not supported yet
- 754 THEN
- 755 UpdateDisk(alias^.fileID);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 756 END;
- 757
- 758 END;
- 759 IF alias^.autolock AND (LockRec(alias,alias^.currentrecnum)#0) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 760 WARN('LockRec Failure in WriteDBRec')
- ***** ^ not supported yet
- ***** ^ not supported yet
- 761 END;
- 762 recordpos := ( alias^.currentrecnum - one ) * VAL( LONGINT,alias^.length
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 763 ) + VAL( LONGINT, alias^.headerlength );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 764 IF alias^.appending THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 765 NeedToWrite:=TRUE;
- 766 (* unlock header only after locking record *)
- 767 IF NOT alias^.exclusive THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 768 alias^.ErrorCode:=Locks.UnLock(alias^.fileID,lock);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 769 IF alias^.ErrorCode#0 THEN WARN('Unable to unlock Header in WriteDBRec') END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 770 END;
- 771 ELSE
- 772 NeedToWrite:=CompareBlock(alias^.currentrec,alias^.BufferPtr,alias^.length)<
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 773 alias^.length;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 774 IF alias^.autolock AND NeedToWrite THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 775 SetFilePtr( alias^.fileID, FromStart, recordpos );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 776 PrintMessage( BlockRead( alias^.fileID, alias^.ReReadPtr ,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 777 alias^.length ));
- ***** ^ not supported yet
- ***** ^ not supported yet
- 778 IF CompareBlock(alias^.ReReadPtr,alias^.BufferPtr,alias^.length)<
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 779 alias^.length
- ***** ^ not supported yet
- ***** ^ not supported yet
- 780 THEN
- 781 NeedToWrite:=alias^.fixup(alias);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 782 (* we update BufferPtr so Update of indexes works *)
- 783 Move(alias^.ReReadPtr,alias^.BufferPtr,alias^.length);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 784 ELSE
- 785 NeedToWrite:=TRUE; (*File was not changed *)
- 786 END;
- 787 END;
- 788
- 789 END (*alias^.appendinng*);
- 790 IF NeedToWrite THEN
- 791 (* Find the file position for the BEGINNING of the record *)
- 792 SetFilePtr( alias^.fileID, FromStart, recordpos );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 793 (* Write the current record *)
- 794 alias^.ErrorCode := BlockWrite( alias^.fileID, alias^.currentrec ,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 795 alias^.length );
- ***** ^ not supported yet
- ***** ^ not supported yet
- 796 IF alias^.IndexList#NIL
- ***** ^ not supported yet
- ***** ^ not supported yet
- 797 THEN (* most do this before modifying Buffer*)
- 798 UpDateIndexes(alias);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 799 END;
- 800 (* copy into buffer *)
- 801 Move(alias^.currentrec,alias^.BufferPtr,alias^.length);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 802 IF alias^.Safety
- ***** ^ not supported yet
- ***** ^ not supported yet
- 803 THEN
- 804 UpdateDisk(alias^.fileID);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 805 IF alias^.MemoOpen
- ***** ^ not supported yet
- ***** ^ not supported yet
- 806 THEN
- 807 UpdateDisk(alias^.MemoHandle);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 808 END;
- 809 END;
- 810 END(* needtowrite*);
- 811 IF alias^.autolock AND (UnLockRec(alias,alias^.currentrecnum)#0) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 812 WARN('UnLockRec Failure in WriteDBF')
- ***** ^ not supported yet
- ***** ^ not supported yet
- 813 END;
- 814 alias^.appending:=FALSE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 815 END WriteDBRec;
- ***** ^ not supported yet
- 816
- 817
- 818 PROCEDURE GetField
- 819 ( alias : DBFile;
- 820 fieldnumber : CARDINAL;
- 821 VAR field : ARRAY OF CHAR );
- ***** ^ not supported yet
- 822 (* operates on the currently active record *)
- 823
- 824 VAR
- 825 limit : CARDINAL;
- 826
- 827 BEGIN
- 828 (* Find offset of field *)
- 829 IF ( fieldnumber <= alias^.numberoffields ) AND ( fieldnumber > 0 )
- ***** ^ not supported yet
- ***** ^ not supported yet
- 830 THEN
- 831 WITH alias^.fieldlist^[fieldnumber] DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 832 limit := Min( HIGH( field )+1, size );
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 833 Move( ADR( alias^.currentrec^[ offset] ),
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 834 ADR( field ), limit );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 835 END;
- ***** ^ not supported yet
- 836 IF ( limit <= HIGH( field ) )
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 837 THEN
- 838 field[limit] := 0C
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 839 END (* if *);
- 840 ELSE
- 841 WARN('Ilegal field number in GetField');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 842 END; (* IF *)
- 843 END GetField;
- ***** ^ not supported yet
- 844
- 845 PROCEDURE Replace(alias: DBFile; fieldnumber: CARDINAL;
- 846 field: ARRAY OF CHAR);
- ***** ^ not supported yet
- 847 VAR j, k: CARDINAL;
- 848 EndOfStr: BOOLEAN;
- 849 BEGIN
- 850 EndOfStr := FALSE;
- 851 k := 0;
- 852 WITH alias^.fieldlist^[fieldnumber] DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 853 FOR j := (offset) TO
- ***** ^ undeclared identifier
- 854 (offset
- ***** ^ undeclared identifier
- 855 + size - 1) DO
- ***** ^ undeclared identifier
- ***** ^ FOR needs integer variable and bounds
- 856 IF NOT EndOfStr THEN
- 857 IF (k <= HIGH(field)) AND (field[k] # 0C) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 858 alias^.currentrec^[j] := field[k];
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 859 ELSE
- 860 EndOfStr := TRUE;
- 861 alias^.currentrec^[j] := ' ';
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 862 END;
- 863 ELSE
- 864 alias^.currentrec^[j] := ' ';
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 865 END;
- 866 INC(k);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 867 END; (* FOR *)
- 868 END;
- ***** ^ not supported yet
- 869 END Replace;
- ***** ^ not supported yet
- 870
- 871 PROCEDURE PosOfField(alias: DBFile; fieldname: ARRAY OF CHAR): CARDINAL;
- ***** ^ not supported yet
- 872 VAR i: CARDINAL;
- 873 BEGIN
- 874 i := 1;
- 875 (* field names are null terminated *)
- 876 WHILE (i <= alias^.numberoffields) AND (NOT PosUtils.Equal(fieldname,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 877
- 878 alias^.fieldlist^[i].name)) DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 879 INC(i);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 880 END;
- 881 IF i > alias^.numberoffields THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 882 i := 0;
- 883 END;
- 884 RETURN i;
- 885 END PosOfField;
- ***** ^ not supported yet
- 886
- 887 (* $O- *)
- 888
- 889 PROCEDURE AppendBlank
- 890 ( alias : DBFile );
- 891
- 892
- 893 BEGIN
- 894 IF NOT alias^.open
- ***** ^ not supported yet
- ***** ^ not supported yet
- 895 THEN (* check to make sure the file is open *)
- 896 WARN('DBFile not open in Append Blank');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 897 END;
- 898 (* set buffer values *)
- 899 alias^.appending:=TRUE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 900 alias^.NumRecords:=1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 901 alias^.BufferPtr:=alias^.dbbuffer;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 902 alias^.currentrecnum:=MAX(LONGINT);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 903 (* Write Recordsize number of blanks *)
- 904 Fill( alias^.currentrec, alias^.length, Blank );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 905 END AppendBlank;
- ***** ^ not supported yet
- 906
- 907 (* $O= *)
- 908
- 909
- 910 PROCEDURE DeleteRecord
- 911 ( alias : DBFile );
- 912
- 913 BEGIN
- 914 alias^.currentrec^[1] := '*';
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 915 WriteDBRec( alias );
- ***** ^ not supported yet
- ***** ^ not supported yet
- 916 END DeleteRecord;
- ***** ^ not supported yet
- 917
- 918
- 919 PROCEDURE UnDeleteRecord
- 920 ( alias : DBFile );
- 921
- 922 BEGIN
- 923 alias^.currentrec^[1] := Blank;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 924 WriteDBRec( alias );
- ***** ^ not supported yet
- ***** ^ not supported yet
- 925 END UnDeleteRecord;
- ***** ^ not supported yet
- 926
- 927
- 928 PROCEDURE Deleted
- 929 ( alias : DBFile ) : BOOLEAN;
- 930
- 931 BEGIN
- 932 RETURN alias^.currentrec^[1] = '*';
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 933 END Deleted;
- ***** ^ not supported yet
- 934
- 935 PROCEDURE LockRec(alias: DBFile;recnum:LONGINT):CARDINAL;
- 936 VAR
- 937 lock:Locks.RangeRec;
- ***** ^ not supported yet
- 938 BEGIN
- 939 lock.FileOffset := ( recnum -one) *
- ***** ^ not supported yet
- ***** ^ not supported yet
- 940 VAL( LONGINT,alias^.length ) + VAL( LONGINT, alias^.headerlength );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 941 lock.RangeLength:=VAL(LONGINT,alias^.length);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 942 RETURN Locks.LockRetry(alias^.fileID,lock,10,alias^.name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 943 END LockRec;
- ***** ^ not supported yet
- 944
- 945 PROCEDURE UnLockRec(alias: DBFile;recnum:LONGINT):CARDINAL;
- 946 VAR
- 947 lock:Locks.RangeRec;
- ***** ^ not supported yet
- 948 BEGIN
- 949 lock.FileOffset := ( recnum -one) *
- ***** ^ not supported yet
- ***** ^ not supported yet
- 950 VAL( LONGINT,alias^.length ) + VAL( LONGINT, alias^.headerlength );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 951 lock.RangeLength:=VAL(LONGINT,alias^.length);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 952 RETURN Locks.UnLock(alias^.fileID,lock);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 953 END UnLockRec;
- ***** ^ not supported yet
- 954
- 955 PROCEDURE InitMemo(handle:CARDINAL) ;
- 956 VAR
- 957 buf:ARRAY[0..511] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 958 i :CARDINAL;
- 959 BEGIN
- 960 FOR i:=1 TO 511 DO
- 961 buf[i]:=0C;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 962 END (* for *);
- 963 buf[0]:=1C;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 964 PrintMessage(BlockWrite(handle,ADR(buf),512));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 965 END InitMemo;
- ***** ^ not supported yet
- 966
- 967
- 968 PROCEDURE BuildDBF( fields: ARRAY OF
- 969 DBFieldDescriptor;NumFields:CARDINAL; alias: DBFile):CARDINAL;
- ***** ^ undeclared identifier
- 970
- 971 (* THIS PROCEDURE WILL SILENTLY OVERWRITE ANY FILE WITH THE
- 972 SAME NAME AS filename -- When used in a program, the
- 973 existing files must be checked and an appropriate warning
- 974 should be given. *)
- 975 (* THIS PROCEDURE DOES NOT CLOSE THE CREATED FILE -- CloseDBF
- 976 must be called to close the file *)
- 977 (* The procedure is to read each field descriptor in the
- 978 array until an illegal name (ie. any name that doesn't
- 979 begin with a letter) is encountered) *)
- 980 (* NOTE THAT FIELDNAMES IN DBASE3 ARE PADDED WITH 0C *)
- 981
- 982 VAR month, day, year, i, j,
- 983 ActionTaken, offset: CARDINAL;
- 984 dumstr, zstr: ARRAY [1..50] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 985 (* zstr is initialized to nulls (0C) and used with
- 986 HandleIO.BlockWrite to write blanks to the
- 987 file *)
- 988 tmpchar: CHAR; (* used to write CHAR values with BlockWrite *)
- 989 filemode:BITSET;
- ***** ^ undeclared identifier
- 990 longtmp: LONGINT; (* used to avoid Function Type Coercion *)
- 991 BEGIN
- 992 IF alias^.Init#InitCode
- ***** ^ not supported yet
- ***** ^ not supported yet
- 993 THEN
- 994 WARN('Unitalized DBF in DBCreate')
- ***** ^ not supported yet
- ***** ^ not supported yet
- 995 END;
- 996 alias^.exclusive:=TRUE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 997 alias^.hasmemo := FALSE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 998 alias^.length := 1; (* even with no fields, the length is 1 *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- 999 alias^.headerlength := 0;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1000 alias^.numofrecords := VAL(LONGINT,0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1001 alias^.currentrecnum:= VAL(LONGINT,0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1002 alias^.open := TRUE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1003 EnvironUtils.GetDate( month, day, year, dumstr, dumstr );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1004 (* open exclusive *)
- 1005 (* create if the file does not exist; truncate if it does exist *)
- 1006 IF alias^.exclusive THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1007 filemode:={1,4}
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1008 ELSE
- 1009 filemode:={1,6} (* allow all *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1010 END;
- 1011 alias^.ErrorCode := FAPI.DOSOPEN( ADR(alias^.name),
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1012 ADR(alias^.fileID), ADR(ActionTaken), VAL(LONGINT,0),
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1013 FAPI.FILE_NORMAL, CARDINAL({1,4}), CARDINAL(filemode),
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1014 VAL(LONGINT,0) );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1015 IF alias^.ErrorCode#0 THEN RETURN alias^.ErrorCode END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1016 Fill(ADR(zstr),HIGH(zstr), 0C);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1017 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(zstr),32);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1018 (* Initialize the first 32 bytes of the header structure *)
- 1019 i := 0;
- 1020 offset := 2;
- 1021 WHILE (i <= HIGH(fields)) AND
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1022 (i<NumFields) AND Alph(fields[i].name[0]) DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1023 fields[i].offset := offset;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1024 FOR j := 0 TO 9 DO
- 1025 IF FieldNameChar(fields[i].name[j]) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1026 alias^.ErrorCode := BlockWrite(alias^.fileID,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1027 ADR(fields[i].name[j]), 1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1028 ELSE
- 1029 alias^.ErrorCode := BlockWrite(alias^.fileID,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1030 ADR(zstr), 1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1031 END;
- 1032 END; (* for *)
- 1033 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(zstr),
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1034 1); (* puts a byte in the 11th space *)
- ***** ^ not supported yet
- 1035 IF CAP(fields[i].fldtype) = 'M' THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1036 alias^.hasmemo := TRUE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1037 fields[i].size := 10;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1038 ELSIF CAP(fields[i].fldtype) = 'L' THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1039 fields[i].size := 1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1040 ELSIF CAP(fields[i].fldtype) = 'D' THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1041 fields[i].size := 8;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1042 ELSIF (CAP(fields[i].fldtype) # 'C') AND
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1043 (CAP(fields[i].fldtype) # 'N') THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1044 WARN('Illegal type encountered in BuildDBF');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1045 END;
- 1046 tmpchar := CAP(fields[i].fldtype);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1047 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(tmpchar), 1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1048 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(zstr), 4);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1049 alias^.ErrorCode := BlockWrite(alias^.fileID,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1050 ADR(fields[i].size), 1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1051 offset := offset + fields[i].size;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1052 IF CAP(fields[i].fldtype) = 'N' THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1053 alias^.ErrorCode := BlockWrite(alias^.fileID,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1054 ADR(fields[i].decplaces), 1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1055 ELSE
- 1056 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(zstr), 1)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1057 END;
- 1058 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(zstr), 14);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1059 alias^.length := alias^.length + fields[i].size;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1060 INC(i);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1061 END; (* while *)
- 1062 alias^.numberoffields := i ;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1063 IF NumFields<i THEN
- 1064 alias^.numberoffields:=NumFields
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1065 END;
- 1066 ALLOCATE(alias^.fieldlist,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1067 (TSIZE(DBFieldArray)DIV MaxField)*(alias^.numberoffields));
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1068 FOR i := 0 TO alias^.numberoffields-1 DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ FOR needs integer variable and bounds
- 1069 alias^.fieldlist^[i+1] := fields[i];
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1070 END;
- 1071 tmpchar := CHR(0DH);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1072 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(tmpchar), 1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1073 (* write the header terminator *)
- 1074 longtmp := GetFilePtr(alias^.fileID);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1075 alias^.headerlength := VAL(INTEGER,longtmp);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1076 (*
- 1077 alias^.headerlength := VAL(INTEGER,HandleIO.GetFilePtr(alias^.fileID));
- 1078 *)
- 1079 (* Next, set the first byte of the file to 03H or 83H *)
- 1080 SetFilePtr(alias^.fileID,FromStart,VAL(LONGINT,0));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1081 IF alias^.hasmemo THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1082 tmpchar := CHR(83H); (* the file has memo fields *)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1083 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(tmpchar), 1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1084 Assign(alias^.name,alias^.MemoName);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1085 i:=Pos( ".", alias^.MemoName);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1086 IF i<=HIGH(alias^.MemoName) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1087 alias^.MemoName[i]:=0C;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1088 END;
- 1089 Append(alias^.MemoName,'.DBT' );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1090 PrintMessage(CreateFile(alias^.MemoHandle,alias^.MemoName));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1091 alias^.MemoOpen:=TRUE;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1092 InitMemo(alias^.MemoHandle);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1093 ELSE
- 1094 tmpchar := 03C;
- 1095 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(tmpchar), 1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1096 (* the file doesn't have memos *)
- 1097 END; (* if *)
- 1098 tmpchar := CHR(year MOD 100);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1099 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(tmpchar), 1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1100 (* Write the year *)
- 1101 tmpchar := CHR(month);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1102 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(tmpchar), 1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1103 (* Write the month *)
- 1104 tmpchar := CHR(day);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1105 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(tmpchar), 1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1106 (* Write the day *)
- 1107 SetFilePtr(alias^.fileID, FromStart, VAL(LONGINT,8));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 1108 alias^.ErrorCode := BlockWrite(alias^.fileID,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1109 ADR(alias^.headerlength), 2);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1110 alias^.ErrorCode := BlockWrite(alias^.fileID,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1111 ADR(alias^.length), 2);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1112 alias^.size:=0;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1113 ALLOCATE(alias^.currentrec,alias^.length);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1114 SetDBBuffer(alias,1);(* minnimum size *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1115 RETURN 0;
- 1116 END BuildDBF;
- ***** ^ not supported yet
- 1117
- 1118 PROCEDURE DefaultFixUp(alias:DBFile):BOOLEAN;
- 1119 (* what we do here is determine if we want to write
- 1120 in which case we return TRUE. If we need to write we will
- 1121 have to fix up any conflicts in the changed data.
- 1122 Here is what the default does:
- 1123 The record is fixed up on a field by field basis as follows:
- 1124 If all same nochange.
- 1125 If currentrec field # current buffer field then use current.
- 1126 if currentrec field = current buffer field then use disk version;
- 1127 We write always.
- 1128 *)
- 1129
- 1130 VAR
- 1131 field:ARRAY[CurrentRec..ReRead] OF ARRAY[0..(MaxField-1)] OF CHAR;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1132 RM:RecordModeType;
- ***** ^ undeclared identifier
- 1133 fld:CARDINAL;
- 1134 BEGIN
- 1135 FOR fld:=1 TO alias^.numberoffields DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1136 FOR RM:=CurrentRec TO ReRead DO
- ***** ^ FOR needs integer variable and bounds
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 1137 SetRecordMode(alias,RM);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1138 GetField(alias,fld,field[RM]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 1139 END (*for*);
- 1140 IF NOT PosUtils.Equal(field[ReRead],field[Buffer])
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 1141 THEN (* disk and buffer copys are different so we have a problem*)
- 1142 IF NOT PosUtils.Equal(field[ReRead],field[CurrentRec])
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 1143 THEN (* is new the same as on the disk?*)
- 1144 IF PosUtils.Equal(field[Buffer],field[CurrentRec])
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 1145 THEN (* did this transaction actually changer the field?*)
- 1146 (* if not set to disk version*)
- 1147 SetRecordMode(alias,CurrentRec);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 1148 Replace(alias,fld,field[ReRead]);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 1149 END;
- 1150 END;
- 1151 END;
- 1152 END(*for *);
- 1153 SetRecordMode(alias,CurrentRec);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 1154 RETURN TRUE(* this version always does the write*)
- 1155 END DefaultFixUp;
- ***** ^ not supported yet
- 1156
- 1157 END ModBase3.
- ***** ^ not supported yet
- 1631 errors
|
