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

📄 unit1.pas

📁 老外的超高效率压缩
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, FileCtrl, ComCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ArcComboBox: TComboBox;
    Label2: TLabel;
    OptComboBox: TComboBox;
    AboutLabel: TLabel;
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    Button1: TButton;
    Button2: TButton;
    LogMemo: TMemo;
    StreamCheck: TCheckBox;
    ProgressBar1: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure ArcComboBoxChange(Sender: TObject);
    procedure FileListBox1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    TotalSize: integer;
  public
    procedure ProgressCallback(Current: integer);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses PowerArc;

procedure TForm1.FormCreate(Sender: TObject);
var j: integer;
begin
  for j:=0 to Length(PowerArcModules)-1 do
    ArcComboBox.Items.Add(PowerArcModules[j].Info^.Name);
  ArcComboBox.ItemIndex:=0;
  ArcComboBoxChange(nil);
end;

procedure TForm1.ArcComboBoxChange(Sender: TObject);
begin
  if ArcComboBox.ItemIndex >= 0 then begin
    AboutLabel.Caption:=PowerArcModules[ArcComboBox.ItemIndex].Info^.Description;
    OptComboBox.Items:=PowerArcModules[ArcComboBox.ItemIndex].Options;
    OptComboBox.Items.Insert(0,'Default');
    OptComboBox.ItemIndex:=0;
  end;
end;

procedure TForm1.FileListBox1Change(Sender: TObject);
begin
  Button1.Enabled:=FileExists(FileListBox1.FileName) and
    (ANSICompareText(ExtractFileExt(FileListBox1.FileName),'.pk') <> 0);
  Button2.Enabled:=FileExists(FileListBox1.FileName) and
    (ANSICompareText(ExtractFileExt(FileListBox1.FileName),'.pk') = 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
var InStream,OutStream: TFileStream;
    Opt: string;
    CompressStream: TPowerArcCompressStream;
begin
  if ArcComboBox.ItemIndex >= 0 then begin
    InStream:=TFileStream.Create(FileListBox1.FileName,fmOpenRead);
    OutStream:=TFileStream.Create(FileListBox1.FileName+'.pk',fmCreate);
    try
      if OptComboBox.ItemIndex <= 0 then Opt:=''
      else Opt:=OptComboBox.Items[OptComboBox.ItemIndex];
      TotalSize:=InStream.Size;
      if StreamCheck.Checked then begin
        CompressStream:=TPowerArcCompressStream.Create(OutStream,ArcComboBox.ItemIndex,Opt);
        try
          CompressStream.OnProgress:=ProgressCallback;
          CompressStream.CopyFrom(InStream,0);
        finally
          CompressStream.Free;
        end;
      end else
        PowerArcCompress(InStream,OutStream,ArcComboBox.ItemIndex,Opt,ProgressCallback);
      LogMemo.Lines.Add('Compress '+FileListBox1.FileName);
      LogMemo.Lines.Add('Size'#9+IntToStr(InStream.Size));
      LogMemo.Lines.Add('Destination '+FileListBox1.FileName+'.pk');
      LogMemo.Lines.Add('Size'#9+IntToStr(OutStream.Size));
      LogMemo.Lines.Add('Ratio'#9+FormatFloat('#0.00',OutStream.Size*100.0/InStream.Size)+'%');
      LogMemo.Lines.Add('BPC'#9+FormatFloat('#0.000',OutStream.Size*8.0/InStream.Size));
      LogMemo.Lines.Add('');
    finally
      InStream.Free;
      OutStream.Free;
    end;
    FileListBox1.Update;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var InStream,OutStream: TFileStream;
    DecompressStream: TPowerArcDecompressStream;
    Buff: array[0..4095] of byte;
    len: integer;
begin
  InStream:=TFileStream.Create(FileListBox1.FileName,fmOpenRead);
  OutStream:=TFileStream.Create(ChangeFileExt(FileListBox1.FileName,'.org'),fmCreate);
  try
    TotalSize:=InStream.Size;
    if StreamCheck.Checked then begin
      DecompressStream:=TPowerArcDecompressStream.Create(InStream);
      try
        DecompressStream.OnProgress:=ProgressCallback;
        len:=DecompressStream.Read(Buff[0],4096);
        while len > 0 do begin
          OutStream.Write(Buff[0],len);
          len:=DecompressStream.Read(Buff[0],4096);
        end;
      finally
        DecompressStream.Free;
      end;
    end else
      PowerArcDecompress(InStream,OutStream,ProgressCallback);
    LogMemo.Lines.Add('Decompress '+FileListBox1.FileName);
    LogMemo.Lines.Add('');
  finally
    InStream.Free;
    OutStream.Free;
  end;
  FileListBox1.Update;
end;

procedure TForm1.ProgressCallback(Current: integer);
begin
  ProgressBar1.Position:=Current*100 div TotalSize;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -