preximfileutils.pas

一个很好的学习例子,有需要的请下载研究,

{
********************************************************************************
*                                                                              * 
*             (c) China Systems 1999 - 2003                                    *   
*                                                                              * 
*               Prexim Imaging development team.                               * 
*                                                                              * 
********************************************************************************
*
* Unit Name: PrEximFileUtils.pas
* Author:    Licwing
* Purpose:   Provides file manipulated utilities
********************************************************************************
}
unit PrEximFileUtils;
//==============================================================================
{* |<PRE>
 Unit name: PrEximFileUtils.pas
 Author:    Licwing
 Purpose:   Provides file manipulated utilities
            -> TFileMappingStream: The file mapping stream with low memory usage
               and multi-access
            -> TTempFileStream: The temporary file stream  
 Develop Platform: Win2K pro & sp3 + delphi6 & patch2
 Test Platform: 
 History:
   08-19-2003  V1.0  by Licwing
     -> first version  
|</PRE>}         
//==============================================================================

interface

uses
  Windows, Classes, SysUtils;

//------------------------------------------------------------------------------
// Functions defines
//------------------------------------------------------------------------------
function GetExclusiveFileName(const Path: string; const Prefix: string='SCANMODULE'): string;
function FileGetTempName(const Prefix: string): string;
function FileCreateTemp(var Prefix: string): THandle;
function CompareFiles(OneFile, TwoFile: TFilename): boolean;

//------------------------------------------------------------------------------
// Classes defines
//------------------------------------------------------------------------------
type
  TFileMappingStream = class (TCustomMemoryStream)
  private
    FFileHandle: THandle;
    FMapping: THandle;
  protected
    procedure Close;
  public
    constructor Create(const FileName: string; FileMode: Word = fmOpenRead or fmShareDenyWrite);
    destructor Destroy; override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

  TTempFileStream = class (THandleStream)
  private
    FFileName: string;
  public
    constructor Create(const Prefix: string);
    destructor Destroy; override;
    property FileName: string read FFileName;
  end;

const
  Temp_Prefix  = 'Temp_Prefix';
implementation

//------------------------------------------------------------------------------
// Resource strings defines
//------------------------------------------------------------------------------
resourcestring
// TFileMappingStream
  RsCreateFileMapping        = 'Failed to create FileMapping';
  RsCreateFileMappingView    = 'Failed to create FileMappingView';
  RsFailedToObtainSize       = 'Failed to obtain size of file';

// TTempFileStream  
  RsFileStreamCreate         = 'Unable to create temporary file stream';


//------------------------------------------------------------------------------
// Functions implementation
//------------------------------------------------------------------------------
function GetExclusiveFileName(const Path: string; const Prefix: string): string;
var
  TempFile: string;
  R: Cardinal;
begin
  Result := '';
  SetLength(TempFile, MAX_PATH);
  R := GetTempFileName(PChar(Path), PChar(Prefix), 0, PChar(TempFile));
  if R <> 0 then
  begin
    SetLength(TempFile, StrLen(PChar(TempFile)));
    Result := TempFile;
  end;
  if FileExists(TempFile) then DeleteFile(TempFile);
end;

function FileGetTempName(const Prefix: string): string;
var
  TempPath, TempFile: string;
  R: Cardinal;
begin
  Result := '';
  R := GetTempPath(0, nil);
  SetLength(TempPath, R);
  R := GetTempPath(R, PChar(TempPath));
  if R <> 0 then
  begin
    SetLength(TempPath, StrLen(PChar(TempPath)));
    SetLength(TempFile, MAX_PATH);
    R := GetTempFileName(PChar(TempPath), PChar(Prefix), 0, PChar(TempFile));
    if R <> 0 then
    begin
      SetLength(TempFile, StrLen(PChar(TempFile)));
      Result := TempFile;
    end;
  end;
end;

function FileCreateTemp(var Prefix: string): THandle;
var
  TempName: string;
begin
  Result := INVALID_HANDLE_VALUE;
  TempName := FileGetTempName(Prefix);
  if TempName <> '' then
  begin
    Result := CreateFile(PChar(TempName), GENERIC_READ or GENERIC_WRITE, 0, nil,
      OPEN_EXISTING, FILE_ATTRIBUTE_TEMPORARY or FILE_FLAG_DELETE_ON_CLOSE, 0);
    // In certain situations it's possible that CreateFile fails yet the file is actually created,
    // therefore explicitly delete it upon failure.
    if Result = INVALID_HANDLE_VALUE then
      DeleteFile(TempName);
    Prefix := TempName;
  end;
end;

function CompareFiles(OneFile, TwoFile: TFilename): boolean;
var
  OneFileStream,
  TwoFileStream: TFileStream;
  OneBuf, TwoBuf: array[0..1023] of byte;
  TotalCount,
  ReadCount: integer;
begin
//  Result := false;
  OneFileStream := nil;
  TwoFileStream := nil;
  try
    OneFileStream := TFileStream.Create(OneFile, fmOpenRead or fmShareDenyWrite);
    TwoFileStream := TFileStream.Create(TwoFile, fmOpenRead or fmShareDenyWrite);

    Result := OneFileStream.Size=TwoFileStream.Size;
    TotalCount := 0;

    if Result then
    begin
      ReadCount := OneFileStream.Read(OneBuf, Sizeof(OneBuf));
      while ReadCount > 0 do
      begin
        TwoFileStream.Read(TwoBuf, Sizeof(TwoBuf));
        Result := CompareMem(@OneBuf, @TwoBuf, Sizeof(OneBuf));

        TotalCount := TotalCount + ReadCount;

        // only compare 50K bytes
        if TotalCount > 51200 then break;

        // break loop if have any difference
        if not Result then break
        else
          ReadCount := OneFileStream.Read(OneBuf, Sizeof(OneBuf));
      end;
    end;
  finally
    TwoFileStream.Free;
    OneFileStream.Free;
  end;
end;

//------------------------------------------------------------------------------
// Classes implementation
//------------------------------------------------------------------------------
{ TFileMappingStream }

procedure TFileMappingStream.Close;
begin
  if Memory <> nil then
  begin
    UnMapViewOfFile(Memory);
    SetPointer(nil, 0);
  end;
  if FMapping <> 0 then
  begin
    CloseHandle(FMapping);
    FMapping := 0;
  end;
  if FFileHandle <> INVALID_HANDLE_VALUE then
  begin
    FileClose(FFileHandle);
    FFileHandle := INVALID_HANDLE_VALUE;
  end;
end;

constructor TFileMappingStream.Create(const FileName: string;
  FileMode: Word);
var
  Protect, Access, Size: DWORD;
  BaseAddress: Pointer;
begin
  inherited Create;
  FFileHandle := THandle(FileOpen(FileName, FileMode));
  if FFileHandle = INVALID_HANDLE_VALUE then
    RaiseLastOSError;
  if (FileMode and $0F) = fmOpenReadWrite then
  begin
    Protect := PAGE_WRITECOPY;
    Access := FILE_MAP_COPY;
  end
  else
  begin
    Protect := PAGE_READONLY;
    Access := FILE_MAP_READ;
  end;
  FMapping := CreateFileMapping(FFileHandle, nil, Protect, 0, 0, nil);
  if FMapping = 0 then
  begin
    Close;
    raise Exception.CreateRes(@RsCreateFileMapping);
  end;
  BaseAddress := MapViewOfFile(FMapping, Access, 0, 0, 0);
  if BaseAddress = nil then
  begin
    Close;
    raise Exception.CreateRes(@RsCreateFileMappingView);
  end;
  Size := GetFileSize(FFileHandle, nil);
  if Size = DWORD(-1) then
  begin
    UnMapViewOfFile(BaseAddress);
    Close;
    raise Exception.CreateRes(@RsFailedToObtainSize);
  end;
  SetPointer(BaseAddress, Size);
end;

destructor TFileMappingStream.Destroy;
begin
  Close;
  inherited;
end;

function TFileMappingStream.Write(const Buffer; Count: Integer): Longint;
begin
  Result := 0;
  if (Size - Position) >= Count then
  begin
    System.Move(Buffer, Pointer(Longint(Memory) + Position)^, Count);
    Position := Position + Count;
    Result := Count;
  end;
end;

{ TTempFileStream }

constructor TTempFileStream.Create(const Prefix: string);
var
  FileHandle: THandle;
begin
  FFileName := Prefix;
  FileHandle := FileCreateTemp(FFileName);
  if FileHandle = INVALID_HANDLE_VALUE then
    raise Exception.CreateRes(@RsFileStreamCreate);
  inherited Create(FileHandle);
end;

destructor TTempFileStream.Destroy;
begin
  if THandle(Handle) <> INVALID_HANDLE_VALUE then
    CloseHandle(Handle);
  inherited Destroy;
end;

end.