Common function libraries of object Sequences

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;
ype: 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 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;
quit T
exit;
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;
quit T
exit;
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, ype, 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;
else t
exit;
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;
else t
exit;
end;

procedure varianttoparameters (input: olevariant; par: tparameters);
// tparameters's property: name, ype, 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;
quit T
exit;
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;
else t
exit;
end;

Initialization
G_downstream: = tmemorystream. Create;
Finalization
Freeandnil (g_downstream );

End.