clzma.pas.bak

来自「这原本是delphi7的7-zip元件安装包, 我因为工作需要自己改成了在La」· BAK 代码 · 共 164 行

unit CLZMA;
{$I SoundDefs.inc}
interface

uses
  SysUtils, Classes,ULZMAEncoder,ULZMADecoder,ULZMACommon,ULZMABase;

type
  TLZMAProcEvent = procedure(Position,TotalSize:Int64)of object;
  TLZMA = class(TComponent)
  private
    FOnProgress: TLZMAProcEvent;
    FFastBytes:Integer;
    FFastByte: Integer;
    { Private declarations }
  protected
    { Protected declarations }
    LZMAEncoder:TLZMAEncoder;
    LZMADecoder:TLZMADecoder;
    FTotalSize:Int64;
    FPosition:Int64;
    procedure DoProgress(const Action:TLZMAProgressAction;const Value:int64);

  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    procedure CompressFile(inFileName,outFileName:String);
    procedure DeCompressFile(inFileName,outFileName:String);
    procedure Compress(inStream,outStream:TStream);
    procedure DeCompress(inStream,outStream:TStream);
  published
    { Published declarations }
    property FastByte:Integer read FFastByte write FFastByte;
    property OnProgress:TLZMAProcEvent read FOnProgress write FOnProgress;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TLZMA]);
end;

{ TLZMA }

procedure TLZMA.Compress(inStream, outStream: TStream);
var
  filesize:Int64;
  i:Integer;
begin
   with LZMAEncoder do begin
         SeNumFastBytes(273);
         SetEndMarkerMode(true);
         WriteCoderProperties(outStream);
         filesize:=-1;
         for i := 0 to 7 do
            WriteByte(outStream,(fileSize shr (8 * i)) and $FF);
         Code(inStream,OutStream,-1,-1);
     end;
end;

procedure TLZMA.CompressFile(inFileName, outFileName: String);
var
   inFile,OutFile:TFileStream;
begin
 try
    InFile := TFileStream.Create(InFileName, fmOpenRead);

    try
       OutFile := TFileStream.Create(OutFileName, fmCreate);
       Compress(inFile,OutFile);
    finally
      OutFile.Free;
    end;
  finally
    InFile.Free;
  end;

end;

constructor TLZMA.Create(AOwner: TComponent);
begin
  inherited;

  LZMAEncoder:=TLZMAEncoder.Create;
  LZMADecoder:=TLZMADecoder.Create;
  LZMAEncoder.OnProgress:=DoProgress;
  LZMADecoder.OnProgress:=DoProgress;
  FTotalSize:=0;
  FPosition:=0;
  FFastByte:=273;
end;

procedure TLZMA.DeCompress(inStream, outStream: TStream);
var
   properties:array[0..4] of byte;
   filesize,outSize:Int64;
   v:byte;
   i:Integer;
const propertiessize=5;
begin
    inStream.position:=0;
    with LZMADecoder do begin
        try
         
         if inStream.read(properties, propertiesSize) <> propertiesSize then
           raise Exception.Create('input .lzma file is too short');
             if not SetDecoderProperties(properties) then
                raise Exception.Create('Incorrect stream properties');
             outSize := 0;
             for i := 0 to 7 do begin
                 v := {shortint}(ReadByte(inStream));
                 if v < 0 then
                    raise Exception.Create('Can''t read stream size');
                 outSize := outSize or v shl (8 * i);
                 end;
             if not Code(inStream, outStream, outSize) then
                raise Exception.Create('Error in data stream');
         except

         end;
     end;
end;

procedure TLZMA.DeCompressFile(inFileName, outFileName: String);
var
  inFile,OutFile:TFileStream;
begin
   try
      InFile := TFileStream.Create(InFileName, fmOpenRead);
      try
      OutFile := TFileStream.Create(OutFileName, fmCreate);
      DeCompress(InFile,OutFile);
      finally
       OutFile.Free;
      end;
    finally
      InFile.Free;
    end;

end;

destructor TLZMA.Destroy;
begin
  FreeAndNil(LZMAEncoder);
  FreeAndNil(LZMADecoder);
  inherited;
end;

procedure TLZMA.DoProgress(const Action: TLZMAProgressAction;
  const Value: int64);
begin
  if Action=LPAPos then FPosition:=Value
   else FTotalSize:=Value;

  if FTotalSize>=FPosition then
    if Assigned(FOnProgress) then FOnProgress(FTotalSize,FPosition);
end;

end.