📄 ztvzipsplitglue.pas
字号:
Unit ztvZipSplitGlue;
Interface
Uses
Windows,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
ztvRegister,
ztvBase,
ztvGbls,
ztvStreams,
ztvZip,
ztvConsts,
Err_Msgs;
Type
TOnGetFileCount =
Procedure(Sender: TObject; TotalFileCount: Integer)
Of Object;
TZipSplitGlue = class(TCustomCClass)
Private
ZipComponent: TZipBase;
fOutArchiveFile: String;
fOnGetFileCount: TOnGetFileCount;
Protected
Procedure SetArchiveFile(SFN: ztv_WString); Override;
Public
Function GlueArchive: Integer;
Published
Property OnFileExists;
Property OnNextVolume;
Property OutArchiveFile: String Read fOutArchiveFile Write fOutArchiveFile;
Property OnGetFileCount: TOnGetFileCount Read fOnGetFileCount Write fOnGetFileCount;
End;
Implementation
Uses
ztvHeaders;
//-------------------------------------------------------------
// returns the number of files copied to the output
// archive (OutArchiveFile property)
Function TZipSplitGlue.GlueArchive: Integer;
Var
pArcFile: ^TStream32;
TempFileStrm: TStream32;
ArcFile: TTempFileStream;
DiskWithThisFile: Integer;
HeaderObj: TCompHeaderObj;
Begin
Result := 0; //False;
ZipComponent := TZipBase.Create(Nil);
Try
If CompareText(fArchiveFile, fOutArchiveFile) = 0 Then
Begin
RaiseErrorStr(fArchiveFile, '', '0', E_FILESMATCH);
Exit;
End Else Begin
If (Not
(ztvFileExists(fArchiveFile) And IsArcSplitable(fArcType) And ZipComponent.SetDefaultValues())
) Then
Begin
RaiseErrorStr(fArchiveFile, '', '0', E_INVALIDARC);
Exit;
End Else
If ztvFileExists(fOutArchiveFile) Then
If Assigned(OnFileExists) Then
Begin
fOverwriteMode := omOverwrite;
OnFileExists(
Self,
OutArchiveFile,
FileDateToDateTime(FileAge(fOutArchiveFile)),
fOverwriteMode);
If fOverwriteMode = omSkip Then Exit;
End Else Begin
RaiseErrorStr(fOutArchiveFile, 'OnFileExists', '0', E_REQUIREDEVENT);
Exit;
End;
End;
ReadMethod := faFile;
WriteMethod := faFile;
If Assigned(OnActivate) Then
OnActivate(Self);
Try
If Assigned(OnElapsedTime) Then
ZipTimer.Start();
Try
TempFileStrm :=
TTempFileStream.Create(Self, TempDir, fOutArchiveFile, fmCreate);
Try
fLOF := TempFileStrm.Size;
HeaderObj := TCompHeaderObj.Create();
Try
HeaderObj.INIT();
ArcFile :=
TTempFileStream.Create(Self, '', fArchiveFile, fmOpenRead Or
fmShareDenyWrite);
Try
ZipComponent.fArchiveFile := fArchiveFile;
ZipComponent.fArcType := fArcType;
// add ALL files
ZipComponent.FileSpec.Clear;
ZipComponent.FileSpec.Add('*.*');
ZipComponent.TranslateOemChar := TranslateOemChar;
ZipComponent.OnNextVolume := OnNextVolume;
ZipComponent.OnError := OnError;
ZipComponent.OnElapsedTime := OnElapsedTime;
ZipComponent.pVolNum := @fVolNum;
// create a working file list
ArcFile.Position := fOffsetStart;
ZipComponent.ArcToList(ArcFile, @HeaderObj);
If Assigned(OnGetFileCount) Then
OnGetFileCount(Self, HeaderObj.FileList.Count);
// be sure the ArcToList function saves
// the first central header.
If (htCentral In HeaderTypeState) Then
DiskWithThisFile := CentralZipHeader.DiskNumberStart
Else
DiskWithThisFile := EndZipHeader.NumberOfThisDisk;
If (htCentral In HeaderTypeState) Then
Begin
If (DiskWithThisFile <> EndZipHeader.NumberOfThisDisk) Then
Begin
If (Not
OpenNextZipVolume(
ArcFile,
DiskWithThisFile,
EndZipHeader.NumberOfThisDisk + 1)
) Then
Exit;
ArcFile.Position := CentralZipHeader.RelativeOffsetOfLocalHeader;
End;
End;
If HeaderObj.FileList.Count = 0 Then
Begin
fLOF := 0;
Exit;
End;
pArcFile := @ArcFile;
ZipComponent.ExecuteCompression(
pArcFile^, TempFileStrm, @HeaderObj);
Count := ZipComponent.Count; //HeaderObj.FileList.Count;
ZipComponent.EndZipHeader.NumberOfThisDisk := 0;
ZipComponent.doCleanUp(TempFileStrm, @HeaderObj);
Finally
ArcFile.Free();
End;
Finally
HeaderObj.Free();
End;
Finally
TempFileStrm.Free();
End;
If Not ztvFileExists(fOutArchiveFile) Then
Result := 0
Else
Result := Count;
Finally
If Assigned(OnElapsedTime) Then
Begin
ZipTimer.Stop();
OnElapsedTime(Self, ZipTimer.ElapsedTime);
End;
End;
Finally
If Assigned(OnDeactivate) Then
OnDeactivate(Self);
End;
Finally
ZipComponent.Free();
End;
End;
//-------------------------------------------------------------
Procedure TZipSplitGlue.SetArchiveFile(SFN: ztv_WString);
Var
s: TFileStream32;
Begin
Inherited;
s := TFileStream32.Create(fArchiveFile, fmOpenRead Or fmShareDenyWrite);
fArcType := GetArcType(s);
fLOF := s.Size;
s.Free();
End;
//-------------------------------------------------------------
End.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -