之前一篇文章的功能增加,新增了时间显示

unit Merger;

{***********************************************************************

                           流文件合并单元

        主要是使用线程进行流文件的合并处理。

        写作的目的在于之前有编文件使用批处理来进行TS文件的合并,效率
        很低,当时试了一下480M的TS需要合并半个多小时。因此自己忍不住
        写了个合并工具。
        这是工具的一部分代码。

        注:该单元请忽使用局部变量来执行,因为内嵌了线程,中间没有阻塞
        操作。因此局部变量,在执行后马上得到FREE。导致线程执行时异常。

        当然也可以进行改正到线程中的处理。后续读者自行处理吧。


        V 1.0.0.2
          添加了时间计算

        作者:边缘
        @RightCopy fsh
        QQ: 19985430
        Email:fengsh998@163.com
***********************************************************************}

interface

uses
    Classes,Windows,Sysutils,DateUtils;

    type
      TMerger = Class;

      TProcessThread = Class(TThread)
        private
          mgr:TMerger;
        protected
          constructor Create(instrance:TMerger);
          procedure Execute;override;
        public
      end;

      //处理进程进度事件
      TProcessEvent = procedure (Sender:TObject;curCount,Tatol:Integer;const dtime:String) of Object;
      //处理完成后事件,单位为byte
      TProcessCompletedEvent = procedure (Sender:TObject;totalSize:Int64) of Object;
      //在进行停止操作前事件
      TProcessWillStopEvent = procedure (Sender:TObject;var is_stop:Boolean) of Object;

      TProcessState = (psNone,psProcessing,psPause,psStop,psCompleted);

      TMerger = Class
        private
          flist:TStringList;
          FpathName : String;
          Fprocess:TProcessEvent;
          FprocessCompleted:TProcessCompletedEvent;
          tranSize:Int64;
          FcCount:Integer;
          FtCount:Integer;
          FpState:TProcessState;
          FpThread:TprocessThread;
          FprocessStop:TProcessWillStopEvent;
          FstartTime:Cardinal;
          FendTime:Cardinal;
          FrecTime:Cardinal;
          procedure initCache;
          procedure processMerger;
          procedure DeleteExistsFile;
          procedure DoProcess;
          procedure DoProcessCompleted;
          procedure ThreadProcess;
          function formatMillsecond(Const milsec:Cardinal):String;
        public
          constructor Create;
          destructor Destroy;override;
          procedure MergerFileList(Const str:TStringList);
          procedure Pause;
          procedure resem;
          procedure Stop;
          procedure Start;
          procedure reStart;
          property savePathName:String read FpathName write FpathName;
          property processState:TProcessState read FpState;
          property OnProcess:TProcessEvent read Fprocess write Fprocess;
          property OnProcessCompleted:TProcessCompletedEvent read FprocessCompleted
                    write FprocessCompleted;
          property OnProcessWillStop:TProcessWillStopEvent read FprocessStop
                    write FprocessStop;
      End;
implementation

{ TMerger }

constructor TMerger.Create;
begin
   flist:=TStringList.Create;
   FpathName:=emptyStr;
   initCache;
end;

procedure TMerger.DeleteExistsFile;
begin
   if FileExists(FpathName) then DeleteFile(FpathName);
end;

destructor TMerger.Destroy;
begin
   flist.free;
  inherited;
end;

procedure TMerger.DoProcess;
var
   ct:String;
begin
   ct := formatMillsecond(FrecTime + FendTime - FstartTime);
   if Assigned(Fprocess) then
      Fprocess(self,FcCount+1,FtCount,ct);
end;

procedure TMerger.DoProcessCompleted;
begin
   FpState := psCompleted;
   if Assigned(FprocessCompleted) then
      FprocessCompleted(self,tranSize);
end;

function TMerger.formatMillsecond(const milsec: Cardinal): String;
var
   sec:Cardinal;
   hour:Cardinal;
   min:Cardinal;
   remain:Cardinal;
begin
   hour := trunc(milsec / 3600000);
   remain := milsec mod 3600000 ;
   min := trunc(remain / 60000);
   remain := remain mod 60000;
   sec := trunc(remain / 1000);
   result := Format('%2d:%2d:%2d',[hour,min,sec]);
end;

procedure TMerger.initCache;
begin
   tranSize := 0;
   FcCount := 0;
   FtCount :=0;
   FpState := psNone;
   FstartTime := 0;
   FendTime := 0;
   FrecTime := 0;
end;

procedure TMerger.MergerFileList(const str: TStringList);
begin
   flist.Assign(str);
end;

procedure TMerger.Pause;
begin
   FpState := psPause;
end;

procedure TMerger.processMerger;
var
   fileItem:String;
   i:integer;
   Load:TFileStream;
   Save:TFileStream;
begin
   FtCount := flist.Count;

   FstartTime := GetTickCount;
   
   if FileExists(FpathName) then
   begin
      Save := TFileStream.Create(FpathName, FmOpenWrite or fmShareDenyNone);
      Save.Position := Save.Size;
   end
   else
   begin
      Save := TFileStream.Create(FpathName,fmCreate or fmOpenReadWrite or fmShareDenyNone);
      Save.Position := 0;
   end;
   try
       for i := FcCount to FtCount - 1 do
       begin
           fileItem := flist[i];
           if FileExists(fileItem) then
           begin
             Load:=TFileStream.Create(fileItem,fmOpenRead);
             try
                Load.Position := 0;
                Save.CopyFrom(Load,Load.Size);
                tranSize := Save.Size;
                FcCount := I;
                FendTime := GetTickCount;
                FpThread.Synchronize(DoProcess);
             finally
                Load.Free;
             end;
           end;

           if (FpState = psPause) or (FpState = psStop) then
           begin
             FrecTime := FrecTime + FendTime - FstartTime;
             break;
           end;
       end;

   finally
     Save.Free;
   end;

   if not ((FpState = psPause) or (FpState = psStop)) then
      FpThread.Synchronize(DoProcessCompleted);
end;

procedure TMerger.resem;
begin
   FpState := psProcessing;
   inc(FcCount);
   ThreadProcess;
end;

procedure TMerger.reStart;
begin
   sleep(2000);
   Start;
end;

procedure TMerger.Start;
begin
   if FpathName = EmptyStr then Exit;

   initCache;
   
   DeleteExistsFile;

   //使用线程
   ThreadProcess;

   FpState := psProcessing;
end;

procedure TMerger.Stop;
var
   stp:Boolean;
begin
   Pause;
   stp := true;

   if Assigned(FprocessStop) then
      FprocessStop(self,stp);

   if stp then
      FpState := psStop
   else
      resem;
end;

procedure TMerger.ThreadProcess;
begin
   FpThread := TprocessThread.Create(self);
   FpThread.FreeOnTerminate := True;
end;

{ TProcessThread }

constructor TProcessThread.Create(instrance: TMerger);
begin
   mgr := instrance;
   inherited Create(false);
end;

procedure TProcessThread.Execute;
begin
   mgr.processMerger;
end;

end.


 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

边缘998

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值