objects.pp 44 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1993,97 by the Free Pascal development team.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {**********[ SOURCE FILE OF FREE VISION ]***************}
  12. { }
  13. { Parts Copyright (c) 1992,96 by Florian Klaempfl }
  14. { [email protected] }
  15. { }
  16. { Parts Copyright (c) 1996 by Frank ZAGO }
  17. { [email protected] }
  18. { }
  19. { Parts Copyright (c) 1995 by MH Spiegel }
  20. { }
  21. { Parts Copyright (c) 1996 by Leon de Boer }
  22. { [email protected] }
  23. { }
  24. { THIS CODE IS FREEWARE }
  25. {*******************************************************}
  26. {***************[ SUPPORTED PLATFORMS ]*****************}
  27. { 16 and 32 Bit compilers }
  28. { DOS - Turbo Pascal 7.0 + (16 Bit) }
  29. { - FPK Pascal (32 Bit) }
  30. { DPMI - Turbo Pascal 7.0 + (16 Bit) }
  31. { WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
  32. { OS2 - Virtual Pascal 0.3 + (32 Bit) }
  33. { SpeedPascal 1.5 G + (32 Bit) }
  34. { C'T patch to BP (16 Bit) }
  35. {*******************************************************}
  36. UNIT Objects;
  37. {$I os.inc}
  38. INTERFACE
  39. CONST
  40. Sw_MaxData = 128*1024*1024; { Maximum data size }
  41. TYPE
  42. Sw_Word = LongInt; { Long integer now }
  43. Sw_Integer = LongInt; { Long integer now }
  44. TYPE
  45. FuncPtr = FUNCTION (Item: Pointer; _EBP: Sw_Word): Boolean;
  46. ProcPtr = PROCEDURE (Item: Pointer; _EBP: Sw_Word);
  47. CONST
  48. stOk = 0; { No stream error }
  49. stError = -1; { Access error }
  50. stInitError = -2; { Initialize error }
  51. stReadError = -3; { Stream read error }
  52. stWriteError = -4; { Stream write error }
  53. stGetError = -5; { Get object error }
  54. stPutError = -6; { Put object error }
  55. stSeekError = -7; { Seek error in stream }
  56. stOpenError = -8; { Error opening stream }
  57. CONST
  58. stCreate = $3C00; { Create new file }
  59. stOpenRead = $3D00; { Read access only }
  60. stOpenWrite = $3D01; { Write access only }
  61. stOpen = $3D02; { Read/write access }
  62. CONST
  63. coIndexError = -1; { Index out of range }
  64. coOverflow = -2; { Overflow }
  65. CONST
  66. sa_XMSFirst = $8000; { Use XMS memory 1st }
  67. sa_EMSFirst = $4000; { Use EMS memory 1st }
  68. sa_RAMFirst = $2000; { Use RAM memory 1st }
  69. sa_DISKFirst = $1000; { Use DISK space 1st }
  70. sa_XMSSecond = $0800; { Use XMS memory 2nd }
  71. sa_EMSSecond = $0400; { Use EMS memory 2nd }
  72. sa_RAMSecond = $0200; { Use RAM memory 2nd }
  73. sa_DISKSecond = $0100; { Use DISK space 2nd }
  74. sa_XMSThird = $0080; { Use XMS memory 3rd }
  75. sa_EMSThird = $0040; { Use EMS memory 3rd }
  76. sa_RAMThird = $0020; { Use RAM memory 3rd }
  77. sa_DISKThird = $0010; { Use DISK space 3rd }
  78. sa_XMSFourth = $0008; { Use XMS memory 4th }
  79. sa_EMSFourth = $0004; { Use EMS memory 4th }
  80. sa_RAMFourth = $0002; { Use RAM memory 4th }
  81. sa_DISKFourth = $0001; { Use DISK space 4th }
  82. CONST
  83. vmtHeaderSize = 8; { VMT header size }
  84. CONST
  85. MaxCollectionSize = Sw_MaxData DIV SizeOf(Pointer);{ Max collection size }
  86. TYPE
  87. TCharSet = SET Of Char; { Character set }
  88. PCharSet = ^TCharSet; { Character set ptr }
  89. TYPE
  90. TByteArray = ARRAY [0..Sw_MaxData-1] Of Byte; { Byte array }
  91. PByteArray = ^TByteArray; { Byte array pointer }
  92. TWordArray = ARRAY [0..Sw_MaxData DIV 2-1] Of Word;{ Word array }
  93. PWordArray = ^TWordArray; { Word array pointer }
  94. TYPE
  95. FNameStr = String;
  96. TYPE
  97. AsciiZ = Array [0..255] Of Char; { Filename array }
  98. TYPE
  99. PByte = ^Byte; { Byte pointer }
  100. PWord = ^Word; { Word pointer }
  101. PLongInt = ^LongInt; { LongInt pointer }
  102. PString = ^String; { String pointer }
  103. TYPE
  104. WordRec = RECORD
  105. Lo, Hi: Byte; { Word to bytes }
  106. END;
  107. LongRec = RECORD
  108. Lo, Hi: Word; { LongInt to words }
  109. END;
  110. PtrRec = RECORD
  111. Ofs, Seg: Word; { Pointer to words }
  112. END;
  113. TYPE
  114. PStreamRec = ^TStreamRec; { Stream record ptr }
  115. TStreamRec = RECORD
  116. ObjType: Sw_Word; { Object type id }
  117. VmtLink: Sw_Word; { VMT link }
  118. Load : Pointer; { Object load code }
  119. Store: Pointer; { Object store code }
  120. Next : Sw_Word; { Bytes to next }
  121. END;
  122. TYPE
  123. TPoint = OBJECT
  124. X, Y: Integer; { Point co-ordinates }
  125. END;
  126. TRect = OBJECT
  127. A, B: TPoint; { Corner points }
  128. FUNCTION Empty: Boolean;
  129. FUNCTION Equals (R: TRect): Boolean;
  130. FUNCTION Contains (P: TPoint): Boolean;
  131. PROCEDURE Copy (R: TRect);
  132. PROCEDURE Union (R: TRect);
  133. PROCEDURE Intersect (R: TRect);
  134. PROCEDURE Move (ADX, ADY: Integer);
  135. PROCEDURE Grow (ADX, ADY: Integer);
  136. PROCEDURE Assign (XA, YA, XB, YB: Integer);
  137. END;
  138. PRect = ^TRect;
  139. TYPE
  140. TObject = OBJECT
  141. CONSTRUCTOR Init;
  142. PROCEDURE Free;
  143. DESTRUCTOR Done; Virtual;
  144. END;
  145. PObject = ^TObject;
  146. TYPE
  147. TStream = OBJECT (TObject)
  148. Status : Integer; { Stream status }
  149. ErrorInfo: Integer; { Stream error info }
  150. FUNCTION Get: PObject;
  151. FUNCTION StrRead: PChar;
  152. FUNCTION GetPos: LongInt; Virtual;
  153. FUNCTION GetSize: LongInt; Virtual;
  154. FUNCTION ReadStr: PString;
  155. PROCEDURE Close; Virtual;
  156. PROCEDURE Reset;
  157. PROCEDURE Flush; Virtual;
  158. PROCEDURE Truncate; Virtual;
  159. PROCEDURE Put (P: PObject);
  160. PROCEDURE Seek (Pos: LongInt); Virtual;
  161. PROCEDURE StrWrite (P: PChar);
  162. PROCEDURE WriteStr (P: PString);
  163. PROCEDURE Open (OpenMode: Word); Virtual;
  164. PROCEDURE Error (Code, Info: Integer); Virtual;
  165. PROCEDURE Read (Var Buf; Count: Sw_Word); Virtual;
  166. PROCEDURE Write (Var Buf; Count: Sw_Word); Virtual;
  167. PROCEDURE CopyFrom (Var S: TStream; Count: Longint);
  168. END;
  169. PStream = ^TStream;
  170. TYPE
  171. TDosStream = OBJECT (TStream)
  172. Handle: Integer; { DOS file handle }
  173. FName : AsciiZ; { AsciiZ filename }
  174. CONSTRUCTOR Init (FileName: FNameStr; Mode: Word);
  175. DESTRUCTOR Done; Virtual;
  176. FUNCTION GetPos: Longint; Virtual;
  177. FUNCTION GetSize: Longint; Virtual;
  178. PROCEDURE Close; Virtual;
  179. PROCEDURE Seek (Pos: LongInt); Virtual;
  180. PROCEDURE Open (OpenMode: Word); Virtual;
  181. PROCEDURE Read (Var Buf; Count: Sw_Word); Virtual;
  182. PROCEDURE Write (Var Buf; Count: Sw_Word); Virtual;
  183. END;
  184. PDosStream = ^TDosStream;
  185. TYPE
  186. TBufStream = OBJECT (TDosStream)
  187. END;
  188. PBufStream = ^TBufStream;
  189. TYPE
  190. TEmsStream = OBJECT (TStream)
  191. END;
  192. PEmsStream = ^TEmsStream;
  193. TYPE
  194. TXmsStream = OBJECT (TStream)
  195. END;
  196. PXmsStream = ^TXmsStream;
  197. TYPE
  198. TMemoryStream = OBJECT (TStream)
  199. END;
  200. PMemoryStream = ^TMemoryStream;
  201. TYPE
  202. TItemList = Array [0..MaxCollectionSize - 1] Of Pointer;
  203. PItemList = ^TItemList;
  204. TCollection = OBJECT (TObject)
  205. Items: PItemList; { Item list pointer }
  206. Count: Sw_Integer; { Item count }
  207. Limit: Sw_Integer; { Item limit count }
  208. Delta: Sw_Integer; { Inc delta size }
  209. CONSTRUCTOR Init (ALimit, ADelta: Sw_Integer);
  210. CONSTRUCTOR Load (Var S: TStream);
  211. DESTRUCTOR Done; Virtual;
  212. FUNCTION At (Index: Sw_Integer): Pointer;
  213. FUNCTION IndexOf (Item: Pointer): Sw_Integer; Virtual;
  214. FUNCTION GetItem (Var S: TStream): Pointer; Virtual;
  215. FUNCTION LastThat (Test: Pointer): Pointer;
  216. FUNCTION FirstThat (Test: Pointer): Pointer;
  217. PROCEDURE Pack;
  218. PROCEDURE FreeAll;
  219. PROCEDURE DeleteAll;
  220. PROCEDURE Free (Item: Pointer);
  221. PROCEDURE Insert (Item: Pointer); Virtual;
  222. PROCEDURE Delete (Item: Pointer);
  223. PROCEDURE AtFree (Index: Sw_Integer);
  224. PROCEDURE FreeItem (Item: Pointer); Virtual;
  225. PROCEDURE AtDelete (Index: Sw_Integer);
  226. PROCEDURE ForEach (Action: Pointer);
  227. PROCEDURE SetLimit (ALimit: Sw_Integer); Virtual;
  228. PROCEDURE Error (Code, Info: Integer); Virtual;
  229. PROCEDURE AtPut (Index: Sw_Integer; Item: Pointer);
  230. PROCEDURE AtInsert (Index: Sw_Integer; Item: Pointer);
  231. PROCEDURE Store (Var S: TStream);
  232. PROCEDURE PutItem (Var S: TStream; Item: Pointer); Virtual;
  233. END;
  234. PCollection = ^TCollection;
  235. TYPE
  236. TSortedCollection = OBJECT (TCollection)
  237. Duplicates: Boolean; { Duplicates flag }
  238. CONSTRUCTOR Init (ALimit, ADelta: Sw_Integer);
  239. CONSTRUCTOR Load (Var S: TStream);
  240. FUNCTION KeyOf (Item: Pointer): Pointer; Virtual;
  241. FUNCTION IndexOf (Item: Pointer): Sw_Integer; Virtual;
  242. FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer; Virtual;
  243. FUNCTION Search (Key: Pointer; Var Index: Sw_Integer): Boolean;Virtual;
  244. PROCEDURE Insert (Item: Pointer); Virtual;
  245. PROCEDURE Store (Var S: TStream);
  246. END;
  247. PSortedCollection = ^TSortedCollection;
  248. TYPE
  249. TStringCollection = OBJECT (TSortedCollection)
  250. FUNCTION GetItem (Var S: TStream): Pointer; Virtual;
  251. FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer; Virtual;
  252. PROCEDURE FreeItem (Item: Pointer); Virtual;
  253. PROCEDURE PutItem (Var S: TStream; Item: Pointer); Virtual;
  254. END;
  255. PStringCollection = ^TStringCollection;
  256. TYPE
  257. TUnSortedStrCollection = OBJECT (TStringCollection)
  258. PROCEDURE Insert (Item: Pointer); Virtual;
  259. END;
  260. PUnSortedStrCollection = ^TUnSortedStrCollection;
  261. FUNCTION NewStr (Const S: String): PString;
  262. PROCEDURE DisposeStr (P: PString);
  263. PROCEDURE Abstract;
  264. PROCEDURE RegisterError;
  265. FUNCTION CreateStream (Strategy: Word; ReqSize: LongInt): PStream;
  266. FUNCTION DosFileOpen (Var FileName: AsciiZ; Mode: Word): Word;
  267. FUNCTION DosRead(Handle: Word; Var BufferArea; BufferLength: Sw_Word;
  268. Var BytesMoved: Sw_Word): Word;
  269. FUNCTION DosWrite(Handle: Word; Var BufferArea; BufferLength: Sw_Word;
  270. Var BytesMoved: Sw_Word): Word;
  271. FUNCTION DosSetFilePtr (Handle: Word; Pos: LongInt; MoveType: Word;
  272. Var NewPos: LongInt): Word;
  273. PROCEDURE DosClose (Handle: Word);
  274. CONST
  275. StreamError: Pointer = Nil; { Stream error ptr }
  276. VAR HoldEBP: Sw_Word; TransferHandle: Sw_Word;
  277. DosStreamError: Sw_Word ; { Dos stream error }
  278. IMPLEMENTATION
  279. CONST
  280. StreamTypes: Sw_Word = $0; { Stream types }
  281. PROCEDURE CheckEmpty (Var Rect: TRect);
  282. BEGIN
  283. If (Rect.A.X >= Rect.B.X) OR
  284. (Rect.A.Y >= Rect.B.Y) Then Begin { Zero of reversed }
  285. Rect.A.X := 0; { Clear a.x }
  286. Rect.A.Y := 0; { Clear a.y }
  287. Rect.B.X := 0; { Clear b.x }
  288. Rect.B.Y := 0; { Clear b.y }
  289. End;
  290. END;
  291. FUNCTION TRect.Empty: Boolean;
  292. BEGIN
  293. Empty := (A.X >= B.X) OR (A.Y >= B.Y); { Empty result }
  294. END;
  295. FUNCTION TRect.Equals (R: TRect): Boolean;
  296. BEGIN
  297. Equals := (A.X = R.A.X) AND (A.Y = R.A.Y) AND
  298. (B.X = R.B.X) AND (B.Y = R.B.Y); { Equals result }
  299. END;
  300. FUNCTION TRect.Contains (P: TPoint): Boolean;
  301. BEGIN
  302. Contains := (P.X >= A.X) AND (P.X < B.X) AND
  303. (P.Y >= A.Y) AND (P.Y < B.Y); { Contains result }
  304. END;
  305. PROCEDURE TRect.Copy (R: TRect);
  306. BEGIN
  307. A := R.A; { Copy point a }
  308. B := R.B; { Copy point b }
  309. END;
  310. PROCEDURE TRect.Union (R: TRect);
  311. BEGIN
  312. If (R.A.X < A.X) Then A.X := R.A.X; { Take if smaller }
  313. If (R.A.Y < A.Y) Then A.Y := R.A.Y; { Take if smaller }
  314. If (R.B.X > B.X) Then B.X := R.B.X; { Take if larger }
  315. If (R.B.Y > B.Y) Then B.Y := R.B.Y; { Take if larger }
  316. END;
  317. PROCEDURE TRect.Intersect (R: TRect);
  318. BEGIN
  319. If (R.A.X > A.X) Then A.X := R.A.X; { Take if larger }
  320. If (R.A.Y > A.Y) Then A.Y := R.A.Y; { Take if larger }
  321. If (R.B.X < B.X) Then B.X := R.B.X; { Take if smaller }
  322. If (R.B.Y < B.Y) Then B.Y := R.B.Y; { Take if smaller }
  323. CheckEmpty(Self); { Check if empty }
  324. END;
  325. PROCEDURE TRect.Move (ADX, ADY: Integer);
  326. BEGIN
  327. Inc(A.X, ADX); { Adjust A.X }
  328. Inc(A.Y, ADY); { Adjust A.Y }
  329. Inc(B.X, ADX); { Adjust B.X }
  330. Inc(B.Y, ADY); { Adjust B.Y }
  331. END;
  332. PROCEDURE TRect.Grow (ADX, ADY: Integer);
  333. BEGIN
  334. Dec(A.X, ADX); { Adjust A.X }
  335. Dec(A.Y, ADY); { Adjust A.Y }
  336. Inc(B.X, ADX); { Adjust B.X }
  337. Inc(B.Y, ADY); { Adjust B.Y }
  338. CheckEmpty(Self); { Check if empty }
  339. END;
  340. PROCEDURE TRect.Assign (XA, YA, XB, YB: Integer);
  341. BEGIN
  342. A.X := XA; { Hold A.X value }
  343. A.Y := YA; { Hold A.Y value }
  344. B.X := XB; { Hold B.X value }
  345. B.Y := YB; { Hold B.Y value }
  346. END;
  347. TYPE
  348. DummyObject = OBJECT (TObject) { Internal object }
  349. Data: RECORD END; { Helps size VMT link }
  350. END;
  351. CONSTRUCTOR TObject.Init;
  352. VAR LinkSize: LongInt; Dummy: DummyObject;
  353. BEGIN
  354. LinkSize := LongInt(@Dummy.Data)-LongInt(@Dummy); { Calc VMT link size }
  355. FillChar(Pointer(LongInt(@Self)+LinkSize)^,
  356. SizeOf(Self)-LinkSize, #0); { Clear data fields }
  357. END;
  358. PROCEDURE TObject.Free;
  359. BEGIN
  360. Dispose(PObject(@Self), Done); { Dispose of self }
  361. END;
  362. DESTRUCTOR TObject.Done;
  363. BEGIN { Abstract method }
  364. END;
  365. FUNCTION TStream.StrRead: PChar;
  366. VAR L: Word; P: PChar;
  367. BEGIN
  368. Read(L, SizeOf(L)); { Read length }
  369. If (L=0) Then StrRead := Nil Else Begin { Check for empty }
  370. GetMem(P, L + 1); { Allocate memory }
  371. If (P<>Nil) Then Begin { Check allocate okay }
  372. Read(P[0], L); { Read the data }
  373. P[L] := #0; { Terminate with #0 }
  374. End;
  375. StrRead := P; { Return PChar }
  376. End;
  377. END;
  378. FUNCTION TStream.ReadStr: PString;
  379. VAR L: Byte; P: PString;
  380. BEGIN
  381. Read(L, 1); { Read string length }
  382. If (L > 0) Then Begin
  383. GetMem(P, L + 1); { Allocate memory }
  384. If (P<>Nil) Then Begin { Check allocate okay }
  385. P^[0] := Char(L); { Hold length }
  386. Read(P^[1], L); { Read string data }
  387. End;
  388. ReadStr := P; { Return string ptr }
  389. End Else ReadStr := Nil;
  390. END;
  391. FUNCTION TStream.GetPos: LongInt;
  392. BEGIN { Abstract method }
  393. Abstract; { Abstract error }
  394. END;
  395. FUNCTION TStream.GetSize: LongInt;
  396. BEGIN { Abstract method }
  397. Abstract; { Abstract error }
  398. END;
  399. PROCEDURE TStream.Close;
  400. BEGIN { Abstract method }
  401. END;
  402. PROCEDURE TStream.Reset;
  403. BEGIN
  404. Status := 0; { Clear status }
  405. ErrorInfo := 0; { Clear error info }
  406. END;
  407. PROCEDURE TStream.Flush;
  408. BEGIN { Abstract method }
  409. END;
  410. PROCEDURE TStream.Truncate;
  411. BEGIN
  412. Abstract; { Abstract error }
  413. END;
  414. PROCEDURE TStream.Seek (Pos: LongInt);
  415. BEGIN
  416. Abstract; { Abstract error }
  417. END;
  418. PROCEDURE TStream.StrWrite (P: PChar);
  419. VAR L: Word; Q: PByteArray;
  420. BEGIN
  421. L := 0; { Preset no size }
  422. Q := PByteArray(P); { Transfer type }
  423. If (Q<>Nil) Then While (Q^[L]<>0) Do Inc(L); { Calc PChar length }
  424. Write(L, SizeOf(L)); { Store PChar length }
  425. If (P<>Nil) Then Write(P[0], L); { Write data }
  426. END;
  427. PROCEDURE TStream.WriteStr (P: PString);
  428. CONST Empty: String[1] = '';
  429. BEGIN
  430. If (P<>Nil) Then Write(P^, Length(P^) + 1) { Write string }
  431. Else Write(Empty, 1); { Write empty string }
  432. END;
  433. PROCEDURE TStream.Open (OpenMode: Word);
  434. BEGIN { Abstract method }
  435. END;
  436. PROCEDURE TStream.Error (Code, Info: Integer);
  437. TYPE TErrorProc = Procedure(Var S: TStream);
  438. BEGIN
  439. Status := Code; { Hold error code }
  440. ErrorInfo := Info; { Hold error info }
  441. If (StreamError<>Nil) Then
  442. TErrorProc(StreamError)(Self); { Call error ptr }
  443. END;
  444. PROCEDURE TStream.Read (Var Buf; Count: Sw_Word);
  445. BEGIN
  446. Abstract; { Abstract error }
  447. END;
  448. PROCEDURE TStream.Write (Var Buf; Count: Sw_Word);
  449. BEGIN
  450. Abstract; { Abstract error }
  451. END;
  452. PROCEDURE TStream.CopyFrom (Var S: TStream; Count: Longint);
  453. VAR W: Word; Buffer: Array[0..1023] of Byte;
  454. BEGIN
  455. While (Count > 0) Do Begin
  456. If (Count > SizeOf(Buffer)) Then { To much data }
  457. W := SizeOf(Buffer) Else W := Count; { Size to transfer }
  458. S.Read(Buffer, W); { Read from stream }
  459. Write(Buffer, W); { Write to stream }
  460. Dec(Count, W); { Dec write count }
  461. End;
  462. END;
  463. CONSTRUCTOR TDosStream.Init (FileName: FNameStr; Mode: Word);
  464. BEGIN
  465. Inherited Init; { Call ancestor }
  466. FileName := FileName+#0; { Make asciiz }
  467. Move(FileName[1], FName, Length(FileName)); { Create asciiz name }
  468. Handle := DosFileOpen(FName, Mode); { Open the file }
  469. If (Handle=0) Then Begin { Open failed }
  470. Error(stInitError, DosStreamError); { Call error }
  471. Status := stInitError; { Set fail status }
  472. Handle := -1; { Set invalid handle }
  473. End;
  474. END;
  475. DESTRUCTOR TDosStream.Done;
  476. BEGIN
  477. If (Handle <> -1) Then DosClose(Handle); { Close the file }
  478. Inherited Done; { Call ancestor }
  479. END;
  480. FUNCTION TDosStream.GetPos: LongInt;
  481. VAR NewPosition: LongInt;
  482. BEGIN
  483. If (Status=stOk) Then Begin { Check status okay }
  484. If (Handle = -1) Then DosStreamError := 103 { File not open }
  485. Else DosStreamError := DosSetFilePtr(Handle,
  486. 0, 1, NewPosition); { Get file position }
  487. If (DosStreamError<>0) Then Begin { Check for error }
  488. Error(stError, DosStreamError); { Identify error }
  489. NewPosition := -1; { Invalidate position }
  490. End;
  491. GetPos := NewPosition; { Return file position }
  492. End Else GetPos := -1; { Stream in error }
  493. END;
  494. FUNCTION TDosStream.GetSize: LongInt;
  495. VAR CurrentPos, FileEndPos: LongInt;
  496. BEGIN
  497. If (Status=stOk) Then Begin { Check status okay }
  498. If (Handle = -1) Then DosStreamError := 103 { File not open }
  499. Else DosStreamError := DosSetFilePtr(Handle,
  500. 0, 1, CurrentPos); { Current position }
  501. If (DosStreamError=0) Then Begin { Check no errors }
  502. DosStreamError := DosSetFilePtr(Handle, 0, 2,
  503. FileEndPos); { Locate end of file }
  504. If (DosStreamError=0) Then
  505. DosSetFilePtr(Handle, 0, 1, CurrentPos); { Reset position }
  506. End;
  507. If (DosStreamError<>0) Then Begin { Check for error }
  508. Error(stError, DosStreamError); { Identify error }
  509. FileEndPos := -1; { Invalidate size }
  510. End;
  511. GetSize := FileEndPos; { Return file size }
  512. End Else GetSize := -1; { Stream in error }
  513. END;
  514. PROCEDURE TDosStream.Close;
  515. BEGIN
  516. If (Handle <> -1) Then DosClose(Handle); { Close the file }
  517. Handle := -1; { Handle now invalid }
  518. END;
  519. PROCEDURE TDosStream.Seek (Pos: LongInt);
  520. VAR NewPosition: LongInt;
  521. BEGIN
  522. If (Status=stOk) Then Begin { Check status okay }
  523. If (Pos < 0) Then Pos := 0; { Negatives removed }
  524. If (Handle = -1) Then DosStreamError := 103 { File not open }
  525. Else DosStreamError := DosSetFilePtr(Handle,
  526. Pos, 0, NewPosition); { Set file position }
  527. If ((DosStreamError<>0) OR (NewPosition<>Pos)) { We have an error }
  528. Then Begin
  529. If (DosStreamError<>0) Then { Error was detected }
  530. Error(stError, DosStreamError) { Specific seek error }
  531. Else Error(stSeekError, 0); { General seek error }
  532. End;
  533. End;
  534. END;
  535. PROCEDURE TDosStream.Open (OpenMode: Word);
  536. BEGIN
  537. If (Handle = -1) Then Begin { File not open }
  538. Handle := DosFileOpen(FName, OpenMode); { Open the file }
  539. If (Handle=0) Then Begin { File open failed }
  540. Error(stOpenError, DosStreamError); { Call error }
  541. Handle := -1; { Set invalid handle }
  542. End;
  543. End;
  544. END;
  545. PROCEDURE TDosStream.Read (Var Buf; Count: Sw_Word);
  546. VAR BytesMoved: Sw_Word;
  547. BEGIN
  548. If (Status=stOk) Then Begin { Check status }
  549. If (Handle = -1) Then BytesMoved := 0 Else { File not open }
  550. DosStreamError := DosRead(Handle, Buf, Count,
  551. BytesMoved); { Read from file }
  552. If ((DosStreamError<>0) OR (BytesMoved<>Count)) { We have an error }
  553. Then Begin
  554. If (DosStreamError<>0) Then { Error was detected }
  555. Error(stError, DosStreamError) { Specific read error }
  556. Else Error(stReadError, 0); { General read error }
  557. End;
  558. End Else FillChar(Buf, Count, #0); { Error clear buffer }
  559. END;
  560. PROCEDURE TDosStream.Write (Var Buf; Count: Sw_Word);
  561. VAR BytesMoved: Sw_Word;
  562. BEGIN
  563. If (Status=stOk) Then Begin
  564. If (Handle=-1) Then BytesMoved := 0 Else { File not open }
  565. DosStreamError := DosWrite(Handle, Buf, Count,
  566. BytesMoved); { Write to file }
  567. If ((DosStreamError<>0) OR (BytesMoved<>Count)) { We have an error }
  568. Then Begin
  569. If (DosStreamError<>0) Then { Error was detected }
  570. Error(stError, DosStreamError) { Specific write error }
  571. Else Error(stWriteError, 0); { General write error }
  572. End;
  573. End;
  574. END;
  575. CONSTRUCTOR TCollection.Init (ALimit, ADelta: Sw_Integer);
  576. BEGIN
  577. Inherited Init; { Call ancestor }
  578. Delta := ADelta; { Set increment }
  579. SetLimit(ALimit); { Set limit }
  580. END;
  581. CONSTRUCTOR TCollection.Load (Var S: TStream);
  582. VAR C, I: Sw_Integer;
  583. BEGIN
  584. S.Read(Count, SizeOf(Count)); { Read count }
  585. S.Read(Limit, SizeOf(Limit)); { Read limit }
  586. S.Read(Delta, SizeOf(Delta)); { Read delta }
  587. Items := Nil; { Clear item pointer }
  588. C := Count; { Hold count }
  589. I := Limit; { Hold limit }
  590. Count := 0; { Clear count }
  591. Limit := 0; { Clear limit }
  592. SetLimit(I); { Set requested limit }
  593. Count := C; { Set count }
  594. For I := 0 To C-1 Do AtPut(I, GetItem(S)); { Get each item }
  595. END;
  596. DESTRUCTOR TCollection.Done;
  597. BEGIN
  598. FreeAll; { Free all items }
  599. SetLimit(0); { Release all memory }
  600. END;
  601. FUNCTION TCollection.At (Index: Sw_Integer): Pointer;
  602. BEGIN
  603. If (Index < 0) OR (Index >= Count) Then Begin { Invalid index }
  604. Error(coIndexError, Index); { Call error }
  605. At := Nil; { Return nil }
  606. End Else At := Items^[Index]; { Return item }
  607. END;
  608. FUNCTION TCollection.IndexOf (Item: Pointer): Sw_Integer;
  609. VAR I: Sw_Integer;
  610. BEGIN
  611. If (Count>0) Then Begin { Count is positive }
  612. For I := 0 To Count-1 Do { For each item }
  613. If (Items^[I]=Item) Then Begin { Look for match }
  614. IndexOf := I; { Return index }
  615. Exit; { Now exit }
  616. End;
  617. End;
  618. IndexOf := -1; { Return index }
  619. END;
  620. FUNCTION TCollection.GetItem (Var S: TStream): Pointer;
  621. BEGIN
  622. GetItem := S.Get; { Item off stream }
  623. END;
  624. FUNCTION TCollection.LastThat (Test: Pointer): Pointer;
  625. VAR I: LongInt; P: FuncPtr;
  626. BEGIN
  627. ASM
  628. MOVL (%EBP), %EAX; { Load EBP }
  629. MOVL %EAX, U_OBJECTS_HOLDEBP; { Store to global }
  630. END;
  631. P := FuncPtr(Test); { Set function ptr }
  632. For I := Count DownTo 1 Do
  633. Begin { Down from last item }
  634. Begin { Test each item }
  635. LastThat := Items^[I-1]; { Return item }
  636. Exit; { Now exit }
  637. End;
  638. End;
  639. LastThat := Nil; { None passed test }
  640. END;
  641. FUNCTION TCollection.FirstThat (Test: Pointer): Pointer;
  642. VAR I: LongInt; P: FuncPtr; {$IFDEF NotFPKPascal} Hold_EBP: Sw_Word; {$ENDIF}
  643. BEGIN
  644. ASM
  645. MOVL (%EBP), %EAX; { Load EBP }
  646. MOVL %EAX, U_OBJECTS_HOLDEBP; { Store to global }
  647. END;
  648. P := FuncPtr(Test); { Set function ptr }
  649. For I := 1 To Count Do Begin { Up from first item }
  650. Begin { Test each item }
  651. FirstThat := Items^[I-1]; { Return item }
  652. Exit; { Now exit }
  653. End;
  654. End;
  655. FirstThat := Nil; { None passed test }
  656. END;
  657. PROCEDURE TCollection.Pack;
  658. VAR I, J: Sw_Integer;
  659. BEGIN
  660. If (Count>0) Then Begin { Count is positive }
  661. I := 0; { Initialize dest }
  662. For J := 1 To Count Do Begin { For each item }
  663. If (Items^[J]<>Nil) Then Begin { Entry is non nil }
  664. Items^[I] := Items^[J]; { Transfer item }
  665. Inc(I); { Advance dest }
  666. End;
  667. End;
  668. Count := I; { Adjust count }
  669. End;
  670. END;
  671. PROCEDURE TCollection.FreeAll;
  672. VAR I: Sw_Integer;
  673. BEGIN
  674. For I := 0 To Count-1 Do FreeItem(At(I)); { Release each item }
  675. Count := 0; { Clear item count }
  676. END;
  677. PROCEDURE TCollection.DeleteAll;
  678. BEGIN
  679. Count := 0; { Clear item count }
  680. END;
  681. PROCEDURE TCollection.Free (Item: Pointer);
  682. BEGIN
  683. Delete(Item); { Delete from list }
  684. FreeItem(Item); { Free the item }
  685. END;
  686. PROCEDURE TCollection.Insert (Item: Pointer);
  687. BEGIN
  688. AtInsert(Count, Item); { Insert item }
  689. END;
  690. PROCEDURE TCollection.Delete (Item: Pointer);
  691. BEGIN
  692. AtDelete(IndexOf(Item)); { Delete from list }
  693. END;
  694. PROCEDURE TCollection.AtFree (Index: Sw_Integer);
  695. VAR Item: Pointer;
  696. BEGIN
  697. Item := At(Index); { Retreive item ptr }
  698. AtDelete(Index); { Delete item }
  699. FreeItem(Item); { Free the item }
  700. END;
  701. PROCEDURE TCollection.FreeItem (Item: Pointer);
  702. VAR P: PObject;
  703. BEGIN
  704. P := PObject(Item); { Convert pointer }
  705. If (P<>Nil) Then Dispose(P, Done); { Dispose of object }
  706. END;
  707. PROCEDURE TCollection.AtDelete (Index: Sw_Integer);
  708. BEGIN
  709. If (Index >= 0) AND (Index < Count) Then Begin { Valid index }
  710. Dec(Count); { One less item }
  711. If (Count>Index) Then Move(Items^[Index+1],
  712. Items^[Index], (Count-Index)*Sizeof(Pointer)); { Shuffle items down }
  713. End Else Error(coIndexError, Index); { Index error }
  714. END;
  715. PROCEDURE TCollection.ForEach (Action: Pointer);
  716. VAR I: LongInt; P: ProcPtr;
  717. BEGIN
  718. ASM
  719. MOVL (%EBP), %EAX; { Load EBP }
  720. MOVL %EAX, U_OBJECTS_HOLDEBP; { Store to global }
  721. END;
  722. P := ProcPtr(Action); { Set procedure ptr }
  723. For I := 1 To Count Do { Up from first item }
  724. P(Items^[I-1], HoldEBP); { Call with each item }
  725. END;
  726. PROCEDURE TCollection.SetLimit (ALimit: Sw_Integer);
  727. VAR AItems: PItemList;
  728. BEGIN
  729. If (ALimit < Count) Then ALimit := Count; { Stop underflow }
  730. If (ALimit > MaxCollectionSize) Then
  731. ALimit := MaxCollectionSize; { Stop overflow }
  732. If (ALimit <> Limit) Then Begin { Limits differ }
  733. If (ALimit = 0) Then AItems := Nil Else { Alimit=0 nil entry }
  734. GetMem(AItems, ALimit * SizeOf(Pointer)); { Allocate memory }
  735. If (AItems<>Nil) OR (ALimit=0) Then Begin { Check success }
  736. If (AItems <>Nil) AND (Items <> Nil) Then { Check both valid }
  737. Move(Items^, AItems^, Count*SizeOf(Pointer));{ Move existing items }
  738. If (Limit <> 0) AND (Items <> Nil) Then { Check old allocation }
  739. FreeMem(Items, Limit * SizeOf(Pointer)); { Release memory }
  740. Items := AItems; { Update items }
  741. Limit := ALimit; { Set limits }
  742. End;
  743. End;
  744. END;
  745. PROCEDURE TCollection.Error (Code, Info: Integer);
  746. BEGIN
  747. RunError(212 - Code); { Run error }
  748. END;
  749. PROCEDURE TCollection.AtPut (Index: Sw_Integer; Item: Pointer);
  750. BEGIN
  751. If (Index >= 0) AND (Index < Count) Then { Index valid }
  752. Items^[Index] := Item { Put item in index }
  753. Else Error(coIndexError, Index); { Index error }
  754. END;
  755. PROCEDURE TCollection.AtInsert (Index: Sw_Integer; Item: Pointer);
  756. VAR I: Sw_Integer;
  757. BEGIN
  758. If (Index >= 0) AND (Index <= Count) Then Begin { Valid index }
  759. If (Count=Limit) Then SetLimit(Limit+Delta); { Expand size if able }
  760. If (Limit>Count) Then Begin
  761. If (Index < Count) Then Begin { Not last item }
  762. For I := Count DownTo Index Do { Start from back }
  763. Items^[I] := Items^[I-1]; { Move each item }
  764. End;
  765. Items^[Index] := Item; { Put item in list }
  766. Inc(Count); { Inc count }
  767. End Else Error(coOverflow, Index); { Expand failed }
  768. End Else Error(coIndexError, Index); { Index error }
  769. END;
  770. PROCEDURE TCollection.Store (Var S: TStream);
  771. PROCEDURE DoPutItem (P: Pointer); FAR;
  772. BEGIN
  773. PutItem(S, P); { Put item on stream }
  774. END;
  775. BEGIN
  776. S.Write(Count, SizeOf(Count)); { Write count }
  777. S.Write(Limit, SizeOf(Limit)); { Write limit }
  778. S.Write(Delta, SizeOf(Delta)); { Write delta }
  779. ForEach(@DoPutItem); { Each item to stream }
  780. END;
  781. PROCEDURE TCollection.PutItem (Var S: TStream; Item: Pointer);
  782. BEGIN
  783. S.Put(Item); { Put item on stream }
  784. END;
  785. CONSTRUCTOR TSortedCollection.Init (ALimit, ADelta: Sw_Integer);
  786. BEGIN
  787. Inherited Init(ALimit, ADelta); { Call ancestor }
  788. Duplicates := False; { Clear flag }
  789. END;
  790. CONSTRUCTOR TSortedCollection.Load (Var S: TStream);
  791. BEGIN
  792. Inherited Load(S); { Call ancestor }
  793. S.Read(Duplicates, SizeOf(Duplicates)); { Read duplicate flag }
  794. END;
  795. FUNCTION TSortedCollection.KeyOf (Item: Pointer): Pointer;
  796. BEGIN
  797. KeyOf := Item; { Return item }
  798. END;
  799. FUNCTION TSortedCollection.IndexOf (Item: Pointer): Sw_Integer;
  800. VAR I: Sw_Integer;
  801. BEGIN
  802. IndexOf := -1; { Preset result }
  803. If Search(KeyOf(Item), I) Then Begin { Search for item }
  804. If Duplicates Then { Duplicates allowed }
  805. While (I < Count) AND (Item <> Items^[I]) Do
  806. Inc(I); { Count duplicates }
  807. If (I < Count) Then IndexOf := I; { Return result }
  808. End;
  809. END;
  810. FUNCTION TSortedCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
  811. BEGIN
  812. Abstract; { Abstract method }
  813. END;
  814. FUNCTION TSortedCollection.Search (Key: Pointer; Var Index: Sw_Integer): Boolean;
  815. VAR L, H, I, C: Sw_Integer;
  816. BEGIN
  817. Search := False; { Preset failure }
  818. L := 0; { Start count }
  819. H := Count - 1; { End count }
  820. While (L <= H) Do Begin
  821. I := (L + H) SHR 1; { Mid point }
  822. C := Compare(KeyOf(Items^[I]), Key); { Compare with key }
  823. If (C < 0) Then L := I + 1 Else Begin { Item to left }
  824. H := I - 1; { Item to right }
  825. If C = 0 Then Begin { Item match found }
  826. Search := True; { Result true }
  827. If NOT Duplicates Then L := I; { Force kick out }
  828. End;
  829. End;
  830. End;
  831. Index := L; { Return result }
  832. END;
  833. PROCEDURE TSortedCollection.Insert (Item: Pointer);
  834. VAR I: Sw_Integer;
  835. BEGIN
  836. If NOT Search(KeyOf(Item), I) OR Duplicates Then { Item valid }
  837. AtInsert(I, Item); { Insert the item }
  838. END;
  839. PROCEDURE TSortedCollection.Store (Var S: TStream);
  840. BEGIN
  841. TCollection.Store(S); { Call ancestor }
  842. S.Write(Duplicates, SizeOf(Duplicates)); { Write duplicate flag }
  843. END;
  844. FUNCTION TStringCollection.GetItem (Var S: TStream): Pointer;
  845. BEGIN
  846. GetItem := S.ReadStr; { Get new item }
  847. END;
  848. FUNCTION TStringCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
  849. VAR I, J: Integer; P1, P2: PString;
  850. BEGIN
  851. P1 := PString(Key1); { String 1 pointer }
  852. P2 := PString(Key2); { String 2 pointer }
  853. If (Length(P1^)<Length(P2^)) Then J := Length(P1^)
  854. Else J := Length(P2^); { Shortest length }
  855. I := 1; { First character }
  856. While (I<J) AND (P1^[I]=P2^[I]) Do Inc(I); { Scan till fail }
  857. If (P1^[I]=P2^[I]) Then Compare := 0 Else { Strings matched }
  858. If (P1^[I]<P2^[I]) Then Compare := -1 Else { String1 < String2 }
  859. Compare := 1; { String1 > String2 }
  860. END;
  861. PROCEDURE TStringCollection.FreeItem (Item: Pointer);
  862. BEGIN
  863. DisposeStr(Item); { Dispose item }
  864. END;
  865. PROCEDURE TStringCollection.PutItem (Var S: TStream; Item: Pointer);
  866. BEGIN
  867. S.WriteStr(Item); { Write string }
  868. END;
  869. PROCEDURE TUnSortedStrCollection.Insert (Item: Pointer);
  870. BEGIN
  871. AtInsert(Count, Item); { NO sorting insert }
  872. END;
  873. FUNCTION TStream.Get: PObject;
  874. BEGIN
  875. END;
  876. PROCEDURE TStream.Put (P: PObject);
  877. BEGIN
  878. END;
  879. FUNCTION NewStr (Const S: String): PString;
  880. VAR P: PString;
  881. BEGIN
  882. If (S = '') Then P := Nil Else Begin { Return nil }
  883. GetMem(P, Length(S) + 1); { Allocate memory }
  884. If (P<>Nil) Then P^ := S; { Hold string }
  885. End;
  886. NewStr := P; { Return result }
  887. END;
  888. PROCEDURE DisposeStr (P: PString);
  889. BEGIN
  890. If (P <> Nil) Then FreeMem(P, Length(P^) + 1); { Release memory }
  891. END;
  892. PROCEDURE Abstract;
  893. BEGIN
  894. RunError(211); { Abstract error }
  895. END;
  896. PROCEDURE RegisterError;
  897. BEGIN
  898. RunError(212); { Register error }
  899. END;
  900. FUNCTION CreateStream (Strategy: Word; ReqSize: LongInt): PStream;
  901. VAR Stream: PStream;
  902. BEGIN
  903. Stream := Nil; { Preset failure }
  904. While (Strategy <> 0) AND (Stream = Nil) Do Begin
  905. If (Strategy AND sa_XMSFirst <> 0) Then Begin { ** XMS STREAM ** }
  906. End Else
  907. If (Strategy AND sa_EMSFirst <> 0) Then Begin { ** EMS STREAM ** }
  908. End Else
  909. If (Strategy AND sa_RamFirst <> 0) Then Begin { ** RAM STREAM ** }
  910. End Else
  911. If (Strategy AND sa_DiskFirst <> 0) Then Begin { ** DISK STREAM ** }
  912. End;
  913. If (Stream<>Nil) AND (Stream^.Status <> stOk) { Stream in error }
  914. Then Begin
  915. Dispose(Stream, Done); { Dispose stream }
  916. Stream := Nil; { Clear pointer }
  917. End;
  918. Strategy := Strategy SHL 4; { Next strategy mask }
  919. End;
  920. CreateStream := Stream; { Return stream result }
  921. END;
  922. { For linux we 'steal' the following from system unit, this way
  923. we don't need to change the system unit interface. }
  924. Var errno : Longint;
  925. {$i sysnr.inc}
  926. {$i errno.inc}
  927. {$i sysconst.inc}
  928. {$i systypes.inc}
  929. {$i syscalls.inc}
  930. FUNCTION DosFileOpen (Var FileName: AsciiZ; Mode: Word): Word;
  931. Var LinuxMode : Word;
  932. BEGIN
  933. LinuxMode:=0;
  934. if (Mode and stCreate)=stCreate then LinuxMode:=Open_Creat;
  935. if (Mode and stOpenRead)=stOpenRead then LinuxMode:=LinuxMode or Open_RdOnly;
  936. If (Mode and stOpenWrite)=stOpenWrite then LinuxMode:=LinuxMode or Open_WrOnly;
  937. if (Mode and stOpen)=stOpen then LinuxMode:=LinuxMode or Open_RdWr;
  938. DosFileOpen:=SYS_Open (pchar(@FileName[0]),438 {666 octal},LinuxMode);
  939. DosStreamError:=Errno;
  940. DosFileOpen:=Errno;
  941. END;
  942. FUNCTION DosRead (Handle: Word; Var BufferArea; BufferLength: Sw_Word;
  943. Var BytesMoved: Sw_Word): Word;
  944. BEGIN
  945. BytesMoved:=Sys_read (Handle,Pchar(@BufferArea),BufferLength);
  946. DosStreamError:=Errno;
  947. END;
  948. FUNCTION DosWrite (Handle: Word; Var BufferArea; BufferLength: Sw_Word;
  949. Var BytesMoved: Sw_Word): Word;
  950. BEGIN
  951. BytesMoved:=Sys_Write (Handle,Pchar(@BufferArea),BufferLength);
  952. DosWrite:=Errno;
  953. DosStreamError:=Errno;
  954. END;
  955. FUNCTION DosSetFilePtr (Handle: Word; Pos: LongInt; MoveType: Word;
  956. VAR NewPos: LongInt): Word;
  957. BEGIN
  958. NewPos:=Sys_LSeek (Handle,Pos,MoveType);
  959. DosSetFilePtr:=Errno;
  960. END;
  961. PROCEDURE DosClose (Handle: Word);
  962. BEGIN
  963. Sys_Close (Handle);
  964. DosStreamError:=Errno;
  965. END;
  966. END.
  967. {
  968. $Log$
  969. Revision 1.1 1998-03-25 11:18:43 root
  970. Initial revision
  971. Revision 1.4 1998/01/26 12:01:22 michael
  972. + Added log at the end
  973. Working file: rtl/linux/objects.pp
  974. description:
  975. ----------------------------
  976. revision 1.3
  977. date: 1998/01/08 23:38:48; author: michael; state: Exp; lines: +49 -917
  978. + implemented the disk stream functions.
  979. ----------------------------
  980. revision 1.2
  981. date: 1997/12/01 12:31:16; author: michael; state: Exp; lines: +13 -0
  982. + Added copyright reference in header.
  983. ----------------------------
  984. revision 1.1
  985. date: 1997/11/27 08:33:54; author: michael; state: Exp;
  986. Initial revision
  987. ----------------------------
  988. revision 1.1.1.1
  989. date: 1997/11/27 08:33:54; author: michael; state: Exp; lines: +0 -0
  990. FPC RTL CVS start
  991. =============================================================================
  992. }