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.