Delphi 通用压缩单元


本文整理自网络,侵删。

 /// <author>cxg 2020-7-7</author>
/// 支持跨os,支持d7及以上版本
unit zip;
 
interface
 
{$if CompilerVersion>= 21}  //d2010
  {$define NEWZLib}
{$IFEND}
 
uses
  Classes, Zlib, SysUtils;
 
type
{$if CompilerVersion< 18.5}  //d2007
  TBytes = array of Byte;
{$IFEND}
 
  TZip = class(TObject)
  public
    /// <summary>
    ///   解压
    /// </summary>
    class procedure UnZipStream(const InStream, OutStream: TStream);
    class procedure UnZipBytes(const inbytes: TBytes; outbytes: TBytes);
    class procedure UnZipBuf(const inbuf: Pointer; insize: Integer; outbuf: Pointer; outsize: Integer);
    /// <summary>
    ///   压缩
    /// </summary>
    class procedure ZipStream(const InStream, OutStream: TStream);
    class procedure ZipBytes(const inbytes: TBytes; outbytes: TBytes);
    class procedure ZipBuf(const inbuf: Pointer; insize: Integer; outbuf: Pointer; outsize: Integer);
    class function verifyData(const buf; len: Cardinal): Cardinal;
    class function verifyStream(Stream: TStream; len: Cardinal): Cardinal;
  end;
 
implementation
 
class procedure TZip.UnZipBuf(const inbuf: Pointer; insize: Integer; outbuf: Pointer; outsize: Integer);
begin
  {$IFDEF POSIX}
  ZLib.ZDecompress(inbuf, insize, outbuf, outsize);
  {$ELSE}
  {$if defined(NEWZLib)}
  ZLib.ZDecompress(inbuf, insize, outbuf, outsize);
  {$ELSE}
  Zlib.DecompressBuf(inbuf, insize, 0, outbuf, outsize);
  {$ifend}
  {$ENDIF}
end;
 
class procedure TZip.UnZipBytes(const inbytes: TBytes; outbytes: TBytes);
{$if not defined(NEWZLib)}
var
  InSize, OutSize: Integer;
  OutBuf: Pointer;
{$ifend}
begin
  {$IFDEF POSIX}
  ZLib.ZDecompress(inbytes, outbytes);
  {$ELSE}
  {$if defined(NEWZLib)}
  ZLib.ZDecompress(inbytes, outbytes);
  {$ELSE}
  InSize := Length(inbytes);
  Zlib.DecompressBuf(@inbytes[0], InSize, 0, OutBuf, OutSize);
  Move(OutBuf^, outbytes[0], OutSize);
  FreeMem(OutBuf, OutSize);
  {$ifend}
  {$ENDIF}
end;
 
class procedure TZip.UnZipStream(const InStream, OutStream: TStream);
var
  l: Integer;
 
{$IFDEF POSIX}
var
  inBytes, OutBytes: TBytes;
{$ELSE}
var
  inBytes: TBytes;
  OutBuf: Pointer;
  Outsize: Integer;
{$ENDIF}
begin
  if InStream = nil then
    exit;
  l := InStream.Size;
  if l = 0 then
    Exit;
  {$IFDEF POSIX}
  SetLength(inBytes, l);
  InStream.Position := 0;
  InStream.Read(inBytes[0], InStream.Size);
  ZLib.ZDecompress(inBytes, OutBytes);
  OutStream.Size := Length(OutBytes);
  OutStream.Position := 0;
  OutStream.Write(OutBytes[0], Length(OutBytes));
  {$ELSE}
  setLength(inBytes, l);
  InStream.Position := 0;
  InStream.ReadBuffer(inBytes[0], l);
  {$if defined(NEWZLib)}
  ZLib.ZDecompress(@inBytes[0], l, OutBuf, Outsize);
  {$ELSE}
  Zlib.DecompressBuf(@inBytes[0], l, 0, OutBuf, Outsize);
  {$ifend}
  try
    OutStream.Size := Outsize;
    OutStream.Position := 0;
    OutStream.WriteBuffer(OutBuf^, Outsize);
  finally
    FreeMem(OutBuf, Outsize);
  end;
  {$ENDIF}
end;
 
class function TZip.verifyData(const buf; len: Cardinal): Cardinal;
var
  i: Cardinal;
  p: PByte;
begin
  i := 0;
  Result := 0;
  p := PByte(@buf);
  while i < len do
  begin
    Result := Result + p^;
    Inc(p);
    Inc(i);
  end;
end;
 
class function TZip.verifyStream(Stream: TStream; len: Cardinal): Cardinal;
var
  l, j: Cardinal;
  lvBytes: TBytes;
begin
  SetLength(lvBytes, 1024);
 
  if len = 0 then
  begin
    j := Stream.Size - Stream.Position;
  end
  else
  begin
    j := len;
  end;
 
  Result := 0;
 
  while j > 0 do
  begin
    if j < 1024 then
      l := j
    else
      l := 1024;
 
    Stream.ReadBuffer(lvBytes[0], l);
 
    Result := Result + verifyData(lvBytes[0], l);
    Dec(j, l);
  end;
end;
 
class procedure TZip.ZipBuf(const inbuf: Pointer; insize: Integer; outbuf: Pointer; outsize: Integer);
begin
  {$IFDEF POSIX}
  ZLib.ZCompress(inbuf, insize, outbuf, outsize);
  {$ELSE}
  {$if defined(NEWZLib)}
  ZLib.ZCompress(inbuf, insize, outbuf, outsize);
  {$ELSE}
  ZLib.CompressBuf(@inbytes[0], insize, outbuf, outsize);
  {$ifend}
  {$ENDIF}
end;
 
class procedure TZip.ZipBytes(const inbytes: TBytes; outbytes: TBytes);
{$if not defined(NEWZLib)}
var
  insize, outsize: integer;
  OutBuf: Pointer;
{$ifend}
begin
  {$IFDEF POSIX}
  ZLib.ZCompress(inbytes, outbytes);
  {$ELSE}
  {$if defined(NEWZLib)}
  ZLib.ZCompress(inbytes, outbytes);
  {$ELSE}
  insize := Length(inbytes);
  ZLib.CompressBuf(@inbytes[0], insize, OutBuf, outsize);
  Move(OutBuf^, outbytes[0], outsize);
  FreeMem(OutBuf, outsize);
  {$ifend}
  {$ENDIF}
end;
 
class procedure TZip.ZipStream(const InStream, OutStream: TStream);
{$IFDEF POSIX}
var
  inBytes, OutBytes: TBytes;
{$ELSE}
var
  inBytes: TBytes;
  OutBuf: Pointer;
  Outsize: Integer;
{$ENDIF}
var
  l: Integer;
begin
  if InStream = nil then
    exit;
  l := InStream.Size;
  if l = 0 then
    Exit;
  {$IFDEF POSIX}
  SetLength(inBytes, InStream.Size);
  InStream.Position := 0;
  InStream.Read(inBytes[0], InStream.Size);
  ZLib.ZCompress(inBytes, OutBytes);
  OutStream.Size := Length(OutBytes);
  OutStream.Position := 0;
  OutStream.Write(OutBytes[0], Length(OutBytes));
  {$ELSE}
  SetLength(inBytes, l);
  InStream.Position := 0;
  InStream.ReadBuffer(inBytes[0], l);
  {$if defined(NEWZLib)}
  ZLib.ZCompress(@inBytes[0], l, OutBuf, Outsize);
  {$ELSE}
  ZLib.CompressBuf(@inBytes[0], l, OutBuf, Outsize);
  {$ifend}
  try
    OutStream.Size := Outsize;
    OutStream.Position := 0;
    OutStream.WriteBuffer(OutBuf^, Outsize);
  finally
    FreeMem(OutBuf, Outsize);
  end;
  {$ENDIF}
end;
 

end.

 

https://www.cnblogs.com/hnxxcxg/p/13264771.html

相关阅读 >>

Delphi tstringlist 排序 customsort

Delphi 用firedac处理sqlite的日期型

Delphi 倒计时源码

Delphi 中的颜色

Delphi topendialog设置多个过滤条件

Delphi判断电脑是否安装了excel

Delphi 获取按键键值

Delphi tthread中文注释

Delphi validatename 过滤特殊字符

Delphi(更改图标)

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...