Chip 2003 January/ChipCD_1.03.iso/zkuste/delphi/unity/d56/FNDUTL.ZIP/Streams/cWriters.pas

Pascal/Delphi Source File | 2002-10-29 | 11.8 KB | 356 lines

{$INCLUDE ..\cDefines.inc}
unit cWriters;

{                                                                              }
{                              Writers v3.01                                   }
{                                                                              }
{         This unit is copyright ⌐ 2002 by David Butler ([e-mail])        }
{                                                                              }
{                  This unit is part of Delphi Fundamentals.                   }
{                   Its original file name is cWriters.pas                     }
{       The latest version is available from the Fundamentals home page        }
{                     http://fundementals.sourceforge.net/                     }
{                                                                              }
{                I invite you to use this unit, free of charge.                }
{        I invite you to distibute this unit, but it must be for free.         }
{             I also invite you to contribute to its development,              }
{             but do not distribute a modified copy of this file.              }
{                                                                              }
{          A forum is available on SourceForge for general discussion          }
{             http://sourceforge.net/forum/forum.php?forum_id=2117             }
{                                                                              }
{                                                                              }
{ Revision history:                                                            }
{   12/05/2002  3.01  Created cWriters unit from cStreams.                     }
{                     AWriter, TFileWriter.                                    }
{                                                                              }

interface

uses
  // Delphi
  SysUtils;



{                                                                              }
{ AWriter                                                                      }
{   Writer abstract base class.                                                }
{                                                                              }
type
  AWriter = class
    protected
    Function  GetPosition : Int64; virtual; abstract;
    Procedure SetPosition (const Position : Int64); virtual; abstract;
    Function  GetSize : Int64; virtual; abstract;
    Procedure SetSize (const Size : Int64); virtual; abstract;

    public
    Function  Write (const Buffer; const Size : Integer) : Integer; virtual; abstract;

    Property  Position : Int64 read GetPosition write SetPosition;
    Property  Size : Int64 read GetSize write SetSize;
  end;
  EWriter = class (Exception);



{                                                                              }
{ AWriterEx                                                                    }
{   Base class for Writer implementations. AWriteEx extends AWriter with       }
{   commonly used functions.                                                   }
{                                                                              }
{   All methods in AWriterEx is implemented using calls to the abstract        }
{   methods in AWriter. Writer implementations can override the virtual        }
{   methods in AWriterEx with more efficient versions.                         }
{                                                                              }
type
  TWriterNewLineType = (nlCR, nlLF, nlCRLF, nlLFCR);
  AWriterEx = class (AWriter)
    public
    Procedure RaiseWriteError;

    Procedure Append;
    Procedure Truncate; virtual;

    Procedure WriteBuffer (const Buffer; const Size : Integer);
    Procedure WriteStr (const Buffer : String); virtual;
    Procedure SetAsString (const S : String);

    Procedure WriteByte (const V : Byte);
    Procedure WriteWord (const V : Word);
    Procedure WriteLongWord (const V : LongWord);
    Procedure WriteLongInt (const V : LongInt);
    Procedure WriteInt64 (const V : Int64);

    Procedure WriteBufLine (const Buffer; const Size : Integer;
              const NewLineType : TWriterNewLineType = nlCRLF);
    Procedure WriteLine (const S : String; const NewLineType : TWriterNewLineType = nlCRLF);
  end;



{                                                                              }
{ TFileWriter                                                                  }
{   Writer implementation for a file.                                          }
{                                                                              }
type
  TFileWriterOpenMode = (fwomOpen,              // Open existing
                         fwomTruncate,          // Open existing and truncate
                         fwomCreate,            // Always create
                         fwomCreateIfNotExist); // Create if not exist else open existing
  TFileWriter = class (AWriterEx)
    protected
    FFileName    : String;
    FHandle      : Integer;
    FHandleOwner : Boolean;
    FFileCreated : Boolean;

    Function  GetPosition : Int64; override;
    Procedure SetPosition (const Position : Int64); override;
    Function  GetSize : Int64; override;
    Procedure SetSize (const Size : Int64); override;

    public
    Constructor Create (const FileName : String;
                const OpenMode : TFileWriterOpenMode = fwomCreateIfNotExist); overload;
    Constructor Create (const FileHandle : Integer; const HandleOwner : Boolean); overload;
    Destructor Destroy; override;

    Property  Handle : Integer read FHandle;
    Property  HandleOwner : Boolean read FHandleOwner;
    Property  FileCreated : Boolean read FFileCreated;

    Function  Write (const Buffer; const Size : Integer) : Integer; override;

    Procedure DeleteFile;
  end;
  EFileWriter = class (EWriter);



{                                                                              }
{ TOutputWriter                                                                }
{   Writer implementation for standard system output.                          }
{                                                                              }
type
  TOutputWriter = class (AWriterEx)
    public
    Function  Write (const Buffer; const Size : Integer) : Integer; override;
  end;



implementation

uses
  // Delphi
  Windows;



{                                                                              }
{ AWriterEx                                                                    }
{                                                                              }
Procedure AWriterEx.RaiseWriteError;
  Begin
    raise EWriter.Create ('Write error');
  End;

Procedure AWriterEx.Append;
  Begin
    Position := Size;
  End;

Procedure AWriterEx.Truncate;
  Begin
    Size := Position;
  End;

Procedure AWriterEx.WriteBuffer (const Buffer; const Size : Integer);
  Begin
    if Size <= 0 then
      exit;
    if Write (Buffer, Size) <> Size then
      RaiseWriteError;
  End;

Procedure AWriterEx.WriteStr (const Buffer : String);
  Begin
    WriteBuffer (Pointer (Buffer)^, Length (Buffer));
  End;

Procedure AWriterEx.SetAsString (const S : String);
  Begin
    Position := 0;
    WriteStr (S);
    Truncate;
  End;

Procedure AWriterEx.WriteByte (const V : Byte);
  Begin
    WriteBuffer (V, Sizeof (Byte));
  End;

Procedure AWriterEx.WriteWord (const V : Word);
  Begin
    WriteBuffer (V, Sizeof (Word));
  End;

Procedure AWriterEx.WriteLongWord (const V : LongWord);
  Begin
    WriteBuffer (V, Sizeof (LongWord));
  End;

Procedure AWriterEx.WriteLongInt (const V : LongInt);
  Begin
    WriteBuffer (V, Sizeof (LongInt));
  End;

Procedure AWriterEx.WriteInt64 (const V : Int64);
  Begin
    WriteBuffer (V, Sizeof (Int64));
  End;

Procedure AWriterEx.WriteBufLine (const Buffer; const Size : Integer; const NewLineType : TWriterNewLineType);
  Begin
    WriteBuffer (Buffer, Size);
    Case NewLineType of
      nlCR   : WriteByte (13);
      nlLF   : WriteByte (10);
      nlCRLF : WriteStr (#13#10);
      nlLFCR : WriteStr (#10#13);
    end;
  End;

Procedure AWriterEx.WriteLine (const S : String; const NewLineType : TWriterNewLineType);
  Begin
    WriteBufLine (Pointer (S)^, Length (S), NewLineType);
  End;



{                                                                              }
{ TFileWriter                                                                  }
{                                                                              }
Constructor TFileWriter.Create (const FileName : String; const OpenMode : TFileWriterOpenMode);
var CreateFile : Boolean;
  Begin
    inherited Create;
    FFileName := FileName;
    Case OpenMode of
      fwomCreate           : CreateFile := True;
      fwomCreateIfNotExist : CreateFile := not FileExists (FileName);
    else
      CreateFile := False;
    end;
    if CreateFile then
      FHandle := FileCreate (FileName) else
      FHandle := FileOpen (FileName, fmOpenReadWrite);
    if FHandle = -1 then {$IFDEF DELPHI6_UP}
      RaiseLastOSError; {$ELSE}
      RaiseLastWin32Error; {$ENDIF}
    FHandleOwner := True;
    FFileCreated := CreateFile;
    if OpenMode = fwomTruncate then
      if not SetEndOfFile (FHandle) then
        raise EFileWriter.Create ('File truncate error');
  End;

Constructor TFileWriter.Create (const FileHandle : Integer; const HandleOwner : Boolean);
  Begin
    inherited Create;
    FHandle := FileHandle;
    FHandleOwner := HandleOwner;
  End;

Destructor TFileWriter.Destroy;
  Begin
    if FHandleOwner and (FHandle <> -1) and (FHandle <> 0) then
      FileClose (FHandle);
    inherited Destroy;
  End;

Function TFileWriter.GetPosition : Int64;
  Begin
    Result := FileSeek (FHandle, Int64 (0), 1);
    if Result = -1 then
      raise EFileWriter.Create ('File error');
  End;

Procedure TFileWriter.SetPosition (const Position : Int64);
  Begin
    if FileSeek (FHandle, Position, 0) = -1 then
      raise EFileWriter.Create ('File seek error');
  End;

Function TFileWriter.GetSize : Int64;
var I : Int64;
  Begin
    I := GetPosition;
    Result := FileSeek (FHandle, Int64 (0), 2);
    SetPosition (I);
    if Result = -1 then
      raise EFileWriter.Create ('File error');
  End;

Procedure TFileWriter.SetSize (const Size : Int64);
  Begin
    SetPosition (Size);
    if not SetEndOfFile (FHandle) then
      raise EFileWriter.Create ('File resize error');
  End;

Function TFileWriter.Write (const Buffer; const Size : Integer) : Integer;
var I : Integer;
  Begin
    if Size <= 0 then
      begin
        Result := 0;
        exit;
      end;
    I := FileWrite (FHandle, Buffer, Size);
    if I < 0 then {$IFDEF DELPHI6_UP}
      RaiseLastOSError; {$ELSE}
      RaiseLastWin32Error; {$ENDIF}
    Result := I;
  End;

Procedure TFileWriter.DeleteFile;
  Begin
    if FFileName = '' then
      raise EFileWriter.Create ('No filename');
    if (FHandle <> -1) and (FHandle <> 0) then
      FileClose (FHandle);
    FHandle := -1;
    SysUtils.DeleteFile (FFileName);
  End;



{                                                                              }
{ TOutputWriter                                                                }
{                                                                              }
Function TOutputWriter.Write (const Buffer; const Size : Integer) : Integer;
var I : Integer;
    P : PByte;
  Begin
    if Size <= 0 then
      begin
        Result := 0;
        exit;
      end;
    P := @Buffer;
    For I := 1 to Size do
      begin
        System.Write (Char (P^));
        Inc (P);
      end;
    Result := Size;
  End;



end.