ztvregister.pas

ziptv为delphi控件

      TempFileProgressProc(Self);
   End;
End;

(*************************************************************)
(*************************************************************)
(*                      TTempFileStream                      *)
(*************************************************************)
(*************************************************************)

Constructor TTempFileStream.Create(Sender: TObject; TmpDir, FileName: String;
   Mode: Word);
Begin
   fLocalObj := Sender;
   TempFileMoveProc := TZipCommon(Sender).TempFileMoveFile;
   TempFileMoveBeginProc := TZipCommon(Sender).TempFileMoveBegin;
   TempFileMoveEndProc := TZipCommon(Sender).TempFileMoveEnd;
   TempFileProgressProc := TZipCommon(Sender).TempFileProgress;
   CancelCallBackPtr := TZipCommon(Sender).pCancel;

   If (Mode And fmCreate = fmCreate) Then
   Begin
      TempFileName := GetTempFileNameStr(TmpDir);
      NewFileName := FileName;
      fAutoDelete := True;
   End
   Else
   Begin
      TempFileName := FileName;
      NewFileName := '';
      fAutoDelete := False;
   End;

   Inherited Create(TempFileName, Mode);

   FileMode := Mode;
   DeleteOptions := DoFinal;
End;
//-------------------------------------------------------------

Destructor TTempFileStream.Destroy;

Function CompareDrives(TempDir: String): Boolean;
   Var
      dPos, fPos: Integer;
   Begin
      dPos := Pos(':', TempDir);
      If dPos > 0 Then
      Begin
         fPos := Pos(':', NewFileName);
         If fPos > 0 Then
            Result :=
               Upcase(TempDir[1]) = Upcase(NewFileName[1])
         Else
            Result := False;
      End
      Else
         Result := False;
   End;
Var
   ECode: DWord;
   SameDrive: Boolean;
Begin

   If (Not fAutoDelete) Or (FileMode And fmOpenRead > 0) Then
      Inherited Destroy
   Else
   Try
      If CancelCallBackPtr^ Then
         Exit;

      If (FileMode <> 0) And (NewFileName <> '') Then
      Begin
         Try
            If (FileMode And fmCreate > 0) Then
            Begin

               SameDrive := CompareDrives(TZipCommon(fLocalObj).TempDir);
               If CloseHandle(THandle(fHandle)) Then
                  fHandle := -1;

               TempFileMoveBeginProc(Self, NewFileName, TempFileName,
                  CancelCallBackPtr^);
               Try
                  If Not CancelCallBackPtr^ Then
                     TempFileMoveProc(Self, NewFileName, TempFileName,
                        SameDrive);
               Finally
                  If TZipCommon(fLocalObj).FLOF > MIN_CUST_SIZE Then
                     TempFileMoveEndProc(Self);
               End;
            End;
         Except
            //ON e: exception DO ShowMessage( e.message );
            ECode := GetLastError();
            If ECode = ERROR_DISK_FULL Then
               With TZipCommon(fLocalObj) Do
                  RaiseErrorStr(ArchiveFile, '', '0', E_DISKFULL);

            Raise;
         End;
      End;
   Finally
      Inherited Destroy;
      DeleteFile(TempFileName);
   End;
End;
//-------------------------------------------------------------

Function TTempFileStream.CopyFrom(Source: TStream32; Count: Int64):
   Int64;
Var
   Buffer: Pchar;
   TempCancel: Boolean;
   BufSize, n: Integer;
Begin
   If Count = 0 Then
   Begin
      Source.Position := 0;
      Count := Source.Size;
   End;

   Result := Count;
   If Count > MaxBufSize Then
      BufSize := MaxBufSize
   Else
      BufSize := Count;

   // if pCancel = true, then assign the stream objects pCancel variable to
   // the current objects cancel variable to allow a process cancelation.
   pCancel := CancelCallBackPtr;
   If pCancel = Nil Then
   Begin
      TempCancel := False;
      pCancel := @TempCancel;
   End;

   OnProgress := ProgressCallBackProc;

   GetMem(Buffer, BufSize);
   Try
      While (Count <> 0) And (Not pCancel^) Do
      Begin
         If Count > BufSize Then
            n := BufSize
         Else
            n := Count;

         Application.ProcessMessages();
         Source.ReadBuffer(Buffer^, n);
         WriteBuffer(Buffer^, n);
         dec(Count, n);
      End;
   Finally
      FreeMem(Buffer, BufSize);
   End;
End;
//-------------------------------------------------------------

Function TTempFileStream.Read(Var Buffer; Count: Longint): Longint;
Begin
   // used in ztvStreams.THandleStream32.Read
     //Result := FileRead(fHandle, Buffer, Count);
     //If Result = -1 Then
     //   Result := 0;
   If Not ReadFile(THandle(Handle), Buffer, Count, LongWord(Result), Nil) Then
      Result := 0;

   If Assigned(TempFileProgressProc) And (TZipCommon(fLocalObj).ProgressPosition > 0)
      Then
   Begin
      TZipCommon(fLocalObj).ProgressPosition :=
         TZipCommon(fLocalObj).ProgressPosition - Count;

      TempFileProgressProc(Self);
   End;
End;
//-------------------------------------------------------------

Constructor TRegisterZipTV.Create(aOwner: TComponent);
Begin
   Inherited Create(aOwner);
   ExtraFieldLen := 0;                  //SizeOf(fEI);
   fEncryptHeaders := False;
   pVolNum := @fVolNum;
   If Not fCrcCalced Then
   Begin
      HKeyed[0] := DefK[0] And DefK[2];
      HKeyed[1] := DefK[1] And DefK[0];
      HKeyed[2] := DefK[2] And DefK[1];
   End;

   fZipCompatible := True;
   pEI := @fEI;
End;
//-------------------------------------------------------------

Destructor TRegisterZipTV.Destroy;
Begin
   Inherited Destroy;
End;
//-------------------------------------------------------------

Function TRegisterZipTV.maxbits: ShortInt;
Begin
   If GetZipCompatible() Then
      Result := MAX_WBITS
   Else
      Result := Abs(MAX_WBITS);
End;
//-------------------------------------------------------------

Procedure TRegisterZipTV.SetZipCmntBufSize(i: Integer);
Begin
   If i > 32767 Then
      i := 32767
   Else
      If i < 2000 Then
         i := 2000;

   fZipCmntBufSize := i;
End;
//-------------------------------------------------------------

Function TRegisterZipTV.GetArchiveFile: ztv_WString;
Begin
   Result := fArchiveFile;
End;
//-------------------------------------------------------------

Function TRegisterZipTV.GetZipCompatible: Boolean;
Begin
   Result := True;
End;
//-------------------------------------------------------------

Function TRegisterZipTV.GetEncryptHeaders: Boolean;
Begin
   Result := fEncryptHeaders;
End;
//-------------------------------------------------------------

Procedure TRegisterZipTV.SetArchiveFile(SAF: ztv_WString);
Var
   s: TFileStream32;
Begin
   (* Do NOT use "Count := 0" in this procedure! *)
   If Not FileExists(SAF) Then
   Begin
      fArcType := atNA;
      fArchiveFile := '';
      Exit;
   End;

   SAF := UnixToDosFilename(SAF);
   fArchiveFile := SAF;

   If (SAF <> '') Then
   Begin

      s := TFileStream32.Create(fArchiveFile, fmOpenRead Or fmShareDenyNone);
      If (s.Handle < 0) Then
      Begin
         fArcType := atNA;
         Exit;
         //Raise EFOpenError.CreateFmt(LoadStr(E_FOPEN), [fArchiveFile]);
      End;

      Try
         fArcType := GetArcType(s);
      Finally
         s.Free();
      End;

      If Not (fArcType In Invalid_ArcType) Then
         InitializeVolumeSet();
   End
   Else
      fArcType := atNA;
End;
//-------------------------------------------------------------

Function TRegisterZipTV.IsHeaderEncrypted(SignAtr: Integer): Boolean;
Begin
   Result :=
      (SignAtr = LOCAL_FILE_ENCRPT_SIGNATURE) Or
      (SignAtr = CENTRAL_FILE_ENCRPT_SIGNATURE) Or
      (SignAtr = END_OF_CENTRAL_ENCRPT_SIGNATURE) Or
      (SignAtr = END_OF_CENTRAL64_ENCRPT_SIGNATURE) Or
      (SignAtr = LOCAL_CUST_ENCRPT_SIGNATURE) Or
      (SignAtr = CENTRAL_CUST_ENCRPT_SIGNATURE);
End;
//-------------------------------------------------------------

Function TRegisterZipTV.IsZipCompatible(SignAtr: Integer): Boolean;
Begin
   Result :=
      (SignAtr = LOCAL_FILE_HEADER_SIGNATURE) Or
      (SignAtr = LOCAL_FILE_ENCRPT_SIGNATURE) Or
      (SignAtr = CENTRAL_FILE_HEADER_SIGNATURE) Or
      (SignAtr = CENTRAL_FILE_ENCRPT_SIGNATURE);
End;
//-------------------------------------------------------------

Function TRegisterZipTV.GetLocalDirOffset(inStream: TStream32; Var Encrypted: Boolean):
   Int64;
Const
   MinSfxSize = 15000;
Var
   b: ^Byte;
   i, j: Cardinal;
   BytesRead: DWord;
   Buffer: TByteArray;
   pSignattr: ^Integer;
Begin
   Result := -1;
   inStream.Seek(MinSfxSize, soBeginning);
   For i := 0 To 3 Do                   //search upto 32k * 4 for local signature
   Begin
      BytesRead := inStream.Read(Buffer[0], SizeOf(Buffer));
      If (BytesRead = 0) Then
         Exit;

      b := @Buffer[0];
      For j := 0 To BytesRead Do
      Begin
         If b^ = 80 Then
         Begin
            pSignattr := @Buffer[j];
            If VerSig(pSignattr^, htLocal, Encrypted) = htLocal Then
            Begin
               Result := MinSfxSize + (i * SizeOf(Buffer)) + j;
               HeaderTypeState := [htLocal];
               Break;
            End;
         End;
         Inc(b);
      End;
      If (htLocal In HeaderTypeState) Then
         Break;
   End;
End;
//-------------------------------------------------------------

Function TRegisterZipTV.GetCentralDirOffset(s: TStream32): Int64;
Var
   b: ^Byte;
   i, j: Integer;
   Buffer: Pchar;
   pSignattr: ^Integer;
   CentralHeadPos,
      EndHeadPos: Int64;
   IsHeader,
      Encrypted: Boolean;
   pEndZipHeader64: ^TZipTV_End64;
   pWZip_End64: ^TWZIP_END64;
   pWZipLocator: ^TWZipLocator;
   BufSize, BytesRead: Integer;
   FileProgressProc: TNotifyEvent;
Begin
   Result := 0;

   If s.Size = 0 Then
      Exit;

   If (s.Size > WSIZE) Then
      BufSize := WSIZE
   Else
      BufSize := s.Size - 1;

   HeaderTypeState := [];

   FileProgressProc := s.TempFileProgressProc;
   s.TempFileProgressProc := Nil;

   GetMem(Buffer, BufSize);
   Try
      s.Position := s.Size - BufSize;
      //s.TempFileProgressProc := Nil;

      BytesRead := s.Read(Buffer[0], BufSize);

      //BytesRead := ReadFile(THandle(Handle), Buffer, Count, LongWord(Result), Nil);
      //If BytesRead <> BufSize Then
    //	BytesRead := 0;

      While (BytesRead > 0) Do
      Begin

         pEndZipHeader64 := @Buffer[BytesRead];
         If VerSig(pEndZipHeader64^.SignAtr, htEnding, Encrypted) = htEnding Then
         Begin
            // ending header found
            HeaderTypeState := [htEnding];

            If Encrypted Then
               DecodeHeader(pEndZipHeader64, htEnding);

            // clear Signature values
            WZipLocator.SignAtr := 0;
            WZip_End64.SignAtr := 0;

            pWZipLocator := @Buffer[BytesRead - SizeOf(TWZipLocator)];
            If pWZipLocator^.SignAtr = CENTRAL_WZIP_HEADER_LOCATOR Then
            Begin
               Include(HeaderTypeState, htLocator);
               pWZip_End64 := @Buffer[BytesRead - (SizeOf(TWZipLocator) +
                  SizeOf(TWZIP_END64))];
               If pWZip_End64^.SignAtr = END_OF_CENTRAL_WZIP_HEADER_SIGNATURE Then
                  Include(HeaderTypeState, htEnding64);
            End;

            EndHeadPos := s.Size - BufSize + BytesRead;