filecopy.pas

delphi 文件拷贝的超级源码,值得收藏喔

unit FileCopy;

interface

uses
  Windows, Classes, SysUtils, CopyThread;

type
  TWVFileCopy = class;
  TTime = class(TPersistent)
  private
    FOwner: TWVFileCopy;
    FCreationTime: boolean;
    FLastAccessTime: boolean;
    FLastWriteTime: boolean;
  public
    constructor Create(Owner: TWVFileCopy);
  published
    property CreationTime: boolean read FCreationTime write FCreationTime default false;
    property LastAccessTime: boolean read FLastAccessTime write FLastAccessTime default false;
    property LastWriteTime: boolean read FLastWriteTime write FLastWriteTime default true;
  end;

  TOnCopyProgress = procedure(Sender: TObject; TotalFileSize: Longword;
    TotalBytesTransferred: Longword; Rate: Byte) of object;
  TOnError = procedure(Sender: TObject; Msg: string;
    Code: DWORD) of object;
  TWVFileCopy = class(TComponent)
  private
    FeHandle: THandle;
    FnHandle: THandle;
    FExistingFile: string;
    FNewFile: string;
    FBreakPoint: Longword;
    FTotalFileSize: Longword;
    FBuffer: Longword;
    FPriority: TThreadPriority;
    FTime: TTime;
    FCopyThread: TCopyThread;
    FCopyThreadHandle: THandle;
    FOnStart: TNotifyEvent;
    FOnFinish: TNotifyEvent;
    FOnRestore: TNotifyEvent;
    FOnStop: TNotifyEvent;
    FOnCancel: TNotifyEvent;
    FOnCopyProgress: TOnCopyProgress;
    FOnError: TOnError;
    function OpenExistingFile: boolean;
    function CreateNewFile: boolean;
    function OpenNewFile: boolean;
    procedure CloseFile(var Handle: THandle);
    function LocateBreakPoint(Handle: THandle; BreakPoint: Longword): boolean;
    procedure CopyData(Sender: TObject);
    procedure SetExistingFile(const Value: string);
    procedure SetNewFile(const Value: string);
    procedure SetBreakPoint(Value: Longword);
    procedure SetPriority(Value: TThreadPriority);
    procedure SetBuffer(Value: Longword);
    procedure SetFileTime;
    procedure RaiseError;
  protected

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Start; virtual;
    procedure Restore; virtual;
    procedure Stop; virtual;
    procedure Cancel; virtual;
  published
    property ExistingFile: string read FExistingFile write SetExistingFile;
    property NewFile: string read FNewFile write SetNewFile;
    property BreakPoint: Longword read FBreakPoint write SetBreakPoint default 0;
    property Priority: TThreadPriority read FPriority write SetPriority default tpNormal;
    property Buffer: Longword read FBuffer write SetBuffer default 1024;
    property Time: TTime read FTime write FTime;
    property OnStart: TNotifyEvent read FOnStart write FOnStart;
    property OnFinish: TNotifyEvent read FOnFinish write FOnFinish;
    property OnRestore: TNotifyEvent read FOnRestore write FOnRestore;
    property OnStop: TNotifyEvent read FOnStop write FOnStop;
    property OnCancel: TNotifyEvent read FOnCancel write FOnCancel;
    property OnCopyProgress: TOnCopyProgress read FOnCopyProgress write FOnCopyProgress;
    property OnError: TOnError read FOnError write FOnError;
  end;

procedure Register;

implementation

{TTime}

constructor TTime.Create(Owner: TWVFileCopy);
begin
  FOwner := Owner;
  FCreationTime := false;
  FLastAccessTime := false;
  FLastWriteTime := true;
end;

{TWVFileCopy}

constructor TWVFileCopy.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FeHandle := INVALID_HANDLE_VALUE;
  FnHandle := INVALID_HANDLE_VALUE;
  FCopyThreadHandle := INVALID_HANDLE_VALUE;
  FExistingFile := '';
  FNewFile := '';
  FBreakPoint := 0;
  FTotalFileSize := 0;
  FBuffer := 1024;
  FPriority := tpNormal;
  FTime := TTime.Create(Self);
end;

destructor TWVFileCopy.Destroy;
begin
  if FCopyThreadHandle <> INVALID_HANDLE_VALUE then
  begin
    FCopyThread.Terminate;
    FCopyThreadHandle := INVALID_HANDLE_VALUE;
  end;
  SetFileTime;
  CloseFile(FeHandle);
  CloseFile(FnHandle);
  FTime.Free;
  inherited Destroy;
end;

procedure TWVFileCopy.Start;
begin
  FBreakPoint := 0;
  if not OpenExistingFile then
    RaiseError
  else
    if not CreateNewFile then
    begin
      RaiseError;
      CloseFile(FeHandle);
    end else begin
      FTotalFileSize := Windows.GetFileSize(FeHandle, nil);
      if FTotalFileSize = $FFFFFFFF then
        RaiseError
      else begin
        FCopyThread := TCopyThread.Create(FPriority);
        FCopyThreadHandle := FCopyThread.Handle;
        if Assigned(FOnStart) then
          FOnStart(Self);
        FCopyThread.OnSignal := CopyData;
      end;
    end;
end;

procedure TWVFileCopy.Restore;
begin
  if not OpenExistingFile then
    RaiseError
  else
    if not OpenNewFile then
    begin
      RaiseError;
      CloseFile(FeHandle);
    end else begin
      if not LocateBreakPoint(FeHandle, FBreakPoint) then
        RaiseError
      else
        if not LocateBreakPoint(FnHandle, FBreakPoint) then
        begin
          RaiseError;
          Exit;
        end;
      FTotalFileSize := Windows.GetFileSize(FeHandle, nil);
      if FTotalFileSize = $FFFFFFFF then
        RaiseError
      else begin
        FCopyThread := TCopyThread.Create(FPriority);
        FCopyThreadHandle := FCopyThread.Handle;
        if Assigned(FOnRestore) then
          FOnRestore(Self);
        FCopyThread.OnSignal := CopyData;
      end;
    end;
end;

procedure TWVFileCopy.Stop;
begin
  if FCopyThreadHandle <> INVALID_HANDLE_VALUE then
  begin
    FCopyThread.Terminate;
    FCopyThreadHandle := INVALID_HANDLE_VALUE;
  end;
  SetFileTime;
  CloseFile(FeHandle);
  CloseFile(FnHandle);
  if Assigned(FOnStop) then
    FOnStop(Self);
end;

procedure TWVFileCopy.Cancel;
begin
  if FCopyThreadHandle <> INVALID_HANDLE_VALUE then
  begin
    FCopyThread.Terminate;
    FCopyThreadHandle := INVALID_HANDLE_VALUE;
  end;
  SetFileTime;
  CloseFile(FeHandle);
  CloseFile(FnHandle);
  if not Windows.DeleteFile(PChar(FNewFile)) then
    RaiseError
  else
    if Assigned(FOnCancel) then
      FOnCancel(Self);
end;

procedure TWVFileCopy.CopyData(Sender: TObject);
var
  Buf: PByte;
  BytesRead, BytesWrite: DWORD;
  bRate: Byte;

  procedure EndOperate;
  begin
    FCopyThread.Terminate;
    SetFileTime;
    CloseFile(FeHandle);
    CloseFile(FnHandle);
  end;

begin
  if FCopyThreadHandle <> INVALID_HANDLE_VALUE then
  begin
    GetMem(Buf, FBuffer);
    try
      if not ReadFile(FeHandle, Buf^, FBuffer, BytesRead, nil) then
      begin
        RaiseError;
        EndOperate;
      end else
        if BytesRead = 0 then           //文件已经拷贝成功，到达源文件尾部
        begin
          EndOperate;
          if Assigned(FOnFinish) then
            FOnFinish(Self);
        end else
          if not WriteFile(FnHandle, Buf^, BytesRead, BytesWrite, nil) then
          begin
            RaiseError;
            EndOperate;
          end else begin
            inc(FBreakPoint, BytesWrite);
            bRate := trunc(FBreakPoint / FTotalFileSize * 100);
            if Assigned(FOnCopyProgress) then
              FOnCopyProgress(Self, FTotalFileSize, FBreakPoint, bRate);
          end;
    finally
      FreeMem(Buf, FBuffer);
    end; {try}
  end; {if}
end;

//打开源文件，成功返回True，失败返回False
function TWVFileCopy.OpenExistingFile: boolean;
begin
  if FeHandle = INVALID_HANDLE_VALUE then
    FeHandle := Windows.CreateFile(PChar(FExistingFile), GENERIC_READ, 0,
      nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := FeHandle <> INVALID_HANDLE_VALUE;
end;

//创建目标文件，成功返回True，失败返回False
function TWVFileCopy.CreateNewFile: boolean;
begin
  if FnHandle = INVALID_HANDLE_VALUE then
    FnHandle := Windows.CreateFile(PChar(FNewFile), GENERIC_WRITE, 0,
      nil, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
  Result := FnHandle <> INVALID_HANDLE_VALUE;
end;

//打开目标文件，成功返回True，失败返回False
function TWVFileCopy.OpenNewFile: boolean;
begin
  if FnHandle = INVALID_HANDLE_VALUE then
    FnHandle := Windows.CreateFile(PChar(FNewFile), GENERIC_WRITE, 0,
      nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := FnHandle <> INVALID_HANDLE_VALUE;
end;

//关闭文件
procedure TWVFileCopy.CloseFile(var Handle: THandle);
begin
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    CloseHandle(Handle);
    Handle := INVALID_HANDLE_VALUE;
  end;
end;

//定位文件指针到指定地点，成功返回True，失败返回False
function TWVFileCopy.LocateBreakPoint(Handle: THandle; BreakPoint: Longword): boolean;
begin
  Result := SetFilePointer(Handle, BreakPoint, nil, FILE_BEGIN) <> $FFFFFFFF;
end;

//设置文件时间
procedure TWVFileCopy.SetFileTime;
var
  CreationTime, LastAccessTime, LastWriteTime: TFileTime;
begin
  if FTime.CreationTime then
  begin
    Windows.GetFileTime(FeHandle, @CreationTime, nil, nil);
    Windows.SetFileTime(FnHandle, @CreationTime, nil, nil);
  end;
  if FTime.LastAccessTime then
  begin
    Windows.GetFileTime(FeHandle, nil, @LastAccessTime, nil);
    Windows.SetFileTime(FnHandle, nil, @LastAccessTime, nil);
  end;
  if FTime.LastWriteTime then
  begin
    Windows.GetFileTime(FeHandle, nil, nil, @LastWriteTime);
    Windows.SetFileTime(FnHandle, nil, nil, @LastWriteTime);
  end;
end;

procedure TWVFileCopy.SetExistingFile(const Value: string);
begin
  if (FeHandle = INVALID_HANDLE_VALUE) or
    (FnHandle = INVALID_HANDLE_VALUE) then
    if FExistingFile <> Value then
      FExistingFile := Value;
end;

procedure TWVFileCopy.SetNewFile(const Value: string);
begin
  if (FeHandle = INVALID_HANDLE_VALUE) or
    (FnHandle = INVALID_HANDLE_VALUE) then
    if FNewFile <> Value then
      FNewFile := Value;
end;

procedure TWVFileCopy.SetBreakPoint(Value: Longword);
begin
  if (FeHandle = INVALID_HANDLE_VALUE) or
    (FnHandle = INVALID_HANDLE_VALUE) then
    if FBreakPoint <> Value then
      FBreakPoint := Value;
end;

procedure TWVFileCopy.SetPriority(Value: TThreadPriority);
begin
  if (FeHandle = INVALID_HANDLE_VALUE) or
    (FnHandle = INVALID_HANDLE_VALUE) then
  begin
    if FPriority <> Value then
      FPriority := Value;
  end else
    if FCopyThread.Priority <> Value then
      FCopyThread.Priority := Value;
end;

procedure TWVFileCopy.SetBuffer(Value: Longword);
begin
  if (FeHandle = INVALID_HANDLE_VALUE) or
    (FnHandle = INVALID_HANDLE_VALUE) then
    if FBuffer <> Value then
      FBuffer := Value;
end;

//返回错误代码，取得错误信息
procedure TWVFileCopy.RaiseError;
var
  Code: DWORD;
  sMessage: PChar;
begin
  SetFileTime;
  sMessage := nil;
  Code := Windows.GetLastError;
  try
    sMessage := StrAlloc(1000);
    Windows.FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil,
      Code, 0, sMessage, 1000, nil);
    if Assigned(FOnError) then
      FOnError(Self, sMessage, Code);
  Finally
    StrDispose(sMessage);
  end;
end;

procedure Register;
begin
  RegisterComponents('System', [TWVFileCopy]);
end;

end.