zncopy.~pas

作者: dmzn @163.com 2006- 12 描述: 线程方式的文件拷贝组件. 声明: 本单元公开源码,个人/商业可免费使用,不过请保留此处的说明文字.如果你 对本单元作了合理

{*******************************************************************************
  作者: dmzn [e-mail] 2006-06-12
  描述: 线程方式的文件拷贝组件.

  声明: 本单元公开源码,个人/商业可免费使用,不过请保留此处的说明文字.如果你
  对本单元作了合理修改,请邮件通知我,谢谢!
*******************************************************************************}
unit ZnCopy;

interface

uses
  SysUtils, Classes;

type
  TZnCopy = class;
  TCopyThread = class(TThread)
  private
    { Private declarations }
    FOwner: TZnCopy;
    FFrom,FDest,FMsg: string;

    FBuf: PChar;
    FSize,FDone: Int64;
    FNormal,FDoCopy: boolean;
  protected
    { Protected declarations }
    procedure DoInit;
    procedure DoBegin;
    procedure DoProcess;
    procedure DoEnd;
    procedure DoMsg;

    procedure Execute; override;
    procedure CopyFile(const nStr: string);
    function DoCopy(const nFrom,nDest: string): boolean;
  public
    { Public declarations } 
    constructor Create(AOwner: TZnCopy);
  end;

  TCopyInit = procedure (const nFrom,nDest: string; var nDoCopy: boolean) of object;
  //初始化拷贝信息
  TCopyBegin = procedure (const nSize: Int64) of object;
  //拷贝开始,传递目的文件全路径和文件大小
  TCopyProcess = procedure (const nHasDone: Int64) of object;
  //拷贝进度,传递以完成的大小
  TCopyEnd = procedure (const nSuccess: boolean; const nLeft: Integer) of object;
  //拷贝结束,是否成功拷贝,还余下多少文件没有拷贝
  TErrMsg = procedure (const nMsg: string) of object;
  //拷贝信息提示,如错误信息,拷贝状态信息等

  TCopyMode = (cmCopy, cmCut);
  //cmCopy复制模式, cmCut剪切模式

  TZnCopy = class(TComponent)
  private
    { Private declarations }
    FAutoDel: boolean;
    FBufSize: integer;
    FFileList: TStrings;
    FCopyMode: TCopyMode;

    FThread: TCopyThread;
    FPriority: TThreadPriority;

    FOnMsg: TErrMsg;
    FOnInit: TCopyInit;

    FOnBegin: TCopyBegin;
    FOnProcess: TCopyProcess; 
    FOnEnd: TCopyEnd;
  protected
    { Protected declarations }
    function GetFileNum: integer;
    procedure ShowMsg(const nMsg: string);
    procedure SetBufSize(const nSize: integer);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent);override;
    destructor Destroy; override;

    procedure StartCopy;
    procedure StopCopy;

    procedure ClearFileList;
    function IsBusy: boolean;
    function AddFile(const nFrom,nDest: string): boolean;
  published
    { Published declarations }
    property AutoDel: boolean read FAutoDel write FAutoDel;
    property BufSize: integer read FBufSize write SetBufSize default 1024;
    property CopyMode: TCopyMode read FCopyMode write FCopyMode;
    property FileNum: integer read GetFileNum;
    property Priority: TThreadPriority read FPriority write FPriority default tpNormal;

    property OnMsg: TErrMsg read FOnMsg write FOnMsg;
    property OnInit: TCopyInit read FOnInit write FOnInit;
    property OnBegin: TCopyBegin read FOnBegin write FOnBegin;
    property OnProcess: TCopyProcess read FOnProcess write FOnProcess;
    property OnEnd: TCopyEnd read FOnEnd write FOnEnd; 
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('RunSoft', [TZnCopy]);
end;

const
  c_Flag = '<*:*>';  //分割标识符

{****************************** TCopyThread **************************}
constructor TCopyThread.Create(AOwner: TZnCopy);
begin
  inherited Create(False);
  FreeOnTerminate := True;

  FOwner := AOwner;
  Priority := FOwner.FPriority;
end;

procedure TCopyThread.DoMsg;
begin
  with FOwner do
  if Assigned(FOnMsg) then FOnMsg(FMsg);
end;

procedure TCopyThread.DoInit;
begin
  FDoCopy := True;
  with FOwner do
  if Assigned(FOnInit) then FOnInit(FFrom,FDest,FDoCopy);
end;

procedure TCopyThread.DoBegin;
begin
  with FOwner do
  if Assigned(FOnBegin) then FOnBegin(FSize);
end;

procedure TCopyThread.DoProcess;
begin
  with FOwner do
  if Assigned(FOnProcess) and
     not (csDestroying in ComponentState) then FOnProcess(FDone);
end;

procedure TCopyThread.DoEnd;
begin
  with FOwner do
  if Assigned(FOnEnd) then FOnEnd(FNormal, FFileList.Count);
end;

//Name: CopyFile
//Parm: nStr,格式化字符串 nFrom + c_Flag + nDest
//Desc: 执行nStr的拷贝任务
procedure TCopyThread.CopyFile(const nStr: string);
var sStr: string;
    nPos,nLen: integer;
begin
  nPos := Pos(c_Flag, nStr);
  if nPos < 1 then Exit;

  nLen := Length(c_Flag);
  FFrom := Copy(nStr, 1, nPos - 1);
  FDest := Copy(nStr, nPos + nLen, Length(nStr) - nPos - nLen + 1);

  Synchronize(DoInit);
  if FileExists(FDest)  then
  begin
    FNormal := True;
    if FOwner.FCopyMode = cmCut then DeleteFile(FFrom); Exit;
  end;

  if not FileExists(FFrom) then
  begin
    FMsg := '错误: 源文件丢失(' + FFrom + ')';
    Synchronize(DoMsg); Exit;
  end;

  sStr := ExtractFilePath(FDest);
  if not (DirectoryExists(sStr) or ForceDirectories(sStr)) then
  begin
    FMsg := '错误: 无法创建文件夹(' + sStr + ')';
    Synchronize(DoMsg); Exit;
  end;
  
  if FDoCopy then FNormal := DoCopy(FFrom,FDest);
end;

//Name: DoCopy
//Parm: nFrom,nDest,原/目的路径
//Desc: 拷贝文件nFrom到nDest
function TCopyThread.DoCopy(const nFrom, nDest: string): boolean;
var nLeft: integer;
    nS1,nS2: TFileStream;
begin
    Result := False; 
    nS1 := TFileStream.Create(nFrom, fmOpenRead);
    nS2 := TFileStream.Create(nDest, fmCreate);
  try
    nLeft := nS1.Size;
    FSize := nS1.Size;
    Synchronize(DoBegin);

    FDone := 0;
    nS1.Seek(0, soFromBeginning);

    while (nLeft > 0) and (not Terminated) do
    with FOwner do
     if nLeft > FBufSize then
     begin
        nS1.ReadBuffer(FBuf^, FBufSize);
        nS2.WriteBuffer(FBuf^, FBufSize);

        nLeft := nLeft - FBufSize;
        Inc(FDone, FBufSize);
        Synchronize(DoProcess);
     end else
     begin
        nS1.ReadBuffer(FBuf^, nLeft);
        nS2.WriteBuffer(FBuf^, nLeft);

        nLeft := nLeft - FBufSize;
        Inc(FDone, nLeft);
        Synchronize(DoProcess);    Result := True;
     end;
  finally
    nS1.Free;
    nS2.Free;

    if Result then
    begin
      if FOwner.FCopyMode = cmCut then DeleteFile(nFrom);
    end else
    if FOwner.FAutoDel and FileExists(nDest) then DeleteFile(nDest);
  end;
end;

procedure TCopyThread.Execute;
begin
  GetMem(FBuf, FOwner.FBufSize);
  try
    with FOwner do
    while (not Terminated) and (FFileList.Count > 0) do
    begin
      try
        FNormal := False;
        CopyFile(FFileList[0]);
      except
      end;

      if not (csDestroying in ComponentState) then
      begin
        FFileList.Delete(0);
        Synchronize(DoEnd);
      end;
    end;
  finally
    FreeMem(FBuf);
    
    if Terminated then
         FreeOnTerminate := False
    else FOwner.FThread := nil;
  end;
end;

{******************************** TZnCopy *****************************}  
constructor TZnCopy.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FAutoDel := True;
  FBufSize := 4096;
  FCopyMode := cmCopy;
  FFileList := TStringList.Create;
end;

destructor TZnCopy.Destroy;
begin
  FFileList.Free;
  StopCopy;
  inherited;
end;

//是否正在拷贝ing...
function TZnCopy.IsBusy: boolean;
begin
  Result := Assigned(FThread);
end;

//提示信息
procedure TZnCopy.ShowMsg(const nMsg: string);
begin
  if Assigned(FOnMsg) then FOnMsg(nMsg);
end;

//获取待拷贝的文件数目
function TZnCopy.GetFileNum: integer;
begin
  Result := FFileList.Count;
end;  

//清空文件列表
procedure TZnCopy.ClearFileList;
begin
  FFileList.Clear;
end;

//设置拷贝缓冲区大小
procedure TZnCopy.SetBufSize(const nSize: integer);
begin
  if IsBusy then
     ShowMsg('提示: 操作正在进行,请稍后...') else
  if (nSize < 1023) or (nSize > 10240) then
  begin
    if csDesigning in ComponentState then
         raise Exception.Create('请输入1024至10240之间的数值')
    else ShowMsg('提示: 请输入1024至10240之间的数值');
  end else FBufSize := nSize;
end;

//添加文件到列表中
function TZnCopy.AddFile(const nFrom, nDest: string): boolean;
var sStr: string;
begin
  Result := False;
  if IsBusy then
     ShowMsg('提示: 操作正在进行,请稍后...') else
  if FileExists(nFrom) then
  begin
    sStr := LowerCase(nFrom + c_Flag + nDest);
    if FFileList.IndexOf(sStr) < 0 then FFileList.Add(sStr);
    Result := True;
  end else ShowMsg('错误: 源文件丢失(' + nFrom + ')');
end;

//启动拷贝线程
procedure TZnCopy.StartCopy;
begin
  if IsBusy then
     ShowMsg('提示: 操作正在进行,请稍后...') else
  if FFileList.Count = 0 then
       ShowMsg('提示: 请添加文件到拷贝列表中')
  else FThread := TCopyThread.Create(Self);
end;

//停止拷贝线程
procedure TZnCopy.StopCopy;
begin
  if IsBusy then
  begin
    FThread.Terminate;
    FThread.WaitFor;
    FreeAndNil(FThread);
  end;
end;

end.