⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ztvzipsplitglue.pas

📁 ziptv为delphi控件
💻 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 + -