对象序列的公共函数库

unit uFun;

interface

uses
  SysUtils, Variants, db, adodb, Classes, EncdDecd;

function ParametersToVariant(par:TParameters): OleVariant;
procedure VariantToParameters(input:OleVariant;par:TParameters);
function ParamsToVariant(par:TParams): OleVariant;
procedure VariantToParams(input:OleVariant;par:TParams);
procedure AddParameter(Params: TParameters; const ParamName: string;
  DataType: TFieldType; Value: OleVariant);
procedure AddParam(Params: TParams; const ParamName: string;
  DataType: TFieldType; Value: OleVariant);
procedure VariantToStream (const V: OLEVariant; Stream: TStream);
procedure StreamToVariant (Stream : TStream; var V: OLEVariant);
function CompressData(V: OleVariant): OleVariant;
function DeCompressData(V: OleVariant): OleVariant;
function Decrypt(Src: string; Key: string): string;
function Encrypt(Src: string; Key: string): string;
function CompressStrToBase64(sStr: string): string;
function DeCompressBase64ToStr(sStr: string): string;

var
  g_DownStream: TMemoryStream;
const
  cPasswordKey='cxg';

implementation

uses ZLibEx;

function CompressStrToBase64(sStr: string): string;
var
  M1: TMemoryStream;
  M0, M2: TStringStream;
begin
  Result := '';
  if sStr = '' then
    Exit;
  M0 := TStringStream.Create(sStr);
  M1 := TMemoryStream.Create;
  M2 := TStringStream.Create(' ');
  try
    M0.Position := 0;
    M1.Position := 0;
    ZCompressStream(M0, M1);
    M1.Position := 0;
    M2.Position := 0;
    EncodeStream(M1, M2);
    Result := M2.DataString;
  finally
    FreeAndNil(M0);
    FreeAndNil(M1);
    FreeAndNil(M2);
  end;
end;

function DeCompressBase64ToStr(sStr: string): string;
var
  M0, M1: TStringStream;
  M2: TMemoryStream;
begin
  Result := '';
  if sStr = '' then
    Exit;
  M0 := TStringStream.Create('');
  M1 := TStringStream.Create(sStr);
  M2 := TMemoryStream.Create;
  try
    M1.Position := 0;
    M2.Position := 0;
    DeCodeStream(M1, M2);
    M0.Position := 0;
    M2.Position := 0;
    ZDecompressStream(M2, M0);
    Result := M0.DataString;
  finally
    FreeAndNil(M0);
    FreeAndNil(M2);
    FreeAndNil(M1);
  end;
end;

function Decrypt(Src: string; Key: string): string;
var
  KeyLen, KeyPos, Offset, SrcPos, SrcAsc, TmpSrcAsc: Integer;
  Dest: string;
begin
  KeyLen := Length(Key);
  if KeyLen = 0 then
    Key := cPasswordKey;
  KeyPos := 0;
  Offset := StrToInt('$' + Copy(Src, 1, 2));
  SrcPos := 3;
  while SrcPos < Length(Src) do
  begin
    SrcAsc := StrToInt('$' + Copy(Src, SrcPos, 2));
    if KeyPos < KeyLen then
      KeyPos := KeyPos + 1
     else
      KeyPos := 1;
    TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
    if TmpSrcAsc <= Offset then
      TmpSrcAsc := 255 + TmpSrcAsc - Offset
    else
      TmpSrcAsc := TmpSrcAsc - Offset;
    Dest := Dest + Chr(TmpSrcAsc);
    Offset := SrcAsc;
    SrcPos := SrcPos + 2;
  end;
  Result := Dest;
end;

function Encrypt(Src: string; Key: string): string;
var
  KeyLen, KeyPos, Offset, SrcPos, SrcAsc: Integer;
  Dest: string;
begin
  KeyLen := Length(Key);
  if KeyLen = 0 then
    Key := cPasswordKey;
  KeyPos := 0;
  Randomize;
  Offset := Random(256);
  Dest := Format('%1.2x', [Offset]);
  for SrcPos := 1 to Length(Src) do
  begin
    SrcAsc := (Ord(Src[SrcPos]) + Offset) mod 255;
    if KeyPos < KeyLen then
      KeyPos:= KeyPos + 1
    else
      KeyPos:=1;
    SrcAsc := SrcAsc xor Ord(Key[KeyPos]);
    Dest := Dest + Format('%1.2x', [SrcAsc]);
    Offset := SrcAsc;
  end;
  Result := Dest;
end;

function DeCompressData(V: OleVariant): OleVariant;
var
  M, M0: TMemoryStream;
begin
  try
    M := TMemoryStream.Create;
    M0 := TMemoryStream.Create;
    try
      if V = Null then exit;
      VariantToStream(V,M);
      M.Position := 0;
      ZDeCompressStream(M, M0);
      StreamToVariant(M0, V);     
    finally
      M.Free;
      M0.Free
    end;
    Result := V;
  except
    Exit;
  end;
end;

function CompressData(V: OleVariant): OleVariant;
var
  M, M0: TMemoryStream;
begin
  try
    M := TMemoryStream.Create;
    M0 := TMemoryStream.Create;
    try
      if V = Null then exit;
      VariantToStream(V,M);
      M.Position := 0;
      ZCompressStream(M, M0);
      StreamToVariant(M0, V);
    finally
      M.Free;
      M0.Free
    end;
    Result := V;
  except
    Exit;
  end;
end;

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

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

procedure AddParam(Params: TParams; const ParamName: string;
  DataType: TFieldType; Value: OleVariant);
// only for client load
var
  p: TParam;
begin
  try
    p := Params.CreateParam(DataType, ParamName, ptInput);
    p.Value := Value;
    p.Size := SizeOf(Value);
  except
    exit;
  end;
end;

procedure AddParameter(Params: TParameters; const ParamName: string;
  DataType: TFieldType; Value: OleVariant);
// only for client load
begin
  try
    Params.CreateParameter(ParamName, DataType, pdInput, SizeOf(Value), Value);
  except
    exit;
  end;
end;

procedure VariantToParams(input:OleVariant;par:TParams);
// TParam 's property: fieldType, paramName, ParamType, value, size
// paramType default value ptinput
// size = sizeof(value)
var
  n, i:integer;
begin
  try
    n:=0;
    i:=0;
    par.Clear;
    while VarArrayHighBound(input,1)>=(n+3)do
    begin
      par.CreateParam(TFieldType(input[n+1]),input[n+2],ptInput);
      par.Items[i].Value := input[n+3];
      par.Items[i].Size :=SizeOf(input[n+3]);
      n:=n+3;
      i:=i+1;
    end;
  except
    Exit;
  end;
end;

function ParamsToVariant(par:TParams): OleVariant;
// TParam 's property: fieldType, paramName, ParamType, value, size
// paramType default value ptinput
// size = sizeof(value)
var
  tmpv:OleVariant;
  n,i:integer;
begin
  try
    tmpv:=VarArrayCreate([1,par.Count*3],VarVariant);
    n:=0;
    i:=0;
    while par.Count>i do
    begin
      tmpv[n+1]:=Ord(par.Items[i].DataType);    
      tmpv[n+2]:=par.Items[i].Name;
      tmpv[n+3]:=par.Items[i].Value;
      i:=i+1;
      n:=n+3;
    end;
    result:=tmpv;
  except
    Exit;
  end;
end;

procedure VariantToParameters(input:OleVariant;par:TParameters);
// TParameters's property: name, dataType, Direction, size, value
// direction default pdinput
// size = sizeof(value)
var
  n:integer;
begin
  try
    n:=0;
    par.Clear;
    while VarArrayHighBound(input,1)>=(n+3)do
    begin
      par.CreateParameter(input[n+1],tfieldtype(input[n+2]),pdInput,SizeOf(input[n+3]),input[n+3]);
      n:=n+3;
    end;
  Except
    Exit;
  end;
end;

function ParametersToVariant(par:TParameters): OleVariant;
// TParameters's property: name, dataType, Direction, size, value
// direction default pdinput
// size = sizeof(value)
var
  tmpv:OleVariant;
  n,i:integer;
begin
  try
    tmpv:=VarArrayCreate([1,par.Count*3],VarVariant);
    n:=0;
    i:=0;
    while par.Count>i do
    begin
      tmpv[n+1]:=par.Items[i].Name;
      tmpv[n+2]:=Ord(par.Items[i].DataType);
      tmpv[n+3]:=par.Items[i].Value;
      i:=i+1;
      n:=n+3;
    end;
    result:=tmpv;
  except
    exit;
  end;
end;

initialization
  g_DownStream := TMemoryStream.Create;
finalization
  FreeAndNil(g_DownStream);

end.