ztvregister.pas

ziptv为delphi控件

Unit ztvregister;

Interface

Uses
   Controls,
   Dialogs,
   Windows,
   Classes,
   Forms,
   ztvHeaders,
   ztvStreams,
   ztvGbls,
   ztvCrypt,
   ztvConsts,
   Registry;

{$I ZipTV.Inc}
{$J+} { Writeable Typed Constants }     // v4.0 added

Type
   TReturnTypes = (rtDelphiFound, rtDelphiInstalled, rtDelphiInUse);
   TReturnType = Set Of TReturnTypes;

   TOwnerReg = Class(TRegistry)
   Public
   	RegKeyInfo: TRegKeyInfo;
		Function CheckKey(hRootKey: HKey; Key: String): Boolean;
      Function CheckDelphiStat(hRootKey: HKey): TReturnType;
   End;

   TTempFileStream = Class(TFileStream32)
   Private
      fAutoDelete: Boolean;
      NewFileName: String;
   Protected
   Public
      fLocalObj: TObject;
      CancelCallBackPtr: pBoolean;
      DeleteOptions: TDeleteOptions;
      FileMode: Word;
      TempFileName: String;
      Constructor Create(Sender: TObject; TmpDir, FileName: String; Mode: Word);
      Destructor Destroy; Override;
      Function CopyFrom(Source: TStream32; Count: Int64): Int64; Override;
      Function Read(Var Buffer; Count: Longint): Longint; Override;
   End;

   TTempMemStream = Class(TMemoryStream32)
   Private
      fAutoDelete: Boolean;
      NewFileName: String;
   Protected
   Public
      fLocalObj: TObject;
      CancelCallBackPtr: pBoolean;
      FileMode: Word;
      TempFileName: String;
      Constructor Create(Sender: TObject; FileName: String; Mode: Word);
      Destructor Destroy; Override;
      Function CopyFrom(Source: TStream32; Count: Int64): Int64; Override;
      Function Read(Var Buffer; Count: Longint): Longint; Override;
   End;

   TExtStruct = Packed Record
      a: Array[0..3] Of Pointer;
   End;

   TRegisterZipTV = Class(TComponent)
   Private
      fExtraFieldLen: Word;
      fEncryptHeaders: Boolean;
      fOnDiskInDrvErr: TOnDiskError;
      fOnWriteProtectErr: TOnDiskError;
      fZipCmntBufSize: Integer;
      Function GetZipCompatible: Boolean;
      Function GetEncryptHeaders: Boolean;
      Procedure SetZipCmntBufSize(i: Integer);
   Protected
      fZipCompatible: Boolean;
      Function GetArchiveFile: ztv_WString; Virtual;
      Function DefSig(HT: THeaderType; Encrypted: Boolean): Integer;
      Function doByteSearch(s: TStream32; Var FAT: TArcType; StartOffset:
         Cardinal): Cardinal;
      //Function ExtraFieldLen: word;
      Function IsSFXZipped(s: TStream32): TArcType;
      Function OpenArchive(Var f: THandle; FileName: String): Boolean;
      Procedure DecodeFilename(p: Pointer; Len: Integer);
      Procedure DecodeComment(p: Pointer; Len: Integer);
      Procedure DecodeHeader(p: Pointer; HType: THeaderType);
      Procedure EncodeFilename(p: Pointer; Len: Integer);
      Procedure EncodeComment(p: Pointer; Len: Integer);
      Procedure EncodeHeader(p: Pointer; HType: THeaderType);
      Procedure InitializeVolumeSet;
      Procedure SetArchiveFile(SAF: ztv_WString); Virtual;
      Procedure SetArcType(ArcType: TArcType); Virtual;
      Procedure WEI(strm: TStream32); Virtual;
      Property ZipCompatible: Boolean Read GetZipCompatible Write
         fZipCompatible Default True;
   Public
      ArchiveCommentPos: Int64;
      ZipSFX_OffsetAdjustment: fs_long;
      fArchiveDate: Integer;
      fArchiveFile: ztv_WString;
      fArcType: TArcType;
      FLOF: Int64;
      fOffsetStart: Int64;
      fVolNum: Integer;
      pVolNum: ^Integer;
      fVolBegChar: Byte;

      LocalZipHeader: TLocal;
      CentralZipHeader: TCentral;
      EndZipHeader: TEnd;
      EndZipHeader64: TZipTV_End64;
      WZip_End64: TWZIP_END64;
      WZipLocator: TWZipLocator;

      TarHeader: TTarHeader;
      CFFile: TCAB_CFFILE;
      HeaderTypeState: THeaderTypeState;
      Constructor Create(aOwner: TComponent); Override;
      Destructor Destroy; Override;
      Function GetArcType(s: TStream32): TArcType;
      Function GetLocalDirOffset(inStream: TStream32; Var Encrypted: Boolean): Int64;
      Function GetCentralDirOffset(s: TStream32): Int64;
      Function IsHeaderEncrypted(SignAtr: Integer): Boolean;
      Function IsZipCompatible(SignAtr: Integer): Boolean;
      Function maxbits: ShortInt;
      Function VerSig(Sig: Integer; HT: THeaderType; Var Encrypted: Boolean): THeaderType;
      Property ArchiveDate: Integer Read fArchiveDate; //Write fArchiveDate;
      Property ArchiveFile: ztv_WString Read GetArchiveFile Write SetArchiveFile;  // Stored False;
      Property ArcType: TArcType Read fArcType Write SetArcType Default atNA;
      Property EncryptHeaders: Boolean Read GetEncryptHeaders Write
         fEncryptHeaders Default False;
      Property ZipCmntBufSize: Integer Read fZipCmntBufSize Write
         SetZipCmntBufSize Stored False;
      // v4.1.11: added to bypass WinRar's header read bug
      // WinRar uses the Central header to retrieve the ExtraFieldLen
      // field instead of the local header.  In a project's code, set the
      // value of this property to 0.
      Property ExtraFieldLen: Word Read fExtraFieldLen Write fExtraFieldLen;
      Property OnDiskInDrvErr: TOnDiskError Read fOnDiskInDrvErr Write fOnDiskInDrvErr;
      Property OnDiskWriteProtectErr: TOnDiskError Read fOnWriteProtectErr
         Write fOnWriteProtectErr;
   Published
   End;

Const
   cMINVER = 6;
   cMAXVER = 8;
   cRevision = 4;
   MAX_WBITS = -15;                     { 32K LZ77 window }
   MaxBufSize = $186A0;

Var
   fCrcCalced: Boolean = False;
   TZInfo: TTimeZoneInformation;
   dwTimeZoneMode: Integer;
   fEI: TExtStruct;
   pEI: ^TExtStruct;
   p: Pointer;
   HKeyed: Tak;
   CF_COMPRESSED_DATA: Integer;

Function CopyStreamFromClipboard(Stream: TMemoryStream32): Boolean;
Function CopyStreamToClipboard(Stream: TMemoryStream32; Len: Integer): Boolean;
Function DosDateToUnix(tm: TDateTime): Integer;
Function IsLeapYear(Year: Word): Boolean;
Function LocalTimeToUniversal(LT: TDateTime): TDateTime;
Function OctStrToInt(s: String): Integer;
Function UniversalTimeToLocal(UT: TDateTime): TDateTime;
Function UnixDateToDos(UnixDate: Integer): TDateTime;
Function vKey: Integer;
Procedure IntToOctStr(Value, digs: Integer; StrTerminate: Boolean; where: Pchar);
Procedure DecodeRarFN(Name: Pchar; EncName: Pchar; EncSize: Integer;
   NameW: PWideChar; MaxDecSize: Integer);

Implementation

Uses
   Clipbrd,
   ShellAPI,
   Buttons,
   StdCtrls,
   SysUtils,
   Err_Msgs,
   ztvBase,
   ztvFileIo;

(*************************************************************)
(*************************************************************)
(*                          TOwnerReg                        *)
(*************************************************************)
(*************************************************************)
Function TOwnerReg.CheckKey(hRootKey: HKey; Key: String): Boolean;
Begin
	Result := False;
   Try
      RootKey := hRootKey;
      If KeyExists(Key) And OpenKeyReadOnly(Key) Then
         Result := GetKeyInfo(RegKeyInfo);
   Except
      //Raise;
   End;
End;
//-------------------------------------------------------------

Function TOwnerReg.CheckDelphiStat(hRootKey: HKey): TReturnType;
Var
   hFileRes: HFILE;
   ExtDescript,
   	sKey: String;
   UnableToOpenExistingFile: Boolean;
Begin
   Result := [];
   Try
      sKey := '\Software\Borland\Delphi\';
      sKey := sKey +
         {$ifdef VER150}		//D7
         '7.0';
         {$else}
            {$ifdef VER140}		//D6
            '6.0';
            {$else}
               {$ifdef VER130}		//D6
               '5.0';
               {$else}
                  {$ifdef VER120}	//D4
                  '4.0';
                  {$else}
                  '7.0';	// default to delphi 7
                  {$endif VER120}
               {$endif VER130}
            {$endif VER140}
         {$endif VER150}


      RootKey := hRootKey;
      If CheckKey(hRootKey, sKey) Then
      Begin
         Include(Result, rtDelphiInstalled);
         //GetKeyInfo(RegKeyInfo);

         {$ifdef VER120}	//D4
         ExtDescript := ReadString('Delphi 4');
         {$else}
         ExtDescript := ReadString('App');  //Delphi 5+ uses 'App' as the description
         {$endif V120}

         If Not FileExists(ExtDescript) Then
            Exit
         Else
            Include(Result, rtDelphiFound);

         // now, is Delphi running?
         hFileRes := CreateFile(Pchar(ExtDescript), GENERIC_READ Or GENERIC_WRITE,
            0, Nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

         UnableToOpenExistingFile := (hFileRes = INVALID_HANDLE_VALUE);
         If Not UnableToOpenExistingFile Then
            CloseHandle(hFileRes);

         If UnableToOpenExistingFile Then
            Include(Result, rtDelphiInUse);
      End;
   Except
      Result := []; //Raise;
   End;
End;

(*************************************************************)
(*************************************************************)
(*                      TTempMemStream                       *)
(*************************************************************)
(*************************************************************)

Constructor TTempMemStream.Create(Sender: TObject; 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
      // veriable TempFileName should acutally be zeor length, since
      // CompressionMethod was set with the value cmInMemory.  Use a dummy
      // string ('NoName') as the value for the TempFileName so the string
      // comparison routines (within the TempFileMoveBeginProc procedure)
      // will pass.
      TempFileName := 'NoName';
      NewFileName := FileName;
      fAutoDelete := True;
   End
   Else
   Begin
      TempFileName := FileName;
      NewFileName := '';
      fAutoDelete := False;
   End;

   Inherited Create();
   FileMode := Mode;
End;
//-------------------------------------------------------------

Destructor TTempMemStream.Destroy;
Var
   ECode: DWord;
   SameDrive: Boolean;
Begin
   If (Not fAutoDelete) Or (FileMode And fmOpenRead > 0) Then
      Inherited Destroy
   Else
   Try
      Try
         If CancelCallBackPtr^ Then
            Exit;

         If (FileMode <> 0) And (NewFileName <> '') Then
         Begin
            Try
               If (FileMode And fmCreate > 0) Then
               Begin
                  SameDrive := False;
                  TempFileMoveBeginProc(Self, NewFileName, TempFileName,
                     CancelCallBackPtr^);
                  Try
                     If Not CancelCallBackPtr^ Then
                        TempFileMoveProc(Self, NewFileName, TempFileName,
                           SameDrive);
                  Finally
                     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();
      End;
   Finally
      Inherited Destroy();
   End;
End;
//-------------------------------------------------------------

Function TTempMemStream.CopyFrom(Source: TStream32; Count: Int64): Int64;
Var
   Buffer: Pchar;
   pCancel: pBoolean;
   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 TTempMemStream.Read(Var Buffer; Count: Longint): Longint;
Begin
   Result := Inherited Read(Buffer, Count);

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