unit1.pas

ziptv为delphi控件

Unit Unit1;

Interface

{$I ZipTV.inc}
{$IFDEF DEL6_OR_HIGHER}
{$WARN UNIT_PLATFORM OFF}
{$ENDIF}

Uses
   SysUtils,
   Classes,
   Controls,
   ComCtrls,
   StdCtrls,
   ExtCtrls,
   Graphics,
   Forms,
   Dialogs,
   Buttons,
   FileCtrl,
   ztvBase,
   ztvUUDecode,
   ztvRegister,
   ztvUUEncode;

Type
   TForm1 = Class(TForm)
      UUEncode1: TUUEncode;
      UUDecode1: TUUDecode;
      imgLed: TImage;
      Panel1: TPanel;
    	Panel2: TPanel;
    	Panel3: TPanel;
      pbxLed: TPaintBox;
    	RadioGroup1: TRadioGroup;
      OpenDialog1: TOpenDialog;
      ProgressBar1: TProgressBar;
      EncodeEdit1: TEdit;
      EncodeEdit2: TEdit;
      EncodeEdit3: TEdit;
      EncodeLabel1: TLabel;
      EncodeLabel2: TLabel;
      EncodeLabel3: TLabel;
      EncodeLabel4: TLabel;
    	Button1: TButton;
    	EncodeOK: TBitBtn;
      EncodeBitBtn1: TBitBtn;
      EncodeBitBtn2: TBitBtn;
      EncodeCheckBox1: TCheckBox;
      EncodeCheckBox2: TCheckBox;
    	DecodeOK: TBitBtn;
    	DecodeBitBtn1: TBitBtn;
    	DecodeEdit1: TEdit;
    	DecodeLabel1: TLabel;
    	DecodeLabel2: TLabel;
      Procedure SetLedColor(lColor: TColor);
      Procedure pbxLedPaint(Sender: TObject);
      Procedure pbxLedClick(Sender: TObject);
    	Procedure FormActivate(Sender: TObject);
      Procedure FormCreate(Sender: TObject);
    	Procedure Button1Click(Sender: TObject);
      Procedure RadioGroup1Click(Sender: TObject);
      Procedure EncodeOKClick(Sender: TObject);
      Procedure EncodeEdit1Change(Sender: TObject);
      Procedure EncodeEdit2Change(Sender: TObject);
      Procedure EncodeBitBtn1Click(Sender: TObject);
      Procedure EncodeBitBtn2Click(Sender: TObject);
      Procedure DecodeOKClick(Sender: TObject);
      Procedure DecodeBitBtn1Click(Sender: TObject);
      Procedure DecodeEdit1Change(Sender: TObject);
      Procedure UUEncode1Progress(Sender: TObject; ProgressByFile,
         ProgressByArchive: Byte);
      Procedure UUEncode1FileExists(Sender: TObject; FileName: String;
         FileDate: TDateTime; Var OverwriteMode: TOverwriteMode);
      Procedure UUEncode1Error(Sender: TObject; FileName, ExtendedMsg,
         VolumeID: String; ECode: Integer);
      Procedure UUDecode1NextVolume(Sender: TObject; Var VolumeName: String;
         VolumeID: Integer; FExists: Boolean; Var Cancel: Boolean);
      Procedure UUDecode1FileExists(Sender: TObject; FileName: String;
         Var NewFileName: String; Var OverwriteMode: TOverwriteMode);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   Form1: TForm1;

Implementation

{$R *.DFM}

Uses
   ztvGbls;                             // for AppendDirTail function

//-------------------------------------------------------------
//                           ENCODE
//-------------------------------------------------------------

// Open file... fill EncodeEdit1.Text & EncodeEdit2.Text properties

Procedure TForm1.EncodeBitBtn1Click(Sender: TObject);
Begin
   With OpenDialog1 Do
   Begin
      FileName := EncodeEdit1.Text;
      Title := 'Select file to encode...';
      InitialDir := GetCurrentDir();
      Options := [ofHideReadOnly, ofFileMustExist, ofPathMustExist];

      If Execute() Then
      Begin
         EncodeEdit1.Text := FileName;
         EncodeEdit2.Text := ChangeFileExt(FileName, UUEncode1.DefaultExt);
         SetCurrentDir(ExtractFilePath(FileName));
      End;
   End;
End;
//-------------------------------------------------------------

// Select directory for the encoded file

Procedure TForm1.EncodeBitBtn2Click(Sender: TObject);
Var
   Dir: String;
Begin
   If DirectoryExists(ExtractFilePath(EncodeEdit2.Text)) Then
   	Dir := ExtractFilePath(EncodeEdit2.Text);
      
   If SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt], -1) Then
   Begin
      UUEncode1.DefaultDir := Dir;
      If EncodeEdit1.Text <> '' Then
         EncodeEdit2.Text :=
            AppendDirTail(Dir) +
            ChangeFileExt(ExtractFilename(EncodeEdit1.Text), UUEncode1.DefaultExt);
   End;
End;
//-------------------------------------------------------------

// Set the UUEcode1 controls properties and activate encoding (Compress property).

Procedure TForm1.EncodeOKClick(Sender: TObject);
Begin
   If CompareText(EncodeEdit1.Text, EncodeEdit2.Text) = 0 Then
   Begin
      ShowMessage('Error: infile and outfile are the same');
      EncodeEdit1.SetFocus();
      Exit;
   End;

   UUEncode1.DefaultDir := ExtractFilePath(EncodeEdit1.Text);
   UUEncode1.ArchiveFile := EncodeEdit1.Text;
   UUEncode1.OutFilename := EncodeEdit2.Text;
   UUEncode1.ConfirmOverwrites := EncodeCheckBox2.Checked;

   // default value for KBytesPerVolume is 0
   If EncodeEdit3.Text <> '' Then
      UUEncode1.KBytesPerVolume := StrToInt(EncodeEdit3.Text)
   Else
      UUEncode1.KBytesPerVolume := 0;

   UUEncode1.WriteTableToFile := EncodeCheckBox1.Checked;

   Screen.Cursor := crHourGlass;
   Try
      // cmUUEncode & cmXXEncode (of type TCompressMethod) are defined
      // in ztvBase (must use ztvBase in this units USES clause).
      Case RadioGroup1.ItemIndex Of
         0: UUEncode1.CompressMethod := cmUUEncode;
         1: UUEncode1.CompressMethod := cmXXEncode;
      End;

      // ----------------------------
      // activate the compress method
      // ----------------------------
      UUEncode1.Compress();

      ProgressBar1.Position := 0;
      ProgressBar1.Update();
   Finally
      Screen.Cursor := crDefault;
   End;
End;
//-------------------------------------------------------------

// enable OK button dependant on the following conditions

Procedure TForm1.EncodeEdit1Change(Sender: TObject);
Begin
   EncodeOK.Enabled := FileExists(EncodeEdit1.Text);
End;
//-------------------------------------------------------------

(* OnProgress - used by both UUEncode1 & UUDecode1 *)

Procedure TForm1.UUEncode1Progress(Sender: TObject; ProgressByFile,
   ProgressByArchive: Byte);
Begin
   ProgressBar1.Position := ProgressByFile; //ProgressByArchive;
   ProgressBar1.Update();
End;
//-------------------------------------------------------------

(* UUEncode1.OnFileExists event -

   NOTE:
 if UUEncode1.ConfirmOverwrites = False, this function will
   not be activated
   *)

Procedure TForm1.UUEncode1FileExists(Sender: TObject; FileName: String;
   FileDate: TDateTime; Var OverwriteMode: TOverwriteMode);
Begin
   With TUUEncode(Sender) Do
      Case
         MessageDlg(FileName + #13#13 + 'File already exists...'#13#13 +
         'Overwrite this file?', mtConfirmation,
         [mbYes, mbNo, mbIgnore, mbCancel], 0) Of

         mrNo: OverwriteMode := omSkip;
         mrYes: OverwriteMode := omOverwrite;
         mrIgnore: ConfirmOverwrites := False;
         mrCancel: Cancel := True;
      End;
End;
//-------------------------------------------------------------

(* OnError event - shared by both UUEncode1 & UUDecode1 components *)

Procedure TForm1.UUEncode1Error(Sender: TObject; FileName, ExtendedMsg,
   VolumeID: String; ECode: Integer);
Var
   Msg: String;
Begin
   Msg :=
      LowerCase(Sender.Classname) + #13 + // classname
   LowerCase(TZipCommon(Sender).ArchiveFile) + // archive filename
   LowerCase(ExtractFilename(FileName)) + // filename
   IntToStr(ECode) +                    // int error code
   LoadStr(ECode) +                     // str error descript
   ExtendedMsg;                         // str error extended descript

   ShowMessage(Msg);
End;
//-------------------------------------------------------------

// Revise output file-extension dependant on encoding method

Procedure TForm1.RadioGroup1Click(Sender: TObject);
Begin
   Case RadioGroup1.ItemIndex Of
      0: UUEncode1.DefaultExt := '.uue';
      1: UUEncode1.DefaultExt := '.xxe';
   End;

   EncodeEdit2.Text :=
      ChangeFileExt(EncodeEdit2.Text, UUEncode1.DefaultExt);
End;
//-------------------------------------------------------------

(* change output file extension, dependant on compress method *)

Procedure TForm1.EncodeEdit2Change(Sender: TObject);
Begin
   //EncodeEdit2.Text :=
   //	ChangeFileExt(EncodeEdit2.Text, UUEncode1.DefaultExt);
End;

//-------------------------------------------------------------
//                           DECODE
//-------------------------------------------------------------

Procedure TForm1.DecodeOKClick(Sender: TObject);
Var
   Dir: String;
Begin
   (* Assign FileName & dir to extract    		 *)
   UUDecode1.ArchiveFile := DecodeEdit1.Text;

   (* Assign the ExtractDir property             *)
   Dir := ExtractFilePath(DecodeEdit1.Text);
   If SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt], -1) Then
      UUDecode1.ExtractDir := Dir;

   (* 'Restore original folders'             	 *)
   UUDecode1.UseStoredDirs := False;

   (* Handle file overwrites                     *)
   If Not UUDecode1.ConfirmOverwrites Then
      UUDecode1.OverwriteMode := omOverwrite;

   (* RestoreFileAttr property                   *)
   UUDecode1.RestoreFileAttr := False;

   (* CreateStoredDirs property / this property creates any dirs
      stored in an archive                       *)
   UUDecode1.CreateStoredDirs := False;

   (* TranslateOemChar property                  *)
   UUDecode1.TranslateOemChar := False; // ...foreign language chars

   (* RecurseDirs property                       *)
   UUDecode1.RecurseDirs := True;

   (*******************************)
   (* Form display controls setup *)
   (*******************************)
   ProgressBar1.Position := 0;
   ProgressBar1.Update();

   Cursor := crHourGlass;
   SetLedColor(clRed);

   Try
      UUDecode1.VolumeName := '';
      UUDecode1.FileSpec.Clear;
      UUDecode1.FileSpec.Add('*.*');

      // ---------------------------
      // activate the Extract method
      // ---------------------------
      UUDecode1.Extract();
   Finally
      ProgressBar1.Position := 0;
      ProgressBar1.Update();
      SetLedColor(clGreen);
      Cursor := crDefault;
   End;

End;
//-------------------------------------------------------------

Procedure TForm1.DecodeBitBtn1Click(Sender: TObject);
Begin
   With OpenDialog1 Do
   Begin
      FileName := DecodeEdit1.Text;
      Title := 'Select file to decode...';
      InitialDir := GetCurrentDir();
      Options := [ofHideReadOnly, ofFileMustExist, ofPathMustExist];
      Filter :=
         'Encoded Archives |*.enc;*.uue;*.xxe|*.enc|*.enc|*.uue|*.uue|*.xxe|*.xxe';
      If Execute() Then
         DecodeEdit1.Text := FileName;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.UUDecode1NextVolume(Sender: TObject;
   Var VolumeName: String; VolumeID: Integer; FExists: Boolean;
   Var Cancel: Boolean);
Var
   NewFile, Prompt, Caption: String;
Begin
   Cancel := False;                     (* Default value = true *)

   If Not FExists Then                  (* FExists = FileExists *)
   Begin
      Caption := ExtractFilename(VolumeName);
      Prompt := 'Volume ID: ' + IntToStr(VolumeID);
      NewFile := VolumeName;

      If Not InputQuery(Caption, Prompt, NewFile) Then
         Cancel := True
      Else
         VolumeName := NewFile;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.UUDecode1FileExists(Sender: TObject; FileName: String;
   Var NewFileName: String; Var OverwriteMode: TOverwriteMode);
Begin
   //
End;

//-------------------------------------------------------------
//                      Misc Form Controls
//-------------------------------------------------------------

Procedure TForm1.SetLedColor(lColor: TColor);
Begin
   With imgLed.Canvas Do
   Begin
      Brush.Color := lColor;
      FloodFill(6, 6, Pixels[6, 6], fsSurface);
   End;
   pbxLed.Repaint;
End;
//-------------------------------------------------------------

(* Little light in right corner of form *)

Procedure TForm1.pbxLedPaint(Sender: TObject);
Begin
   With Sender As TPaintBox Do
      Canvas.Draw((Width - imgLed.Width) Div 2,
         (Height - imgLed.Height) Div 2,
         imgLed.Picture.Graphic);
End;
//-------------------------------------------------------------

(* TPaintBox ( pbxLed ) component OnClick event -
   Set the Cancel property to True *)

Procedure TForm1.pbxLedClick(Sender: TObject);
Begin
   UUEncode1.Cancel := True;
   UUDecode1.Cancel := True;
   Cursor := crDefault;
End;
//-------------------------------------------------------------

Procedure TForm1.FormActivate(Sender: TObject);
Begin
   EncodeOK.Enabled := FileExists(EncodeEdit1.Text);
End;
//-------------------------------------------------------------

Procedure TForm1.FormCreate(Sender: TObject);
Begin
   imgLed.Top := Panel3.Top + 5;	(* Panel3 = status_bar holder *)
   imgLed.left := pbxLed.left + 3;
End;
//-------------------------------------------------------------

Procedure TForm1.DecodeEdit1Change(Sender: TObject);
Begin
   DecodeOK.Enabled := FileExists(DecodeEdit1.Text);
End;
//-------------------------------------------------------------

Procedure TForm1.Button1Click(Sender: TObject);
Begin
	Close();
End;
//-------------------------------------------------------------

End.