ImagingIO.pas 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753
  1. {
  2. Vampyre Imaging Library
  3. by Marek Mauder
  4. https://github.com/galfar/imaginglib
  5. https://imaginglib.sourceforge.io
  6. - - - - -
  7. This Source Code Form is subject to the terms of the Mozilla Public
  8. License, v. 2.0. If a copy of the MPL was not distributed with this
  9. file, You can obtain one at https://mozilla.org/MPL/2.0.
  10. }
  11. { This unit contains default IO functions for reading from/writing to
  12. files, streams and memory.}
  13. unit ImagingIO;
  14. {$I ImagingOptions.inc}
  15. interface
  16. uses
  17. SysUtils, Classes, ImagingTypes, Imaging, ImagingUtility;
  18. type
  19. TMemoryIORec = record
  20. Data: ImagingUtility.PByteArray;
  21. Position: LongInt;
  22. Size: Int64;
  23. end;
  24. PMemoryIORec = ^TMemoryIORec;
  25. var
  26. OriginalFileIO: TIOFunctions;
  27. FileIO: TIOFunctions;
  28. StreamIO: TIOFunctions;
  29. MemoryIO: TIOFunctions;
  30. { Helper function that returns size of input (from current position to the end)
  31. represented by Handle (and opened and operated on by members of IOFunctions).}
  32. function GetInputSize(const IOFunctions: TIOFunctions; Handle: TImagingHandle): Int64;
  33. { Helper function that initializes TMemoryIORec with given params.}
  34. function PrepareMemIO(Data: Pointer; const Size: Int64): TMemoryIORec;
  35. { Reads one text line from input (CR+LF, CR, or LF as line delimiter).}
  36. function ReadLine(const IOFunctions: TIOFunctions; Handle: TImagingHandle;
  37. out Line: AnsiString; FailOnControlChars: Boolean = False): Boolean;
  38. { Writes one text line to input with optional line delimiter.}
  39. procedure WriteLine(const IOFunctions: TIOFunctions; Handle: TImagingHandle;
  40. const Line: AnsiString; const LineEnding: AnsiString = sLineBreak);
  41. type
  42. TReadMemoryStream = class(TCustomMemoryStream)
  43. public
  44. constructor Create(Data: Pointer; Size: Integer);
  45. class function CreateFromIOHandle(const IOFunctions: TIOFunctions; Handle: TImagingHandle): TReadMemoryStream;
  46. end;
  47. { A TStream descendant that wraps an existing TIOFunctions record and TImagingHandle.
  48. It translates TStream methods (Read, Write, Seek) into calls to the
  49. corresponding functions in the TIOFunctions record.
  50. Note: This stream does not own or manage the lifetime of the TImagingHandle.
  51. Closing the handle must be done externally using the appropriate TCloseProc.
  52. Note: Resizing the stream is not supported. }
  53. TImagingIOStream = class(TStream)
  54. private
  55. FIO: TIOFunctions;
  56. FHandle: TImagingHandle;
  57. FSize: Int64;
  58. protected
  59. function GetSize: Int64; override;
  60. procedure SetSize(const NewSize: Int64); override;
  61. public
  62. { Creates a stream wrapper around existing IO functions and handle.
  63. The handle must already be opened. The stream does NOT close the handle
  64. when destroyed. }
  65. constructor Create(const AIOFunctions: TIOFunctions; AHandle: TImagingHandle);
  66. function Read(var Buffer; Count: TIOReadWriteCount): TIOReadWriteCount; override;
  67. function Write(const Buffer; Count: TIOReadWriteCount): TIOReadWriteCount; override;
  68. function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
  69. {$IFNDEF FPC}
  70. function ReadByte: Byte; {$IFDEF USE_INLINE}inline;{$ENDIF}
  71. procedure WriteByte(Value: Byte); {$IFDEF USE_INLINE}inline;{$ENDIF}
  72. {$ENDIF}
  73. property Handle: TImagingHandle read FHandle;
  74. property IOFunctions: TIOFunctions read FIO;
  75. end;
  76. implementation
  77. const
  78. DefaultBufferSize = 32 * 1024;
  79. type
  80. { Based on TaaBufferedStream
  81. Copyright (c) Julian M Bucknall 1997, 1999 }
  82. TBufferedStream = class
  83. private
  84. FBuffer: PByteArray;
  85. FBufSize: Integer;
  86. FBufStart: Int64;
  87. FBufPos: Integer;
  88. FBytesInBuf: Integer;
  89. FSize: Int64;
  90. FDirty: Boolean;
  91. FStream: TStream;
  92. function GetPosition: Int64;
  93. function GetSize: Int64;
  94. procedure ReadBuffer;
  95. procedure WriteBuffer;
  96. procedure SetPosition(const Value: Int64);
  97. public
  98. constructor Create(AStream: TStream);
  99. destructor Destroy; override;
  100. function Read(var Buffer; Count: NativeInt): NativeInt;
  101. function Write(const Buffer; Count: NativeInt): NativeInt;
  102. function Seek(Offset: Int64; Origin: Word): Int64;
  103. procedure Commit;
  104. property Stream: TStream read FStream;
  105. property Position: Int64 read GetPosition write SetPosition;
  106. property Size: Int64 read GetSize;
  107. end;
  108. constructor TBufferedStream.Create(AStream: TStream);
  109. begin
  110. inherited Create;
  111. FStream := AStream;
  112. FBufSize := DefaultBufferSize;
  113. GetMem(FBuffer, FBufSize);
  114. FBufPos := 0;
  115. FBytesInBuf := 0;
  116. FBufStart := 0;
  117. FDirty := False;
  118. FSize := AStream.Size;
  119. end;
  120. destructor TBufferedStream.Destroy;
  121. begin
  122. if FBuffer <> nil then
  123. begin
  124. Commit;
  125. FreeMem(FBuffer);
  126. end;
  127. FStream.Position := Position; // Make sure source stream has right position
  128. inherited Destroy;
  129. end;
  130. function TBufferedStream.GetPosition: Int64;
  131. begin
  132. Result := FBufStart + FBufPos;
  133. end;
  134. procedure TBufferedStream.SetPosition(const Value: Int64);
  135. begin
  136. Seek(Value, soFromCurrent);
  137. end;
  138. function TBufferedStream.GetSize: Int64;
  139. begin
  140. Result := FSize;
  141. end;
  142. procedure TBufferedStream.ReadBuffer;
  143. var
  144. SeekResult: Integer;
  145. begin
  146. SeekResult := FStream.Seek(FBufStart, soBeginning);
  147. if SeekResult = -1 then
  148. raise Exception.Create('TBufferedStream.ReadBuffer: seek failed');
  149. FBytesInBuf := FStream.Read(FBuffer^, FBufSize);
  150. if FBytesInBuf <= 0 then
  151. raise Exception.Create('TBufferedStream.ReadBuffer: read failed');
  152. end;
  153. procedure TBufferedStream.WriteBuffer;
  154. var
  155. SeekResult: Integer;
  156. BytesWritten: Integer;
  157. begin
  158. SeekResult := FStream.Seek(FBufStart, soBeginning);
  159. if SeekResult = -1 then
  160. raise Exception.Create('TBufferedStream.WriteBuffer: seek failed');
  161. BytesWritten := FStream.Write(FBuffer^, FBytesInBuf);
  162. if BytesWritten <> FBytesInBuf then
  163. raise Exception.Create('TBufferedStream.WriteBuffer: write failed');
  164. end;
  165. procedure TBufferedStream.Commit;
  166. begin
  167. if FDirty then
  168. begin
  169. WriteBuffer;
  170. FDirty := False;
  171. end;
  172. end;
  173. function TBufferedStream.Read(var Buffer; Count: NativeInt): NativeInt;
  174. var
  175. BufAsBytes: TByteArray absolute Buffer;
  176. BufIdx, BytesToGo, BytesToRead: NativeInt;
  177. begin
  178. // Calculate the actual number of bytes we can read - this depends on
  179. // the current position and size of the stream as well as the number
  180. // of bytes requested.
  181. BytesToGo := Count;
  182. if FSize < (FBufStart + FBufPos + Count) then
  183. BytesToGo := FSize - (FBufStart + FBufPos);
  184. if BytesToGo <= 0 then
  185. begin
  186. Result := 0;
  187. Exit;
  188. end;
  189. // Remember to return the result of our calculation
  190. Result := BytesToGo;
  191. BufIdx := 0;
  192. if FBytesInBuf = 0 then
  193. ReadBuffer;
  194. // Calculate the number of bytes we can read prior to the loop
  195. BytesToRead := FBytesInBuf - FBufPos;
  196. if BytesToRead > BytesToGo then
  197. BytesToRead := BytesToGo;
  198. // Copy from the stream buffer to the caller's buffer
  199. Move(FBuffer^[FBufPos], BufAsBytes[BufIdx], BytesToRead);
  200. // Calculate the number of bytes still to read}
  201. Dec(BytesToGo, BytesToRead);
  202. // while we have bytes to read, read them
  203. while BytesToGo > 0 do
  204. begin
  205. Inc(BufIdx, BytesToRead);
  206. // As we've exhausted this buffer-full, advance to the next, check
  207. // to see whether we need to write the buffer out first
  208. if FDirty then
  209. begin
  210. WriteBuffer;
  211. FDirty := false;
  212. end;
  213. Inc(FBufStart, FBufSize);
  214. FBufPos := 0;
  215. ReadBuffer;
  216. // Calculate the number of bytes we can read in this cycle
  217. BytesToRead := FBytesInBuf;
  218. if BytesToRead > BytesToGo then
  219. BytesToRead := BytesToGo;
  220. // Copy from the stream buffer to the caller's buffer
  221. Move(FBuffer^, BufAsBytes[BufIdx], BytesToRead);
  222. // Calculate the number of bytes still to read
  223. Dec(BytesToGo, BytesToRead);
  224. end;
  225. // Remember our new position
  226. Inc(FBufPos, BytesToRead);
  227. if FBufPos = FBufSize then
  228. begin
  229. Inc(FBufStart, FBufSize);
  230. FBufPos := 0;
  231. FBytesInBuf := 0;
  232. end;
  233. end;
  234. function TBufferedStream.Seek(Offset: Int64; Origin: Word): Int64;
  235. var
  236. NewBufStart, NewPos: Int64;
  237. begin
  238. // Calculate the new position
  239. case Origin of
  240. soFromBeginning : NewPos := Offset;
  241. soFromCurrent : NewPos := FBufStart + FBufPos + Offset;
  242. soFromEnd : NewPos := FSize + Offset;
  243. else
  244. raise Exception.Create('TBufferedStream.Seek: invalid origin');
  245. end;
  246. if (NewPos < 0) or (NewPos > FSize) then
  247. begin
  248. //NewPos := ClampInt(NewPos, 0, FSize); don't do this - for writing
  249. end;
  250. // Calculate which page of the file we need to be at
  251. NewBufStart := NewPos and not Pred(FBufSize);
  252. // If the new page is different than the old, mark the buffer as being
  253. // ready to be replenished, and if need be write out any dirty data
  254. if NewBufStart <> FBufStart then
  255. begin
  256. if FDirty then
  257. begin
  258. WriteBuffer;
  259. FDirty := False;
  260. end;
  261. FBufStart := NewBufStart;
  262. FBytesInBuf := 0;
  263. end;
  264. // Save the new position
  265. FBufPos := NewPos - NewBufStart;
  266. Result := NewPos;
  267. end;
  268. function TBufferedStream.Write(const Buffer; Count: NativeInt): NativeInt;
  269. var
  270. BufAsBytes: TByteArray absolute Buffer;
  271. BufIdx, BytesToGo, BytesToWrite: NativeInt;
  272. begin
  273. // When we write to this stream we always assume that we can write the
  274. // requested number of bytes: if we can't (eg, the disk is full) we'll
  275. // get an exception somewhere eventually.
  276. BytesToGo := Count;
  277. // Remember to return the result of our calculation
  278. Result := BytesToGo;
  279. BufIdx := 0;
  280. if (FBytesInBuf = 0) and (FSize > FBufStart) then
  281. ReadBuffer;
  282. // Calculate the number of bytes we can write prior to the loop
  283. BytesToWrite := FBufSize - FBufPos;
  284. if BytesToWrite > BytesToGo then
  285. BytesToWrite := BytesToGo;
  286. // Copy from the caller's buffer to the stream buffer
  287. Move(BufAsBytes[BufIdx], FBuffer^[FBufPos], BytesToWrite);
  288. // Mark our stream buffer as requiring a save to the actual stream,
  289. // note that this will suffice for the rest of the routine as well: no
  290. // inner routine will turn off the dirty flag.
  291. FDirty := True;
  292. // Calculate the number of bytes still to write
  293. Dec(BytesToGo, BytesToWrite);
  294. // While we have bytes to write, write them
  295. while BytesToGo > 0 do
  296. begin
  297. Inc(BufIdx, BytesToWrite);
  298. // As we've filled this buffer, write it out to the actual stream
  299. // and advance to the next buffer, reading it if required
  300. FBytesInBuf := FBufSize;
  301. WriteBuffer;
  302. Inc(FBufStart, FBufSize);
  303. FBufPos := 0;
  304. FBytesInBuf := 0;
  305. if FSize > FBufStart then
  306. ReadBuffer;
  307. // Calculate the number of bytes we can write in this cycle
  308. BytesToWrite := FBufSize;
  309. if BytesToWrite > BytesToGo then
  310. BytesToWrite := BytesToGo;
  311. // Copy from the caller's buffer to our buffer
  312. Move(BufAsBytes[BufIdx], FBuffer^, BytesToWrite);
  313. // Calculate the number of bytes still to write
  314. Dec(BytesToGo, BytesToWrite);
  315. end;
  316. // Remember our new position
  317. Inc(FBufPos, BytesToWrite);
  318. // Make sure the count of valid bytes is correct
  319. if FBytesInBuf < FBufPos then
  320. FBytesInBuf := FBufPos;
  321. // Make sure the stream size is correct
  322. if FSize < (FBufStart + FBytesInBuf) then
  323. FSize := FBufStart + FBytesInBuf;
  324. // If we're at the end of the buffer, write it out and advance to the
  325. // start of the next page
  326. if FBufPos = FBufSize then
  327. begin
  328. WriteBuffer;
  329. FDirty := False;
  330. Inc(FBufStart, FBufSize);
  331. FBufPos := 0;
  332. FBytesInBuf := 0;
  333. end;
  334. end;
  335. { TImagingIOStream }
  336. constructor TImagingIOStream.Create(const AIOFunctions: TIOFunctions; AHandle: TImagingHandle);
  337. begin
  338. inherited Create;
  339. if (AHandle = nil) or
  340. not Assigned(AIOFunctions.Read) or
  341. not Assigned(AIOFunctions.Write) or
  342. not Assigned(AIOFunctions.Seek) or
  343. not Assigned(AIOFunctions.Tell) then
  344. begin
  345. raise EStreamError.Create('Invalid TIOFunctions or TImagingHandle provided');
  346. end;
  347. FIO := AIOFunctions;
  348. FHandle := AHandle;
  349. FSize := GetInputSize(FIO, FHandle);
  350. end;
  351. function TImagingIOStream.GetSize: Int64;
  352. begin
  353. Result := FSize;
  354. end;
  355. procedure TImagingIOStream.SetSize(const NewSize: Int64);
  356. begin
  357. raise EStreamError.CreateFmt('%s does not support SetSize', [ClassName]);
  358. end;
  359. function TImagingIOStream.Read(var Buffer; Count: TIOReadWriteCount): TIOReadWriteCount;
  360. begin
  361. Result := 0;
  362. if Count < 0 then raise EStreamError.Create('Read count cannot be negative');
  363. if Count = 0 then Exit;
  364. Result := FIO.Read(FHandle, @Buffer, Count);
  365. end;
  366. function TImagingIOStream.Write(const Buffer; Count: TIOReadWriteCount): TIOReadWriteCount;
  367. begin
  368. Result := 0;
  369. if Count < 0 then raise EStreamError.Create('Write count cannot be negative');
  370. if Count = 0 then Exit;
  371. Result := FIO.Write(FHandle, @Buffer, Count);
  372. end;
  373. function TImagingIOStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
  374. begin
  375. Result := FIO.Seek(FHandle, Offset, TSeekMode(Origin));
  376. end;
  377. {$IFNDEF FPC}
  378. function TImagingIOStream.ReadByte: Byte;
  379. begin
  380. ReadBuffer(Result, 1);
  381. end;
  382. procedure TImagingIOStream.WriteByte(Value: Byte);
  383. begin
  384. WriteBuffer(Value, 1);
  385. end;
  386. {$ENDIF}
  387. { File IO functions }
  388. function FileOpen(FileName: PChar; Mode: TOpenMode): TImagingHandle; cdecl;
  389. var
  390. Stream: TStream;
  391. begin
  392. Stream := nil;
  393. case Mode of
  394. omReadOnly: Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  395. omCreate: Stream := TFileStream.Create(FileName, fmCreate);
  396. omReadWrite:
  397. begin
  398. if FileExists(FileName) then
  399. Stream := TFileStream.Create(FileName, fmOpenReadWrite or fmShareExclusive)
  400. else
  401. Stream := TFileStream.Create(FileName, fmCreate);
  402. end;
  403. end;
  404. Assert(Stream <> nil);
  405. Result := TBufferedStream.Create(Stream);
  406. end;
  407. procedure FileClose(Handle: TImagingHandle); cdecl;
  408. var
  409. Stream: TStream;
  410. begin
  411. Stream := TBufferedStream(Handle).Stream;
  412. TBufferedStream(Handle).Free;
  413. Stream.Free;
  414. end;
  415. function FileEof(Handle: TImagingHandle): Boolean; cdecl;
  416. begin
  417. Result := TBufferedStream(Handle).Position = TBufferedStream(Handle).Size;
  418. end;
  419. function FileSeek(Handle: TImagingHandle; Offset: Int64; Mode: TSeekMode): Int64; cdecl;
  420. begin
  421. Result := TBufferedStream(Handle).Seek(Offset, LongInt(Mode));
  422. end;
  423. function FileTell(Handle: TImagingHandle): Int64; cdecl;
  424. begin
  425. Result := TBufferedStream(Handle).Position;
  426. end;
  427. function FileRead(Handle: TImagingHandle; Buffer: Pointer; Count: TIOReadWriteCount): TIOReadWriteCount; cdecl;
  428. begin
  429. Result := TBufferedStream(Handle).Read(Buffer^, Count);
  430. end;
  431. function FileWrite(Handle: TImagingHandle; Buffer: Pointer; Count: TIOReadWriteCount): TIOReadWriteCount; cdecl;
  432. begin
  433. Result := TBufferedStream(Handle).Write(Buffer^, Count);
  434. end;
  435. { Stream IO functions }
  436. function StreamOpen(FileName: PChar; Mode: TOpenMode): TImagingHandle; cdecl;
  437. begin
  438. Result := FileName;
  439. end;
  440. procedure StreamClose(Handle: TImagingHandle); cdecl;
  441. begin
  442. end;
  443. function StreamEof(Handle: TImagingHandle): Boolean; cdecl;
  444. begin
  445. Result := TStream(Handle).Position = TStream(Handle).Size;
  446. end;
  447. function StreamSeek(Handle: TImagingHandle; Offset: Int64; Mode: TSeekMode): Int64; cdecl;
  448. begin
  449. Result := TStream(Handle).Seek(Offset, Word(Mode));
  450. end;
  451. function StreamTell(Handle: TImagingHandle): Int64; cdecl;
  452. begin
  453. Result := TStream(Handle).Position;
  454. end;
  455. function StreamRead(Handle: TImagingHandle; Buffer: Pointer; Count: TIOReadWriteCount):
  456. TIOReadWriteCount; cdecl;
  457. begin
  458. Result := TStream(Handle).Read(Buffer^, Count);
  459. end;
  460. function StreamWrite(Handle: TImagingHandle; Buffer: Pointer; Count: TIOReadWriteCount):
  461. TIOReadWriteCount; cdecl;
  462. begin
  463. Result := TStream(Handle).Write(Buffer^, Count);
  464. end;
  465. { Memory IO functions }
  466. function MemoryOpen(FileName: PChar; Mode: TOpenMode): TImagingHandle; cdecl;
  467. begin
  468. Result := FileName;
  469. end;
  470. procedure MemoryClose(Handle: TImagingHandle); cdecl;
  471. begin
  472. end;
  473. function MemoryEof(Handle: TImagingHandle): Boolean; cdecl;
  474. begin
  475. Result := PMemoryIORec(Handle).Position = PMemoryIORec(Handle).Size;
  476. end;
  477. function MemorySeek(Handle: TImagingHandle; Offset: Int64; Mode: TSeekMode): Int64; cdecl;
  478. begin
  479. Result := PMemoryIORec(Handle).Position;
  480. case Mode of
  481. smFromBeginning: Result := Offset;
  482. smFromCurrent: Result := PMemoryIORec(Handle).Position + Offset;
  483. smFromEnd: Result := PMemoryIORec(Handle).Size + Offset;
  484. end;
  485. //Result := ClampInt(Result, 0, PMemoryIORec(Handle).Size); don't do this - some file formats use it
  486. PMemoryIORec(Handle).Position := Result;
  487. end;
  488. function MemoryTell(Handle: TImagingHandle): Int64; cdecl;
  489. begin
  490. Result := PMemoryIORec(Handle).Position;
  491. end;
  492. function MemoryRead(Handle: TImagingHandle; Buffer: Pointer; Count: TIOReadWriteCount):
  493. TIOReadWriteCount; cdecl;
  494. var
  495. Rec: PMemoryIORec;
  496. begin
  497. Rec := PMemoryIORec(Handle);
  498. Result := Count;
  499. if Rec.Position + Count > Rec.Size then
  500. Result := Rec.Size - Rec.Position;
  501. Move(Rec.Data[Rec.Position], Buffer^, Result);
  502. Rec.Position := Rec.Position + Result;
  503. end;
  504. function MemoryWrite(Handle: TImagingHandle; Buffer: Pointer; Count: TIOReadWriteCount):
  505. TIOReadWriteCount; cdecl;
  506. var
  507. Rec: PMemoryIORec;
  508. begin
  509. Rec := PMemoryIORec(Handle);
  510. Result := Count;
  511. if Rec.Position + Count > Rec.Size then
  512. Result := Rec.Size - Rec.Position;
  513. Move(Buffer^, Rec.Data[Rec.Position], Result);
  514. Rec.Position := Rec.Position + Result;
  515. end;
  516. { Helper IO functions }
  517. function GetInputSize(const IOFunctions: TIOFunctions; Handle: TImagingHandle): Int64;
  518. var
  519. OldPos: Int64;
  520. begin
  521. OldPos := IOFunctions.Tell(Handle);
  522. IOFunctions.Seek(Handle, 0, smFromEnd);
  523. Result := IOFunctions.Tell(Handle);
  524. IOFunctions.Seek(Handle, OldPos, smFromBeginning);
  525. end;
  526. function PrepareMemIO(Data: Pointer; const Size: Int64): TMemoryIORec;
  527. begin
  528. Result.Data := Data;
  529. Result.Position := 0;
  530. Result.Size := Size;
  531. end;
  532. function ReadLine(const IOFunctions: TIOFunctions; Handle: TImagingHandle;
  533. out Line: AnsiString; FailOnControlChars: Boolean): Boolean;
  534. const
  535. MaxLine = 1024;
  536. var
  537. EolPos, Pos: Integer;
  538. C: AnsiChar;
  539. EolReached: Boolean;
  540. Endings: set of AnsiChar;
  541. begin
  542. Line := '';
  543. Pos := 0;
  544. EolPos := 0;
  545. EolReached := False;
  546. Endings := [#10, #13];
  547. Result := True;
  548. while not IOFunctions.Eof(Handle) do
  549. begin
  550. IOFunctions.Read(Handle, @C, SizeOf(C));
  551. if FailOnControlChars and (Byte(C) < $20) then
  552. begin
  553. Break;
  554. end;
  555. if not (C in Endings) then
  556. begin
  557. if EolReached then
  558. begin
  559. IOFunctions.Seek(Handle, EolPos, smFromBeginning);
  560. Exit;
  561. end
  562. else
  563. begin
  564. SetLength(Line, Length(Line) + 1);
  565. Line[Length(Line)] := C;
  566. end;
  567. end
  568. else if not EolReached then
  569. begin
  570. EolReached := True;
  571. EolPos := IOFunctions.Tell(Handle);
  572. end;
  573. Inc(Pos);
  574. if Pos >= MaxLine then
  575. begin
  576. Break;
  577. end;
  578. end;
  579. Result := False;
  580. IOFunctions.Seek(Handle, -Pos, smFromCurrent);
  581. end;
  582. procedure WriteLine(const IOFunctions: TIOFunctions; Handle: TImagingHandle;
  583. const Line: AnsiString; const LineEnding: AnsiString);
  584. var
  585. ToWrite: AnsiString;
  586. begin
  587. ToWrite := Line + LineEnding;
  588. IOFunctions.Write(Handle, @ToWrite[1], Length(ToWrite));
  589. end;
  590. { TReadMemoryStream }
  591. constructor TReadMemoryStream.Create(Data: Pointer; Size: Integer);
  592. begin
  593. SetPointer(Data, Size);
  594. end;
  595. class function TReadMemoryStream.CreateFromIOHandle(const IOFunctions: TIOFunctions; Handle: TImagingHandle): TReadMemoryStream;
  596. var
  597. Data: Pointer;
  598. Size: Integer;
  599. begin
  600. Size := GetInputSize(IOFunctions, Handle);
  601. GetMem(Data, Size);
  602. IOFunctions.Read(Handle, Data, Size);
  603. Result := TReadMemoryStream.Create(Data, Size);
  604. end;
  605. initialization
  606. OriginalFileIO.Open := FileOpen;
  607. OriginalFileIO.Close := FileClose;
  608. OriginalFileIO.Eof := FileEof;
  609. OriginalFileIO.Seek := FileSeek;
  610. OriginalFileIO.Tell := FileTell;
  611. OriginalFileIO.Read := FileRead;
  612. OriginalFileIO.Write := FileWrite;
  613. StreamIO.Open := StreamOpen;
  614. StreamIO.Close := StreamClose;
  615. StreamIO.Eof := StreamEof;
  616. StreamIO.Seek := StreamSeek;
  617. StreamIO.Tell := StreamTell;
  618. StreamIO.Read := StreamRead;
  619. StreamIO.Write := StreamWrite;
  620. MemoryIO.Open := MemoryOpen;
  621. MemoryIO.Close := MemoryClose;
  622. MemoryIO.Eof := MemoryEof;
  623. MemoryIO.Seek := MemorySeek;
  624. MemoryIO.Tell := MemoryTell;
  625. MemoryIO.Read := MemoryRead;
  626. MemoryIO.Write := MemoryWrite;
  627. ResetFileIO;
  628. {
  629. File Notes:
  630. -- TODOS ----------------------------------------------------
  631. - nothing now
  632. -- 0.77.3 ---------------------------------------------------
  633. - IO functions now have 64bit sizes and offsets.
  634. - Added helper classes TReadMemoryStream and TImagingIOStream.
  635. -- 0.77.1 ---------------------------------------------------
  636. - Updated IO Open functions according to changes in ImagingTypes.
  637. - Added ReadLine and WriteLine functions.
  638. -- 0.23 Changes/Bug Fixes -----------------------------------
  639. - Added merge between buffered read-only and write-only file
  640. stream adapters - TIFF saving needed both reading and writing.
  641. - Fixed bug causing wrong value of TBufferedWriteFile.Size
  642. (needed to add buffer pos to size).
  643. -- 0.21 Changes/Bug Fixes -----------------------------------
  644. - Removed TMemoryIORec.Written, use Position to get proper memory
  645. position (Written didn't take Seeks into account).
  646. - Added TBufferedReadFile and TBufferedWriteFile classes for
  647. buffered file reading/writing. File IO functions now use these
  648. classes resulting in performance increase mainly in file formats
  649. that read/write many small chunks.
  650. - Added fmShareDenyWrite to FileOpenRead. You can now read
  651. files opened for reading by Imaging from other apps.
  652. - Added GetInputSize and PrepareMemIO helper functions.
  653. -- 0.19 Changes/Bug Fixes -----------------------------------
  654. - changed behaviour of MemorySeek to act as TStream
  655. based Seeks
  656. }
  657. end.