Common function libraries of object Sequences

Source: Internet
Author: User

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.

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.