powerarc.pas

老外的超高效率压缩

    PowerArcModule.Info:=GetPowerArcModuleInfo;
    // check that module exists
    for j:=0 to Length(PowerArcModules)-1 do
      if PowerArcModules[j].Info^.ModuleID = PowerArcModule.Info.ModuleID then begin
        Result:=j;
        FreeLibrary(PowerArcModule.hLib);
        Exit;
      end;
    // continue init
    PowerArcModule.SetOptions:=TPowerArcSetOptions(GetProcAddress(PowerArcModule.hLib,'SetOptions'));
    PowerArcModule.Compress:=TPowerArcCompress(GetProcAddress(PowerArcModule.hLib,'Compress'));
    PowerArcModule.CompressMem:=TPowerArcCompressMem(GetProcAddress(PowerArcModule.hLib,'CompressMem'));
    PowerArcModule.Decompress:=TPowerArcDecompress(GetProcAddress(PowerArcModule.hLib,'Decompress'));
    if Assigned(GetPowerArcModuleInfo) and
       (PowerArcModule.Info^.Signature = PowerArcModuleSignature) and
       Assigned(PowerArcModule.SetOptions) and
       Assigned(PowerArcModule.Compress) and
       Assigned(PowerArcModule.CompressMem) and
       Assigned(PowerArcModule.Decompress) then begin
      PowerArcModule.Options:=TStringList.Create;
      POpt:=PowerArcModule.Info^.Options;
      while POpt^ <> #0 do begin
        PowerArcModule.Options.Add(POpt);
        POpt:=POpt+StrLen(POpt)+1;
      end;
      SetLength(PowerArcModules,Length(PowerArcModules)+1);
      PowerArcModules[Length(PowerArcModules)-1]:=PowerArcModule;
      Result:=Length(PowerArcModules)-1;
    end else
      FreeLibrary(PowerArcModule.hLib);
  end;
end;

procedure PowerArcUnregisterModules;
var j: integer;
begin
  for j:=0 to Length(PowerArcModules)-1 do begin
    if PowerArcModules[j].hLib <> 0 then
      FreeLibrary(PowerArcModules[j].hLib);
    PowerArcModules[j].Options.Free;
  end;
  PowerArcModules:=nil;
end;

{ TCompressThread }

type
  TCompressThread = class(TThread)
  private
    Done: Boolean;
    CompressStream: TPowerArcCompressStream;
  protected
    procedure Execute; override;
  end;

{ TCompressThread }

function ReadCompressFunc(Data: Pointer; var Buffer; Size: integer): integer; stdcall;
begin
  if not Windows.ReadFile(TPowerArcCompressStream(Data).hReadPipe,Buffer,Size,DWORD(Result),nil) then
    Result:=-1;
end;

function WriteCompressFunc(Data: Pointer; const Buffer; Size: integer): integer; stdcall;
begin
  Result:=TPowerArcCompressStream(Data).Base.Write(Buffer,Size);
end;

procedure TCompressThread.Execute;
begin
  try
    CompressStream.Base.Write(PowerArcModules[CompressStream.ArcIdx].Info^.ModuleID[0],8);
    PowerArcModules[CompressStream.ArcIdx].Compress(CompressStream,
      PChar(CompressStream.ArcOpt),ReadCompressFunc,WriteCompressFunc);
  except
  end;
  CloseHandle(CompressStream.hReadPipe);
  Done:=True;
end;

{ TPowerArcCompressStream }

constructor TPowerArcCompressStream.Create(BaseStream: TStream;
  FArcIdx: integer; const FArcOpt: string);
begin
  inherited Create;
  Base:=BaseStream;
  ArcIdx:=FArcIdx;
  ArcOpt:=FArcOpt;
  Thread:=nil;
  FOnProgress:=nil;
  TotalWrited:=0;
  if not ValidArcIdx(ArcIdx) then
    raise EPowerArcError.Create('Invalid acrhive index');
  if ArcIdx = iPowerBZIP then begin
    Base.Write(PowerArcModules[ArcIdx].Info^.ModuleID[0],8);
    BZCompressionStream:=TBZCompressionStream.Create(Base);
    BZCompressionStream.OnProgress:=DoProgress;
  end else
    BZCompressionStream:=nil;
end;

destructor TPowerArcCompressStream.Destroy;
begin
  if Thread <> nil then begin
    CloseHandle(hWritePipe);
    while not TCompressThread(Thread).Done do Sleep(0);
    Thread.Free;
  end;
  if BZCompressionStream <> nil then
    BZCompressionStream.Free;
  inherited;
end;

procedure TPowerArcCompressStream.DoProgress(Current: integer);
begin
  if Assigned(FOnProgress) then FOnProgress(Current);
end;

function TPowerArcCompressStream.Read(var Buffer; Count: Integer): Longint;
begin
  raise EPowerArcError.Create('Invalid stream operation');
end;

function TPowerArcCompressStream.Seek(Offset: Integer;
  Origin: Word): Longint;
begin
  if (Offset = 0) and (Origin = soFromCurrent) then
    Result := TotalWrited
  else
    raise EPowerArcError.Create('Invalid stream operation');
end;

function TPowerArcCompressStream.Write(const Buffer;
  Count: Integer): Longint;
var Ret: Boolean;
    ActualWrite: DWORD;
    P: PChar;
begin
  if ArcIdx = iPowerBZIP then
    Result:=BZCompressionStream.Write(Buffer,Count)
  else if Count > 0 then begin
    if Thread = nil then begin
      CreatePipe(hReadPipe,hWritePipe,nil,PipeSize);
      Thread:=TCompressThread.Create(True);
      TCompressThread(Thread).CompressStream:=Self;
      TCompressThread(Thread).Done:=False;
      Thread.FreeOnTerminate:=False;
      Thread.Resume;
    end;
    //Windows.WriteFile(hWritePipe,Buffer,Count,DWORD(Result),nil);
    Result:=0;
    P:=PChar(@Buffer);
    while Count > 0 do begin
      Ret:=Windows.WriteFile(hWritePipe,P^,Count,ActualWrite,nil);
      if not Ret or (Ret and (ActualWrite = 0)) then begin
        if Result = 0 then Result:=-1;
        Break;
      end;
      Dec(Count,ActualWrite);
      Inc(Result,ActualWrite);
      Inc(P,ActualWrite);
      Sleep(0);
    end;
  end else
    Result:=0;
  if Result > 0 then begin
    Inc(TotalWrited,Result);
    if ArcIdx <> iPowerBZIP then
      DoProgress(TotalWrited);
  end;
end;

{ TDecompressThread }

type
  TDecompressThread = class(TThread)
  private
    Done: Boolean;
    DecompressStream: TPowerArcDecompressStream;
  protected
    procedure Execute; override;
  end;

{ TDecompressThread }

function ReadDecompressFunc(Data: Pointer; var Buffer; Size: integer): integer; stdcall;
begin
  Result:=TPowerArcDecompressStream(Data).Base.Read(Buffer,Size);
end;

function WriteDecompressFunc(Data: Pointer; const Buffer; Size: integer): integer; stdcall;
begin
  if not Windows.WriteFile(TPowerArcDecompressStream(Data).hWritePipe,Buffer,Size,DWORD(Result),nil) then
    Result:=-1;
end;

procedure TDecompressThread.Execute;
begin
  try
   PowerArcModules[DecompressStream.ArcIdx].Decompress(DecompressStream,
     ReadDecompressFunc,WriteDecompressFunc);
  except
  end;
  CloseHandle(DecompressStream.hWritePipe);
  Done:=True;
end;

{ TPowerArcDecompressStream }

constructor TPowerArcDecompressStream.Create(BaseStream: TStream);
var ModuleID: packed array[0..7] of Char;
    j: integer;
begin
  inherited Create;
  Base:=BaseStream;
  Thread:=nil;
  FOnProgress:=nil;
  TotalReaded:=0;
  if Base.Read(ModuleID[0],8) = 8 then
    for j:=0 to Length(PowerArcModules)-1 do
      if PowerArcModules[j].Info^.ModuleID = ModuleID then begin
        if j = iPowerBZIP then begin
          BZDecompressionStream:=TBZDecompressionStream.Create(Base);
          BZDecompressionStream.OnProgress:=DoProgress;
        end else
          BZDecompressionStream:=nil;
        ArcIdx:=j;
        Exit;
      end;
  raise EPowerArcError.Create('Invalid acrhive index');
end;

destructor TPowerArcDecompressStream.Destroy;
begin
  if Thread <> nil then begin
    CloseHandle(hReadPipe);
    while not TDecompressThread(Thread).Done do Sleep(0);
    Thread.Free;
  end;
  if BZDecompressionStream <> nil then
    BZDecompressionStream.Free;
  inherited;
end;

procedure TPowerArcDecompressStream.DoProgress(Current: integer);
begin
  if Assigned(FOnProgress) then FOnProgress(Current);
end;

function TPowerArcDecompressStream.Read(var Buffer;
  Count: Integer): Longint;
var Ret: Boolean;
    ActualRead: DWORD;
    P: PChar;
begin
  if ArcIdx = iPowerBZIP then
    Result:=BZDecompressionStream.Read(Buffer,Count)
  else if Count > 0 then begin
    if Thread = nil then begin
      CreatePipe(hReadPipe,hWritePipe,nil,PipeSize);
      Thread:=TDecompressThread.Create(True);
      TDecompressThread(Thread).DecompressStream:=Self;
      TDecompressThread(Thread).Done:=False;
      Thread.FreeOnTerminate:=False;
      Thread.Resume;
    end;
    Result:=0;
    P:=PChar(@Buffer);
    while Count > 0 do begin
      Ret:=Windows.ReadFile(hReadPipe,P^,Count,ActualRead,nil);
      if not Ret or (Ret and (ActualRead = 0)) then begin
        if Result = 0 then Result:=-1;
        Break;
      end;
      Dec(Count,ActualRead);
      Inc(Result,ActualRead);
      Inc(P,ActualRead);
      Sleep(0);
    end;
  end else
    Result:=0;
  if Result > 0 then begin
    Inc(TotalReaded,Result);
    if ArcIdx <> iPowerBZIP then
      DoProgress(TotalReaded);
  end;
end;

function TPowerArcDecompressStream.Seek(Offset: Integer;
  Origin: Word): Longint;
begin
  if (Offset = 0) and (Origin = soFromCurrent) then
    Result := TotalReaded
  else
    raise EPowerArcError.Create('Invalid stream operation');
end;

function TPowerArcDecompressStream.Write(const Buffer;
  Count: Integer): Longint;
begin
  raise EPowerArcError.Create('Invalid stream operation');
end;

// register default compression engine
procedure RegisterBZIP;
var POpt: PChar;
begin
  SetLength(PowerArcModules,1);
  with PowerArcModules[iPowerBZIP] do begin
    Name:='';
    hLib:=0;
    Info:=BZGetPowerArcModuleInfo;
    Options:=TStringList.Create;
    POpt:=Info^.Options;
    while POpt^ <> #0 do begin
      Options.Add(POpt);
      POpt:=POpt+StrLen(POpt)+1;
    end;
    SetOptions:=nil;
    Compress:=nil;
    CompressMem:=nil;
    Decompress:=nil;
  end;
end;

{ TCallbackObj }

initialization
  RegisterBZIP;
  iPowerRANK:=PowerArcRegisterModule('PowerRANK.dll');
  iPowerZIP:=PowerArcRegisterModule('PowerZIP.dll');
  iPowerPPM:=PowerArcRegisterModule('PowerPPM.dll');
finalization
  PowerArcUnregisterModules;
end.