575 lines
17 KiB
Plaintext
575 lines
17 KiB
Plaintext
{
|
|
$Id: ImagingIO.pas 100 2007-06-28 21:09:52Z galfar $
|
|
Vampyre Imaging Library
|
|
by Marek Mauder
|
|
http://imaginglib.sourceforge.net
|
|
|
|
The contents of this file are used with permission, subject to the Mozilla
|
|
Public License Version 1.1 (the "License"); you may not use this file except
|
|
in compliance with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
Alternatively, the contents of this file may be used under the terms of the
|
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
|
provisions of the LGPL License are applicable instead of those above.
|
|
If you wish to allow use of your version of this file only under the terms
|
|
of the LGPL License and not to allow others to use your version of this file
|
|
under the MPL, indicate your decision by deleting the provisions above and
|
|
replace them with the notice and other provisions required by the LGPL
|
|
License. If you do not delete the provisions above, a recipient may use
|
|
your version of this file under either the MPL or the LGPL License.
|
|
|
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
|
}
|
|
|
|
{ This unit contains default IO functions for reading from/writting to
|
|
files, streams and memory.}
|
|
unit ImagingIO;
|
|
|
|
{$I ImagingOptions.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes, ImagingTypes, Imaging, ImagingUtility;
|
|
|
|
type
|
|
TMemoryIORec = record
|
|
Data: ImagingUtility.PByteArray;
|
|
Position: LongInt;
|
|
Size: LongInt;
|
|
end;
|
|
PMemoryIORec = ^TMemoryIORec;
|
|
|
|
var
|
|
OriginalFileIO: TIOFunctions;
|
|
FileIO: TIOFunctions;
|
|
StreamIO: TIOFunctions;
|
|
MemoryIO: TIOFunctions;
|
|
|
|
{ Helper function that returns size of input (from current position to the end)
|
|
represented by Handle (and opened and operated on by members of IOFunctions).}
|
|
function GetInputSize(IOFunctions: TIOFunctions; Handle: TImagingHandle): LongInt;
|
|
{ Helper function that initializes TMemoryIORec with given params.}
|
|
function PrepareMemIO(Data: Pointer; Size: LongInt): TMemoryIORec;
|
|
|
|
implementation
|
|
|
|
const
|
|
DefaultBufferSize = 16 * 1024;
|
|
|
|
type
|
|
{ Based on TaaBufferedStream
|
|
Copyright (c) Julian M Bucknall 1997, 1999 }
|
|
TBufferedStream = class(TObject)
|
|
private
|
|
FBuffer: PByteArray;
|
|
FBufSize: Integer;
|
|
FBufStart: Integer;
|
|
FBufPos: Integer;
|
|
FBytesInBuf: Integer;
|
|
FSize: Integer;
|
|
FDirty: Boolean;
|
|
FStream: TStream;
|
|
function GetPosition: Integer;
|
|
function GetSize: Integer;
|
|
procedure ReadBuffer;
|
|
procedure WriteBuffer;
|
|
procedure SetPosition(const Value: Integer);
|
|
public
|
|
constructor Create(AStream: TStream);
|
|
destructor Destroy; override;
|
|
function Read(var Buffer; Count: Integer): Integer;
|
|
function Write(const Buffer; Count: Integer): Integer;
|
|
function Seek(Offset: Integer; Origin: Word): Integer;
|
|
procedure Commit;
|
|
property Stream: TStream read FStream;
|
|
property Position: Integer read GetPosition write SetPosition;
|
|
property Size: Integer read GetSize;
|
|
end;
|
|
|
|
constructor TBufferedStream.Create(AStream: TStream);
|
|
begin
|
|
inherited Create;
|
|
FStream := AStream;
|
|
FBufSize := DefaultBufferSize;
|
|
GetMem(FBuffer, FBufSize);
|
|
FBufPos := 0;
|
|
FBytesInBuf := 0;
|
|
FBufStart := 0;
|
|
FDirty := False;
|
|
FSize := AStream.Size;
|
|
end;
|
|
|
|
destructor TBufferedStream.Destroy;
|
|
begin
|
|
if FBuffer <> nil then
|
|
begin
|
|
Commit;
|
|
FreeMem(FBuffer);
|
|
end;
|
|
FStream.Position := Position; // Make sure source stream has right position
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TBufferedStream.GetPosition: Integer;
|
|
begin
|
|
Result := FBufStart + FBufPos;
|
|
end;
|
|
|
|
procedure TBufferedStream.SetPosition(const Value: Integer);
|
|
begin
|
|
Seek(Value, soFromCurrent);
|
|
end;
|
|
|
|
function TBufferedStream.GetSize: Integer;
|
|
begin
|
|
Result := FSize;
|
|
end;
|
|
|
|
procedure TBufferedStream.ReadBuffer;
|
|
var
|
|
SeekResult: Integer;
|
|
begin
|
|
SeekResult := FStream.Seek(FBufStart, 0);
|
|
if SeekResult = -1 then
|
|
raise Exception.Create('TBufferedStream.ReadBuffer: seek failed');
|
|
FBytesInBuf := FStream.Read(FBuffer^, FBufSize);
|
|
if FBytesInBuf <= 0 then
|
|
raise Exception.Create('TBufferedStream.ReadBuffer: read failed');
|
|
end;
|
|
|
|
procedure TBufferedStream.WriteBuffer;
|
|
var
|
|
SeekResult: Integer;
|
|
BytesWritten: Integer;
|
|
begin
|
|
SeekResult := FStream.Seek(FBufStart, 0);
|
|
if SeekResult = -1 then
|
|
raise Exception.Create('TBufferedStream.WriteBuffer: seek failed');
|
|
BytesWritten := FStream.Write(FBuffer^, FBytesInBuf);
|
|
if BytesWritten <> FBytesInBuf then
|
|
raise Exception.Create('TBufferedStream.WriteBuffer: write failed');
|
|
end;
|
|
|
|
procedure TBufferedStream.Commit;
|
|
begin
|
|
if FDirty then
|
|
begin
|
|
WriteBuffer;
|
|
FDirty := False;
|
|
end;
|
|
end;
|
|
|
|
function TBufferedStream.Read(var Buffer; Count: Integer): Integer;
|
|
var
|
|
BufAsBytes : TByteArray absolute Buffer;
|
|
BufIdx, BytesToGo, BytesToRead: Integer;
|
|
begin
|
|
// Calculate the actual number of bytes we can read - this depends on
|
|
// the current position and size of the stream as well as the number
|
|
// of bytes requested.
|
|
BytesToGo := Count;
|
|
if FSize < (FBufStart + FBufPos + Count) then
|
|
BytesToGo := FSize - (FBufStart + FBufPos);
|
|
|
|
if BytesToGo <= 0 then
|
|
begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
// Remember to return the result of our calculation
|
|
Result := BytesToGo;
|
|
|
|
BufIdx := 0;
|
|
if FBytesInBuf = 0 then
|
|
ReadBuffer;
|
|
// Calculate the number of bytes we can read prior to the loop
|
|
BytesToRead := FBytesInBuf - FBufPos;
|
|
if BytesToRead > BytesToGo then
|
|
BytesToRead := BytesToGo;
|
|
// Copy from the stream buffer to the caller's buffer
|
|
Move(FBuffer^[FBufPos], BufAsBytes[BufIdx], BytesToRead);
|
|
// Calculate the number of bytes still to read}
|
|
Dec(BytesToGo, BytesToRead);
|
|
|
|
// while we have bytes to read, read them
|
|
while BytesToGo > 0 do
|
|
begin
|
|
Inc(BufIdx, BytesToRead);
|
|
// As we've exhausted this buffer-full, advance to the next, check
|
|
// to see whether we need to write the buffer out first
|
|
if FDirty then
|
|
begin
|
|
WriteBuffer;
|
|
FDirty := false;
|
|
end;
|
|
Inc(FBufStart, FBufSize);
|
|
FBufPos := 0;
|
|
ReadBuffer;
|
|
// Calculate the number of bytes we can read in this cycle
|
|
BytesToRead := FBytesInBuf;
|
|
if BytesToRead > BytesToGo then
|
|
BytesToRead := BytesToGo;
|
|
// Ccopy from the stream buffer to the caller's buffer
|
|
Move(FBuffer^, BufAsBytes[BufIdx], BytesToRead);
|
|
// Calculate the number of bytes still to read
|
|
Dec(BytesToGo, BytesToRead);
|
|
end;
|
|
// Remember our new position
|
|
Inc(FBufPos, BytesToRead);
|
|
if FBufPos = FBufSize then
|
|
begin
|
|
Inc(FBufStart, FBufSize);
|
|
FBufPos := 0;
|
|
FBytesInBuf := 0;
|
|
end;
|
|
end;
|
|
|
|
function TBufferedStream.Seek(Offset: Integer; Origin: Word): Integer;
|
|
var
|
|
NewBufStart, NewPos: Integer;
|
|
begin
|
|
// Calculate the new position
|
|
case Origin of
|
|
soFromBeginning : NewPos := Offset;
|
|
soFromCurrent : NewPos := FBufStart + FBufPos + Offset;
|
|
soFromEnd : NewPos := FSize + Offset;
|
|
else
|
|
raise Exception.Create('TBufferedStream.Seek: invalid origin');
|
|
end;
|
|
|
|
if (NewPos < 0) or (NewPos > FSize) then
|
|
begin
|
|
//NewPos := ClampInt(NewPos, 0, FSize); don't do this - for writing
|
|
end;
|
|
// Calculate which page of the file we need to be at
|
|
NewBufStart := NewPos and not Pred(FBufSize);
|
|
// If the new page is different than the old, mark the buffer as being
|
|
// ready to be replenished, and if need be write out any dirty data
|
|
if NewBufStart <> FBufStart then
|
|
begin
|
|
if FDirty then
|
|
begin
|
|
WriteBuffer;
|
|
FDirty := False;
|
|
end;
|
|
FBufStart := NewBufStart;
|
|
FBytesInBuf := 0;
|
|
end;
|
|
// Save the new position
|
|
FBufPos := NewPos - NewBufStart;
|
|
Result := NewPos;
|
|
end;
|
|
|
|
function TBufferedStream.Write(const Buffer; Count: Integer): Integer;
|
|
var
|
|
BufAsBytes: TByteArray absolute Buffer;
|
|
BufIdx, BytesToGo, BytesToWrite: Integer;
|
|
begin
|
|
// When we write to this stream we always assume that we can write the
|
|
// requested number of bytes: if we can't (eg, the disk is full) we'll
|
|
// get an exception somewhere eventually.
|
|
BytesToGo := Count;
|
|
// Remember to return the result of our calculation
|
|
Result := BytesToGo;
|
|
|
|
BufIdx := 0;
|
|
if (FBytesInBuf = 0) and (FSize > FBufStart) then
|
|
ReadBuffer;
|
|
// Calculate the number of bytes we can write prior to the loop
|
|
BytesToWrite := FBufSize - FBufPos;
|
|
if BytesToWrite > BytesToGo then
|
|
BytesToWrite := BytesToGo;
|
|
// Copy from the caller's buffer to the stream buffer
|
|
Move(BufAsBytes[BufIdx], FBuffer^[FBufPos], BytesToWrite);
|
|
// Mark our stream buffer as requiring a save to the actual stream,
|
|
// note that this will suffice for the rest of the routine as well: no
|
|
// inner routine will turn off the dirty flag.
|
|
FDirty := True;
|
|
// Calculate the number of bytes still to write
|
|
Dec(BytesToGo, BytesToWrite);
|
|
|
|
// While we have bytes to write, write them
|
|
while BytesToGo > 0 do
|
|
begin
|
|
Inc(BufIdx, BytesToWrite);
|
|
// As we've filled this buffer, write it out to the actual stream
|
|
// and advance to the next buffer, reading it if required
|
|
FBytesInBuf := FBufSize;
|
|
WriteBuffer;
|
|
Inc(FBufStart, FBufSize);
|
|
FBufPos := 0;
|
|
FBytesInBuf := 0;
|
|
if FSize > FBufStart then
|
|
ReadBuffer;
|
|
// Calculate the number of bytes we can write in this cycle
|
|
BytesToWrite := FBufSize;
|
|
if BytesToWrite > BytesToGo then
|
|
BytesToWrite := BytesToGo;
|
|
// Copy from the caller's buffer to our buffer
|
|
Move(BufAsBytes[BufIdx], FBuffer^, BytesToWrite);
|
|
// Calculate the number of bytes still to write
|
|
Dec(BytesToGo, BytesToWrite);
|
|
end;
|
|
// Remember our new position
|
|
Inc(FBufPos, BytesToWrite);
|
|
// Make sure the count of valid bytes is correct
|
|
if FBytesInBuf < FBufPos then
|
|
FBytesInBuf := FBufPos;
|
|
// Make sure the stream size is correct
|
|
if FSize < (FBufStart + FBytesInBuf) then
|
|
FSize := FBufStart + FBytesInBuf;
|
|
// If we're at the end of the buffer, write it out and advance to the
|
|
// start of the next page
|
|
if FBufPos = FBufSize then
|
|
begin
|
|
WriteBuffer;
|
|
FDirty := False;
|
|
Inc(FBufStart, FBufSize);
|
|
FBufPos := 0;
|
|
FBytesInBuf := 0;
|
|
end;
|
|
end;
|
|
|
|
{ File IO functions }
|
|
|
|
function FileOpenRead(FileName: PChar): TImagingHandle; cdecl;
|
|
begin
|
|
Result := TBufferedStream.Create(TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite));
|
|
end;
|
|
|
|
function FileOpenWrite(FileName: PChar): TImagingHandle; cdecl;
|
|
begin
|
|
Result := TBufferedStream.Create(TFileStream.Create(FileName, fmCreate or fmShareDenyWrite));
|
|
end;
|
|
|
|
procedure FileClose(Handle: TImagingHandle); cdecl;
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TBufferedStream(Handle).Stream;
|
|
TBufferedStream(Handle).Free;
|
|
Stream.Free;
|
|
end;
|
|
|
|
function FileEof(Handle: TImagingHandle): Boolean; cdecl;
|
|
begin
|
|
Result := TBufferedStream(Handle).Position = TBufferedStream(Handle).Size;
|
|
end;
|
|
|
|
function FileSeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode):
|
|
LongInt; cdecl;
|
|
begin
|
|
Result := TBufferedStream(Handle).Seek(Offset, LongInt(Mode));
|
|
end;
|
|
|
|
function FileTell(Handle: TImagingHandle): LongInt; cdecl;
|
|
begin
|
|
Result := TBufferedStream(Handle).Position;
|
|
end;
|
|
|
|
function FileRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
|
|
LongInt; cdecl;
|
|
begin
|
|
Result := TBufferedStream(Handle).Read(Buffer^, Count);
|
|
end;
|
|
|
|
function FileWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
|
|
LongInt; cdecl;
|
|
begin
|
|
Result := TBufferedStream(Handle).Write(Buffer^, Count);
|
|
end;
|
|
|
|
{ Stream IO functions }
|
|
|
|
function StreamOpenRead(FileName: PChar): TImagingHandle; cdecl;
|
|
begin
|
|
Result := FileName;
|
|
end;
|
|
|
|
function StreamOpenWrite(FileName: PChar): TImagingHandle; cdecl;
|
|
begin
|
|
Result := FileName;
|
|
end;
|
|
|
|
procedure StreamClose(Handle: TImagingHandle); cdecl;
|
|
begin
|
|
end;
|
|
|
|
function StreamEof(Handle: TImagingHandle): Boolean; cdecl;
|
|
begin
|
|
Result := TStream(Handle).Position = TStream(Handle).Size;
|
|
end;
|
|
|
|
function StreamSeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode):
|
|
LongInt; cdecl;
|
|
begin
|
|
Result := TStream(Handle).Seek(Offset, LongInt(Mode));
|
|
end;
|
|
|
|
function StreamTell(Handle: TImagingHandle): LongInt; cdecl;
|
|
begin
|
|
Result := TStream(Handle).Position;
|
|
end;
|
|
|
|
function StreamRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
|
|
LongInt; cdecl;
|
|
begin
|
|
Result := TStream(Handle).Read(Buffer^, Count);
|
|
end;
|
|
|
|
function StreamWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
|
|
LongInt; cdecl;
|
|
begin
|
|
Result := TStream(Handle).Write(Buffer^, Count);
|
|
end;
|
|
|
|
{ Memory IO functions }
|
|
|
|
function MemoryOpenRead(FileName: PChar): TImagingHandle; cdecl;
|
|
begin
|
|
Result := FileName;
|
|
end;
|
|
|
|
function MemoryOpenWrite(FileName: PChar): TImagingHandle; cdecl;
|
|
begin
|
|
Result := FileName;
|
|
end;
|
|
|
|
procedure MemoryClose(Handle: TImagingHandle); cdecl;
|
|
begin
|
|
end;
|
|
|
|
function MemoryEof(Handle: TImagingHandle): Boolean; cdecl;
|
|
begin
|
|
Result := PMemoryIORec(Handle).Position = PMemoryIORec(Handle).Size;
|
|
end;
|
|
|
|
function MemorySeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode):
|
|
LongInt; cdecl;
|
|
begin
|
|
Result := PMemoryIORec(Handle).Position;
|
|
case Mode of
|
|
smFromBeginning: Result := Offset;
|
|
smFromCurrent: Result := PMemoryIORec(Handle).Position + Offset;
|
|
smFromEnd: Result := PMemoryIORec(Handle).Size + Offset;
|
|
end;
|
|
//Result := ClampInt(Result, 0, PMemoryIORec(Handle).Size); don't do this - some file formats use it
|
|
PMemoryIORec(Handle).Position := Result;
|
|
end;
|
|
|
|
function MemoryTell(Handle: TImagingHandle): LongInt; cdecl;
|
|
begin
|
|
Result := PMemoryIORec(Handle).Position;
|
|
end;
|
|
|
|
function MemoryRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
|
|
LongInt; cdecl;
|
|
var
|
|
Rec: PMemoryIORec;
|
|
begin
|
|
Rec := PMemoryIORec(Handle);
|
|
Result := Count;
|
|
if Rec.Position + Count > Rec.Size then
|
|
Result := Rec.Size - Rec.Position;
|
|
Move(Rec.Data[Rec.Position], Buffer^, Result);
|
|
Rec.Position := Rec.Position + Result;
|
|
end;
|
|
|
|
function MemoryWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
|
|
LongInt; cdecl;
|
|
var
|
|
Rec: PMemoryIORec;
|
|
begin
|
|
Rec := PMemoryIORec(Handle);
|
|
Result := Count;
|
|
if Rec.Position + Count > Rec.Size then
|
|
Result := Rec.Size - Rec.Position;
|
|
Move(Buffer^, Rec.Data[Rec.Position], Result);
|
|
Rec.Position := Rec.Position + Result;
|
|
end;
|
|
|
|
{ Helper IO functions }
|
|
|
|
function GetInputSize(IOFunctions: TIOFunctions; Handle: TImagingHandle): LongInt;
|
|
var
|
|
OldPos: Int64;
|
|
begin
|
|
OldPos := IOFunctions.Tell(Handle);
|
|
IOFunctions.Seek(Handle, 0, smFromEnd);
|
|
Result := IOFunctions.Tell(Handle);
|
|
IOFunctions.Seek(Handle, OldPos, smFromBeginning);
|
|
end;
|
|
|
|
function PrepareMemIO(Data: Pointer; Size: LongInt): TMemoryIORec;
|
|
begin
|
|
Result.Data := Data;
|
|
Result.Position := 0;
|
|
Result.Size := Size;
|
|
end;
|
|
|
|
initialization
|
|
OriginalFileIO.OpenRead := FileOpenRead;
|
|
OriginalFileIO.OpenWrite := FileOpenWrite;
|
|
OriginalFileIO.Close := FileClose;
|
|
OriginalFileIO.Eof := FileEof;
|
|
OriginalFileIO.Seek := FileSeek;
|
|
OriginalFileIO.Tell := FileTell;
|
|
OriginalFileIO.Read := FileRead;
|
|
OriginalFileIO.Write := FileWrite;
|
|
|
|
StreamIO.OpenRead := StreamOpenRead;
|
|
StreamIO.OpenWrite := StreamOpenWrite;
|
|
StreamIO.Close := StreamClose;
|
|
StreamIO.Eof := StreamEof;
|
|
StreamIO.Seek := StreamSeek;
|
|
StreamIO.Tell := StreamTell;
|
|
StreamIO.Read := StreamRead;
|
|
StreamIO.Write := StreamWrite;
|
|
|
|
MemoryIO.OpenRead := MemoryOpenRead;
|
|
MemoryIO.OpenWrite := MemoryOpenWrite;
|
|
MemoryIO.Close := MemoryClose;
|
|
MemoryIO.Eof := MemoryEof;
|
|
MemoryIO.Seek := MemorySeek;
|
|
MemoryIO.Tell := MemoryTell;
|
|
MemoryIO.Read := MemoryRead;
|
|
MemoryIO.Write := MemoryWrite;
|
|
|
|
ResetFileIO;
|
|
|
|
{
|
|
File Notes:
|
|
|
|
-- TODOS ----------------------------------------------------
|
|
- nothing now
|
|
|
|
-- 0.23 Changes/Bug Fixes -----------------------------------
|
|
- Added merge between buffered read-only and write-only file
|
|
stream adapters - TIFF saving needed both reading and writing.
|
|
- Fixed bug causing wrong value of TBufferedWriteFile.Size
|
|
(needed to add buffer pos to size).
|
|
|
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
|
- Removed TMemoryIORec.Written, use Position to get proper memory
|
|
position (Written didn't take Seeks into account).
|
|
- Added TBufferedReadFile and TBufferedWriteFile classes for
|
|
buffered file reading/writting. File IO functions now use these
|
|
classes resulting in performance increase mainly in file formats
|
|
that read/write many small chunks.
|
|
- Added fmShareDenyWrite to FileOpenRead. You can now read
|
|
files opened for reading by Imaging from other apps.
|
|
- Added GetInputSize and PrepareMemIO helper functions.
|
|
|
|
-- 0.19 Changes/Bug Fixes -----------------------------------
|
|
- changed behaviour of MemorySeek to act as TStream
|
|
based Seeks
|
|
}
|
|
end.
|
|
|