pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Release 13

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@29 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby
2008-04-23 20:49:43 +00:00
parent 0653015f1b
commit e9e1d8f75a
8 changed files with 460 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

59
asn1util.pas
View File

@@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.001.000 |
| Project : Delphree - Synapse | 001.002.000 |
|==============================================================================|
| Content: support for ASN.1 coding and decoding |
|==============================================================================|
@@ -42,12 +42,14 @@ const
ASN1_COUNTER = $41;
ASN1_GAUGE = $42;
ASN1_TIMETICKS = $43;
ASN1_OPAQUE = $44;
function ASNEncOIDitem(Value: integer): string;
function ASNDecOIDitem(var Start: integer; Buffer: string): integer;
function ASNEncLen(Len: integer): string;
function ASNDecLen(var Start: integer; Buffer: string): integer;
function ASNEncInt(Value: integer): string;
function ASNEncUInt(Value: integer): string;
function ASNObject(Data: string; ASNType: integer): string;
function ASNItem(var Start: integer; Buffer: string; var ValueType:integer): string;
@@ -135,15 +137,40 @@ end;
function ASNEncInt(Value: integer): string;
var
x,y:integer;
x,y:cardinal;
neg:boolean;
begin
x:=Value;
neg:=value<0;
x:=abs(Value);
if neg then
x:=not (x-1);
result:='';
repeat
y:=x mod 256;
x:=x div 256;
result:=char(y)+result;
until x=0;
if (not neg) and (result[1]>#$7F)
then result:=#0+result;
end;
function ASNEncUInt(Value: integer): string;
var
x,y:integer;
neg:boolean;
begin
neg:=value<0;
x:=Value;
if neg
then x:=x and $7FFFFFFF;
result:='';
repeat
y:=x mod 256;
x:=x div 256;
result:=char(y)+result;
until x=0;
if neg
then result[1]:=char(ord(result[1]) or $80);
end;
function ASNObject(Data: string; ASNType: integer): string;
@@ -155,9 +182,11 @@ function ASNItem(var Start: integer; Buffer: string; var ValueType:integer): str
var
ASNType: integer;
ASNSize: integer;
y, n: integer;
y,n: integer;
x: byte;
s: string;
c: char;
neg: boolean;
begin
ASNType := Ord(Buffer[Start]);
Valuetype:=ASNType;
@@ -170,7 +199,25 @@ begin
end
else
case ASNType of
ASN1_INT, ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
ASN1_INT:
begin
y := 0;
neg:=false;
for n := 1 to ASNSize do
begin
x:=Ord(Buffer[Start]);
if (n=1) and (x>$7F)
then neg:=true;
if neg
then x:=not x;
y := y * 256 + x;
Inc(Start);
end;
if neg
then y:=-(y+1);
Result := IntToStr(y);
end;
ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
begin
y := 0;
for n := 1 to ASNSize do
@@ -180,7 +227,7 @@ begin
end;
Result := IntToStr(y);
end;
ASN1_OCTSTR, $44:
ASN1_OCTSTR, ASN1_OPAQUE:
begin
for n := 1 to ASNSize do
begin

37
mimechar.pas
View File

@@ -1,8 +1,7 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.000 |
| Project : Delphree - Synapse | 001.001.000 |
|==============================================================================|
| Content: MIME support character conversion tables
|
| Content: MIME support character conversion tables |
|==============================================================================|
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
| (the "License"); you may not use this file except in compliance with the |
@@ -49,7 +48,8 @@ TMimeChar=(
CP1255,
CP1256,
CP1257,
CP1258
CP1258,
KOI8_R
);
TSetChar=set of TMimeChar;
@@ -510,6 +510,28 @@ Lappish, Latvian, Lithuanian, Norwegian and Swedish.
$00f8, $00f9, $00fa, $00fb, $00fc, $01b0, $20ab, $00ff
);
{Cyrillic
}
CharKOI8_R:array [128..255] of word =
(
$2500, $2502, $250c, $2510, $2514, $2518, $251c, $2524,
$252c, $2534, $253c, $2580, $2584, $2588, $258c, $2590,
$2591, $2592, $2593, $2320, $25a0, $2219, $221a, $2248,
$2264, $2265, $00a0, $2321, $00b0, $00b2, $00b7, $00f7,
$2550, $2551, $2552, $0451, $2553, $2554, $2555, $2556,
$2557, $2558, $2559, $255a, $255b, $255c, $255d, $255e,
$255f, $2560, $2561, $0401, $2562, $2563, $2564, $2565,
$2566, $2567, $2568, $2569, $256a, $256b, $256c, $00a9,
$044e, $0430, $0431, $0446, $0434, $0435, $0444, $0433,
$0445, $0438, $0439, $043a, $043b, $043c, $043d, $043e,
$043f, $044f, $0440, $0441, $0442, $0443, $0436, $0432,
$044c, $044b, $0437, $0448, $044d, $0449, $0447, $044a,
$042e, $0410, $0411, $0426, $0414, $0415, $0424, $0413,
$0425, $0418, $0419, $041a, $041b, $041c, $041d, $041e,
$041f, $042f, $0420, $0421, $0422, $0423, $0416, $0412,
$042c, $042b, $0417, $0428, $042d, $0429, $0427, $042a
);
{==============================================================================}
Function DecodeChar(value:string;CharFrom:TMimeChar;CharTo:TMimeChar):string;
Function GetCurCP:TMimeChar;
@@ -556,6 +578,7 @@ begin
CP1256: CopyArray(CharCP_1256,Result);
CP1257: CopyArray(CharCP_1257,Result);
CP1258: CopyArray(CharCP_1258,Result);
KOI8_R: CopyArray(CharKOI8_R,Result);
end;
end;
@@ -714,6 +737,11 @@ begin
Result:=CP1258;
exit;
end;
if Pos('KOI8-R',value)=1 then
begin
Result:=KOI8_R;
exit;
end;
end;
{==============================================================================}
@@ -738,6 +766,7 @@ begin
CP1256 : result:='WINDOWS-1256';
CP1257 : result:='WINDOWS-1257';
CP1258 : result:='WINDOWS-1258';
KOI8_R : result:='KOI8-R';
else result:='ISO-8859-1';
end;
end;

18
mimepart.pas
View File

@@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.000 |
| Project : Delphree - Synapse | 001.000.001 |
|==============================================================================|
| Content: MIME support procedures and functions |
|==============================================================================|
@@ -188,6 +188,7 @@ var
s,su,b:string;
st,st2:string;
e:boolean;
fn:string;
begin
t:=tstringlist.create;
try
@@ -200,6 +201,7 @@ begin
FileName:='';
encoding:='7BIT';
fn:='';
x:=beginline;
b:=boundary;
if b<>'' then
@@ -225,6 +227,8 @@ begin
st2:=separateleft(st,';');
primary:=separateleft(st2,'/');
secondary:=separateright(st2,'/');
if (secondary=primary) and (pos('/',st2)<1)
then secondary:='';
case primarycode of
MP_TEXT:
begin
@@ -239,7 +243,7 @@ begin
end;
MP_BINARY:
begin
filename:=getparameter(s,'filename=');
filename:=getparameter(s,'name=');
end;
end;
end;
@@ -251,8 +255,15 @@ begin
begin
description:=separateright(s,':');
end;
if pos('CONTENT-DISPOSITION:',su)=1 then
begin
fn:=getparameter(s,'filename=');
end;
end;
if (primarycode=MP_BINARY) and (filename='')
then filename:=fn;
x1:=x;
x2:=value.count-1;
if b<>'' then
@@ -340,7 +351,8 @@ begin
if s[length(s)]<>'='
then s:=s+CRLF;
s:=DecodeQuotedPrintable(s);
s:=decodeChar(s,CharsetCode,TargetCharset);
if PrimaryCode=MP_TEXT
then s:=decodeChar(s,CharsetCode,TargetCharset);
end;
ME_BASE64:
begin

1
pingsend.pas
View File

@@ -112,7 +112,6 @@ var
PIPHeader:^TIPHeader;
IpHdrLen:Integer;
PIcmpEchoHeader:^TICMPEchoHeader;
data:string;
n,x:integer;
begin
Result:=False;

11
snmpsend.pas
View File

@@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.001.000 |
| Project : Delphree - Synapse | 002.002.000 |
|==============================================================================|
| Content: SNMP client |
|==============================================================================|
@@ -101,6 +101,7 @@ constructor TSNMPRec.Create;
begin
inherited create;
SNMPMibList := TList.create;
id:=1;
end;
{TSNMPRec.Destroy}
@@ -148,11 +149,16 @@ begin
begin
SNMPMib := SNMPMibList[n];
case (SNMPMib.ValueType) of
ASN1_INT, ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
ASN1_INT:
begin
s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID)
+ASNObject(ASNEncInt(strToIntDef(SNMPMib.Value,0)),SNMPMib.ValueType);
end;
ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
begin
s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID)
+ASNObject(ASNEncUInt(strToIntDef(SNMPMib.Value,0)),SNMPMib.ValueType);
end;
ASN1_OBJID:
begin
s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID) + ASNObject(MibToID(SNMPMib.Value),SNMPMib.ValueType);
@@ -190,7 +196,6 @@ begin
version:=0;
community:='';
PDUType:=0;
ID:=0;
ErrorStatus:=0;
ErrorIndex:=0;
for i := 0 to SNMPMibList.count - 1 do

9
snmptrap.pas
View File

@@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.000.001 |
| Project : Delphree - Synapse | 002.001.000 |
|==============================================================================|
| Content: SNMP traps |
|==============================================================================|
@@ -163,11 +163,16 @@ begin
begin
SNMPMib := SNMPMibList[n];
case (SNMPMib.ValueType) of
ASN1_INT, ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
ASN1_INT:
begin
s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID)
+ASNObject(ASNEncInt(strToIntDef(SNMPMib.Value,0)),SNMPMib.ValueType);
end;
ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
begin
s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID)
+ASNObject(ASNEncUInt(strToIntDef(SNMPMib.Value,0)),SNMPMib.ValueType);
end;
ASN1_OBJID:
begin
s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID) + ASNObject(MibToID(SNMPMib.Value),SNMPMib.ValueType);

331
synacode.pas
View File

@@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.000 |
| Project : Delphree - Synapse | 001.001.000 |
|==============================================================================|
| Content: Coding and decoding support |
|==============================================================================|
@@ -42,11 +42,95 @@ const
'+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
}
Crc32Tab: array[0..255] of integer = (
$00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3,
$0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,
$1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
$136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63, $8d080df5,
$3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
$35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
$26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,
$2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d,
$76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
$7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
$6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,
$65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
$4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,
$4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,
$5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
$5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,
$edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683,
$e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
$f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7,
$fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
$d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
$d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79,
$cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f,
$c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
$9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
$95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,
$86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
$88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45,
$a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db,
$aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
$bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf,
$b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
);
Crc16Tab: array[0..255] of word = (
$0000, $1189, $2312, $329b, $4624, $57ad, $6536, $74bf,
$8c48, $9dc1, $af5a, $bed3, $ca6c, $dbe5, $e97e, $f8f7,
$1081, $0108, $3393, $221a, $56a5, $472c, $75b7, $643e,
$9cc9, $8d40, $bfdb, $ae52, $daed, $cb64, $f9ff, $e876,
$2102, $308b, $0210, $1399, $6726, $76af, $4434, $55bd,
$ad4a, $bcc3, $8e58, $9fd1, $eb6e, $fae7, $c87c, $d9f5,
$3183, $200a, $1291, $0318, $77a7, $662e, $54b5, $453c,
$bdcb, $ac42, $9ed9, $8f50, $fbef, $ea66, $d8fd, $c974,
$4204, $538d, $6116, $709f, $0420, $15a9, $2732, $36bb,
$ce4c, $dfc5, $ed5e, $fcd7, $8868, $99e1, $ab7a, $baf3,
$5285, $430c, $7197, $601e, $14a1, $0528, $37b3, $263a,
$decd, $cf44, $fddf, $ec56, $98e9, $8960, $bbfb, $aa72,
$6306, $728f, $4014, $519d, $2522, $34ab, $0630, $17b9,
$ef4e, $fec7, $cc5c, $ddd5, $a96a, $b8e3, $8a78, $9bf1,
$7387, $620e, $5095, $411c, $35a3, $242a, $16b1, $0738,
$ffcf, $ee46, $dcdd, $cd54, $b9eb, $a862, $9af9, $8b70,
$8408, $9581, $a71a, $b693, $c22c, $d3a5, $e13e, $f0b7,
$0840, $19c9, $2b52, $3adb, $4e64, $5fed, $6d76, $7cff,
$9489, $8500, $b79b, $a612, $d2ad, $c324, $f1bf, $e036,
$18c1, $0948, $3bd3, $2a5a, $5ee5, $4f6c, $7df7, $6c7e,
$a50a, $b483, $8618, $9791, $e32e, $f2a7, $c03c, $d1b5,
$2942, $38cb, $0a50, $1bd9, $6f66, $7eef, $4c74, $5dfd,
$b58b, $a402, $9699, $8710, $f3af, $e226, $d0bd, $c134,
$39c3, $284a, $1ad1, $0b58, $7fe7, $6e6e, $5cf5, $4d7c,
$c60c, $d785, $e51e, $f497, $8028, $91a1, $a33a, $b2b3,
$4a44, $5bcd, $6956, $78df, $0c60, $1de9, $2f72, $3efb,
$d68d, $c704, $f59f, $e416, $90a9, $8120, $b3bb, $a232,
$5ac5, $4b4c, $79d7, $685e, $1ce1, $0d68, $3ff3, $2e7a,
$e70e, $f687, $c41c, $d595, $a12a, $b0a3, $8238, $93b1,
$6b46, $7acf, $4854, $59dd, $2d62, $3ceb, $0e70, $1ff9,
$f78f, $e606, $d49d, $c514, $b1ab, $a022, $92b9, $8330,
$7bc7, $6a4e, $58d5, $495c, $3de3, $2c6a, $1ef1, $0f78
);
type
TMD5Ctx = record
State: array[0..3] of integer;
Count: array[0..1] of integer;
case Integer of
0: (BufChar: array[0..63] of Byte);
1: (BufLong: array[0..15] of integer);
end;
function DecodeQuotedPrintable(value:string):string;
function EncodeQuotedPrintable(value:string):string;
function Decode4to3(value,table:string):string;
function DecodeBase64(value:string):string;
function EncodeBase64(value:string):string;
function UpdateCrc32(value:byte;crc32:integer):integer;
function Crc32(value:string):integer;
function UpdateCrc16(value:byte;crc16:word):word;
function Crc16(value:string):word;
function MD5(value:string):string;
implementation
@@ -181,6 +265,251 @@ begin
end;
end;
{==============================================================================}
{UpdateCrc32}
function UpdateCrc32(value:byte;crc32:integer):integer;
begin
result:=((crc32 shr 8) and $00FFFFFF)
xor crc32tab[byte(crc32 XOR integer(value)) and $000000FF];
end;
{==============================================================================}
{Crc32}
function Crc32(value:string):integer;
var
n:integer;
begin
result:=$FFFFFFFF;
for n:=1 to length(value) do
result:=UpdateCrc32(ord(value[n]), result);
end;
{==============================================================================}
{UpdateCrc16}
function UpdateCrc16(value:byte;crc16:word):word;
begin
result:=((crc16 shr 8) and $00FF)
xor crc16tab[byte(crc16 XOR (word(value)) and $00FF)];
end;
{==============================================================================}
{Crc16}
function Crc16(value:string):word;
var
n:integer;
begin
result:=$FFFF;
for n:=1 to length(value) do
result:=UpdateCrc16(ord(value[n]), result);
end;
{==============================================================================}
procedure MD5Init(var MD5Context: TMD5Ctx);
begin
FillChar(MD5Context, SizeOf(TMD5Ctx), #0);
with MD5Context do begin
State[0] := $67452301;
State[1] := $EFCDAB89;
State[2] := $98BADCFE;
State[3] := $10325476;
end
end;
procedure MD5Transform(var Buf:array of LongInt; const Data:array of LongInt);
var
A,B,C,D: LongInt;
procedure Round1(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
begin
Inc(W, (Z xor (X and (Y xor Z))) + Data);
W := (W shl S) or (W shr (32 - S));
Inc(W, X)
end;
procedure Round2(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
begin
Inc(W, (Y xor (Z and (X xor Y))) + Data);
W := (W shl S) or (W shr (32 - S));
Inc(W, X)
end;
procedure Round3(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
begin
Inc(W, (X xor Y xor Z) + Data);
W := (W shl S) or (W shr (32 - S));
Inc(W, X)
end;
procedure Round4(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
begin
Inc(W, (Y xor (X or not Z)) + Data);
W := (W shl S) or (W shr (32 - S));
Inc(W, X)
end;
begin
A:=Buf[0];
B:=Buf[1];
C:=Buf[2];
D:=Buf[3];
Round1(A,B,C,D, Data[ 0] + $d76aa478, 7);
Round1(D,A,B,C, Data[ 1] + $e8c7b756, 12);
Round1(C,D,A,B, Data[ 2] + $242070db, 17);
Round1(B,C,D,A, Data[ 3] + $c1bdceee, 22);
Round1(A,B,C,D, Data[ 4] + $f57c0faf, 7);
Round1(D,A,B,C, Data[ 5] + $4787c62a, 12);
Round1(C,D,A,B, Data[ 6] + $a8304613, 17);
Round1(B,C,D,A, Data[ 7] + $fd469501, 22);
Round1(A,B,C,D, Data[ 8] + $698098d8, 7);
Round1(D,A,B,C, Data[ 9] + $8b44f7af, 12);
Round1(C,D,A,B, Data[10] + $ffff5bb1, 17);
Round1(B,C,D,A, Data[11] + $895cd7be, 22);
Round1(A,B,C,D, Data[12] + $6b901122, 7);
Round1(D,A,B,C, Data[13] + $fd987193, 12);
Round1(C,D,A,B, Data[14] + $a679438e, 17);
Round1(B,C,D,A, Data[15] + $49b40821, 22);
Round2(A,B,C,D, Data[ 1] + $f61e2562, 5);
Round2(D,A,B,C, Data[ 6] + $c040b340, 9);
Round2(C,D,A,B, Data[11] + $265e5a51, 14);
Round2(B,C,D,A, Data[ 0] + $e9b6c7aa, 20);
Round2(A,B,C,D, Data[ 5] + $d62f105d, 5);
Round2(D,A,B,C, Data[10] + $02441453, 9);
Round2(C,D,A,B, Data[15] + $d8a1e681, 14);
Round2(B,C,D,A, Data[ 4] + $e7d3fbc8, 20);
Round2(A,B,C,D, Data[ 9] + $21e1cde6, 5);
Round2(D,A,B,C, Data[14] + $c33707d6, 9);
Round2(C,D,A,B, Data[ 3] + $f4d50d87, 14);
Round2(B,C,D,A, Data[ 8] + $455a14ed, 20);
Round2(A,B,C,D, Data[13] + $a9e3e905, 5);
Round2(D,A,B,C, Data[ 2] + $fcefa3f8, 9);
Round2(C,D,A,B, Data[ 7] + $676f02d9, 14);
Round2(B,C,D,A, Data[12] + $8d2a4c8a, 20);
Round3(A,B,C,D, Data[ 5] + $fffa3942, 4);
Round3(D,A,B,C, Data[ 8] + $8771f681, 11);
Round3(C,D,A,B, Data[11] + $6d9d6122, 16);
Round3(B,C,D,A, Data[14] + $fde5380c, 23);
Round3(A,B,C,D, Data[ 1] + $a4beea44, 4);
Round3(D,A,B,C, Data[ 4] + $4bdecfa9, 11);
Round3(C,D,A,B, Data[ 7] + $f6bb4b60, 16);
Round3(B,C,D,A, Data[10] + $bebfbc70, 23);
Round3(A,B,C,D, Data[13] + $289b7ec6, 4);
Round3(D,A,B,C, Data[ 0] + $eaa127fa, 11);
Round3(C,D,A,B, Data[ 3] + $d4ef3085, 16);
Round3(B,C,D,A, Data[ 6] + $04881d05, 23);
Round3(A,B,C,D, Data[ 9] + $d9d4d039, 4);
Round3(D,A,B,C, Data[12] + $e6db99e5, 11);
Round3(C,D,A,B, Data[15] + $1fa27cf8, 16);
Round3(B,C,D,A, Data[ 2] + $c4ac5665, 23);
Round4(A,B,C,D, Data[ 0] + $f4292244, 6);
Round4(D,A,B,C, Data[ 7] + $432aff97, 10);
Round4(C,D,A,B, Data[14] + $ab9423a7, 15);
Round4(B,C,D,A, Data[ 5] + $fc93a039, 21);
Round4(A,B,C,D, Data[12] + $655b59c3, 6);
Round4(D,A,B,C, Data[ 3] + $8f0ccc92, 10);
Round4(C,D,A,B, Data[10] + $ffeff47d, 15);
Round4(B,C,D,A, Data[ 1] + $85845dd1, 21);
Round4(A,B,C,D, Data[ 8] + $6fa87e4f, 6);
Round4(D,A,B,C, Data[15] + $fe2ce6e0, 10);
Round4(C,D,A,B, Data[ 6] + $a3014314, 15);
Round4(B,C,D,A, Data[13] + $4e0811a1, 21);
Round4(A,B,C,D, Data[ 4] + $f7537e82, 6);
Round4(D,A,B,C, Data[11] + $bd3af235, 10);
Round4(C,D,A,B, Data[ 2] + $2ad7d2bb, 15);
Round4(B,C,D,A, Data[ 9] + $eb86d391, 21);
Inc(Buf[0],A);
Inc(Buf[1],B);
Inc(Buf[2],C);
Inc(Buf[3],D);
end;
procedure MD5Update(var MD5Context:TMD5Ctx; const Data:string);
var
Index,t,len:integer;
begin
len:=length(data);
with MD5Context do
begin
T:=Count[0];
Inc(Count[0], Len shl 3);
if Count[0]<T then
Inc(Count[1]);
Inc(Count[1], Len shr 29);
T:=(T shr 3) and $3F;
Index:=0;
if T<>0 then
begin
Index:=T;
T:=64-T;
if Len<T then
begin
Move(Data, Bufchar[Index], Len);
Exit;
end;
Move(Data, Bufchar[Index], T);
MD5Transform(State, Buflong);
Dec(Len, T);
Index:=T;
end;
while Len>=64 do
begin
Move(Data[Index+1], Bufchar, 64);
MD5Transform(State, Buflong);
Inc(Index, 64);
Dec(Len, 64);
end;
Move(Data[Index+1], Bufchar, Len);
end
end;
function MD5Final(var MD5Context: TMD5Ctx):string;
var
Cnt : Word;
P : Byte;
digest:array[0..15] of Char;
i:integer;
begin
for I:=0 to 15 do
Byte(Digest[I]):=I+1;
with MD5Context do
begin
Cnt:=(Count[0] shr 3) and $3F;
P:=Cnt;
BufChar[P]:=$80;
Inc(P);
Cnt:=64-1-Cnt;
if Cnt<8 then
begin
FillChar(BufChar[P], Cnt, #0);
MD5Transform(State, BufLong);
FillChar(BufChar, 56, #0);
end
else fillChar(BufChar[P], Cnt-8, #0);
BufLong[14] := Count[0];
BufLong[15] := Count[1];
MD5Transform(State, BufLong);
Move(State, Digest, 16);
result:='';
for i:=0 to 15 do
result:=result+char(digest[i]);
end;
FillChar(MD5Context, SizeOf(TMD5Ctx), #0)
end;
{==============================================================================}
{MD5}
function MD5(value:string): string;
var
MD5Context : TMD5Ctx;
begin
MD5Init(MD5Context);
MD5Update(MD5Context,value);
result:=MD5Final(MD5Context);
end;
{==============================================================================}
begin

16
synautil.pas
View File

@@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.003.000 |
| Project : Delphree - Synapse | 001.004.000 |
|==============================================================================|
| Content: support procedures and functions |
|==============================================================================|
@@ -48,6 +48,7 @@ function SeparateRight(value,delimiter:string):string;
function getparameter(value,parameter:string):string;
function GetEmailAddr(value:string):string;
function GetEmailDesc(value:string):string;
function StrToHex(value:string):string;
implementation
@@ -316,7 +317,7 @@ end;
{GetParameter}
function getparameter(value,parameter:string):string;
var
x,x1,n:integer;
x,x1:integer;
s:string;
begin
x:=pos(uppercase(parameter),uppercase(value));
@@ -381,6 +382,17 @@ begin
result:=trim(s);
end;
{==============================================================================}
{StrToHex}
function StrToHex(value:string):string;
var
n:integer;
begin
result:='';
for n:=1 to length(value) do
Result:=Result+IntToHex(Byte(value[n]),2);
result:=lowercase(result);
end;
{==============================================================================}
end.