123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082 |
- {**********[ SOURCE FILE OF FREE VISION ]***************}
- { }
- { Parts Copyright (c) 1992,96 by Florian Klaempfl }
- { [email protected] }
- { }
- { Parts Copyright (c) 1996 by Frank ZAGO }
- { [email protected] }
- { }
- { Parts Copyright (c) 1995 by MH Spiegel }
- { }
- { Parts Copyright (c) 1996 by Leon de Boer }
- { [email protected] }
- { }
- { THIS CODE IS FREEWARE }
- {*******************************************************}
- {***************[ SUPPORTED PLATFORMS ]*****************}
- { 16 and 32 Bit compilers }
- { DOS - Turbo Pascal 7.0 + (16 Bit) }
- { - FPK Pascal (32 Bit) }
- { DPMI - Turbo Pascal 7.0 + (16 Bit) }
- { WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
- { OS2 - Virtual Pascal 0.3 + (32 Bit) }
- { SpeedPascal 1.5 G + (32 Bit) }
- { C'T patch to BP (16 Bit) }
- {*******************************************************}
- UNIT Objects;
- {$I os.inc}
- {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
- INTERFACE
- {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
- { ******************************* REMARK ****************************** }
- { FPK does not accept $IFNDEF compiler defines and mishandles $IFDEF }
- { with constants. Can we please get this error fixed!!!!! }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- {====Compiler conditional defines to sort platforms out =============}
- {$DEFINE NotFPKPascal} { Predefine Not FPK }
- {$DEFINE NotOS2} { Predefine NOT OS2 }
- {$IFDEF FPK} { FPK PASCAL }
- {$DEFINE FPKPascal} { Set FPK definition }
- {$DEFINE DOS_OS} { Define DOS_OS }
- {$DEFINE CODE_32_BIT} { 32 BIT CODE }
- {$UNDEF USE_BGI} { Can't use BGI }
- {$UNDEF NotFPKPascal} { This is FPK pascal }
- {$ENDIF}
- {$IFDEF MSDOS} { MSDOS PLATFORM }
- {$DEFINE DOS_OS} { Define DOS_OS }
- {$ENDIF}
- {$IFDEF DPMI} { DPMI PLATFORM }
- {$DEFINE DOS_OS} { Define DOS_OS }
- {$ENDIF}
- {$IFDEF Windows} { WINDOWS platform }
- {$DEFINE ADV_OS} { Set as advanced }
- {$UNDEF USE_BGI} { Can't use BGI }
- {$ENDIF}
- {$IFDEF OS2} { OS2 platform }
- {$DEFINE ADV_OS} { Set as advanced }
- {$IFNDEF FPK}
- {$DEFINE BPOS2} { Define BPOS2 }
- {$ENDIF FPK}
- {$UNDEF NotOS2} { This is OS2 compiler }
- {$UNDEF USE_BGI} { Can't use BGI }
- {$UNDEF DOS_OS}
- {$ENDIF}
- {$IFDEF VirtualPascal} { VIRTUAL PASCAL }
- {$DEFINE CODE_32_BIT} { 32 BIT CODE }
- {$DEFINE ASM_32_BIT} { 32 BIT ASSSEMBLER }
- {$DEFINE API_32_BIT} { 32 BIT API CALLS }
- {$UNDEF BPOS2} { Undefine BPOS2 }
- {$ENDIF}
- {$IFDEF Speed} { SPEED PASCAL }
- {$DEFINE CODE_32_BIT} { 32 BIT CODE }
- {$DEFINE ASM_32_BIT} { 32 BIT ASSSEMBLER }
- {$DEFINE API_32_BIT} { 32 BIT API CALLS }
- {$UNDEF BPOS2} { Undefine BPOS2 }
- {$ENDIF}
- {--------------------------------------------------------------------}
- { ******************************* REMARK ****************************** }
- { How about FPK accepting all the standard compiler directives even if }
- { It just ignores them for now!! }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- {==== Compiler directives ===========================================}
- {$IFDEF FPKPascal} { FPK PASCAL }
- {$E-}
- {$DEFINE NoExceptions}
- {$DEFINE SString}
- CONST
- Sw_MaxData = 128*1024*1024; { Maximum data size }
- TYPE
- Sw_Word = LongInt; { Long integer now }
- Sw_Integer = LongInt; { Long integer now }
- TYPE
- FuncPtr = FUNCTION (Item: Pointer; _EBP: Sw_Word): Boolean;
- ProcPtr = PROCEDURE (Item: Pointer; _EBP: Sw_Word);
- {$ENDIF}
- {$IFDEF NotFPKPascal} { ALL OTHER COMPILERS }
- {$N-} { No 80x87 code generation }
- {$O+} { This unit may be overlaid }
- {$X+} { Extended syntax is ok }
- {$F+} { Force far calls }
- {$A+} { Word Align Data }
- {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
- {$R-} { Disable range checking }
- {$S-} { Disable Stack Checking }
- {$I-} { Disable IO Checking }
- {$Q-} { Disable Overflow Checking }
- {$V-} { Turn off strict VAR strings }
- {$B-} { Allow short circuit boolean evaluations }
- {$IFNDEF CODE_32_BIT} { 16 BIT DEFINITIONS }
- CONST
- Sw_MaxData = 65520; { Maximum data size }
- TYPE
- Sw_Word = Word; { Standard word }
- Sw_Integer = Integer; { Standard integer }
- {$ELSE} { 32 BIT DEFINITIONS }
- CONST
- Sw_MaxData = 128*1024*1024; { Maximum data size }
- TYPE
- Sw_Word = LongInt; { Long integer now }
- Sw_Integer = LongInt; { Long integer now }
- {$ENDIF}
- TYPE
- {$IFDEF VirtualPascal} { VP is different }
- FuncPtr = FUNCTION (Item: Pointer): Boolean;
- {$ELSE} { All others }
- FuncPtr = FUNCTION (Item: Pointer; _EBP: Sw_Word): Boolean;
- {$ENDIF}
- TYPE
- {$IFDEF VirtualPascal} { VP is different }
- ProcPtr = PROCEDURE (Item: Pointer);
- {$ELSE} { All others }
- ProcPtr = PROCEDURE (Item: Pointer; _EBP: Sw_Word);
- {$ENDIF}
- {$ENDIF}
- {---------------------------------------------------------------------}
- CONST
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ STREAM ERROR STATE MASKS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- stOk = 0; { No stream error }
- stError = -1; { Access error }
- stInitError = -2; { Initialize error }
- stReadError = -3; { Stream read error }
- stWriteError = -4; { Stream write error }
- stGetError = -5; { Get object error }
- stPutError = -6; { Put object error }
- stSeekError = -7; { Seek error in stream }
- stOpenError = -8; { Error opening stream }
- CONST
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ STREAM ACCESS MODE CONSTANTS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- stCreate = $3C00; { Create new file }
- stOpenRead = $3D00; { Read access only }
- stOpenWrite = $3D01; { Write access only }
- stOpen = $3D02; { Read/write access }
- CONST
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TCollection ERROR CODES Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- coIndexError = -1; { Index out of range }
- coOverflow = -2; { Overflow }
- CONST
- { ******************************* REMARK ****************************** }
- { These are completely NEW FREE VISION ONLY constants that are used }
- { in conjuction with CreateStream a NEW FREE VISION call. This call }
- { tries creating a stream in the order of the Strategy Mask and will }
- { return the successfully created stream or nil if it fails. }
- { ****************************** END REMARK *** Leon de Boer, 15May96 * }
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ STREAM CREATE STRATEGY MASKS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- sa_XMSFirst = $8000; { Use XMS memory 1st }
- sa_EMSFirst = $4000; { Use EMS memory 1st }
- sa_RAMFirst = $2000; { Use RAM memory 1st }
- sa_DISKFirst = $1000; { Use DISK space 1st }
- sa_XMSSecond = $0800; { Use XMS memory 2nd }
- sa_EMSSecond = $0400; { Use EMS memory 2nd }
- sa_RAMSecond = $0200; { Use RAM memory 2nd }
- sa_DISKSecond = $0100; { Use DISK space 2nd }
- sa_XMSThird = $0080; { Use XMS memory 3rd }
- sa_EMSThird = $0040; { Use EMS memory 3rd }
- sa_RAMThird = $0020; { Use RAM memory 3rd }
- sa_DISKThird = $0010; { Use DISK space 3rd }
- sa_XMSFourth = $0008; { Use XMS memory 4th }
- sa_EMSFourth = $0004; { Use EMS memory 4th }
- sa_RAMFourth = $0002; { Use RAM memory 4th }
- sa_DISKFourth = $0001; { Use DISK space 4th }
- CONST
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ GENERAL USE CONSTANTS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- {$IFDEF VirtualPascal}
- vmtHeaderSize = 12; { VMT header size }
- {$ELSE}
- vmtHeaderSize = 8; { VMT header size }
- {$ENDIF}
- CONST
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ MAXIMUM COLLECTION SIZE CONSTANT Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- MaxCollectionSize = Sw_MaxData DIV SizeOf(Pointer);{ Max collection size }
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ CHARACTER SET Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TCharSet = SET Of Char; { Character set }
- PCharSet = ^TCharSet; { Character set ptr }
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ GENERAL ARRAYS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TByteArray = ARRAY [0..Sw_MaxData-1] Of Byte; { Byte array }
- PByteArray = ^TByteArray; { Byte array pointer }
- TWordArray = ARRAY [0..Sw_MaxData DIV 2-1] Of Word;{ Word array }
- PWordArray = ^TWordArray; { Word array pointer }
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ DOS FILENAME STRING Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- {$IFDEF DOS_OS} { DOS/DPMI DEFINE }
- FNameStr = String[79]; { DOS filename }
- {$ENDIF}
- {$IFDEF Windows} { WINDOWS DEFINE }
- FNameStr = PChar; { Windows filename }
- {$ENDIF}
- {$IFDEF OS2} { OS2 DEFINE }
- FNameStr = String; { OS2 filename }
- {$ENDIF}
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ DOS ASCIIZ FILENAME Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- AsciiZ = Array [0..255] Of Char; { Filename array }
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ GENERAL TYPE POINTERS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- PByte = ^Byte; { Byte pointer }
- PWord = ^Word; { Word pointer }
- PLongInt = ^LongInt; { LongInt pointer }
- PString = ^String; { String pointer }
- {***************************************************************************}
- { RECORD DEFINITIONS }
- {***************************************************************************}
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TYPE CONVERSION RECORDS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- WordRec = RECORD
- Lo, Hi: Byte; { Word to bytes }
- END;
- LongRec = RECORD
- Lo, Hi: Word; { LongInt to words }
- END;
- PtrRec = RECORD
- Ofs, Seg: Word; { Pointer to words }
- END;
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TStreamRec RECORD - STREAM OBJECT RECORD Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- PStreamRec = ^TStreamRec; { Stream record ptr }
- TStreamRec = RECORD
- ObjType: Sw_Word; { Object type id }
- VmtLink: Sw_Word; { VMT link }
- Load : Pointer; { Object load code }
- Store: Pointer; { Object store code }
- Next : Sw_Word; { Bytes to next }
- END;
- {***************************************************************************}
- { OBJECT DEFINITIONS }
- {***************************************************************************}
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TPoint RECORD - POINT RECORD Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TPoint = RECORD
- X, Y: Integer; { Point co-ordinates }
- END;
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TRect OBJECT - RECTANGLE OBJECT Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TRect = OBJECT
- A, B: TPoint; { Corner points }
- FUNCTION Empty: Boolean;
- FUNCTION Equals (R: TRect): Boolean;
- FUNCTION Contains (P: TPoint): Boolean;
- PROCEDURE Copy (R: TRect);
- PROCEDURE Union (R: TRect);
- PROCEDURE Intersect (R: TRect);
- PROCEDURE Move (ADX, ADY: Integer);
- PROCEDURE Grow (ADX, ADY: Integer);
- PROCEDURE Assign (XA, YA, XB, YB: Integer);
- END;
- PRect = ^TRect;
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TObject OBJECT - BASE ANCESTOR OBJECT Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TObject = OBJECT
- CONSTRUCTOR Init;
- PROCEDURE Free;
- DESTRUCTOR Done; Virtual;
- END;
- PObject = ^TObject;
- TYPE
- { ******************************* REMARK ****************************** }
- { Two new virtual methods have been added to the object in the form of }
- { Close and Open. The main use here is in the Disk Based Descendants }
- { the calls open and close the given file so these objects can be }
- { used like standard files. All existing code will compile and work }
- { completely normally oblivious to these new methods. }
- { ****************************** END REMARK *** Leon de Boer, 15May96 * }
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TStream OBJECT - STREAM ANCESTOR OBJECT Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TStream = OBJECT (TObject)
- Status : Integer; { Stream status }
- ErrorInfo: Integer; { Stream error info }
- FUNCTION Get: PObject;
- FUNCTION StrRead: PChar;
- FUNCTION GetPos: LongInt; Virtual;
- FUNCTION GetSize: LongInt; Virtual;
- FUNCTION ReadStr: PString;
- PROCEDURE Close; Virtual;
- PROCEDURE Reset;
- PROCEDURE Flush; Virtual;
- PROCEDURE Truncate; Virtual;
- PROCEDURE Put (P: PObject);
- PROCEDURE Seek (Pos: LongInt); Virtual;
- PROCEDURE StrWrite (P: PChar);
- PROCEDURE WriteStr (P: PString);
- PROCEDURE Open (OpenMode: Word); Virtual;
- PROCEDURE Error (Code, Info: Integer); Virtual;
- PROCEDURE Read (Var Buf; Count: Sw_Word); Virtual;
- PROCEDURE Write (Var Buf; Count: Sw_Word); Virtual;
- PROCEDURE CopyFrom (Var S: TStream; Count: Longint);
- END;
- PStream = ^TStream;
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TDosStream OBJECT - DOS FILE STREAM OBJECT Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TDosStream = OBJECT (TStream)
- Handle: Integer; { DOS file handle }
- FName : AsciiZ; { AsciiZ filename }
- CONSTRUCTOR Init (FileName: FNameStr; Mode: Word);
- DESTRUCTOR Done; Virtual;
- FUNCTION GetPos: Longint; Virtual;
- FUNCTION GetSize: Longint; Virtual;
- PROCEDURE Close; Virtual;
- PROCEDURE Seek (Pos: LongInt); Virtual;
- PROCEDURE Open (OpenMode: Word); Virtual;
- PROCEDURE Read (Var Buf; Count: Sw_Word); Virtual;
- PROCEDURE Write (Var Buf; Count: Sw_Word); Virtual;
- END;
- PDosStream = ^TDosStream;
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TBufStream OBJECT - BUFFERED DOS FILE STREAM Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TBufStream = OBJECT (TDosStream)
- END;
- PBufStream = ^TBufStream;
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TEmsStream OBJECT - EMS STREAM OBJECT Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TEmsStream = OBJECT (TStream)
- END;
- PEmsStream = ^TEmsStream;
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TXmsStream OBJECT - XMS STREAM OBJECT Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TXmsStream = OBJECT (TStream)
- END;
- PXmsStream = ^TXmsStream;
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TMemoryStream OBJECT - MEMORY STREAM OBJECT Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TMemoryStream = OBJECT (TStream)
- END;
- PMemoryStream = ^TMemoryStream;
- TYPE
- TItemList = Array [0..MaxCollectionSize - 1] Of Pointer;
- PItemList = ^TItemList;
- { ******************************* REMARK ****************************** }
- { The changes here look worse than they are. The Sw_Integer simply }
- { switches between Integers and LongInts if switched between 16 and 32 }
- { bit code. All existing code will compile without any changes. }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TCollection OBJECT - COLLECTION ANCESTOR OBJECT Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TCollection = OBJECT (TObject)
- Items: PItemList; { Item list pointer }
- Count: Sw_Integer; { Item count }
- Limit: Sw_Integer; { Item limit count }
- Delta: Sw_Integer; { Inc delta size }
- CONSTRUCTOR Init (ALimit, ADelta: Sw_Integer);
- CONSTRUCTOR Load (Var S: TStream);
- DESTRUCTOR Done; Virtual;
- FUNCTION At (Index: Sw_Integer): Pointer;
- FUNCTION IndexOf (Item: Pointer): Sw_Integer; Virtual;
- FUNCTION GetItem (Var S: TStream): Pointer; Virtual;
- FUNCTION LastThat (Test: Pointer): Pointer;
- FUNCTION FirstThat (Test: Pointer): Pointer;
- PROCEDURE Pack;
- PROCEDURE FreeAll;
- PROCEDURE DeleteAll;
- PROCEDURE Free (Item: Pointer);
- PROCEDURE Insert (Item: Pointer); Virtual;
- PROCEDURE Delete (Item: Pointer);
- PROCEDURE AtFree (Index: Sw_Integer);
- PROCEDURE FreeItem (Item: Pointer); Virtual;
- PROCEDURE AtDelete (Index: Sw_Integer);
- PROCEDURE ForEach (Action: Pointer);
- PROCEDURE SetLimit (ALimit: Sw_Integer); Virtual;
- PROCEDURE Error (Code, Info: Integer); Virtual;
- PROCEDURE AtPut (Index: Sw_Integer; Item: Pointer);
- PROCEDURE AtInsert (Index: Sw_Integer; Item: Pointer);
- PROCEDURE Store (Var S: TStream);
- PROCEDURE PutItem (Var S: TStream; Item: Pointer); Virtual;
- END;
- PCollection = ^TCollection;
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TSortedCollection OBJECT - SORTED COLLECTION ANCESTOR Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TSortedCollection = OBJECT (TCollection)
- Duplicates: Boolean; { Duplicates flag }
- CONSTRUCTOR Init (ALimit, ADelta: Sw_Integer);
- CONSTRUCTOR Load (Var S: TStream);
- FUNCTION KeyOf (Item: Pointer): Pointer; Virtual;
- FUNCTION IndexOf (Item: Pointer): Sw_Integer; Virtual;
- FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer; Virtual;
- FUNCTION Search (Key: Pointer; Var Index: Sw_Integer): Boolean;Virtual;
- PROCEDURE Insert (Item: Pointer); Virtual;
- PROCEDURE Store (Var S: TStream);
- END;
- PSortedCollection = ^TSortedCollection;
- TYPE
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TStringCollection OBJECT - STRING COLLECTION OBJECT Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TStringCollection = OBJECT (TSortedCollection)
- FUNCTION GetItem (Var S: TStream): Pointer; Virtual;
- FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer; Virtual;
- PROCEDURE FreeItem (Item: Pointer); Virtual;
- PROCEDURE PutItem (Var S: TStream; Item: Pointer); Virtual;
- END;
- PStringCollection = ^TStringCollection;
- TYPE
- { ******************************* REMARK ****************************** }
- { This is a completely NEW FREE VISION ONLY object which holds a }
- { collection of strings but does not alphabetically sort them. It is }
- { a very useful object as you will find !!!! }
- { ****************************** END REMARK *** Leon de Boer, 15May96 * }
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TUnSortedStrCollection - UNSORTED STRING COLLECTION OBJECT Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TUnSortedStrCollection = OBJECT (TStringCollection)
- PROCEDURE Insert (Item: Pointer); Virtual;
- END;
- PUnSortedStrCollection = ^TUnSortedStrCollection;
- {***************************************************************************}
- { INTERFACE ROUTINES }
- {***************************************************************************}
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ DYNAMIC STRING INTERFACE ROUTINES Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- FUNCTION NewStr (Const S: String): PString;
- PROCEDURE DisposeStr (P: PString);
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ STREAM INTERFACE ROUTINES Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- PROCEDURE Abstract;
- PROCEDURE RegisterError;
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ NEW FREE VISION STREAM ROUTINES Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- { ******************************* REMARK ****************************** }
- { This NEW FREE VISION call tries creating a stream in the order of }
- { the Strategy Mask and will return the successfully created stream }
- { or nil if it fails using the strategy given. }
- { ****************************** END REMARK *** Leon de Boer, 15May96 * }
- FUNCTION CreateStream (Strategy: Word; ReqSize: LongInt): PStream;
- { ******************************* REMARK ****************************** }
- { As we have to provide these NEW FREE VISION CALLS as part of our }
- { stream support we might as well provide them on the interface! They }
- { mimic the behaviour of the OS2 API calls in most cases. }
- { ****************************** END REMARK *** Leon de Boer, 16May96 * }
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ NEW FREE VISION DOS FILE ROUTINES Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- {=DosFileOpen=========================================================
- Calls the operating system to try to open the file denoted by the given
- AsciiZ filename in the requested file mode. Any error is held in
- DosStreamError and the call will return zero. If successful and no error
- occurs the call will return the file handle of the opened file.
- -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB
- =====================================================================}
- FUNCTION DosFileOpen (Var FileName: AsciiZ; Mode: Word): Word;
- {=DosRead============================================================
- Calls the operating system to read BufferLength bytes of data from
- the file denoted by the handle to the bufferarea. Any error in attempting
- to read from the file is held in DosStreamError and returned from call.
- If the return is zero (ie no error) BytesMoved contains the number of
- bytes read from the file.
- -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB
- =====================================================================}
- FUNCTION DosRead(Handle: Word; Var BufferArea; BufferLength: Sw_Word;
- Var BytesMoved: Sw_Word): Word;
- {=DosWrite===========================================================
- Calls the operating system to write to BufferLength bytes of data from
- the bufferarea to the file denoted by the handle. Any error in attempting
- to write to the file is held in DosStreamError and returned from call.
- If the return is zero (ie no error) BytesMoved contains the number of
- bytes written to the file.
- -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB
- =====================================================================}
- FUNCTION DosWrite(Handle: Word; Var BufferArea; BufferLength: Sw_Word;
- Var BytesMoved: Sw_Word): Word;
- {=DosSetFilePtr======================================================
- Calls the operating system to move the file denoted by the handle to
- to the requested position. The move method can be: 0 = absolute offset;
- 1 = offset from present location; 2 = offset from end of file;
- Any error is held in DosErrorStream and returned from the call.
- If the return is zero (ie no error) NewPos contains the new absolute
- file position.
- -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB
- =====================================================================}
- FUNCTION DosSetFilePtr (Handle: Word; Pos: LongInt; MoveType: Word;
- Var NewPos: LongInt): Word;
- {=DosClose===========================================================
- Calls the operating system to close the file handle provided. Any error
- in attempting to close file is held DosErrorStream.
- -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB
- =====================================================================}
- PROCEDURE DosClose (Handle: Word);
- CONST
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ INITIALIZED PUBLIC VARIABLES Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- StreamError: Pointer = Nil; { Stream error ptr }
- {$IFDEF NotFPKPascal}
- DosStreamError: Sw_Word = $0; { Dos stream error }
- {$ENDIF}
- { ******************************* REMARK ****************************** }
- { FPK does not accept local variables with it's assembler which means }
- { these have to be global. Can we please get this error fixed!!!!! }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- {$IFDEF FPKPascal} { FPK Pascal compiler }
- VAR HoldEBP: Sw_Word; TransferHandle: Sw_Word;
- DosStreamError: Sw_Word ; { Dos stream error }
- {$ENDIF}
- {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
- IMPLEMENTATION
- {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
- {$IFDEF Windows} { WINDOWS CODE }
- USES WinTypes, WinProcs; { Standard units }
- {$ENDIF}
- {$IFDEF Speed} { SPEED PASCAL CODE }
- USES BseDos; { Speed Pascal def }
- {$ENDIF}
- {$IFDEF VirtualPascal} { VIRTUAL PASCAL CODE }
- USES OS2Base; { Virtual Pascal base }
- {$ENDIF}
- {$IFDEF BPOS2} { C'T PATCH TO BP CODE }
- FUNCTION DosClose (Handle: Word): Word; FAR;
- EXTERNAL 'DOSCALLS' Index 59; { Dos close function }
- FUNCTION DosOpen (FileName: PChar; Var Handle: Word;
- Var ActionTaken: Word; FileSize: LongInt;
- FileAttr: Word; OpenFlag, OpenMode: Word;
- Reserved: Pointer): Word; FAR;
- EXTERNAL 'DOSCALLS' Index 70; { Dos open function }
- FUNCTION DosRead(Handle: Word; Var BufferArea;
- BufferLength: Word; Var BytesRead : Word): Word; FAR;
- EXTERNAL 'DOSCALLS' Index 137; { Dos read procedure }
- FUNCTION DosWrite(Handle: Word; Var BufferArea;
- BufferLength: Word; Var BytesRead : Word): Word; FAR;
- EXTERNAL 'DOSCALLS' Index 138; { Dos write procedure }
- FUNCTION DosSetFilePtr (Handle: Word; ulOffset: LongInt;
- MoveType: Word; Var NewPointer: LongInt): LongInt; FAR;
- EXTERNAL 'DOSCALLS' Index 58; { Dos write procedure }
- {$ENDIF}
- {$IFDEF OS2} { OS2 CODE }
- CONST
- { Private Os2 File mode magic numbers }
- FmInput = $20; { Open file for input }
- FmOutput = $31; { Open file for output }
- FmInout = $42; { Open file }
- FmClosed = $0; { Close file }
- {$ENDIF}
- {$IFDEF DPMI} { DPMI CODE }
- {$DEFINE NewExeFormat} { New format EXE }
- {$ENDIF}
- {$IFDEF ADV_OS} { WINDOWS/OS2 CODE }
- {$DEFINE NewExeFormat} { New format EXE }
- {$ENDIF}
- CONST
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ INITIALIZED PRIVATE VARIABLES Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- StreamTypes: Sw_Word = $0; { Stream types }
- {***************************************************************************}
- { OBJECT METHODS }
- {***************************************************************************}
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TRect OBJECT METHODS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- PROCEDURE CheckEmpty (Var Rect: TRect);
- { ******************************* REMARK ****************************** }
- { This is is my desired code but FPK does not like the with statement }
- { Can we please get this error fixed!!!!! }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- { With Rect Do Begin }
- { If (A.X >= B.X) OR (A.Y >= B.Y) Then Begin } { Zero of reversed }
- { A.X := 0; } { Clear a.x }
- { A.Y := 0; } { Clear a.y }
- { B.X := 0; } { Clear b.x }
- { B.Y := 0; } { Clear b.y }
- { End; }
- { End; }
- BEGIN
- If (Rect.A.X >= Rect.B.X) OR
- (Rect.A.Y >= Rect.B.Y) Then Begin { Zero of reversed }
- Rect.A.X := 0; { Clear a.x }
- Rect.A.Y := 0; { Clear a.y }
- Rect.B.X := 0; { Clear b.x }
- Rect.B.Y := 0; { Clear b.y }
- End;
- END;
- { ******************************* REMARK ****************************** }
- { This is a bug fix of EMPTY from the original code which was: }
- { Empty := (A.X = B.X) AND (A.Y = B.Y) }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- {**TRect********************************************************************}
- { Empty -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- FUNCTION TRect.Empty: Boolean;
- BEGIN
- Empty := (A.X >= B.X) OR (A.Y >= B.Y); { Empty result }
- END;
- {**TRect********************************************************************}
- { Equals -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- FUNCTION TRect.Equals (R: TRect): Boolean;
- BEGIN
- Equals := (A.X = R.A.X) AND (A.Y = R.A.Y) AND
- (B.X = R.B.X) AND (B.Y = R.B.Y); { Equals result }
- END;
- { ******************************* REMARK ****************************** }
- { This is a bug fix of Contains from the original code which was: }
- { Contains := (P.X >= A.X) AND (P.X <= B.X) AND }
- { (P.Y >= A.Y) AND (P.Y <= B.Y) }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- {**TRect********************************************************************}
- { Contains -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- FUNCTION TRect.Contains (P: TPoint): Boolean;
- BEGIN
- Contains := (P.X >= A.X) AND (P.X < B.X) AND
- (P.Y >= A.Y) AND (P.Y < B.Y); { Contains result }
- END;
- {**TRect********************************************************************}
- { Copy -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TRect.Copy (R: TRect);
- BEGIN
- A := R.A; { Copy point a }
- B := R.B; { Copy point b }
- END;
- {**TRect********************************************************************}
- { Union -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TRect.Union (R: TRect);
- BEGIN
- If (R.A.X < A.X) Then A.X := R.A.X; { Take if smaller }
- If (R.A.Y < A.Y) Then A.Y := R.A.Y; { Take if smaller }
- If (R.B.X > B.X) Then B.X := R.B.X; { Take if larger }
- If (R.B.Y > B.Y) Then B.Y := R.B.Y; { Take if larger }
- END;
- {**TRect********************************************************************}
- { Intersect -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TRect.Intersect (R: TRect);
- BEGIN
- If (R.A.X > A.X) Then A.X := R.A.X; { Take if larger }
- If (R.A.Y > A.Y) Then A.Y := R.A.Y; { Take if larger }
- If (R.B.X < B.X) Then B.X := R.B.X; { Take if smaller }
- If (R.B.Y < B.Y) Then B.Y := R.B.Y; { Take if smaller }
- CheckEmpty(Self); { Check if empty }
- END;
- {**TRect********************************************************************}
- { Move -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TRect.Move (ADX, ADY: Integer);
- BEGIN
- Inc(A.X, ADX); { Adjust A.X }
- Inc(A.Y, ADY); { Adjust A.Y }
- Inc(B.X, ADX); { Adjust B.X }
- Inc(B.Y, ADY); { Adjust B.Y }
- END;
- {**TRect********************************************************************}
- { Grow -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TRect.Grow (ADX, ADY: Integer);
- BEGIN
- Dec(A.X, ADX); { Adjust A.X }
- Dec(A.Y, ADY); { Adjust A.Y }
- Inc(B.X, ADX); { Adjust B.X }
- Inc(B.Y, ADY); { Adjust B.Y }
- CheckEmpty(Self); { Check if empty }
- END;
- {**TRect********************************************************************}
- { Assign -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TRect.Assign (XA, YA, XB, YB: Integer);
- BEGIN
- A.X := XA; { Hold A.X value }
- A.Y := YA; { Hold A.Y value }
- B.X := XB; { Hold B.X value }
- B.Y := YB; { Hold B.Y value }
- END;
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TObject OBJECT METHODS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- TYPE
- DummyObject = OBJECT (TObject) { Internal object }
- Data: RECORD END; { Helps size VMT link }
- END;
- { ******************************* REMARK ****************************** }
- { I Prefer this code because it self sizes VMT link rather than using a }
- { fixed record structure thus it should work on all compilers without a }
- { specific record to match each compiler. }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- CONSTRUCTOR TObject.Init;
- VAR LinkSize: LongInt; Dummy: DummyObject;
- BEGIN
- LinkSize := LongInt(@Dummy.Data)-LongInt(@Dummy); { Calc VMT link size }
- FillChar(Pointer(LongInt(@Self)+LinkSize)^,
- SizeOf(Self)-LinkSize, #0); { Clear data fields }
- END;
- {**TObject******************************************************************}
- { Free -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TObject.Free;
- BEGIN
- Dispose(PObject(@Self), Done); { Dispose of self }
- END;
- {**TObject******************************************************************}
- { Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- DESTRUCTOR TObject.Done;
- BEGIN { Abstract method }
- END;
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TStream OBJECT METHODS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- { ******************************* REMARK ****************************** }
- { Bug fix of TStream.StrRead from the original code which was: }
- { GetMem(P, L+1) can fail and return Nil which should be checked! }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- {**TStream******************************************************************}
- { StrRead -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- FUNCTION TStream.StrRead: PChar;
- VAR L: Word; P: PChar;
- BEGIN
- Read(L, SizeOf(L)); { Read length }
- If (L=0) Then StrRead := Nil Else Begin { Check for empty }
- GetMem(P, L + 1); { Allocate memory }
- If (P<>Nil) Then Begin { Check allocate okay }
- Read(P[0], L); { Read the data }
- P[L] := #0; { Terminate with #0 }
- End;
- StrRead := P; { Return PChar }
- End;
- END;
- { ******************************* REMARK ****************************** }
- { Bug fix of TStream.ReadStr from the original code which was: }
- { GetMem(P, L+1) can fail and return Nil which should be checked! }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- {**TStream******************************************************************}
- { ReadStr -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- FUNCTION TStream.ReadStr: PString;
- VAR L: Byte; P: PString;
- BEGIN
- Read(L, 1); { Read string length }
- If (L > 0) Then Begin
- GetMem(P, L + 1); { Allocate memory }
- If (P<>Nil) Then Begin { Check allocate okay }
- P^[0] := Char(L); { Hold length }
- Read(P^[1], L); { Read string data }
- End;
- ReadStr := P; { Return string ptr }
- End Else ReadStr := Nil;
- END;
- {**TStream******************************************************************}
- { GetPos -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- FUNCTION TStream.GetPos: LongInt;
- BEGIN { Abstract method }
- Abstract; { Abstract error }
- END;
- {**TStream******************************************************************}
- { GetSize -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- FUNCTION TStream.GetSize: LongInt;
- BEGIN { Abstract method }
- Abstract; { Abstract error }
- END;
- {**TStream******************************************************************}
- { Close -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TStream.Close;
- BEGIN { Abstract method }
- END;
- {**TStream******************************************************************}
- { Reset -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TStream.Reset;
- BEGIN
- Status := 0; { Clear status }
- ErrorInfo := 0; { Clear error info }
- END;
- {**TStream******************************************************************}
- { Flush -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TStream.Flush;
- BEGIN { Abstract method }
- END;
- {**TStream******************************************************************}
- { Truncate -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TStream.Truncate;
- BEGIN
- Abstract; { Abstract error }
- END;
- {**TStream******************************************************************}
- { Seek -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TStream.Seek (Pos: LongInt);
- BEGIN
- Abstract; { Abstract error }
- END;
- {**TStream******************************************************************}
- { StrWrite -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TStream.StrWrite (P: PChar);
- VAR L: Word; Q: PByteArray;
- BEGIN
- L := 0; { Preset no size }
- Q := PByteArray(P); { Transfer type }
- If (Q<>Nil) Then While (Q^[L]<>0) Do Inc(L); { Calc PChar length }
- Write(L, SizeOf(L)); { Store PChar length }
- If (P<>Nil) Then Write(P[0], L); { Write data }
- END;
- {**TStream******************************************************************}
- { WriteStr -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TStream.WriteStr (P: PString);
- CONST Empty: String[1] = '';
- BEGIN
- If (P<>Nil) Then Write(P^, Length(P^) + 1) { Write string }
- Else Write(Empty, 1); { Write empty string }
- END;
- {**TStream******************************************************************}
- { Open -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TStream.Open (OpenMode: Word);
- BEGIN { Abstract method }
- END;
- {**TStream******************************************************************}
- { Error -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TStream.Error (Code, Info: Integer);
- TYPE TErrorProc = Procedure(Var S: TStream);
- BEGIN
- Status := Code; { Hold error code }
- ErrorInfo := Info; { Hold error info }
- If (StreamError<>Nil) Then
- TErrorProc(StreamError)(Self); { Call error ptr }
- END;
- {**TStream******************************************************************}
- { Read -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TStream.Read (Var Buf; Count: Sw_Word);
- BEGIN
- Abstract; { Abstract error }
- END;
- {**TStream******************************************************************}
- { Write -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TStream.Write (Var Buf; Count: Sw_Word);
- BEGIN
- Abstract; { Abstract error }
- END;
- {**TStream******************************************************************}
- { CopyFrom -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
- {***************************************************************************}
- PROCEDURE TStream.CopyFrom (Var S: TStream; Count: Longint);
- VAR W: Word; Buffer: Array[0..1023] of Byte;
- BEGIN
- While (Count > 0) Do Begin
- If (Count > SizeOf(Buffer)) Then { To much data }
- W := SizeOf(Buffer) Else W := Count; { Size to transfer }
- S.Read(Buffer, W); { Read from stream }
- Write(Buffer, W); { Write to stream }
- Dec(Count, W); { Dec write count }
- End;
- END;
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TDosStream OBJECT METHODS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- {**TDosStream***************************************************************}
- { Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
- {***************************************************************************}
- CONSTRUCTOR TDosStream.Init (FileName: FNameStr; Mode: Word);
- BEGIN
- Inherited Init; { Call ancestor }
- {$IFDEF Windows}
- AnsiToOem(FileName, FName); { Ansi to OEM }
- {$ELSE}
- FileName := FileName+#0; { Make asciiz }
- Move(FileName[1], FName, Length(FileName)); { Create asciiz name }
- {$ENDIF}
- Handle := DosFileOpen(FName, Mode); { Open the file }
- If (Handle=0) Then Begin { Open failed }
- Error(stInitError, DosStreamError); { Call error }
- Status := stInitError; { Set fail status }
- Handle := -1; { Set invalid handle }
- End;
- END;
- {**TDosStream***************************************************************}
- { Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
- {***************************************************************************}
- DESTRUCTOR TDosStream.Done;
- BEGIN
- If (Handle <> -1) Then DosClose(Handle); { Close the file }
- Inherited Done; { Call ancestor }
- END;
- {**TDosStream***************************************************************}
- { GetPos -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
- {***************************************************************************}
- FUNCTION TDosStream.GetPos: LongInt;
- VAR NewPosition: LongInt;
- BEGIN
- If (Status=stOk) Then Begin { Check status okay }
- If (Handle = -1) Then DosStreamError := 103 { File not open }
- Else DosStreamError := DosSetFilePtr(Handle,
- 0, 1, NewPosition); { Get file position }
- If (DosStreamError<>0) Then Begin { Check for error }
- Error(stError, DosStreamError); { Identify error }
- NewPosition := -1; { Invalidate position }
- End;
- GetPos := NewPosition; { Return file position }
- End Else GetPos := -1; { Stream in error }
- END;
- {**TDosStream***************************************************************}
- { GetSize -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
- {***************************************************************************}
- FUNCTION TDosStream.GetSize: LongInt;
- VAR CurrentPos, FileEndPos: LongInt;
- BEGIN
- If (Status=stOk) Then Begin { Check status okay }
- If (Handle = -1) Then DosStreamError := 103 { File not open }
- Else DosStreamError := DosSetFilePtr(Handle,
- 0, 1, CurrentPos); { Current position }
- If (DosStreamError=0) Then Begin { Check no errors }
- DosStreamError := DosSetFilePtr(Handle, 0, 2,
- FileEndPos); { Locate end of file }
- If (DosStreamError=0) Then
- DosSetFilePtr(Handle, 0, 1, CurrentPos); { Reset position }
- End;
- If (DosStreamError<>0) Then Begin { Check for error }
- Error(stError, DosStreamError); { Identify error }
- FileEndPos := -1; { Invalidate size }
- End;
- GetSize := FileEndPos; { Return file size }
- End Else GetSize := -1; { Stream in error }
- END;
- {**TDosStream***************************************************************}
- { Close -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
- {***************************************************************************}
- PROCEDURE TDosStream.Close;
- BEGIN
- If (Handle <> -1) Then DosClose(Handle); { Close the file }
- Handle := -1; { Handle now invalid }
- END;
- {**TDosStream***************************************************************}
- { Seek -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
- {***************************************************************************}
- PROCEDURE TDosStream.Seek (Pos: LongInt);
- VAR NewPosition: LongInt;
- BEGIN
- If (Status=stOk) Then Begin { Check status okay }
- If (Pos < 0) Then Pos := 0; { Negatives removed }
- If (Handle = -1) Then DosStreamError := 103 { File not open }
- Else DosStreamError := DosSetFilePtr(Handle,
- Pos, 0, NewPosition); { Set file position }
- If ((DosStreamError<>0) OR (NewPosition<>Pos)) { We have an error }
- Then Begin
- If (DosStreamError<>0) Then { Error was detected }
- Error(stError, DosStreamError) { Specific seek error }
- Else Error(stSeekError, 0); { General seek error }
- End;
- End;
- END;
- {**TDosStream***************************************************************}
- { Open -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
- {***************************************************************************}
- PROCEDURE TDosStream.Open (OpenMode: Word);
- BEGIN
- If (Handle = -1) Then Begin { File not open }
- Handle := DosFileOpen(FName, OpenMode); { Open the file }
- If (Handle=0) Then Begin { File open failed }
- Error(stOpenError, DosStreamError); { Call error }
- Handle := -1; { Set invalid handle }
- End;
- End;
- END;
- {**TDosStream***************************************************************}
- { Read -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
- {***************************************************************************}
- PROCEDURE TDosStream.Read (Var Buf; Count: Sw_Word);
- VAR BytesMoved: Sw_Word;
- BEGIN
- If (Status=stOk) Then Begin { Check status }
- If (Handle = -1) Then BytesMoved := 0 Else { File not open }
- DosStreamError := DosRead(Handle, Buf, Count,
- BytesMoved); { Read from file }
- If ((DosStreamError<>0) OR (BytesMoved<>Count)) { We have an error }
- Then Begin
- If (DosStreamError<>0) Then { Error was detected }
- Error(stError, DosStreamError) { Specific read error }
- Else Error(stReadError, 0); { General read error }
- End;
- End Else FillChar(Buf, Count, #0); { Error clear buffer }
- END;
- {**TDosStream***************************************************************}
- { Write -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
- {***************************************************************************}
- PROCEDURE TDosStream.Write (Var Buf; Count: Sw_Word);
- VAR BytesMoved: Sw_Word;
- BEGIN
- If (Status=stOk) Then Begin
- If (Handle=-1) Then BytesMoved := 0 Else { File not open }
- DosStreamError := DosWrite(Handle, Buf, Count,
- BytesMoved); { Write to file }
- If ((DosStreamError<>0) OR (BytesMoved<>Count)) { We have an error }
- Then Begin
- If (DosStreamError<>0) Then { Error was detected }
- Error(stError, DosStreamError) { Specific write error }
- Else Error(stWriteError, 0); { General write error }
- End;
- End;
- END;
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TCollection OBJECT METHODS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- CONSTRUCTOR TCollection.Init (ALimit, ADelta: Sw_Integer);
- BEGIN
- Inherited Init; { Call ancestor }
- Delta := ADelta; { Set increment }
- SetLimit(ALimit); { Set limit }
- END;
- CONSTRUCTOR TCollection.Load (Var S: TStream);
- VAR C, I: Sw_Integer;
- BEGIN
- S.Read(Count, SizeOf(Count)); { Read count }
- S.Read(Limit, SizeOf(Limit)); { Read limit }
- S.Read(Delta, SizeOf(Delta)); { Read delta }
- Items := Nil; { Clear item pointer }
- C := Count; { Hold count }
- I := Limit; { Hold limit }
- Count := 0; { Clear count }
- Limit := 0; { Clear limit }
- SetLimit(I); { Set requested limit }
- Count := C; { Set count }
- For I := 0 To C-1 Do AtPut(I, GetItem(S)); { Get each item }
- END;
- DESTRUCTOR TCollection.Done;
- BEGIN
- FreeAll; { Free all items }
- SetLimit(0); { Release all memory }
- END;
- FUNCTION TCollection.At (Index: Sw_Integer): Pointer;
- BEGIN
- If (Index < 0) OR (Index >= Count) Then Begin { Invalid index }
- Error(coIndexError, Index); { Call error }
- At := Nil; { Return nil }
- End Else At := Items^[Index]; { Return item }
- END;
- { ******************************* REMARK ****************************** }
- { Bug fix of TCollection.IndexOf from the original code which was: }
- { For I := 0 To Count-1 Do <- What happens if count=0!!!! }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- FUNCTION TCollection.IndexOf (Item: Pointer): Sw_Integer;
- VAR I: Sw_Integer;
- BEGIN
- If (Count>0) Then Begin { Count is positive }
- For I := 0 To Count-1 Do { For each item }
- If (Items^[I]=Item) Then Begin { Look for match }
- IndexOf := I; { Return index }
- Exit; { Now exit }
- End;
- End;
- IndexOf := -1; { Return index }
- END;
- FUNCTION TCollection.GetItem (Var S: TStream): Pointer;
- BEGIN
- GetItem := S.Get; { Item off stream }
- END;
- FUNCTION TCollection.LastThat (Test: Pointer): Pointer;
- VAR I: LongInt; P: FuncPtr; {$IFDEF NotFPKPascal} Hold_EBP: Sw_Word; {$ENDIF}
- BEGIN
- {$IFDEF FPKPascal} { FPK pascal compiler }
- ASM
- MOVL (%EBP), %EAX; { Load EBP }
- MOVL %EAX, U_OBJECTS_HOLDEBP; { Store to global }
- END;
- {$ELSE} { Other compilers }
- ASM
- {$IFNDEF CODE_32_BIT} { 16 BIT CODE }
- MOV AX, [BP]; { Load AX from BP }
- {$IFDEF Windows}
- AND AL, 0FEH; { Windows make even }
- {$ENDIF}
- MOV Hold_EBP, AX; { Hold value }
- {$ELSE} { 32 BIT CODE }
- MOV EAX, [EBP]; { Load EAX from EBP }
- MOV Hold_EBP, EAX; { Hold value }
- {$ENDIF}
- END;
- {$ENDIF}
- P := FuncPtr(Test); { Set function ptr }
- For I := Count DownTo 1 Do Begin { Down from last item }
- {$IFDEF FPKPascal}
- {$$$$$ crahes the compiler
- If P(Items^[I-1], HoldEBP) Then
- } Begin { Test each item }
- {$ELSE}
- {$IFDEF VirtualPascal}
- If P(Items^[I-1]) Then Begin { Test each item }
- {$ELSE}
- If P(Items^[I-1], Hold_EBP) Then Begin { Test each item }
- {$ENDIF}
- {$ENDIF}
- LastThat := Items^[I-1]; { Return item }
- Exit; { Now exit }
- End;
- End;
- LastThat := Nil; { None passed test }
- END;
- FUNCTION TCollection.FirstThat (Test: Pointer): Pointer;
- VAR I: LongInt; P: FuncPtr; {$IFDEF NotFPKPascal} Hold_EBP: Sw_Word; {$ENDIF}
- BEGIN
- {$IFDEF FPKPascal} { FPK pascal compiler }
- ASM
- MOVL (%EBP), %EAX; { Load EBP }
- MOVL %EAX, U_OBJECTS_HOLDEBP; { Store to global }
- END;
- {$ELSE} { Other compilers }
- ASM
- {$IFNDEF CODE_32_BIT} { 16 BIT CODE }
- MOV AX, [BP]; { Load AX from BP }
- {$IFDEF Windows}
- AND AL, 0FEH; { Windows make even }
- {$ENDIF}
- MOV Hold_EBP, AX; { Hold value }
- {$ELSE} { 32 BIT CODE }
- MOV EAX, [EBP]; { Load EAX from EBP }
- MOV Hold_EBP, EAX; { Hold value }
- {$ENDIF}
- END;
- {$ENDIF}
- P := FuncPtr(Test); { Set function ptr }
- For I := 1 To Count Do Begin { Up from first item }
- {$IFDEF FPKPascal}
- {$$$$$$ crashes the compiler
- If P(Items^[I-1], HoldEBP) Then }
- Begin { Test each item }
- {$ELSE}
- {$IFDEF VirtualPascal}
- If P(Items^[I-1]) Then Begin { Test each item }
- {$ELSE}
- If P(Items^[I-1], Hold_EBP) Then Begin { Test each item }
- {$ENDIF}
- {$ENDIF}
- FirstThat := Items^[I-1]; { Return item }
- Exit; { Now exit }
- End;
- End;
- FirstThat := Nil; { None passed test }
- END;
- { ******************************* REMARK ****************************** }
- { Bug fix of TCollection.Pack from the original code which was: }
- { While (I<Count) Do - Yes but who forget to initialize variable I }
- { If count is equal to zero this was going to crash big time and you }
- { must re-adjust the count value - Basically it was stuffed!!! }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- PROCEDURE TCollection.Pack;
- VAR I, J: Sw_Integer;
- BEGIN
- If (Count>0) Then Begin { Count is positive }
- I := 0; { Initialize dest }
- For J := 1 To Count Do Begin { For each item }
- If (Items^[J]<>Nil) Then Begin { Entry is non nil }
- Items^[I] := Items^[J]; { Transfer item }
- Inc(I); { Advance dest }
- End;
- End;
- Count := I; { Adjust count }
- End;
- END;
- PROCEDURE TCollection.FreeAll;
- VAR I: Sw_Integer;
- BEGIN
- For I := 0 To Count-1 Do FreeItem(At(I)); { Release each item }
- Count := 0; { Clear item count }
- END;
- PROCEDURE TCollection.DeleteAll;
- BEGIN
- Count := 0; { Clear item count }
- END;
- PROCEDURE TCollection.Free (Item: Pointer);
- BEGIN
- Delete(Item); { Delete from list }
- FreeItem(Item); { Free the item }
- END;
- PROCEDURE TCollection.Insert (Item: Pointer);
- BEGIN
- AtInsert(Count, Item); { Insert item }
- END;
- PROCEDURE TCollection.Delete (Item: Pointer);
- BEGIN
- AtDelete(IndexOf(Item)); { Delete from list }
- END;
- PROCEDURE TCollection.AtFree (Index: Sw_Integer);
- VAR Item: Pointer;
- BEGIN
- Item := At(Index); { Retreive item ptr }
- AtDelete(Index); { Delete item }
- FreeItem(Item); { Free the item }
- END;
- PROCEDURE TCollection.FreeItem (Item: Pointer);
- VAR P: PObject;
- BEGIN
- P := PObject(Item); { Convert pointer }
- If (P<>Nil) Then Dispose(P, Done); { Dispose of object }
- END;
- PROCEDURE TCollection.AtDelete (Index: Sw_Integer);
- BEGIN
- If (Index >= 0) AND (Index < Count) Then Begin { Valid index }
- Dec(Count); { One less item }
- If (Count>Index) Then Move(Items^[Index+1],
- Items^[Index], (Count-Index)*Sizeof(Pointer)); { Shuffle items down }
- End Else Error(coIndexError, Index); { Index error }
- END;
- PROCEDURE TCollection.ForEach (Action: Pointer);
- VAR I: LongInt; P: ProcPtr; {$IFDEF NotFPKPascal} Hold_EBP: Sw_Word; {$ENDIF}
- BEGIN
- {$IFDEF FPKPascal} { FPK pascal compiler }
- ASM
- MOVL (%EBP), %EAX; { Load EBP }
- MOVL %EAX, U_OBJECTS_HOLDEBP; { Store to global }
- END;
- {$ELSE} { Other compilers }
- ASM
- {$IFNDEF CODE_32_BIT} { 16 BIT CODE }
- MOV AX, [BP];
- {$IFDEF WINDOWS}
- AND AL, 0FEH; { Windows make even }
- {$ENDIF}
- MOV Hold_EBP, AX; { Hold value }
- {$ELSE} { 32 BIT CODE }
- MOV EAX, [EBP]; { Load EAX from EBP }
- MOV Hold_EBP, EAX; { Hold value }
- {$ENDIF}
- END;
- {$ENDIF}
- P := ProcPtr(Action); { Set procedure ptr }
- For I := 1 To Count Do { Up from first item }
- {$IFDEF FPKPascal}
- P(Items^[I-1], HoldEBP); { Call with each item }
- {$ELSE}
- {$IFDEF VirtualPascal}
- P(Items^[I-1]); { Call with each item }
- {$ELSE}
- P(Items^[I-1], Hold_EBP); { Call with each item }
- {$ENDIF}
- {$ENDIF}
- END;
- { ******************************* REMARK ****************************** }
- { Bug fix of TCollection.SetLimit from the original code which was: }
- { getmem(p,alimit*sizeof(pointer)); <- This can fail OR ALimit=0 }
- { move(items^,p^,count*sizeof(Pointer)); <- This would now crash! }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- PROCEDURE TCollection.SetLimit (ALimit: Sw_Integer);
- VAR AItems: PItemList;
- BEGIN
- If (ALimit < Count) Then ALimit := Count; { Stop underflow }
- If (ALimit > MaxCollectionSize) Then
- ALimit := MaxCollectionSize; { Stop overflow }
- If (ALimit <> Limit) Then Begin { Limits differ }
- If (ALimit = 0) Then AItems := Nil Else { Alimit=0 nil entry }
- GetMem(AItems, ALimit * SizeOf(Pointer)); { Allocate memory }
- If (AItems<>Nil) OR (ALimit=0) Then Begin { Check success }
- If (AItems <>Nil) AND (Items <> Nil) Then { Check both valid }
- Move(Items^, AItems^, Count*SizeOf(Pointer));{ Move existing items }
- If (Limit <> 0) AND (Items <> Nil) Then { Check old allocation }
- FreeMem(Items, Limit * SizeOf(Pointer)); { Release memory }
- Items := AItems; { Update items }
- Limit := ALimit; { Set limits }
- End;
- End;
- END;
- PROCEDURE TCollection.Error (Code, Info: Integer);
- BEGIN
- RunError(212 - Code); { Run error }
- END;
- PROCEDURE TCollection.AtPut (Index: Sw_Integer; Item: Pointer);
- BEGIN
- If (Index >= 0) AND (Index < Count) Then { Index valid }
- Items^[Index] := Item { Put item in index }
- Else Error(coIndexError, Index); { Index error }
- END;
- { ******************************* REMARK ****************************** }
- { Bug fix of TCollection.AtInsert from the original code which was: }
- { original remark: copy old items, count is tested by move }
- { Move(Items^[Index], Items^[Index+1],(Count-Index)*Sizeof(Pointer)); }
- { This does not work you must work from the back down!!!! }
- { ****************************** END REMARK *** Leon de Boer, 10May96 * }
- PROCEDURE TCollection.AtInsert (Index: Sw_Integer; Item: Pointer);
- VAR I: Sw_Integer;
- BEGIN
- If (Index >= 0) AND (Index <= Count) Then Begin { Valid index }
- If (Count=Limit) Then SetLimit(Limit+Delta); { Expand size if able }
- If (Limit>Count) Then Begin
- If (Index < Count) Then Begin { Not last item }
- For I := Count DownTo Index Do { Start from back }
- Items^[I] := Items^[I-1]; { Move each item }
- End;
- Items^[Index] := Item; { Put item in list }
- Inc(Count); { Inc count }
- End Else Error(coOverflow, Index); { Expand failed }
- End Else Error(coIndexError, Index); { Index error }
- END;
- PROCEDURE TCollection.Store (Var S: TStream);
- PROCEDURE DoPutItem (P: Pointer); FAR;
- BEGIN
- PutItem(S, P); { Put item on stream }
- END;
- BEGIN
- S.Write(Count, SizeOf(Count)); { Write count }
- S.Write(Limit, SizeOf(Limit)); { Write limit }
- S.Write(Delta, SizeOf(Delta)); { Write delta }
- ForEach(@DoPutItem); { Each item to stream }
- END;
- PROCEDURE TCollection.PutItem (Var S: TStream; Item: Pointer);
- BEGIN
- S.Put(Item); { Put item on stream }
- END;
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TSortedCollection OBJECT METHODS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- CONSTRUCTOR TSortedCollection.Init (ALimit, ADelta: Sw_Integer);
- BEGIN
- Inherited Init(ALimit, ADelta); { Call ancestor }
- Duplicates := False; { Clear flag }
- END;
- CONSTRUCTOR TSortedCollection.Load (Var S: TStream);
- BEGIN
- Inherited Load(S); { Call ancestor }
- S.Read(Duplicates, SizeOf(Duplicates)); { Read duplicate flag }
- END;
- FUNCTION TSortedCollection.KeyOf (Item: Pointer): Pointer;
- BEGIN
- KeyOf := Item; { Return item }
- END;
- FUNCTION TSortedCollection.IndexOf (Item: Pointer): Sw_Integer;
- VAR I: Sw_Integer;
- BEGIN
- IndexOf := -1; { Preset result }
- If Search(KeyOf(Item), I) Then Begin { Search for item }
- If Duplicates Then { Duplicates allowed }
- While (I < Count) AND (Item <> Items^[I]) Do
- Inc(I); { Count duplicates }
- If (I < Count) Then IndexOf := I; { Return result }
- End;
- END;
- FUNCTION TSortedCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
- BEGIN
- Abstract; { Abstract method }
- END;
- FUNCTION TSortedCollection.Search (Key: Pointer; Var Index: Sw_Integer): Boolean;
- VAR L, H, I, C: Sw_Integer;
- BEGIN
- Search := False; { Preset failure }
- L := 0; { Start count }
- H := Count - 1; { End count }
- While (L <= H) Do Begin
- I := (L + H) SHR 1; { Mid point }
- C := Compare(KeyOf(Items^[I]), Key); { Compare with key }
- If (C < 0) Then L := I + 1 Else Begin { Item to left }
- H := I - 1; { Item to right }
- If C = 0 Then Begin { Item match found }
- Search := True; { Result true }
- If NOT Duplicates Then L := I; { Force kick out }
- End;
- End;
- End;
- Index := L; { Return result }
- END;
- PROCEDURE TSortedCollection.Insert (Item: Pointer);
- VAR I: Sw_Integer;
- BEGIN
- If NOT Search(KeyOf(Item), I) OR Duplicates Then { Item valid }
- AtInsert(I, Item); { Insert the item }
- END;
- PROCEDURE TSortedCollection.Store (Var S: TStream);
- BEGIN
- TCollection.Store(S); { Call ancestor }
- S.Write(Duplicates, SizeOf(Duplicates)); { Write duplicate flag }
- END;
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TStringCollection OBJECT METHODS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- FUNCTION TStringCollection.GetItem (Var S: TStream): Pointer;
- BEGIN
- GetItem := S.ReadStr; { Get new item }
- END;
- FUNCTION TStringCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
- VAR I, J: Integer; P1, P2: PString;
- BEGIN
- P1 := PString(Key1); { String 1 pointer }
- P2 := PString(Key2); { String 2 pointer }
- If (Length(P1^)<Length(P2^)) Then J := Length(P1^)
- Else J := Length(P2^); { Shortest length }
- I := 1; { First character }
- While (I<J) AND (P1^[I]=P2^[I]) Do Inc(I); { Scan till fail }
- If (P1^[I]=P2^[I]) Then Compare := 0 Else { Strings matched }
- If (P1^[I]<P2^[I]) Then Compare := -1 Else { String1 < String2 }
- Compare := 1; { String1 > String2 }
- END;
- PROCEDURE TStringCollection.FreeItem (Item: Pointer);
- BEGIN
- DisposeStr(Item); { Dispose item }
- END;
- PROCEDURE TStringCollection.PutItem (Var S: TStream; Item: Pointer);
- BEGIN
- S.WriteStr(Item); { Write string }
- END;
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ TUnSortedStrCollection OBJECT METHODS Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- PROCEDURE TUnSortedStrCollection.Insert (Item: Pointer);
- BEGIN
- AtInsert(Count, Item); { NO sorting insert }
- END;
- FUNCTION TStream.Get: PObject;
- BEGIN
- END;
- PROCEDURE TStream.Put (P: PObject);
- BEGIN
- END;
- {***************************************************************************}
- { INTERFACE ROUTINES }
- {***************************************************************************}
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ DYNAMIC STRING INTERFACE ROUTINES Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- FUNCTION NewStr (Const S: String): PString;
- VAR P: PString;
- BEGIN
- If (S = '') Then P := Nil Else Begin { Return nil }
- GetMem(P, Length(S) + 1); { Allocate memory }
- If (P<>Nil) Then P^ := S; { Hold string }
- End;
- NewStr := P; { Return result }
- END;
- PROCEDURE DisposeStr (P: PString);
- BEGIN
- If (P <> Nil) Then FreeMem(P, Length(P^) + 1); { Release memory }
- END;
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ STREAM INTERFACE ROUTINES Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- PROCEDURE Abstract;
- BEGIN
- RunError(211); { Abstract error }
- END;
- PROCEDURE RegisterError;
- BEGIN
- RunError(212); { Register error }
- END;
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ NEW FREE VISION STREAM ROUTINES Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- FUNCTION CreateStream (Strategy: Word; ReqSize: LongInt): PStream;
- VAR Stream: PStream;
- BEGIN
- Stream := Nil; { Preset failure }
- While (Strategy <> 0) AND (Stream = Nil) Do Begin
- If (Strategy AND sa_XMSFirst <> 0) Then Begin { ** XMS STREAM ** }
- End Else
- If (Strategy AND sa_EMSFirst <> 0) Then Begin { ** EMS STREAM ** }
- End Else
- If (Strategy AND sa_RamFirst <> 0) Then Begin { ** RAM STREAM ** }
- End Else
- If (Strategy AND sa_DiskFirst <> 0) Then Begin { ** DISK STREAM ** }
- End;
- If (Stream<>Nil) AND (Stream^.Status <> stOk) { Stream in error }
- Then Begin
- Dispose(Stream, Done); { Dispose stream }
- Stream := Nil; { Clear pointer }
- End;
- Strategy := Strategy SHL 4; { Next strategy mask }
- End;
- CreateStream := Stream; { Return stream result }
- END;
- {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
- {Þ NEW FREE VISION DOS FILE ROUTINES Ý}
- {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
- {***************************************************************************}
- { DosFileOpen -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
- {***************************************************************************}
- FUNCTION DosFileOpen (Var FileName: AsciiZ; Mode: Word): Word;
- {$IFDEF NotOS2} { DOS/DPMI/WINDOWS }
- {$IFDEF FPKPascal} { FPK Pascal compiler }
- {$IFDEF GO32V2}
- var regs : trealregs;
- BEGIN
- syscopytodos(longint(@FileName),256);
- regs.realedx:=tb mod 16;
- regs.realds:=tb div 16;
- regs.realeax := Mode;
- regs.realecx:=0;
- sysrealintr($21,regs);
- if (regs.realflags and 1) <> 0 then
- begin
- InOutRes:=lo(regs.realeax);
- DosFileOpen:=-1;
- exit;
- end else
- DosFileOpen:=regs.realeax;
- END;
- {$ELSE not GO32V2}
- BEGIN
- ASM
- XOR %AX, %AX; { Clear error }
- MOVW %AX, U_OBJECTS_DOSSTREAMERROR;
- MOVL Filename, %EDX; { Filename to open }
- XOR %CX, %CX;
- MOVW Mode, %AX; { Mode to open file }
- PUSHL %EBP;
- INT $0x21; { Open/create the file }
- POPL %EBP;
- JNC EXIT1;
- MOV %AX, U_OBJECTS_DOSSTREAMERROR; { Hold error }
- XOR %AX, %AX; { Open failed }
- EXIT1:
- MOV %AX, U_OBJECTS_TRANSFERHANDLE; { Hold opened handle }
- END;
- DosFileOpen := TransferHandle; { Return handle }
- END;
- {$ENDIF GO32V2}
- {$ELSE} { Other compilers }
- ASSEMBLER;
- ASM
- XOR AX, AX; { Dos error cleared }
- MOV DosStreamError, AX;
- MOV AX, Mode; { Mode to open file }
- PUSH DS;
- LDS DX, FileName; { Filename to open }
- XOR CX, CX;
- INT $21; { Open/create file }
- POP DS;
- JNC @@Exit1; { Check for error }
- MOV DosStreamError, AX;
- XOR AX, AX; { Open fail return 0 }
- @@Exit1:
- END;
- {$ENDIF}
- {$ELSE} { OS2 CODE }
- {$IFNDEF FPK}
- VAR Attr, OpenFlags, OpenMode: Word; Success, Handle, ActionTaken: Sw_Word;
- BEGIN
- Case Mode Of
- stCreate: Begin { Create file }
- Attr := $20; { Archive file }
- OpenFlags := 18; { Open flags }
- OpenMode := FmInOut; { Input/output file }
- End;
- stOpenRead: Begin { Open file for read }
- Attr := $0; { Any attributes }
- OpenFlags := 1; { Open flags }
- OpenMode := FmInput; { Input file }
- End;
- stOpenWrite: Begin { Open file for write }
- Attr := $0; { Any attributes }
- OpenFlags := 1; { Open flags }
- OpenMode := FmOutput; { Output file }
- End;
- stOpen: Begin { Open file read/write }
- Attr := $0; { Any attributes }
- OpenFlags := 1; { Open flags }
- OpenMode := FmInOut; { Input/output file }
- End;
- End;
- {$IFDEF Speed} { Speed pascal differs }
- DosStreamError := DosOpen(CString(FileName), Handle,
- {$ELSE} { Other OS2 compilers }
- DosStreamError := DosOpen(@FileName[0], Handle,
- {$ENDIF}
- ActionTaken, 0, Attr, OpenFlags, OpenMode, Nil); { Open the file }
- If (DosStreamError=0) Then DosFileOpen := Handle { Successful open }
- Else DosFileOpen := 0; { Fail so return zero }
- END;
- {$ELSE FPK}
- BEGIN
- ASM
- XOR %AX, %AX; { Clear error }
- MOVW %AX, U_OBJECTS_DOSSTREAMERROR;
- MOVL Filename, %EDX; { Filename to open }
- XOR %CX, %CX;
- MOVW Mode, %AX; { Mode to open file }
- CALL ___SYSCALL; { Open/create the file }
- JNC EXIT1;
- MOV %AX, U_OBJECTS_DOSSTREAMERROR; { Hold error }
- XOR %AX, %AX; { Open failed }
- EXIT1:
- MOV %AX, U_OBJECTS_TRANSFERHANDLE; { Hold opened handle }
- END;
- DosFileOpen := TransferHandle; { Return handle }
- END;
- {$ENDIF FPK}
- {$ENDIF}
- {***************************************************************************}
- { DosRead -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB }
- {***************************************************************************}
- FUNCTION DosRead (Handle: Word; Var BufferArea; BufferLength: Sw_Word;
- Var BytesMoved: Sw_Word): Word;
- {$IFDEF FPKPascal} { FPK pascal compiler }
- {$IFDEF GO32V2}
- BEGIN
- BytesMoved:=system.dosread(Handle,longint(@BufferArea),BufferLength);
- DosRead:=InOutRes;
- End;
- {$ELSE not GO32V2}
- {$IFNDEF OS2}
- BEGIN
- ASM
- MOVL BufferArea, %EDX; { Buffer for data }
- MOVL BufferLength, %CX; { Bytes to read }
- MOVB $0x3F, %AH;
- MOVW Handle, %BX; { Load file handle }
- PUSHL %EBP;
- INT $0x21; { Read from file }
- POPL %EBP;
- JC EXIT2; { Check for error }
- MOVL BytesMoved, %EDI;
- MOVZWL %AX, %EAX;
- MOVL %EAX, (%EDI); { Update bytes moved }
- XOR %EAX, %EAX; { Clear register }
- EXIT2:
- MOV %AX, U_OBJECTS_DOSSTREAMERROR; { DOS error returned }
- END;
- DosRead := DosStreamError; { Return any error }
- END;
- {$ELSE OS2}
- BEGIN
- ASM
- MOVL BufferArea, %EDX; { Buffer for data }
- MOVL BufferLength, %CX; { Bytes to read }
- MOVB $0x3F, %AH;
- MOVW Handle, %BX; { Load file handle }
- CALL ___SYSCALL; { Read from file }
- JC EXIT2; { Check for error }
- MOVL BytesMoved, %EDI;
- MOVZWL %AX, %EAX;
- MOVL %EAX, (%EDI); { Update bytes moved }
- XOR %EAX, %EAX; { Clear register }
- EXIT2:
- MOV %AX, U_OBJECTS_DOSSTREAMERROR; { DOS error returned }
- END;
- DosRead := DosStreamError; { Return any error }
- END;
- {$ENDIF OS2}
- {$EndIf GO32V2}
- {$ELSE} { Other compilers }
- ASSEMBLER;
- ASM
- PUSH DS;
- LDS DX, BufferArea; { Data dest buffer }
- MOV CX, BufferLength;
- MOV BX, Handle; { Load file handle }
- MOV AH, $0x3F;
- INT $0x21; { Read from file }
- POP DS;
- JC @@Exit2; { Check for error }
- LES DI, BytesMoved;
- MOV ES:[DI], AX; { Update bytes moved }
- XOR AX, AX;
- @@Exit2:
- MOV DosStreamError, AX; { DOS error returned }
- END;
- {$ENDIF}
- {***************************************************************************}
- { DosWrite -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB }
- {***************************************************************************}
- FUNCTION DosWrite (Handle: Word; Var BufferArea; BufferLength: Sw_Word;
- Var BytesMoved: Sw_Word): Word;
- {$IFDEF FPKPascal} { FPK pascal compiler }
- {$IFDEF GO32V2}
- BEGIN
- system.doswrite(Handle,longint(@BufferArea),BufferLength);
- BytesMoved:=BufferLength;
- DosWrite:=InOutRes;
- End;
- {$ELSE not GO32V2}
- BEGIN
- ASM
- MOVL BufferArea, %EDX; { Buffer with data }
- MOVL BufferLength, %CX; { Bytes to write }
- MOVB $0x40, %AH;
- MOVW Handle, %BX; { Load file handle }
- PUSHL %EBP;
- INT $0x21; { Write to file }
- POPL %EBP;
- JC EXIT3; { Check for error }
- MOVL BytesMoved, %EDI;
- MOVZWL %AX, %EAX;
- MOVL %EAX, (%EDI); { Update bytes moved }
- XOR %EAX, %EAX;
- EXIT3:
- MOV %AX, U_OBJECTS_DOSSTREAMERROR; { DOS error returned }
- END;
- DosWrite := DosStreamError; { Return any error }
- END;
- {$ENDIF GO32V2}
- {$ELSE} { Other compilers }
- ASSEMBLER;
- ASM
- PUSH DS;
- LDS DX, BufferArea; { Data source buffer }
- MOV CX, BufferLength;
- MOV BX, Handle; { Load file handle }
- MOV AH, $40;
- INT $21; { Write to file }
- POP DS;
- JC @@Exit3; { Check for error }
- LES DI, BytesMoved;
- MOV ES:[DI], AX; { Update bytes moved }
- XOR AX, AX;
- @@Exit3:
- MOV DosStreamError, AX; { DOS error returned }
- END;
- {$ENDIF}
- {***************************************************************************}
- { DosSetFilePtr -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB }
- {***************************************************************************}
- FUNCTION DosSetFilePtr (Handle: Word; Pos: LongInt; MoveType: Word;
- VAR NewPos: LongInt): Word;
- {$IFDEF FPKPascal} { FPK pascal compiler }
- {$IFNDEF OS2}
- BEGIN
- ASM
- MOVW MoveType, %AX; { Load move type }
- MOVB $0x42, %AH;
- MOVW POS, %DX; { Load file position }
- MOVL POS, %ECX;
- SHRL $16,%ECX;
- MOVW Handle, %BX; { Load file handle }
- PUSHL %EBP;
- INT $0x21; { Position the file }
- POPL %EBP;
- JC EXIT4;
- MOVL NewPos, %EDI; { New position address }
- MOVW %AX, %BX;
- MOVW %DX, %AX;
- SHLL $0x10, %EAX; { Roll to high part }
- MOVW %BX, %AX;
- MOVL %EAX, (%EDI); { Update new position }
- XOR %EAX, %EAX;
- EXIT4:
- MOVW %AX, U_OBJECTS_DOSSTREAMERROR; { DOS error returned }
- END;
- DosSetFilePtr := DosStreamError; { Return any error }
- END;
- {$ELSE OS2}
- BEGIN
- ASM
- MOVW MoveType, %AX; { Load move type }
- MOVB $0x42, %AH;
- MOVW POS, %DX; { Load file position }
- MOVL POS, %ECX;
- SHRL $16,%ECX;
- MOVW Handle, %BX; { Load file handle }
- CALL ___SYSCALL; { Position the file }
- JC EXIT4;
- MOVL NewPos, %EDI; { New position address }
- MOVW %AX, %BX;
- MOVW %DX, %AX;
- SHLL $0x10, %EAX; { Roll to high part }
- MOVW %BX, %AX;
- MOVL %EAX, (%EDI); { Update new position }
- XOR %EAX, %EAX;
- EXIT4:
- MOVW %AX, U_OBJECTS_DOSSTREAMERROR; { DOS error returned }
- END;
- DosSetFilePtr := DosStreamError; { Return any error }
- END;
- {$ENDIF OS2}
- {$ELSE} { Other compilers }
- ASSEMBLER;
- ASM
- MOV AX, MoveType; { Load move type }
- MOV AH, $42;
- MOV DX, Pos.Word[0]; { Load file position }
- MOV CX, Pos.Word[2];
- MOV BX, Handle; { Load file handle }
- INT $21; { Position the file }
- JC @@Exit4;
- LES DI, NewPos; { New position address }
- MOV ES:[DI], AX;
- MOV ES:[DI+2], DX; { Update new position }
- XOR AX, AX;
- @@Exit4:
- MOV DosStreamError, AX; { DOS error returned }
- END;
- {$ENDIF}
- {***************************************************************************}
- { DosClose -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB }
- {***************************************************************************}
- PROCEDURE DosClose (Handle: Word);
- {$IFDEF FPKPascal} { FPK pascal compiler }
- {$IFNDEF OS2}
- BEGIN
- ASM
- XOR %AX, %AX;
- MOVW %AX, U_OBJECTS_DOSSTREAMERROR; { DOS error cleared }
- MOVB $0x3E, %AH;
- MOVW Handle, %BX; { DOS file handle }
- PUSHL %EBP;
- INT $0x21; { Close the file }
- POPL %EBP;
- JNC EXIT5;
- MOVW %AX, U_OBJECTS_DOSSTREAMERROR; { DOS error returned }
- EXIT5:
- END;
- END;
- {$ELSE OS2}
- BEGIN
- ASM
- XOR %AX, %AX;
- MOVW %AX, U_OBJECTS_DOSSTREAMERROR; { DOS error cleared }
- MOVB $0x3E, %AH;
- MOVW Handle, %BX; { DOS file handle }
- CALL ___SYSCALL; { Close the file }
- JNC EXIT5;
- MOVW %AX, U_OBJECTS_DOSSTREAMERROR; { DOS error returned }
- EXIT5:
- END;
- END;
- {$ENDIF OS2}
- {$ELSE} { Other compilers }
- ASSEMBLER;
- ASM
- XOR AX, AX; { DOS error cleared }
- MOV DosStreamError, AX;
- MOV BX, Handle; { DOS file handle }
- MOV AH, $3E;
- INT $21; { Close the file }
- JNC @@Exit5;
- MOV DosStreamError, AX; { DOS error returned }
- @@Exit5:
- END;
- {$ENDIF}
- END.
|