PageRenderTime 64ms CodeModel.GetById 24ms RepoModel.GetById 1ms app.codeStats 0ms

/components/turbopower_ipro/ipstrms.pas

http://github.com/graemeg/lazarus
Pascal | 1794 lines | 1270 code | 192 blank | 332 comment | 179 complexity | 1eac0fd6b1f3d563c654715ba920c979 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0, MPL-2.0-no-copyleft-exception
  1. {******************************************************************}
  2. {* IPSTRMS.PAS - Various stream classes *}
  3. {******************************************************************}
  4. { $Id$ }
  5. (* ***** BEGIN LICENSE BLOCK *****
  6. * Version: MPL 1.1
  7. *
  8. * The contents of this file are subject to the Mozilla Public License Version
  9. * 1.1 (the "License"); you may not use this file except in compliance with
  10. * the License. You may obtain a copy of the License at
  11. * http://www.mozilla.org/MPL/
  12. *
  13. * Software distributed under the License is distributed on an "AS IS" basis,
  14. * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  15. * for the specific language governing rights and limitations under the
  16. * License.
  17. *
  18. * The Original Code is TurboPower Internet Professional
  19. *
  20. * The Initial Developer of the Original Code is
  21. * TurboPower Software
  22. *
  23. * Portions created by the Initial Developer are Copyright (C) 2000-2002
  24. * the Initial Developer. All Rights Reserved.
  25. *
  26. * Contributor(s):
  27. *
  28. * Markus Kaemmerer <mk@happyarts.de> SourceForge: mkaemmerer
  29. *
  30. * ***** END LICENSE BLOCK ***** *)
  31. { Global defines potentially affecting this unit }
  32. {$I IPDEFINE.INC}
  33. unit IpStrms;
  34. {- Ansi text stream class}
  35. interface
  36. uses
  37. SysUtils,
  38. Classes,
  39. {$IFDEF IP_LAZARUS}
  40. FPCAdds,
  41. LCLType,
  42. GraphType,
  43. LCLIntf,
  44. LazFileUtils,
  45. {$ELSE}
  46. Windows, // put Windows behind Classes because of THandle
  47. {$ENDIF}
  48. IpUtils,
  49. IpConst;
  50. const
  51. IpFileOpenFailed = THandle(-1);
  52. { TIpMemMapStream }
  53. type
  54. TIpMemMapStream = class(TStream)
  55. protected
  56. FCanGrow : Boolean;
  57. { If True then the map file can grow if the user writes past the
  58. current end of the stream. Note that growing may be expensive
  59. time-wise. }
  60. FDataSize : Longint;
  61. { The amount of data actually written to the stream. }
  62. FGrowthFactor : Double;
  63. { The factor by which the map file is to be grow each time a size
  64. increase is needed. }
  65. FReadOnly : Boolean;
  66. { If set to True then file is to be opened for read-only access. }
  67. FSize : Longint;
  68. { The current size of the mapped file. When creating files, the size
  69. must be pre-set. The size is fixed unless the CanGrow property is
  70. set to True. }
  71. mmFileExists : Boolean;
  72. { Set to True if the file existed when the open method was called. }
  73. mmFileHandle : THandle;
  74. mmFileIsTemp : Boolean;
  75. { If set to True then file was created by this stream. }
  76. mmFileName : string;
  77. mmMapHandle : THandle;
  78. mmPointer : Pointer;
  79. { Pointer to the beginning of the file. }
  80. mmPos : Longint;
  81. { Current position in the file. }
  82. { Verification methods }
  83. procedure CheckClosed(const aMethodName : string);
  84. procedure CheckFileName;
  85. procedure CloseFile;
  86. procedure CloseMap;
  87. procedure OpenFile;
  88. procedure OpenMap;
  89. procedure Resize(const NewSize : Longint);
  90. procedure SetSize(NewSize : Longint); override;
  91. public
  92. constructor Create(const FileName : string;
  93. const ReadOnly, Temporary : Boolean);
  94. destructor Destroy; override;
  95. procedure Open;
  96. { After the stream has been created, call this method to open the file. }
  97. function Read(var Buffer; Count: Longint): Longint; override;
  98. function Write(const Buffer; Count: Longint): Longint; override;
  99. function Seek(Offset: Longint; Origin: Word): Longint; override;
  100. property ReadOnly : Boolean read FReadOnly;
  101. { Returns True if the file is being opened in read-only mode. }
  102. property CanGrow : Boolean read FCanGrow write FCanGrow;
  103. { If True then the mapped stream can grow in size when data is written
  104. past the current end of the stream. Note this involves closing &
  105. reopening the map which may be expensive time-wise.
  106. Defaults to True. }
  107. property DataSize : Longint read FDataSize;
  108. { The amount of data actually written to the stream. It is calculated
  109. based upon the highest position to which data was written.
  110. For example, if an app seeks to position 100 and writes 100 bytes
  111. of data then the data size is 201. }
  112. property GrowthFactor : Double read FGrowthFactor write FGrowthFactor;
  113. { The factor by which the stream will be grown in size if CanGrow is
  114. True and data is written past the current end of stream.
  115. Defaults to 0.25. }
  116. property Memory: Pointer read mmPointer;
  117. { Points to the memory associated with the file. }
  118. property Size : Longint read FSize write SetSize;
  119. { For temporary files, specify the maximum size of the file via this
  120. property. }
  121. end;
  122. { TIpBufferedStream }
  123. type
  124. TIpBufferedStream = class(TStream)
  125. private {- property variables }
  126. FBufCount: Longint;
  127. FBuffer : PAnsiChar;
  128. FBufOfs : Longint;
  129. FBufPos : Longint;
  130. FBufSize : Longint;
  131. FDirty : Boolean;
  132. FSize : {$IFDEF IP_LAZARUS}TStreamSeekType{$ELSE}longint{$ENDIF};
  133. FStream : TStream;
  134. protected {- methods }
  135. procedure bsInitForNewStream; virtual;
  136. procedure bsReadFromStream;
  137. procedure bsSetStream(aValue : TStream);
  138. procedure bsWriteToStream;
  139. public {- methods }
  140. constructor Create(aStream : TStream);
  141. constructor CreateEmpty;
  142. destructor Destroy; override;
  143. procedure Flush; {!!.12}
  144. { Flush any unwritten changes to the stream. }
  145. procedure FreeStream;
  146. function ReadChar(var aCh : AnsiChar) : Boolean;
  147. function Read(var Buffer; Count : Longint) : Longint; override;
  148. function Seek(Offset : Longint; Origin : word) : Longint; override;
  149. function Write(const Buffer; Count : Longint) : Longint; override;
  150. public {-properties }
  151. property FastSize: {$IFDEF IP_LAZARUS}TStreamSeekType{$ELSE}longint{$ENDIF}
  152. read FSize;
  153. property Stream : TStream
  154. read FStream write bsSetStream;
  155. end;
  156. { TIpAnsiTextStream }
  157. type
  158. TIpAnsiTextStream = class(TIpBufferedStream)
  159. private {- property variables }
  160. FLineEndCh : AnsiChar;
  161. FLineLen : Integer;
  162. FLineTerm : TIpLineTerminator;
  163. FFixedLine : PAnsiChar;
  164. FLineCount : Longint;
  165. FLineCurrent : Longint;
  166. FLineCurOfs : Longint;
  167. FLineIndex : TList;
  168. FLineInxStep : Longint;
  169. FLineInxTop : Integer;
  170. protected {- methods }
  171. procedure atsGetLine(var aStartPos, aEndPos, aLen : Longint);
  172. function atsGetLineCount : Longint;
  173. procedure atsResetLineIndex;
  174. procedure atsSetLineTerm(aValue : TIpLineTerminator);
  175. procedure atsSetLineEndCh(aValue : AnsiChar);
  176. procedure atsSetLineLen(aValue : Integer);
  177. public {- properties }
  178. property FixedLineLength : Integer
  179. read FLineLen write atsSetLineLen;
  180. property LineCount : Longint
  181. read atsGetLineCount;
  182. property LineTermChar : AnsiChar
  183. read FLineEndCh write atsSetLineEndCh;
  184. property LineTerminator : TIpLineTerminator
  185. read FLineTerm write atsSetLineTerm;
  186. public {- methods }
  187. constructor Create(aStream : TStream);
  188. destructor Destroy; override;
  189. function AtEndOfStream : Boolean;
  190. procedure bsInitForNewStream; override; {!!.01}
  191. function ReadLine : string;
  192. function ReadLineArray(aCharArray : PAnsiChar; aLen : Longint) : Longint;
  193. function ReadLineZ(aSt : PAnsiChar; aMaxLen : Longint) : PAnsiChar;
  194. function SeekNearestLine(aOffset : Longint) : Longint;
  195. function SeekLine(aLineNum : Longint) : Longint;
  196. procedure WriteLine(const aSt : string);
  197. procedure WriteLineArray(aCharArray : PAnsiChar; aLen : Longint);
  198. procedure WriteLineZ(aSt : PAnsiChar);
  199. end;
  200. { TIpDownloadFileStream }
  201. type
  202. TIpDownloadFileStream = class(TStream)
  203. private
  204. FHandle : THandle;
  205. FPath : string;
  206. FFileName : string;
  207. FRenamed : boolean;
  208. protected
  209. procedure dfsMakeTempFile(const aPath : string);
  210. public
  211. constructor Create(const aPath : string);
  212. destructor Destroy; override;
  213. function Read(var Buffer; Count : Longint) : Longint; override;
  214. procedure Rename(aNewName : string);
  215. procedure Move(aNewName: string);
  216. function Seek(Offset : Longint; Origin : Word) : Longint; override;
  217. function Write(const Buffer; Count : Longint) : Longint; override;
  218. property Handle : THandle read FHandle;
  219. property FileName : string read FFileName;
  220. end;
  221. { TIpByteStream }
  222. type
  223. TIpByteStream = class
  224. private {variables}
  225. FStream : TStream;
  226. BufEnd : Integer;
  227. BufPos : Integer;
  228. Buffer : array[0..1023] of Byte;
  229. protected {methods}
  230. function GetPosition : Integer;
  231. function GetSize : Integer;
  232. public {methods}
  233. constructor Create(aStream : TStream);
  234. destructor Destroy; override;
  235. function Read(var b :Byte) : Boolean;
  236. public {properties}
  237. property Position : Integer
  238. read GetPosition;
  239. property Size : longint
  240. read GetSize;
  241. end;
  242. implementation
  243. const
  244. LineTerm : array [TIpLineTerminator] of
  245. array [0..1] of AnsiChar =
  246. ('', #13, #10, #13#10, '');
  247. const
  248. LineIndexCount = 1024;
  249. LineIndexMax = pred(LineIndexCount);
  250. {--- Helper routines ---------------------------------------------------------}
  251. function MinLong(A, B : Longint) : Longint;
  252. begin
  253. if A < B then
  254. Result := A
  255. else
  256. Result := B;
  257. end;
  258. {-----------------------------------------------------------------------------}
  259. { TIpMemMapStream }
  260. {-----------------------------------------------------------------------------}
  261. constructor TIpMemMapStream.Create(const FileName : string;
  262. const ReadOnly, Temporary : Boolean);
  263. begin
  264. inherited Create;
  265. FCanGrow := True;
  266. FDataSize := 0;
  267. FGrowthFactor := 0.25;
  268. FReadOnly := ReadOnly;
  269. FSize := 64 * 1024;
  270. mmFileName := FileName;
  271. mmFileIsTemp := Temporary;
  272. end;
  273. {-----------------------------------------------------------------------------}
  274. destructor TIpMemMapStream.Destroy;
  275. begin
  276. CloseMap;
  277. CloseFile;
  278. { If map file was temporary then get rid of it. }
  279. if mmFileIsTemp and FileExistsUTF8(mmFileName) then
  280. DeleteFileUTF8(mmFileName);
  281. inherited;
  282. end;
  283. {-----------------------------------------------------------------------------}
  284. procedure TIpMemMapStream.CheckClosed(const aMethodName : string);
  285. begin
  286. if mmFileHandle <> 0 then
  287. raise EIpBaseException.CreateFmt(SMemMapMustBeClosed, [aMethodName]);
  288. end;
  289. {-----------------------------------------------------------------------------}
  290. procedure TIpMemMapStream.CheckFileName;
  291. begin
  292. if mmFileName = '' then
  293. raise EIpBaseException.Create(SMemMapFilenameRequired);
  294. end;
  295. {-----------------------------------------------------------------------------}
  296. procedure TIpMemMapStream.CloseFile;
  297. begin
  298. {$IFDEF IP_LAZARUS}
  299. writeln('TIpMemMapStream.CloseFile ToDo');
  300. {$ELSE}
  301. if mmFileHandle <> 0 then
  302. CloseHandle(mmFileHandle);
  303. {$ENDIF}
  304. end;
  305. {-----------------------------------------------------------------------------}
  306. procedure TIpMemMapStream.CloseMap;
  307. begin
  308. {$IFDEF IP_LAZARUS}
  309. writeln('TIpMemMapStream.CloseMap ToDo');
  310. {$ELSE}
  311. FlushViewOfFile(mmPointer, 0);
  312. UnMapViewOfFile(mmPointer);
  313. if mmMapHandle <> 0 then
  314. CloseHandle(mmMapHandle);
  315. {$ENDIF}
  316. end;
  317. {-----------------------------------------------------------------------------}
  318. procedure TIpMemMapStream.Open;
  319. begin
  320. OpenFile;
  321. OpenMap;
  322. end;
  323. {-----------------------------------------------------------------------------}
  324. procedure TIpMemMapStream.OpenFile;
  325. {$IFDEF IP_LAZARUS}
  326. begin
  327. writeln('TIpMemMapStream.OpenFile ToDo');
  328. end;
  329. {$ELSE}
  330. var
  331. CreateMode,
  332. Flags,
  333. OpenMode : DWORD;
  334. begin
  335. { Check requirements. }
  336. CheckFileName;
  337. CheckClosed('Open');
  338. { Are we opening an existing file or creating a new file? }
  339. if not FileExistsUTF8(mmFileName) then
  340. CreateMode:= CREATE_ALWAYS
  341. else
  342. CreateMode := OPEN_EXISTING;
  343. OpenMode := GENERIC_READ;
  344. if FReadOnly then
  345. Flags := FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN
  346. else begin
  347. OpenMode := OpenMode or GENERIC_WRITE;
  348. Flags := FILE_ATTRIBUTE_NORMAL or FILE_FLAG_RANDOM_ACCESS;
  349. end;
  350. mmFileExists := (CreateMode = OPEN_EXISTING);
  351. mmFileHandle := CreateFile(PChar(mmFileName),
  352. OpenMode,
  353. 0, { exclusive }
  354. nil,
  355. CreateMode,
  356. Flags,
  357. 0);
  358. if mmFileHandle = INVALID_HANDLE_VALUE then
  359. { Raise exception. }
  360. raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
  361. mmFileName);
  362. end;
  363. {$ENDIF}
  364. {-----------------------------------------------------------------------------}
  365. procedure TIpMemMapStream.OpenMap;
  366. {$IFDEF IP_LAZARUS}
  367. begin
  368. writeln('TIpMemMapStream.OpenMap ToDo');
  369. end;
  370. {$ELSE}
  371. var
  372. AccessMode,
  373. ProtectMode,
  374. SizeHigh : DWORD;
  375. Size : DWORD;
  376. begin
  377. { If this was an existing file then get the size of the file. }
  378. if mmFileExists then begin
  379. SizeHigh := 0;
  380. Size := GetFileSize(mmFileHandle, @SizeHigh);
  381. FSize := Size;
  382. FDataSize := Size;
  383. if Size = $FFFFFFFF then
  384. { Raise exception. }
  385. raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
  386. mmFileName);
  387. end
  388. else
  389. Size := FSize;
  390. { Read-only? }
  391. if FReadOnly then begin
  392. AccessMode := FILE_MAP_READ;
  393. ProtectMode := PAGE_READONLY;
  394. end
  395. else begin
  396. AccessMode := FILE_MAP_ALL_ACCESS;
  397. ProtectMode := PAGE_READWRITE;
  398. end;
  399. mmMapHandle := CreateFileMapping(mmFileHandle, nil, ProtectMode,
  400. 0, Size, nil);
  401. if mmMapHandle = 0 then
  402. { Raise exception. }
  403. raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
  404. mmFileName);
  405. mmPointer := MapViewOfFile(mmMapHandle, AccessMode, 0, 0, Size);
  406. if mmPointer = nil then
  407. raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
  408. mmFileName);
  409. mmPos := 0;
  410. end;
  411. {$ENDIF}
  412. {-----------------------------------------------------------------------------}
  413. procedure TIpMemMapStream.Resize(const NewSize : Longint);
  414. var
  415. SavPos : Longint;
  416. begin
  417. { Close the map. }
  418. if NewSize < FSize then
  419. SavPos := 0
  420. else
  421. SavPos := mmPos;
  422. CloseMap;
  423. {$IFDEF IP_LAZARUS}
  424. writeln('TIpMemMapStream.Resize ToDo');
  425. {$ELSE}
  426. { Update the size of the file. }
  427. if SetFilePointer(mmFileHandle, NewSize, nil, FILE_BEGIN) <> $FFFFFFFF then begin
  428. if SetEndOfFile(mmFileHandle) = false then
  429. raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
  430. mmFileName);
  431. end
  432. else
  433. raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
  434. mmFileName);
  435. {$ENDIF}
  436. { Update internal size information. }
  437. FSize := NewSize;
  438. if FSize < FDataSize then
  439. FDataSize := FSize;
  440. { Re-open the map. }
  441. mmFileExists := True;
  442. OpenMap;
  443. mmPos := SavPos;
  444. end;
  445. {-----------------------------------------------------------------------------}
  446. procedure TIpMemMapStream.SetSize(NewSize : Longint);
  447. begin
  448. if mmFileHandle <> 0 then
  449. Resize(NewSize);
  450. FSize := NewSize;
  451. end;
  452. {-----------------------------------------------------------------------------}
  453. function TIpMemMapStream.Read(var Buffer; Count: Longint): Longint;
  454. begin
  455. if mmFileHandle = 0 then
  456. raise EIpBaseException.CreateFmt(SMemMapMustBeOpen, ['Read']);
  457. if (mmPos + Count) > FDataSize then
  458. Result := FDataSize - mmPos
  459. else
  460. Result := Count;
  461. Move(PByteArray(mmPointer)[mmPos], Buffer, Result);
  462. inc(mmPos, Result);
  463. end;
  464. {-----------------------------------------------------------------------------}
  465. function TIpMemMapStream.Write(const Buffer; Count: Longint): Longint;
  466. var
  467. NewSize : Longint;
  468. begin
  469. if mmFileHandle = 0 then
  470. raise EIpBaseException.CreateFmt(SMemMapMustBeOpen, ['Write']);
  471. if not FReadOnly then begin
  472. if (mmPos + Count) > FSize then begin
  473. if FCanGrow then begin
  474. { Grow the stream. }
  475. NewSize := FSize + Trunc(FSize * FGrowthFactor);
  476. if NewSize < FSize + Count then
  477. NewSize := FSize + Count;
  478. Resize(NewSize);
  479. Result := Count;
  480. end
  481. else
  482. Result := FSize - mmPos;
  483. end
  484. else
  485. Result := Count;
  486. Move(Buffer, PByteArray(mmPointer)[mmPos], Result);
  487. inc(mmPos, Result);
  488. if mmPos > FDataSize then
  489. FDataSize := mmPos + 1;
  490. end
  491. else
  492. Result := 0;
  493. end;
  494. {-----------------------------------------------------------------------------}
  495. function TIpMemMapStream.Seek(Offset: Longint; Origin: Word): Longint;
  496. begin
  497. if mmFileHandle = 0 then
  498. raise EIpBaseException.CreateFmt(SMemMapMustBeOpen, ['Seek']);
  499. case Origin of
  500. soFromBeginning :
  501. if Offset < 0 then
  502. raise EIpBaseException.Create(SOriginFromBegin)
  503. else
  504. mmPos := Offset;
  505. soFromCurrent :
  506. mmPos := mmPos + Offset;
  507. soFromEnd :
  508. if Offset > 0 then
  509. raise EIpBaseException.Create(SOriginFromEnd)
  510. else
  511. mmPos := FSize + Offset;
  512. end; { case }
  513. Result := mmPos;
  514. end;
  515. {-----------------------------------------------------------------------------}
  516. { TIpBufferedStream }
  517. {-----------------------------------------------------------------------------}
  518. const
  519. BufferSize = 16384; // higher values for more speed but more memory
  520. constructor TIpBufferedStream.Create(aStream : TStream);
  521. begin
  522. inherited Create;
  523. {allocate the buffer}
  524. FBufSize := BufferSize;
  525. GetMem(FBuffer, FBufSize);
  526. {save the stream}
  527. if (aStream = nil) then
  528. raise EIpBaseException.Create(SNoStreamErr);
  529. FStream := aStream;
  530. bsInitForNewStream;
  531. end;
  532. {-----------------------------------------------------------------------------}
  533. constructor TIpBufferedStream.CreateEmpty;
  534. begin
  535. inherited Create;
  536. {allocate the buffer}
  537. FBufSize := BufferSize;
  538. GetMem(FBuffer, FBufSize);
  539. bsInitForNewStream
  540. end;
  541. {-----------------------------------------------------------------------------}
  542. destructor TIpBufferedStream.Destroy;
  543. begin
  544. if (FBuffer <> nil) and (FStream <> nil) then
  545. if FDirty then
  546. bsWriteToStream;
  547. FreeMem(FBuffer, FBufSize);
  548. inherited Destroy;
  549. end;
  550. {-----------------------------------------------------------------------------}
  551. procedure TIpBufferedStream.bsInitForNewStream;
  552. begin
  553. if (FStream <> nil) then
  554. FSize := FStream.Size
  555. else
  556. FSize := 0;
  557. FBufCount := 0;
  558. FBufOfs := 0;
  559. FBufPos := 0;
  560. FDirty := false;
  561. end;
  562. {-----------------------------------------------------------------------------}
  563. function TIpBufferedStream.ReadChar(var aCh : AnsiChar) : Boolean;
  564. begin
  565. {is there anything to read?}
  566. if (FSize = (FBufOfs + FBufPos)) then begin
  567. Result := false;
  568. Exit;
  569. end;
  570. {if we get here, we'll definitely read a character}
  571. Result := true;
  572. {make sure that the buffer has some data in it}
  573. if (FBufCount = 0) then
  574. bsReadFromStream
  575. else if (FBufPos = FBufCount) then begin
  576. if FDirty then
  577. bsWriteToStream;
  578. FBufPos := 0;
  579. inc(FBufOfs, FBufSize);
  580. bsReadFromStream;
  581. end;
  582. {get the next character}
  583. aCh := AnsiChar(FBuffer[FBufPos]);
  584. inc(FBufPos);
  585. end;
  586. {-----------------------------------------------------------------------------}
  587. procedure TIpBufferedStream.bsReadFromStream;
  588. var
  589. NewPos : Longint;
  590. begin
  591. {assumptions: FBufOfs is where to read the buffer
  592. FBufSize is the number of bytes to read
  593. FBufCount will be the number of bytes read}
  594. NewPos := FStream.Seek(FBufOfs, soFromBeginning);
  595. if (NewPos <> FBufOfs) then
  596. raise EIpBaseException.Create(SNoSeekForRead);
  597. FBufCount := FStream.Read(FBuffer^, FBufSize);
  598. end;
  599. {-----------------------------------------------------------------------------}
  600. procedure TIpBufferedStream.bsSetStream(aValue : TStream);
  601. begin
  602. if (aValue <> FStream) then begin
  603. {if the buffer is dirty, flush it to the current stream}
  604. if FDirty and (FStream <> nil) then
  605. bsWriteToStream;
  606. {remember the stream and initialize all fields}
  607. FStream := aValue;
  608. bsInitForNewStream;
  609. end;
  610. end;
  611. {-----------------------------------------------------------------------------}
  612. procedure TIpBufferedStream.bsWriteToStream;
  613. var
  614. NewPos : Longint;
  615. BytesWritten : Longint;
  616. begin
  617. {assumptions: FDirty is true
  618. FBufOfs is where to write the buffer
  619. FBufCount is the number of bytes to write
  620. FDirty will be set false afterwards}
  621. NewPos := FStream.Seek(FBufOfs, soFromBeginning);
  622. if (NewPos <> FBufOfs) then
  623. raise EIpBaseException.Create(SNoSeekForWrite);
  624. BytesWritten := FStream.Write(FBuffer^, FBufCount);
  625. if (BytesWritten <> FBufCount) then
  626. raise EIpBaseException.Create(SCannotWriteToStream);
  627. FDirty := false;
  628. end;
  629. {Begin !!.12}
  630. {-----------------------------------------------------------------------------}
  631. procedure TIpBufferedStream.Flush;
  632. begin
  633. if FDirty then
  634. bsWriteToStream;
  635. end;
  636. {End !!.12}
  637. {-----------------------------------------------------------------------------}
  638. procedure TIpBufferedStream.FreeStream ;
  639. begin
  640. if (FBuffer <> nil) and (FStream <> nil) then begin
  641. if FDirty then
  642. bsWriteToStream;
  643. FStream.Free;
  644. FStream := nil;
  645. end;
  646. end;
  647. {-----------------------------------------------------------------------------}
  648. function TIpBufferedStream.Read(var Buffer; Count : Longint) : Longint;
  649. var
  650. BytesToGo : Longint;
  651. BytesToRead : Longint;
  652. BufAsBytes : TByteArray absolute Buffer;
  653. DestPos : Longint;
  654. begin
  655. Result := 0;
  656. if not Assigned(FStream) then
  657. Exit;
  658. {calculate the number of bytes we could read if possible}
  659. BytesToGo := MinLong(Count, FSize - (FBufOfs + FBufPos));
  660. {we will return this number of bytes or raise an exception}
  661. Result := BytesToGo;
  662. {are we going to read some data after all?}
  663. if (BytesToGo > 0) then begin
  664. {make sure that the buffer has some data in it}
  665. if (FBufCount = 0) then
  666. bsReadFromStream;
  667. {read as much as we can from the current buffer}
  668. BytesToRead := MinLong(BytesToGo, FBufCount - FBufPos);
  669. {transfer that number of bytes}
  670. Move(FBuffer[FBufPos], BufAsBytes[0], BytesToRead);
  671. {update our counters}
  672. inc(FBufPos, BytesToRead);
  673. dec(BytesToGo, BytesToRead);
  674. {if we have more bytes to read then we've reached the end of the
  675. buffer and so we need to read another, and another, etc}
  676. DestPos := 0;
  677. while BytesToGo > 0 do begin
  678. {if the current buffer is dirty, write it out}
  679. if FDirty then
  680. bsWriteToStream;
  681. {position and read the next buffer}
  682. FBufPos := 0;
  683. inc(FBufOfs, FBufSize);
  684. bsReadFromStream;
  685. {calculate the new destination position, and the number of bytes
  686. to read from this buffer}
  687. inc(DestPos, BytesToRead);
  688. BytesToRead := MinLong(BytesToGo, FBufCount - FBufPos);
  689. {transfer that number of bytes}
  690. Move(FBuffer[FBufPos], BufAsBytes[DestPos], BytesToRead);
  691. {update our counters}
  692. inc(FBufPos, BytesToRead);
  693. dec(BytesToGo, BytesToRead);
  694. end;
  695. end;
  696. end;
  697. {-----------------------------------------------------------------------------}
  698. function TIpBufferedStream.Seek(Offset : Longint; Origin : word) : Longint;
  699. var
  700. NewPos : Longint;
  701. NewOfs : Longint;
  702. begin
  703. Result := 0;
  704. if not Assigned(FStream) then
  705. Exit;
  706. {optimization: to help code that just wants the current stream
  707. position (ie, reading the Position property), check for this as a
  708. special case}
  709. if (Offset = 0) and (Origin = soFromCurrent) then begin
  710. Result := FBufOfs + FBufPos;
  711. Exit;
  712. end;
  713. {calculate the desired position}
  714. case Origin of
  715. soFromBeginning : NewPos := Offset;
  716. soFromCurrent : NewPos := (FBufOfs + FBufPos) + Offset;
  717. soFromEnd : NewPos := FSize + Offset;
  718. else
  719. raise EIpBaseException.Create(SBadSeekOrigin);
  720. NewPos := 0; {to fool the compiler's warning--we never get here}
  721. end;
  722. {force the new position to be valid}
  723. if (NewPos < 0) then
  724. NewPos := 0
  725. else if (NewPos > FSize) then
  726. NewPos := FSize;
  727. {calculate the offset for the buffer}
  728. NewOfs := (NewPos div FBufSize) * FBufSize;
  729. {if the offset differs, we have to move the buffer window}
  730. if (NewOfs <> FBufOfs) then begin
  731. {check to see whether we have to write the current buffer to the
  732. original stream first}
  733. if FDirty then
  734. bsWriteToStream;
  735. {mark the buffer as empty}
  736. FBufOfs := NewOfs;
  737. FBufCount := 0;
  738. end;
  739. {set the position within the buffer}
  740. FBufPos := NewPos - FBufOfs;
  741. Result := NewPos;
  742. end;
  743. {-----------------------------------------------------------------------------}
  744. function TIpBufferedStream.Write(const Buffer; Count : Longint) : Longint;
  745. type
  746. TIpByteArray = array[0..MaxInt-1] of Byte;
  747. var
  748. BytesToGo : Longint;
  749. BytesToWrite: Longint;
  750. BufAsBytes : TIpByteArray absolute Buffer;
  751. DestPos : Longint;
  752. begin
  753. Result := 0;
  754. if not Assigned(FStream) then
  755. Exit;
  756. {calculate the number of bytes we should be able to write}
  757. BytesToGo := Count;
  758. {we will return this number of bytes or raise an exception}
  759. Result := BytesToGo;
  760. {are we going to write some data?}
  761. if (BytesToGo > 0) then begin
  762. {try and make sure that the buffer has some data in it}
  763. if (FBufCount = 0) and ((FBufOfs + FBufPos) < FSize) then
  764. bsReadFromStream;
  765. {write as much as we can to the current buffer}
  766. BytesToWrite := MinLong(BytesToGo, FBufSize - FBufPos);
  767. {transfer that number of bytes}
  768. Move(BufAsBytes[0], FBuffer[FBufPos], BytesToWrite);
  769. FDirty := true;
  770. {update our counters}
  771. inc(FBufPos, BytesToWrite);
  772. if (FBufCount < FBufPos) then begin
  773. FBufCount := FBufPos;
  774. FSize := FBufOfs + FBufPos;
  775. end;
  776. dec(BytesToGo, BytesToWrite);
  777. {if we have more bytes to write then we've reached the end of the
  778. buffer and so we need to write another, and another, etc}
  779. DestPos := 0;
  780. while BytesToGo > 0 do begin
  781. {as the current buffer is dirty, write it out}
  782. bsWriteToStream;
  783. {position and read the next buffer, if required}
  784. FBufPos := 0;
  785. inc(FBufOfs, FBufSize);
  786. if (FBufOfs < FSize) then
  787. bsReadFromStream
  788. else
  789. FBufCount := 0;
  790. {calculate the new destination position, and the number of bytes
  791. to write to this buffer}
  792. inc(DestPos, BytesToWrite);
  793. BytesToWrite := MinLong(BytesToGo, FBufSize - FBufPos);
  794. {transfer that number of bytes}
  795. if BytesToWrite > 0 then
  796. Move(BufAsBytes[DestPos], FBuffer[0], BytesToWrite);
  797. FDirty := true;
  798. {update our counters}
  799. inc(FBufPos, BytesToWrite);
  800. if (FBufCount < FBufPos) then begin
  801. FBufCount := FBufPos;
  802. FSize := FBufOfs + FBufPos;
  803. end;
  804. dec(BytesToGo, BytesToWrite);
  805. end;
  806. end;
  807. end;
  808. {-----------------------------------------------------------------------------}
  809. { TIpAnsiTextStream }
  810. {-----------------------------------------------------------------------------}
  811. constructor TIpAnsiTextStream.Create(aStream : TStream);
  812. begin
  813. inherited Create(aStream);
  814. {set up the line index variables}
  815. atsResetLineIndex;
  816. end;
  817. {-----------------------------------------------------------------------------}
  818. destructor TIpAnsiTextStream.Destroy;
  819. begin
  820. {if needed, free the fixed line buffer}
  821. if (FFixedLine <> nil) then
  822. FreeMem(FFixedLine, FixedLineLength);
  823. {free the line index}
  824. FLineIndex.Free;
  825. inherited Destroy;
  826. end;
  827. {-----------------------------------------------------------------------------}
  828. function TIpAnsiTextStream.AtEndOfStream : Boolean;
  829. begin
  830. Result := FSize = (FBufOfs + FBufPos);
  831. end;
  832. {-----------------------------------------------------------------------------}
  833. procedure TIpAnsiTextStream.atsGetLine(var aStartPos, aEndPos, aLen : Longint);
  834. var
  835. Done : Boolean;
  836. Ch : AnsiChar;
  837. PrevCh : AnsiChar;
  838. TempLineTerm: Integer;
  839. begin
  840. if (LineTerminator = ltNone) then begin
  841. aStartPos := FBufOfs + FBufPos;
  842. aEndPos := Seek(aStartPos + FixedLineLength, soFromBeginning);
  843. aLen := aEndPos - aStartPos;
  844. end
  845. else begin
  846. aStartPos := FBufOfs + FBufPos;
  847. Ch := #0;
  848. Done := false;
  849. // use temp as local variable for speed
  850. case LineTerminator of
  851. ltCRLF : TempLineTerm := 0;
  852. ltLF : TempLineTerm := 1;
  853. ltCR : TempLineTerm := 2;
  854. ltOther: TempLineTerm := 3;
  855. else
  856. raise EIpBaseException.Create(SBadLineTerminator);
  857. end;
  858. if FDirty then
  859. bsWriteToStream;
  860. while not Done do
  861. begin
  862. PrevCh := Ch;
  863. {is there anything to read?}
  864. if (FSize = (FBufOfs + FBufPos)) then begin
  865. aEndPos := FBufOfs + FBufPos;
  866. aLen := aEndPos - aStartPos;
  867. Done := True;
  868. end;
  869. {make sure that the buffer has some data in it}
  870. if (FBufCount = 0) then
  871. bsReadFromStream
  872. else if (FBufPos = FBufCount) then begin
  873. FBufPos := 0;
  874. inc(FBufOfs, FBufSize);
  875. bsReadFromStream;
  876. end;
  877. {get the next character}
  878. Ch := AnsiChar(FBuffer[FBufPos]);
  879. inc(FBufPos);
  880. case TempLineTerm of
  881. 0 : if (Ch = #10) then begin
  882. Done := true;
  883. aEndPos := FBufOfs + FBufPos;
  884. if PrevCh = #13 then
  885. aLen := aEndPos - aStartPos - 2
  886. else
  887. aLen := aEndPos - aStartPos - 1;
  888. end;
  889. 1 : if (Ch = #10) then begin
  890. Done := true;
  891. aEndPos := FBufOfs + FBufPos;
  892. aLen := aEndPos - aStartPos - 1;
  893. end;
  894. 2 : if (Ch = #13) then begin
  895. Done := true;
  896. aEndPos := FBufOfs + FBufPos;
  897. aLen := aEndPos - aStartPos - 1;
  898. end;
  899. 3 : if (Ch = LineTermChar) then begin
  900. Done := true;
  901. aEndPos := FBufOfs + FBufPos;
  902. aLen := aEndPos - aStartPos - 1;
  903. end;
  904. end;
  905. end;
  906. end;
  907. end;
  908. {-----------------------------------------------------------------------------}
  909. function TIpAnsiTextStream.atsGetLineCount : Longint;
  910. begin
  911. if FLineCount < 0 then
  912. Result := MaxLongInt
  913. else
  914. Result := FLineCount;
  915. end;
  916. {-----------------------------------------------------------------------------}
  917. procedure TIpAnsiTextStream.atsResetLineIndex;
  918. begin
  919. {make sure we have a line index}
  920. if (FLineIndex = nil) then begin
  921. FLineIndex := TList.Create; {create the index: even elements are}
  922. FLineIndex.Count := LineIndexCount * 2; {linenums, odd are offsets}
  923. {if we didn't have a line index, set up some reasonable defaults}
  924. FLineTerm := ltCRLF; {normal Windows text file terminator}
  925. FLineEndCh := #10; {not used straight away}
  926. FLineLen := 80; {not used straight away}
  927. end;
  928. FLineIndex[0] := pointer(0); {the first line is line 0 and...}
  929. FLineIndex[1] := pointer(0); {...it starts at position 0}
  930. FLineInxTop := 0; {the top valid index}
  931. FLineInxStep := 1; {step count before add a line to index}
  932. FLineCount := -1; {number of lines (-1 = don't know)}
  933. FLineCurrent := 0; {current line}
  934. FLineCurOfs := 0; {current line offset}
  935. end;
  936. {-----------------------------------------------------------------------------}
  937. procedure TIpAnsiTextStream.atsSetLineTerm(aValue : TIpLineTerminator);
  938. begin
  939. if (aValue <> LineTerminator) and ((FBufOfs + FBufPos) = 0) then begin
  940. {if there was no terminator, free the line buffer}
  941. if (LineTerminator = ltNone) then begin
  942. FreeMem(FFixedLine, FixedLineLength);
  943. FFixedLine := nil;
  944. end;
  945. {set the new value}
  946. FLineTerm := aValue;
  947. {if there is no terminator now, allocate the line buffer}
  948. if (LineTerminator = ltNone) then begin
  949. GetMem(FFixedLine, FixedLineLength);
  950. end;
  951. atsResetLineIndex;
  952. end;
  953. end;
  954. {-----------------------------------------------------------------------------}
  955. procedure TIpAnsiTextStream.atsSetLineEndCh(aValue : AnsiChar);
  956. begin
  957. if ((FBufOfs + FBufPos) = 0) then begin
  958. FLineEndCh := aValue;
  959. atsResetLineIndex;
  960. end;
  961. end;
  962. {-----------------------------------------------------------------------------}
  963. procedure TIpAnsiTextStream.atsSetLineLen(aValue : Integer);
  964. begin
  965. if (aValue <> FixedLineLength) and ((FBufOfs + FBufPos) = 0) then begin
  966. {validate the new length first}
  967. if (aValue < 1) or (aValue > 1024) then
  968. raise EIpBaseException.Create(SBadLineLength);
  969. {set the new value; note that if there is no terminator we need to
  970. free the old line buffer, and then allocate a new one}
  971. if (LineTerminator = ltNone) then
  972. FreeMem(FFixedLine, FixedLineLength);
  973. FLineLen := aValue;
  974. if (LineTerminator = ltNone) then
  975. GetMem(FFixedLine, FixedLineLength);
  976. atsResetLineIndex;
  977. end;
  978. end;
  979. {-----------------------------------------------------------------------------}
  980. procedure TIpAnsiTextStream.bsInitForNewStream;
  981. begin
  982. inherited bsInitForNewStream;
  983. atsResetLineIndex;
  984. end;
  985. {-----------------------------------------------------------------------------}
  986. function TIpAnsiTextStream.ReadLine : string;
  987. var
  988. CurPos : Longint;
  989. EndPos : Longint;
  990. Len : Longint;
  991. StLen : Longint;
  992. begin
  993. if not Assigned(FStream) then
  994. Exit;
  995. atsGetLine(CurPos, EndPos, Len);
  996. if (LineTerminator = ltNone) then begin
  997. {at this point, Len will either equal FixedLineLength, or it will
  998. be less than it because we read the last line of all and it was
  999. short}
  1000. StLen := FixedLineLength;
  1001. {$IFDEF MSWindows}
  1002. SetLength(Result, StLen);
  1003. {$ELSE}
  1004. {$IFDEF IP_LAZARUS}
  1005. SetLength(Result, StLen);
  1006. {$ELSE}
  1007. if (StLen > 255) then
  1008. StLen := 255;
  1009. Result[0] := char(StLen);
  1010. {$ENDIF}
  1011. {$ENDIF}
  1012. if (Len < StLen) then
  1013. FillChar(Result[Len+1], StLen-Len, ' ');
  1014. end
  1015. else {LineTerminator is not ltNone} begin
  1016. {$IFDEF MSWindows}
  1017. SetLength(Result, Len);
  1018. {$ELSE}
  1019. {$IFDEF IP_LAZARUS}
  1020. SetLength(Result, Len);
  1021. {$ELSE}
  1022. if (Len > 255) then
  1023. Len := 255;
  1024. Result[0] := char(Len);
  1025. {$ENDIF}
  1026. {$ENDIF}
  1027. end;
  1028. {read the line}
  1029. Seek(CurPos, soFromBeginning);
  1030. if Len > 0 then
  1031. Read(Result[1], Len);
  1032. Seek(EndPos, soFromBeginning);
  1033. end;
  1034. {-----------------------------------------------------------------------------}
  1035. function TIpAnsiTextStream.ReadLineArray(aCharArray : PAnsiChar;
  1036. aLen : Longint)
  1037. : Longint;
  1038. var
  1039. CurPos : Longint;
  1040. EndPos : Longint;
  1041. Len : Longint;
  1042. StLen : Longint;
  1043. begin
  1044. Result := 0;
  1045. if not Assigned(FStream) then
  1046. Exit;
  1047. atsGetLine(CurPos, EndPos, Len);
  1048. if (LineTerminator = ltNone) then begin
  1049. {at this point, Len will either equal FixedLineLength, or it will
  1050. be less than it because we read the last line of all and it was
  1051. short}
  1052. StLen := FixedLineLength;
  1053. if (StLen > aLen) then
  1054. StLen := aLen;
  1055. if (Len < StLen) then
  1056. FillChar(aCharArray[Len], StLen-Len, ' ');
  1057. Result := StLen;
  1058. end
  1059. else {LineTerminator is not ltNone} begin
  1060. if (Len > aLen) then
  1061. Len := aLen;
  1062. Result := Len;
  1063. end;
  1064. Seek(CurPos, soFromBeginning);
  1065. Read(aCharArray[0], Len);
  1066. Seek(EndPos, soFromBeginning);
  1067. end;
  1068. {-----------------------------------------------------------------------------}
  1069. function TIpAnsiTextStream.ReadLineZ(aSt : PAnsiChar; aMaxLen : Longint) : PAnsiChar;
  1070. var
  1071. CurPos : Longint;
  1072. EndPos : Longint;
  1073. Len : Longint;
  1074. StLen : Longint;
  1075. begin
  1076. Result := nil;
  1077. if not Assigned(FStream) then
  1078. Exit;
  1079. Result := aSt;
  1080. atsGetLine(CurPos, EndPos, Len);
  1081. if (LineTerminator = ltNone) then begin
  1082. {at this point, Len will either equal FixedLineLength, or it will
  1083. be less than it because we read the last line of all and it was
  1084. short}
  1085. StLen := FixedLineLength;
  1086. if (StLen > aMaxLen) then
  1087. StLen := aMaxLen;
  1088. if (Len < StLen) then
  1089. FillChar(Result[Len], StLen-Len, ' ');
  1090. Result[StLen] := #0;
  1091. end
  1092. else {LineTerminator is not ltNone} begin
  1093. if (Len > aMaxLen) then
  1094. Len := aMaxLen;
  1095. Result[Len] := #0;
  1096. end;
  1097. Seek(CurPos, soFromBeginning);
  1098. Read(Result[0], Len);
  1099. Seek(EndPos, soFromBeginning);
  1100. end;
  1101. {-----------------------------------------------------------------------------}
  1102. function TIpAnsiTextStream.SeekNearestLine(aOffset : Longint) : Longint;
  1103. var
  1104. CurLine : Longint;
  1105. CurOfs : Longint;
  1106. CurPos : Longint;
  1107. EndPos : Longint;
  1108. Len : Longint;
  1109. i : Longint;
  1110. Done : Boolean;
  1111. L, R, M : Integer;
  1112. begin
  1113. Result := 0;
  1114. if not Assigned(FStream) then
  1115. Exit;
  1116. {if the offset we want is for the current line, reposition at the
  1117. current line offset, return the current line number and exit}
  1118. if (aOffset = FLineCurOfs) then begin
  1119. Seek(FLineCurOfs, soFromBeginning);
  1120. Result := FLineCurrent;
  1121. Exit;
  1122. end;
  1123. {if the offset requested is less than or equal to zero, just
  1124. position at line zero (ie, the start of the stream)}
  1125. if (aOffset <= 0) then begin
  1126. Seek(0, soFromBeginning);
  1127. FLineCurrent := 0;
  1128. FLineCurOfs := 0;
  1129. Result := 0;
  1130. Exit;
  1131. end;
  1132. {if the offset requested is greater than or equal to the size of the
  1133. stream, position at the end of the stream (note that if we don't
  1134. know the number of lines in the stream yet, FLineCount is set to
  1135. -1 and we can't take this shortcut because we need to return the
  1136. true value)}
  1137. if (FLineCount >= 0) and (aOffset >= FSize) then begin
  1138. Seek(0, soFromEnd);
  1139. FLineCurrent := FLineCount;
  1140. FLineCurOfs := FSize;
  1141. Result := FLineCount;
  1142. Exit;
  1143. end;
  1144. {if the offset requested is greater than the top item in the
  1145. line index, we shall have to build up the index until we get to the
  1146. line we require, or just beyond}
  1147. if (aOffset > {%H-}Longint(FLineIndex[FLineInxTop+1])) then begin
  1148. {position at the last known line offset}
  1149. CurLine := {%H-}Longint(FLineIndex[FLineInxTop]);
  1150. CurOfs := {%H-}Longint(FLineIndex[FLineInxTop+1]);
  1151. Seek(CurOfs, soFromBeginning);
  1152. Done := false;
  1153. {continue reading lines in chunks of FLineInxStep and add an index
  1154. entry for each chunk}
  1155. while not Done do begin
  1156. for i := 0 to pred(FLineInxStep) do begin
  1157. atsGetLine(CurPos, EndPos, Len);
  1158. inc(CurLine);
  1159. CurOfs := EndPos;
  1160. if (EndPos = FSize) then begin
  1161. Done := true;
  1162. Break;
  1163. end;
  1164. end;
  1165. if Done then
  1166. FLineCount := CurLine
  1167. else begin
  1168. inc(FLineInxTop, 2);
  1169. if (FLineInxTop = (LineIndexCount * 2)) then begin
  1170. {we've exhausted the space in the index: rescale}
  1171. FLineInxTop := FLineInxTop div 2;
  1172. for i := 0 to pred(FLineInxTop) do begin
  1173. if Odd(i) then
  1174. FLineIndex.Exchange((i*2)-1, i)
  1175. else
  1176. FLineIndex.Exchange(i*2, i);
  1177. end;
  1178. FLineInxStep := FLineInxStep * 2;
  1179. end;
  1180. FLineIndex[FLineInxTop] := {%H-}pointer(CurLine);
  1181. FLineIndex[FLineInxTop+1] := {%H-}pointer(CurOfs);
  1182. if (aOffset <= CurOfs) then
  1183. Done := true;
  1184. end;
  1185. end;
  1186. end;
  1187. {we can now work out where the nearest item in the index is to the
  1188. line we require}
  1189. L := 1;
  1190. R := FLineInxTop+1;
  1191. while (L <= R) do begin
  1192. M := (L + R) div 2;
  1193. if not Odd(M) then
  1194. inc(M);
  1195. if (aOffset < {%H-}Longint(FLineIndex[M])) then
  1196. R := M - 2
  1197. else if (aOffset > {%H-}Longint(FLineIndex[M])) then
  1198. L := M + 2
  1199. else begin
  1200. FLineCurrent := {%H-}Longint(FLineIndex[M-1]);
  1201. FLineCurOfs := {%H-}Longint(FLineIndex[M]);
  1202. Seek(FLineCurOfs, soFromBeginning);
  1203. Result := FLineCurrent;
  1204. Exit;
  1205. end;
  1206. end;
  1207. {the item at L-2 will have the nearest smaller offset than the
  1208. one we want, hence the nearest smaller line is at L-3; start here
  1209. and read through the stream forwards}
  1210. CurLine := {%H-}Longint(FLineIndex[L-3]);
  1211. Seek({%H-}Longint(FLineIndex[L-2]), soFromBeginning);
  1212. while true do begin
  1213. atsGetLine(CurPos, EndPos, Len);
  1214. inc(CurLine);
  1215. if (EndPos > aOffset) then begin
  1216. FLineCurrent := CurLine - 1;
  1217. FLineCurOfs := CurPos;
  1218. Seek(CurPos, soFromBeginning);
  1219. Result := CurLine - 1;
  1220. Exit;
  1221. end
  1222. else if (CurLine = FLineCount) or (EndPos = aOffset) then begin
  1223. FLineCurrent := CurLine;
  1224. FLineCurOfs := EndPos;
  1225. Seek(EndPos, soFromBeginning);
  1226. Result := CurLine;
  1227. Exit;
  1228. end;
  1229. end;
  1230. end;
  1231. {-----------------------------------------------------------------------------}
  1232. function TIpAnsiTextStream.SeekLine(aLineNum : Longint) : Longint;
  1233. var
  1234. CurLine : Longint;
  1235. CurOfs : Longint;
  1236. CurPos : Longint;
  1237. EndPos : Longint;
  1238. Len : Longint;
  1239. i : Longint;
  1240. Done : Boolean;
  1241. L, R, M : Integer;
  1242. begin
  1243. Result := 0;
  1244. if not Assigned(FStream) then
  1245. Exit;
  1246. {if the line number we want is the current line, reposition at the
  1247. current line offset, return the current line number and exit}
  1248. if (aLineNum = FLineCurrent) then begin
  1249. Seek(FLineCurOfs, soFromBeginning);
  1250. Result := FLineCurrent;
  1251. Exit;
  1252. end;
  1253. {if the line number requested is less than or equal to zero, just
  1254. position at line zero (ie, the start of the stream)}
  1255. if (aLineNum <= 0) then begin
  1256. Seek(0, soFromBeginning);
  1257. FLineCurrent := 0;
  1258. FLineCurOfs := 0;
  1259. Result := 0;
  1260. Exit;
  1261. end;
  1262. {if the line number requested is greater than or equal to the line
  1263. count, position at the end of the stream (note that if we don't
  1264. know the number of lines in the stream yet, FLineCount is set to
  1265. -1)}
  1266. if (FLineCount >= 0) and (aLineNum > FLineCount) then begin
  1267. Seek(0, soFromEnd);
  1268. FLineCurrent := FLineCount;
  1269. FLineCurOfs := FSize;
  1270. Result := FLineCount;
  1271. Exit;
  1272. end;
  1273. {if the line number requested is greater than the top item in the
  1274. line index, we shall have to build up the index until we get to the
  1275. line we require, or just beyond}
  1276. if (aLineNum > {%H-}Longint(FLineIndex[FLineInxTop])) then begin
  1277. {position at the last known line offset}
  1278. CurLine := {%H-}Longint(FLineIndex[FLineInxTop]);
  1279. CurOfs := {%H-}Longint(FLineIndex[FLineInxTop+1]);
  1280. Seek(CurOfs, soFromBeginning);
  1281. Done := false;
  1282. {continue reading lines in chunks of FLineInxStep and add an index
  1283. entry for each chunk}
  1284. while not Done do begin
  1285. for i := 0 to pred(FLineInxStep) do begin
  1286. atsGetLine(CurPos, EndPos, Len);
  1287. inc(CurLine);
  1288. CurOfs := EndPos;
  1289. if (EndPos = FSize) then begin
  1290. Done := true;
  1291. Break;
  1292. end;
  1293. end;
  1294. if Done then
  1295. FLineCount := CurLine
  1296. else begin
  1297. inc(FLineInxTop, 2);
  1298. if (FLineInxTop = (LineIndexCount * 2)) then begin
  1299. {we've exhausted the space in the index: rescale}
  1300. FLineInxTop := FLineInxTop div 2;
  1301. for i := 0 to pred(FLineInxTop) do begin
  1302. if Odd(i) then
  1303. FLineIndex.Exchange((i*2)-1, i)
  1304. else
  1305. FLineIndex.Exchange(i*2, i);
  1306. end;
  1307. FLineInxStep := FLineInxStep * 2;
  1308. end;
  1309. FLineIndex[FLineInxTop] := {%H-}pointer(CurLine);
  1310. FLineIndex[FLineInxTop+1] := {%H-}pointer(CurOfs);
  1311. if (aLineNum <= CurLine) then
  1312. Done := true;
  1313. end;
  1314. end;
  1315. end;
  1316. {we can now work out where the nearest item in the index is to the
  1317. line we require}
  1318. L := 0;
  1319. R := FLineInxTop;
  1320. while (L <= R) do begin
  1321. M := (L + R) div 2;
  1322. if Odd(M) then
  1323. dec(M);
  1324. if (aLineNum < {%H-}Longint(FLineIndex[M])) then
  1325. R := M - 2
  1326. else if (aLineNum > {%H-}Longint(FLineIndex[M])) then
  1327. L := M + 2
  1328. else begin
  1329. FLineCurrent := {%H-}Longint(FLineIndex[M]);
  1330. FLineCurOfs := {%H-}Longint(FLineIndex[M+1]);
  1331. Seek(FLineCurOfs, soFromBeginning);
  1332. Result := FLineCurrent;
  1333. Exit;
  1334. end;
  1335. end;
  1336. {the item at L-2 will have the nearest smaller line number than the
  1337. one we want; start here and read through the stream forwards}
  1338. CurLine := Longint({%H-}PtrInt(FLineIndex[L-2]));
  1339. Seek(Longint({%H-}PtrInt(FLineIndex[L-1])), soFromBeginning);
  1340. while true do begin
  1341. atsGetLine(CurPos, EndPos, Len);
  1342. inc(CurLine);
  1343. if (CurLine = FLineCount) or (CurLine = aLineNum) then begin
  1344. FLineCurrent := CurLine;
  1345. FLineCurOfs := EndPos;
  1346. Seek(EndPos, soFromBeginning);
  1347. Result := CurLine;
  1348. Exit;
  1349. end;
  1350. end;
  1351. end;
  1352. {-----------------------------------------------------------------------------}
  1353. procedure TIpAnsiTextStream.WriteLine(const aSt : string);
  1354. {Rewritten !!.15}
  1355. begin
  1356. if Length(aSt) > 0 then
  1357. WriteLineArray(@aSt[1], length(aSt))
  1358. else
  1359. WriteLineArray(nil, 0);
  1360. end;
  1361. {-----------------------------------------------------------------------------}
  1362. procedure TIpAnsiTextStream.WriteLineArray(aCharArray : PAnsiChar;
  1363. aLen : Longint);
  1364. var
  1365. C : AnsiChar;
  1366. begin
  1367. if not Assigned(FStream) then
  1368. Exit;
  1369. if (aCharArray = nil) then
  1370. aLen := 0;
  1371. if (LineTerminator = ltNone) then begin
  1372. if (aLen >= FixedLineLength) then
  1373. Write(aCharArray[0], FixedLineLength)
  1374. else begin
  1375. FillChar(FFixedLine[aLen], FixedLineLength-aLen, ' ');
  1376. if (aLen > 0) then
  1377. Move(aCharArray[0], FFixedLine[0], aLen);
  1378. Write(FFixedLine[0], FixedLineLength);
  1379. end;
  1380. end
  1381. else begin
  1382. if (aLen > 0) then
  1383. Write(aCharArray[0], aLen);
  1384. case LineTerminator of
  1385. ltNone : {this'll never get hit};
  1386. ltCR : Write(LineTerm[ltCR], 1);
  1387. ltLF : Write(LineTerm[ltLF], 1);
  1388. ltCRLF : Write(LineTerm[ltCRLF], 2);
  1389. ltOther: begin
  1390. C := LineTermChar;
  1391. Write(C, 1);
  1392. end;
  1393. else
  1394. raise EIpBaseException.Create(SBadLineTerminator);
  1395. end;
  1396. end;
  1397. end;
  1398. {-----------------------------------------------------------------------------}
  1399. procedure TIpAnsiTextStream.WriteLineZ(aSt : PAnsiChar);
  1400. var
  1401. LenSt : Longint;
  1402. begin
  1403. if not Assigned(FStream) then
  1404. Exit;
  1405. if (aSt = nil) then
  1406. LenSt := 0
  1407. else
  1408. LenSt := StrLen(aSt);
  1409. WriteLineArray(aSt, LenSt);
  1410. end;
  1411. { TIpDownloadFileStream }
  1412. constructor TIpDownloadFileStream.Create(const aPath : string);
  1413. begin
  1414. FHandle := IpFileOpenFailed;
  1415. inherited Create;
  1416. dfsMakeTempFile(aPath);
  1417. FHandle := THandle(FileOpen(FFileName, fmShareDenyNone + fmOpenReadWrite));
  1418. if (Handle = IpFileOpenFailed) then
  1419. {$IFDEF Version6OrHigher}
  1420. RaiseLastOSError;
  1421. {$ELSE}
  1422. RaiseLastWin32Error;
  1423. {$ENDIF}
  1424. end;
  1425. destructor TIpDownloadFileStream.Destroy;
  1426. begin
  1427. {$IFDEF IP_LAZARUS}
  1428. writeln('ToDo: TIpDownloadFileStream.Destroy ');
  1429. {$ELSE}
  1430. FlushFileBuffers(FHandle);
  1431. if (Handle <> INVALID_HANDLE_VALUE) then
  1432. CloseHandle(Handle);
  1433. {$ENDIF}
  1434. inherited Destroy;
  1435. end;
  1436. procedure TIpDownloadFileStream.dfsMakeTempFile(const aPath : string);
  1437. begin
  1438. { Make sure the path has no backslash. }
  1439. if aPath[length(aPath)] = '\' then
  1440. FPath := Copy(aPath, 1, pred(length(aPath)))
  1441. else
  1442. FPath := aPath;
  1443. { Check that it really exists. }
  1444. if not DirExists(aPath) then
  1445. raise EIpBaseException.Create(SBadPath);
  1446. { Create a new uniquely named file in that folder. }
  1447. FFileName := GetTemporaryFile(FPath); {!!.12}
  1448. end;
  1449. function TIpDownloadFileStream.Read(var Buffer; Count : Longint) : Longint;
  1450. {$IFDEF IP_LAZARUS}
  1451. begin
  1452. writeln('ToDo: TIpDownloadFileStream.Read ');
  1453. Result:=0;
  1454. end;
  1455. {$ELSE}
  1456. var
  1457. ReadOK : Bool;
  1458. begin
  1459. ReadOK := ReadFile(Handle, Buffer, Count, DWord(Result), nil);
  1460. if not ReadOK then begin
  1461. raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename + FFileName);
  1462. Result := 0;
  1463. end;
  1464. end;
  1465. {$ENDIF}
  1466. procedure TIpDownloadFileStream.Rename(aNewName : string);
  1467. var
  1468. NewFullName : string;
  1469. begin
  1470. {$IFDEF IP_LAZARUS}
  1471. writeln('ToDo: TIpDownloadFileStream.Rename ');
  1472. {$ENDIF}
  1473. {close the current handle}
  1474. {$IFNDEF IP_LAZARUS}
  1475. CloseHandle(Handle);
  1476. {$ENDIF}
  1477. FHandle := IpFileOpenFailed;
  1478. {calculate the full new name}
  1479. NewFullName := FPath + '\' + aNewName;
  1480. {rename the file}
  1481. {$IFDEF Version6OrHigher}
  1482. {$IFNDEF IP_LAZARUS}
  1483. if not MoveFile(PAnsiChar(FFileName), PAnsiChar(NewFullName)) then
  1484. RaiseLastOSError;
  1485. {$ENDIF}
  1486. {$ELSE}
  1487. Win32Check(MoveFile(PAnsiChar(FFileName), PAnsiChar(NewFullName)));
  1488. {$ENDIF}
  1489. {open up the same file, but with its new name}
  1490. FFileName := NewFullName;
  1491. try
  1492. FHandle := THandle(FileOpen(FFileName, fmShareDenyNone + fmOpenRead));
  1493. except
  1494. { do nothing }
  1495. end;
  1496. if (Handle = IpFileOpenFailed) then
  1497. {$IFDEF Version6OrHigher}
  1498. RaiseLastOSError;
  1499. {$ELSE}
  1500. RaiseLastWin32Error;
  1501. {$ENDIF}
  1502. FRenamed := true;
  1503. end;
  1504. procedure TIpDownloadFileStream.Move(aNewName : string);
  1505. begin
  1506. {$IFDEF IP_LAZARUS}
  1507. writeln('ToDo: TIpDownloadFileStream.Move ');
  1508. {$ENDIF}
  1509. {close the current handle}
  1510. {$IFNDEF IP_LAZARUS}
  1511. CloseHandle(Handle);
  1512. {$ENDIF}
  1513. FHandle := IpFileOpenFailed;
  1514. {copy the file} {!!.01}
  1515. {$IFDEF Version6OrHigher}
  1516. {$IFNDEF IP_LAZARUS}
  1517. if not CopyFile(PAnsiChar(FFileName), PAnsiChar(aNewName), False) then
  1518. RaiseLastOSError;
  1519. {$ENDIF}
  1520. {$ELSE}
  1521. Win32Check(CopyFile(PAnsiChar(FFileName), {!!.01}
  1522. PAnsiChar(aNewName), False)); {!!.01}
  1523. {$ENDIF}
  1524. {open up the same file, but with its new name}
  1525. FFileName := aNewName;
  1526. try
  1527. FHandle := THandle(FileOpen(FFileName, fmShareDenyNone + fmOpenRead));
  1528. except
  1529. { do nothing }
  1530. end;
  1531. if (Handle = IpFileOpenFailed) then
  1532. {$IFDEF Version6OrHigher}
  1533. RaiseLastOSError;
  1534. {$ELSE}
  1535. RaiseLastWin32Error;
  1536. {$ENDIF}
  1537. FRenamed := true;
  1538. end;
  1539. function TIpDownloadFileStream.Seek(Offset : Longint; Origin : Word) : Longint;
  1540. begin
  1541. {$IFDEF IP_LAZARUS}
  1542. writeln('ToDo: TIpDownloadFileStream.Seek');
  1543. Result := 0;
  1544. {$ELSE}
  1545. Result := SetFilePointer(Handle, Offset, nil, Origin);
  1546. {$ENDIF}
  1547. end;
  1548. function TIpDownloadFileStream.Write(const Buffer; Count : Longint) : Longint;
  1549. {$IFDEF IP_LAZARUS}
  1550. begin
  1551. writeln('ToDo: TIpDownloadFileStream.Write');
  1552. Result:=Count;
  1553. end;
  1554. {$ELSE}
  1555. var
  1556. WriteOK : Bool;
  1557. begin
  1558. WriteOK := WriteFile(Handle, Buffer, Count, DWord(Result), nil);
  1559. if not WriteOK then begin
  1560. raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename + FFileName);
  1561. Result := 0
  1562. end;
  1563. end;
  1564. {$ENDIF}
  1565. { TIpByteStream }
  1566. constructor TIpByteStream.Create(aStream : TStream);
  1567. begin
  1568. inherited Create;
  1569. FStream := aStream;
  1570. end;
  1571. destructor TIpByteStream.Destroy;
  1572. begin
  1573. inherited Destroy;
  1574. end;
  1575. function TIpByteStream.Read(var b : Byte) : Boolean;
  1576. begin
  1577. Result := True;
  1578. if (BufPos = BufEnd) then begin
  1579. BufPos := 0;
  1580. BufEnd := FStream.Read(Buffer, SizeOf(Buffer));
  1581. if (BufEnd = 0) then begin
  1582. Result := False;
  1583. Exit;
  1584. end;
  1585. end;
  1586. b := Buffer[BufPos];
  1587. Inc(BufPos);
  1588. end;
  1589. function TIpByteStream.GetPosition : Integer;
  1590. begin
  1591. Result := FStream.Position - BufEnd + BufPos;
  1592. end;
  1593. function TIpByteStream.GetSize : Integer;
  1594. begin
  1595. Result := FStream.Size;
  1596. end;
  1597. end.