首页 > 其他分享 >sys.zlib.pas

sys.zlib.pas

时间:2025-01-10 16:13:04浏览次数:1  
标签:function pas end val Stream zlib zipStream sys TStream

sys.zlib.pas

unit sys.zlib;

// cxg 2025-1-10 fit(fpc+delphi)
interface

uses
{$IFDEF fpc}
  ZStream,
{$else}
  zlib,
{$endif}
Variants, SysUtils, Classes;

function CompressVariant(V: OleVariant): OleVariant;
function CompressStream(val: TStream): TStream;
function CompressBytes(val: TBytes): TBytes;

function DeCompressVariant(V: OleVariant): OleVariant;
function DeCompressStream(val: TStream): TStream;
function DeCompressBytes(val: TBytes): TBytes;

implementation

procedure StreamToVariant(Stream: TStream; var V: OleVariant);
var
  P: Pointer;
begin
  V := VarArrayCreate([0, Stream.Size - 1], varByte);
  P := VarArrayLock(V);
  try
    Stream.Position := 0;
    Stream.Read(P^, Stream.Size);
  finally
    VarArrayUnlock(V);
  end;
end;

procedure VariantToStream(const V: OleVariant; Stream: TStream);
var
  P: Pointer;
begin
  Stream.Position := 0;
  Stream.Size := VarArrayHighBound(V, 1) - VarArrayLowBound(V, 1) + 1;
  P := VarArrayLock(V);
  try
    Stream.Write(P^, Stream.Size);
  finally
    VarArrayUnlock(V);
  end;
  Stream.Position := 0;
end;

function CompressBytes(val: TBytes): TBytes;
var
  zipStream: TCompressionStream;
  Stream: TBytesStream;
begin
  Stream := TBytesStream.Create(val);
  try
    zipStream := TCompressionStream.Create(cldefault, Stream);
    try
      SetLength(Result, zipStream.Size);
      zipStream.Position := 0;
      zipStream.Read(PByte(Result)^, zipStream.Size);
    finally
      zipStream.Free;
    end;
  finally
    Stream.Free;
  end;
end;

function CompressStream(val: TStream): TStream;
begin
  Result := TCompressionStream.Create(cldefault, val);
end;

function CompressVariant(V: OleVariant): OleVariant;
var
  zipStream: TCompressionStream;
  Stream: TStream;
begin
  Stream := TMemoryStream.Create;
  try
    VariantToStream(V, Stream);
    zipStream := TCompressionStream.Create(cldefault, Stream);
    try
      StreamToVariant(zipStream, Result);
    finally
      zipStream.Free;
    end;
  finally
    Stream.Free;
  end;
end;

function DeCompressBytes(val: TBytes): TBytes;
var
  Stream: TBytesStream;
  zipStream: TDecompressionStream;
begin
  Stream := TBytesStream.Create(val);
  try
    zipStream := TDecompressionStream.Create(Stream);
    try
      SetLength(Result, zipStream.Size);
      zipStream.Position := 0;
      zipStream.Read(PByte(val)^, zipStream.Size);
    finally
      zipStream.Free;
    end;
  finally
    Stream.Free;
  end;
end;

function DeCompressStream(val: TStream): TStream;
begin
  Result := TDecompressionStream.Create(val);
end;

function DeCompressVariant(V: OleVariant): OleVariant;
var
  zipStream: TDecompressionStream;
  Stream: TStream;
begin
  Stream := TMemoryStream.Create;
  try
    VariantToStream(V, Stream);
    zipStream := TDecompressionStream.Create(Stream);
    try
      StreamToVariant(zipStream, Result);
    finally
      zipStream.Free;
    end;
  finally
    Stream.Free;
  end;
end;

end.

 

标签:function,pas,end,val,Stream,zlib,zipStream,sys,TStream
From: https://www.cnblogs.com/hnxxcxg/p/18664141

相关文章

  • WWW‘24:Collaborative Large Language Model for Recommender Systems文献阅读
    摘要本文介绍了一种新型的基于协同大型语言模型(CLLM4Rec)的推荐系统,该系统将传统的基于ID的推荐系统范式与基于大型语言模型(LLM)的范式相结合,旨在解决自然语言与推荐任务之间语义差异的问题。通过引入用户/项目ID标记和创新的软+硬提示策略,CLLM4Rec能够有效地学习用户和项目的协......
  • 【PaddleOCR 踩坑记录】FatalError: `Illegal instruction` is detected by the opera
    背景需要使用GPU版的PaddleOCR安装步骤如下:参考官方文档condacreate--nameocrcondaactivateocrpipinstallpaddlepaddle-gpupipinstallpaddleocr问题出现报错如下:(ocr)user@user:~/Desktop/ocr$paddleocr--image_dir./imgs/11.jpg--use_angle_cls......
  • Windows 11 Hyper-V 运行WSL2(Windows Subsystem for Linux ) openEuler 从 22.09升级24
    版本  Windows11专业版版本号  22H2安装日期  ‎2023/‎3/‎19操作系统版本  22621.4387体验  WindowsFeatureExperiencePack1000.22700.1047.0-[archives.openeuler.openatom.cn/openEuler-22.09/everything/x86\_64/](https://archives.openeuler.o......
  • python画大的pass与fail logo(带颜色)
    print("\033[32m"+4*""+9*"x"+10*""+1*"x"+11*""+7*"x"+5*""+7*"x"+4*""+"\033[0m")print("\033[32m"+4*""+2*"x"......
  • 改造应用从容器tomcat迁移到pas(信创容器中间件)的适配工作
    背景近年来由于信创要求的重视,软件国产化越来越要提上日程了,相信在相关行业的人已经有很多开始在准备信创相关适配改造工作了吧我们公司也一样,经过2个月的研究终于算是把我们的主要产品改造成功,下面我就介绍下:我们无源代码的tomcat容器应用如何迁移到普元Pas正文由于不方面说......
  • 在Lazarus下的Free Pascal编程教程——打造有智能感知的用户设置操作界面
    0.前言我想通过编写一个完整的游戏程序方式引导读者体验程序设计的全过程。我将采用多种方式编写具有相同效果的应用程序,并通过不同方式形成的代码和实现方法的对比来理解程序开发更深层的知识。了解我编写教程的思路,请参阅体现我最初想法的那篇文章中的“1.编程计划”和“2.已经......
  • C# System.Threading.Timer 与 System.Timers.Timer 的一点点区别
    先说一下结论:差不多。我目前明显感受到的唯一的差别是,Timers.Timer的启动时,先要等一个interval时间,才触发Timers.Timer.ElapsedEventHandler。而Threading.Timer,可以做到先触发它的TimedCallback,再等一个period时间(类似Timers.Timer的interval),再触发下一次TimedCall......
  • cgroup与systemd: 通过src rpm获取systemd源代码,添加日志并使用rpmbuild重新打包
    问题起源服务跑在富容器中。容器使用init进程作为一号进程,然后用systemd管理所有service。在做一次升级时,nginx启动脚本有更新,原来是root拉起,现在进行了去root改造,使用nginx用户拉起。升级过程中,发现nginx进程无法被拉起,报错:"RefusingtoacceptPIDoutsideofservicecon......
  • sys.base64.pas
    sys.base64.pasunitsys.base64;//cxg2025-1-9fit(delphi+fpc)interfaceuses{$ifndeffpc}System.NetEncoding,{$else}base64,{$endif}SysUtils,Classes;functionbase64Encode(constval:string):string;overload;functionbase64Encode(co......
  • .net core 在Liunx 使用System.Drawing.Common 出现Gdip问题
    问题:当我们使用画图之类的功能可能会引用System.Drawing.Common,或者间接引用它,由于它是依赖Windows系统,所以我们在Windows是正常的,放在Linux就会出现类似于下面这种错误System.TypeInitializationException:Thetypeinitializerfor'Gdip'threwanexception.--->S......