Release 15
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@33 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby
parent
318575bb8e
commit
7daa8087a7
312
mimechar.pas
312
mimechar.pas
@ -1,5 +1,5 @@
|
||||
{==============================================================================|
|
||||
| Project : Delphree - Synapse | 001.001.000 |
|
||||
| Project : Delphree - Synapse | 002.000.000 |
|
||||
|==============================================================================|
|
||||
| Content: MIME support character conversion tables |
|
||||
|==============================================================================|
|
||||
@ -49,15 +49,24 @@ TMimeChar=(
|
||||
CP1256,
|
||||
CP1257,
|
||||
CP1258,
|
||||
KOI8_R
|
||||
KOI8_R,
|
||||
UCS_2,
|
||||
UCS_4,
|
||||
UTF_8,
|
||||
UTF_7
|
||||
);
|
||||
|
||||
TSetChar=set of TMimeChar;
|
||||
|
||||
var
|
||||
SetTwo:set of TMimeChar=[UCS_2, UTF_7];
|
||||
SetFour:set of TMimeChar=[UCS_4, UTF_8];
|
||||
|
||||
const
|
||||
|
||||
NotFoundChar='_';
|
||||
|
||||
//character transcoding tables X to UCS-2
|
||||
{
|
||||
//dummy table
|
||||
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
|
||||
@ -533,6 +542,10 @@ Lappish, Latvian, Lithuanian, Norwegian and Swedish.
|
||||
);
|
||||
|
||||
{==============================================================================}
|
||||
Function UTF8toUCS4 (value:string):string;
|
||||
Function UCS4toUTF8 (value:string):string;
|
||||
Function UTF7toUCS2 (value:string):string;
|
||||
Function UCS2toUTF7 (value:string):string;
|
||||
Function DecodeChar(value:string;CharFrom:TMimeChar;CharTo:TMimeChar):string;
|
||||
Function GetCurCP:TMimeChar;
|
||||
Function GetCPfromID(value:string):TMimeChar;
|
||||
@ -544,7 +557,7 @@ Function IdealCoding(value:string;CharFrom:TMimeChar;CharTo:TSetChar):TMimeChar;
|
||||
implementation
|
||||
|
||||
uses
|
||||
windows, sysutils;
|
||||
windows, sysutils, synautil, synacode;
|
||||
|
||||
{==============================================================================}
|
||||
procedure CopyArray(var SourceTable, TargetTable:array of word);
|
||||
@ -582,6 +595,213 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
procedure ReadMulti(value:string; var index:integer; mb:byte;
|
||||
var b1,b2,b3,b4:byte);
|
||||
var
|
||||
b:array[0..3] of byte;
|
||||
n:integer;
|
||||
s:string;
|
||||
begin
|
||||
b[0]:=0;
|
||||
b[1]:=0;
|
||||
b[2]:=0;
|
||||
b[3]:=0;
|
||||
if (length(value)+1)<index+mb
|
||||
then exit;
|
||||
s:='';
|
||||
for n:=1 to mb do
|
||||
begin
|
||||
s:=value[index]+s;
|
||||
inc(index);
|
||||
end;
|
||||
for n:=1 to mb do
|
||||
b[n-1]:=ord(s[n]);
|
||||
b1:=b[0];
|
||||
b2:=b[1];
|
||||
b3:=b[2];
|
||||
b4:=b[3];
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
function WriteMulti(b1,b2,b3,b4:byte; mb:byte):string;
|
||||
var
|
||||
b:array[0..3] of byte;
|
||||
n:integer;
|
||||
begin
|
||||
result:='';
|
||||
b[0]:=b1;
|
||||
b[1]:=b2;
|
||||
b[2]:=b3;
|
||||
b[3]:=b4;
|
||||
for n:=1 to mb do
|
||||
result:=char(b[n-1])+Result;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
function UTF8toUCS4 (value:string):string;
|
||||
var
|
||||
n,x,ul,m:integer;
|
||||
s:string;
|
||||
w1,w2:word;
|
||||
begin
|
||||
result:='';
|
||||
n:=1;
|
||||
while length(value)>=n do
|
||||
begin
|
||||
x:=ord(value[n]);
|
||||
inc(n);
|
||||
if x<128
|
||||
then result:=result+writemulti(x,0,0,0,4)
|
||||
else
|
||||
begin
|
||||
m:=0;
|
||||
if (x and $E0)=$C0 then m:=$1F;
|
||||
if (x and $F0)=$E0 then m:=$0F;
|
||||
if (x and $F8)=$F0 then m:=$07;
|
||||
if (x and $FC)=$F8 then m:=$03;
|
||||
if (x and $FE)=$FC then m:=$01;
|
||||
ul:=x and m;
|
||||
s:=inttobin(ul,0);
|
||||
while length(value)>=n do
|
||||
begin
|
||||
x:=ord(value[n]);
|
||||
inc(n);
|
||||
if (x and $C0)=$80
|
||||
then s:=s+inttobin(x and $3F, 6)
|
||||
else
|
||||
begin
|
||||
dec(n);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
ul:=bintoint(s);
|
||||
w1:=ul div 65536;
|
||||
w2:=ul mod 65536;
|
||||
result:=result+writemulti(lo(w2),hi(w2),lo(w1),hi(w1),4);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
function UCS4toUTF8 (value:string):string;
|
||||
var
|
||||
s,l,k:string;
|
||||
b1,b2,b3,b4:byte;
|
||||
n,m,x,y:integer;
|
||||
b:byte;
|
||||
begin
|
||||
result:='';
|
||||
n:=1;
|
||||
while length(value)>=n do
|
||||
begin
|
||||
readmulti(value,n,4,b1,b2,b3,b4);
|
||||
if (b2=0) and (b3=0) and (b4=0)
|
||||
then result:=result+char(b1)
|
||||
else
|
||||
begin
|
||||
x:=(b1+256*b2)+(b3+256*b4)*65536;
|
||||
l:=inttobin(x,0);
|
||||
y:=length(l) div 6;
|
||||
s:='';
|
||||
for m:=1 to y do
|
||||
begin
|
||||
k:=copy(l,length(l)-5,6);
|
||||
l:=copy(l,1,length(l)-6);
|
||||
b:=bintoint(k) or $80;
|
||||
s:=char(b)+s;
|
||||
end;
|
||||
b:=bintoint(l);
|
||||
case y of
|
||||
5: b:=b or $FC;
|
||||
4: b:=b or $F8;
|
||||
3: b:=b or $F0;
|
||||
2: b:=b or $E0;
|
||||
1: b:=b or $C0;
|
||||
end;
|
||||
s:=char(b)+s;
|
||||
result:=result+s;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
function UTF7toUCS2(value:string):string;
|
||||
var
|
||||
n:integer;
|
||||
c:char;
|
||||
s:string;
|
||||
begin
|
||||
result:='';
|
||||
n:=1;
|
||||
while length(value)>=n do
|
||||
begin
|
||||
c:=value[n];
|
||||
inc(n);
|
||||
if c<>'+'
|
||||
then result:=result+writemulti(ord(c),0,0,0,2)
|
||||
else
|
||||
begin
|
||||
s:='';
|
||||
while length(value)>=n do
|
||||
begin
|
||||
c:=value[n];
|
||||
inc(n);
|
||||
if c='-'
|
||||
then break;
|
||||
if (c='=') or (pos(c,TableBase64)<1) then
|
||||
begin
|
||||
dec(n);
|
||||
break;
|
||||
end;
|
||||
s:=s+c;
|
||||
end;
|
||||
if s=''
|
||||
then s:='+'
|
||||
else s:=DecodeBase64(s);
|
||||
result:=result+s;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
Function UCS2toUTF7 (value:string):string;
|
||||
var
|
||||
s:string;
|
||||
b1,b2,b3,b4:byte;
|
||||
n,m:integer;
|
||||
begin
|
||||
result:='';
|
||||
n:=1;
|
||||
while length(value)>=n do
|
||||
begin
|
||||
readmulti(value,n,2,b1,b2,b3,b4);
|
||||
if (b2=0)
|
||||
then if char(b1)='+'
|
||||
then result:=result+'+-'
|
||||
else result:=result+char(b1)
|
||||
else
|
||||
begin
|
||||
s:=char(b2)+char(b1);
|
||||
while length(value)>=n do
|
||||
begin
|
||||
readmulti(value,n,2,b1,b2,b3,b4);
|
||||
if b2=0 then
|
||||
begin
|
||||
dec(n,2);
|
||||
break;
|
||||
end;
|
||||
s:=s+char(b2)+char(b1);
|
||||
end;
|
||||
s:=EncodeBase64(s);
|
||||
m:=pos('=',s);
|
||||
if m>0 then
|
||||
s:=copy(s,1,m-1);
|
||||
result:=result+'+'+s+'-';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{DecodeChar}
|
||||
Function DecodeChar(value:string;CharFrom:TMimeChar;CharTo:TMimeChar):string;
|
||||
@ -589,18 +809,54 @@ var
|
||||
uni:word;
|
||||
n,m:integer;
|
||||
b:byte;
|
||||
b1,b2,b3,b4:byte;
|
||||
SourceTable,TargetTable:array [128..255] of word;
|
||||
mbf,mbt:byte;
|
||||
begin
|
||||
GetArray(CharFrom,SourceTable);
|
||||
GetArray(CharTo,TargetTable);
|
||||
mbf:=1;
|
||||
if CharFrom in SetTwo
|
||||
then mbf:=2;
|
||||
if CharFrom in SetFour
|
||||
then mbf:=4;
|
||||
mbt:=1;
|
||||
if CharTo in SetTwo
|
||||
then mbt:=2;
|
||||
if CharTo in SetFour
|
||||
then mbt:=4;
|
||||
|
||||
if Charfrom=UTF_8
|
||||
then value:=UTF8toUCS4(value);
|
||||
if Charfrom=UTF_7
|
||||
then value:=UTF7toUCS2(value);
|
||||
result:='';
|
||||
for n:=1 to length(value) do
|
||||
|
||||
n:=1;
|
||||
while length(value)>=n do
|
||||
begin
|
||||
b:=ord(value[n]);
|
||||
if b>128
|
||||
Readmulti(value,n,mbf,b1,b2,b3,b4);
|
||||
if mbf=1 then
|
||||
if b1>127 then
|
||||
begin
|
||||
uni:=SourceTable[b1];
|
||||
b1:=lo(uni);
|
||||
b2:=hi(uni);
|
||||
end;
|
||||
//b1..b4 - unicode char
|
||||
uni:=b2*256+b1;
|
||||
if (b3<>0) or (b4<>0)
|
||||
then
|
||||
begin
|
||||
uni:=SourceTable[b];
|
||||
b1:=ord(NotFoundChar);
|
||||
b2:=0;
|
||||
b3:=0;
|
||||
b4:=0;
|
||||
end
|
||||
else
|
||||
if mbt=1 then
|
||||
if uni>127 then
|
||||
begin
|
||||
b:=ord(NotFoundChar);
|
||||
for m:=128 to 255 do
|
||||
if TargetTable[m]=uni
|
||||
@ -609,9 +865,18 @@ begin
|
||||
b:=m;
|
||||
break;
|
||||
end;
|
||||
b1:=b;
|
||||
b2:=0;
|
||||
end
|
||||
else b1:=lo(uni);
|
||||
result:=result+writemulti(b1,b2,b3,b4,mbt)
|
||||
end;
|
||||
result:=result+char(b);
|
||||
end;
|
||||
|
||||
if CharTo=UTF_7
|
||||
then result:=UCS2toUTF7(result);
|
||||
if CharTo=UTF_8
|
||||
then result:=UCS4toUTF8(result);
|
||||
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
@ -742,6 +1007,31 @@ begin
|
||||
Result:=KOI8_R;
|
||||
exit;
|
||||
end;
|
||||
if Pos('UTF-7',value)=1 then
|
||||
begin
|
||||
Result:=UTF_7;
|
||||
exit;
|
||||
end;
|
||||
if Pos('UTF-8',value)>0 then
|
||||
begin
|
||||
Result:=UTF_8;
|
||||
exit;
|
||||
end;
|
||||
if Pos('UCS-4',value)>0 then
|
||||
begin
|
||||
Result:=UCS_4;
|
||||
exit;
|
||||
end;
|
||||
if Pos('UCS-2',value)>0 then
|
||||
begin
|
||||
Result:=UCS_2;
|
||||
exit;
|
||||
end;
|
||||
if Pos('UNICODE',value)=1 then
|
||||
begin
|
||||
Result:=UCS_2;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
@ -767,6 +1057,10 @@ begin
|
||||
CP1257 : result:='WINDOWS-1257';
|
||||
CP1258 : result:='WINDOWS-1258';
|
||||
KOI8_R : result:='KOI8-R';
|
||||
UCS_2 : result:='Unicode-1-1-UCS-2';
|
||||
UCS_4 : result:='Unicode-1-1-UCS-4';
|
||||
UTF_8 : result:='UTF-8';
|
||||
UTF_7 : result:='UTF-7';
|
||||
else result:='ISO-8859-1';
|
||||
end;
|
||||
end;
|
||||
|
||||
10
mimemess.pas
10
mimemess.pas
@ -1,5 +1,5 @@
|
||||
{==============================================================================|
|
||||
| Project : Delphree - Synapse | 001.000.001 |
|
||||
| Project : Delphree - Synapse | 001.001.000 |
|
||||
|==============================================================================|
|
||||
| Content: MIME message object |
|
||||
|==============================================================================|
|
||||
@ -206,14 +206,15 @@ end;
|
||||
procedure TMimeMess.ParseHeaders;
|
||||
var
|
||||
s:string;
|
||||
n:integer;
|
||||
x:integer;
|
||||
cp:TMimeChar;
|
||||
begin
|
||||
cp:=getCurCP;
|
||||
header.ToList.clear;
|
||||
for n:=0 to lines.count-1 do
|
||||
x:=0;
|
||||
while lines.count>x do
|
||||
begin
|
||||
s:=lines[n];
|
||||
s:=normalizeheader(lines,x);
|
||||
if s=''
|
||||
then break;
|
||||
If pos('FROM:',uppercase(s))=1
|
||||
@ -240,7 +241,6 @@ begin
|
||||
m:=tmimepart.create;
|
||||
try
|
||||
l.assign(lines);
|
||||
normalizepart(l);
|
||||
with header do
|
||||
begin
|
||||
from:='';
|
||||
|
||||
74
mimepart.pas
74
mimepart.pas
@ -1,5 +1,5 @@
|
||||
{==============================================================================|
|
||||
| Project : Delphree - Synapse | 001.001.000 |
|
||||
| Project : Delphree - Synapse | 001.002.000 |
|
||||
|==============================================================================|
|
||||
| Content: MIME support procedures and functions |
|
||||
|==============================================================================|
|
||||
@ -28,7 +28,7 @@ unit MIMEpart;
|
||||
interface
|
||||
|
||||
uses
|
||||
sysutils, classes, windows, MIMEchar, SynaCode, SynaUtil;
|
||||
sysutils, classes, windows, MIMEchar, SynaCode, SynaUtil, MIMEinLn;
|
||||
|
||||
type
|
||||
|
||||
@ -40,7 +40,9 @@ TMimePrimary=(MP_TEXT,
|
||||
TMimeEncoding=(ME_7BIT,
|
||||
ME_8BIT,
|
||||
ME_QUOTED_PRINTABLE,
|
||||
ME_BASE64);
|
||||
ME_BASE64,
|
||||
ME_UU,
|
||||
ME_XX);
|
||||
|
||||
TMimePart=class
|
||||
private
|
||||
@ -109,40 +111,37 @@ const
|
||||
('ZIP','application','ZIP')
|
||||
);
|
||||
|
||||
procedure NormalizePart(value:Tstringlist);
|
||||
function NormalizeHeader(value:TStringList;var index:integer):string;
|
||||
function GenerateBoundary:string;
|
||||
|
||||
implementation
|
||||
|
||||
procedure NormalizePart(value:Tstringlist);
|
||||
function NormalizeHeader(value:TStringList;var index:integer):string;
|
||||
var
|
||||
t:tstringlist;
|
||||
s:string;
|
||||
s,t:string;
|
||||
n:integer;
|
||||
begin
|
||||
t:=tstringlist.create;
|
||||
try
|
||||
while (value.Count-1) > 0 do
|
||||
begin
|
||||
s:=value[0];
|
||||
if s=''
|
||||
then break;
|
||||
if (s[1]=' ') or (s[1]=#9)
|
||||
s:=value[index];
|
||||
inc(index);
|
||||
if s<>''
|
||||
then
|
||||
while (value.Count-1) > index do
|
||||
begin
|
||||
s:=' '+trim(s);
|
||||
if t.count=0
|
||||
then t.add(s)
|
||||
else t[t.count-1]:=t[t.count-1]+s;
|
||||
end
|
||||
t:=value[index];
|
||||
if t=''
|
||||
then break;
|
||||
for n:=1 to length(t) do
|
||||
if t[n]=#9
|
||||
then t[n]:=' ';
|
||||
if t[1]<>' '
|
||||
then break
|
||||
else
|
||||
t.add(s);
|
||||
value.Delete(0);
|
||||
begin
|
||||
s:=s+' '+trim(t);
|
||||
inc(index);
|
||||
end;
|
||||
t.AddStrings(value);
|
||||
value.assign(t);
|
||||
finally
|
||||
t.free;
|
||||
end;
|
||||
result:=s;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
@ -219,8 +218,7 @@ begin
|
||||
{parse header}
|
||||
while value.count>x do
|
||||
begin
|
||||
s:=value[x];
|
||||
inc(x);
|
||||
s:=normalizeheader(value,x);
|
||||
if s=''
|
||||
then break;
|
||||
su:=uppercase(s);
|
||||
@ -266,6 +264,8 @@ begin
|
||||
|
||||
if (primarycode=MP_BINARY) and (filename='')
|
||||
then filename:=fn;
|
||||
filename:=InlineDecode(filename,getCurCP);
|
||||
filename:=extractfilename(filename);
|
||||
|
||||
x1:=x;
|
||||
x2:=value.count-1;
|
||||
@ -364,6 +364,16 @@ begin
|
||||
if PrimaryCode=MP_TEXT
|
||||
then s:=decodeChar(s,CharsetCode,TargetCharset);
|
||||
end;
|
||||
ME_UU:
|
||||
begin
|
||||
if s<>''
|
||||
then s:=DecodeUU(s);
|
||||
end;
|
||||
ME_XX:
|
||||
begin
|
||||
if s<>''
|
||||
then s:=DecodeXX(s);
|
||||
end;
|
||||
end;
|
||||
Decodedlines.Write(pointer(s)^,length(s));
|
||||
end;
|
||||
@ -378,6 +388,10 @@ var
|
||||
s,buff:string;
|
||||
n,x:integer;
|
||||
begin
|
||||
if EncodingCode=ME_UU
|
||||
then encoding:='base64';
|
||||
if EncodingCode=ME_XX
|
||||
then encoding:='base64';
|
||||
l:=tstringlist.create;
|
||||
Lines.clear;
|
||||
decodedlines.Seek(0,soFromBeginning);
|
||||
@ -511,6 +525,10 @@ begin
|
||||
then EncodingCode:=ME_QUOTED_PRINTABLE;
|
||||
if Pos('BASE64',s)=1
|
||||
then EncodingCode:=ME_BASE64;
|
||||
if Pos('X-UU',s)=1
|
||||
then EncodingCode:=ME_UU;
|
||||
if Pos('X-XX',s)=1
|
||||
then EncodingCode:=ME_XX;
|
||||
end;
|
||||
|
||||
{TMIMEPart.SetCharset}
|
||||
|
||||
55
synacode.pas
55
synacode.pas
@ -1,5 +1,5 @@
|
||||
{==============================================================================|
|
||||
| Project : Delphree - Synapse | 001.001.001 |
|
||||
| Project : Delphree - Synapse | 001.002.000 |
|
||||
|==============================================================================|
|
||||
| Content: Coding and decoding support |
|
||||
|==============================================================================|
|
||||
@ -36,11 +36,11 @@ const
|
||||
|
||||
TableBase64=
|
||||
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
|
||||
{ TableUU=
|
||||
TableUU=
|
||||
'`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
|
||||
TableXX=
|
||||
'+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
|
||||
}
|
||||
'+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_';
|
||||
|
||||
|
||||
Crc32Tab: array[0..255] of integer = (
|
||||
$00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3,
|
||||
@ -126,6 +126,8 @@ function EncodeQuotedPrintable(value:string):string;
|
||||
function Decode4to3(value,table:string):string;
|
||||
function DecodeBase64(value:string):string;
|
||||
function EncodeBase64(value:string):string;
|
||||
function DecodeUU(value:string):string;
|
||||
function DecodeXX(value:string):string;
|
||||
function UpdateCrc32(value:byte;crc32:integer):integer;
|
||||
function Crc32(value:string):integer;
|
||||
function UpdateCrc16(value:byte;crc16:word):word;
|
||||
@ -265,6 +267,51 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{DecodeUU}
|
||||
function DecodeUU(value:string):string;
|
||||
var
|
||||
s:string;
|
||||
uut:string;
|
||||
x:integer;
|
||||
begin
|
||||
result:='';
|
||||
uut:=TableUU;
|
||||
s:=trim(uppercase(value));
|
||||
if s='' then exit;
|
||||
if pos('BEGIN',s)=1 then exit;
|
||||
if pos('END',s)=1 then exit;
|
||||
if pos('TABLE',s)=1 then exit; //ignore table yet (set custom UUT)
|
||||
//begin decoding
|
||||
x:=pos(value[1],uut)-1;
|
||||
x:=round((x/3)*4);
|
||||
//x - lenght UU line
|
||||
s:=copy(value,2,x);
|
||||
if s='' then exit;
|
||||
result:=Decode4to3(s,uut);
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{DecodeXX}
|
||||
function DecodeXX(value:string):string;
|
||||
var
|
||||
s:string;
|
||||
x:integer;
|
||||
begin
|
||||
result:='';
|
||||
s:=trim(uppercase(value));
|
||||
if s='' then exit;
|
||||
if pos('BEGIN',s)=1 then exit;
|
||||
if pos('END',s)=1 then exit;
|
||||
//begin decoding
|
||||
x:=pos(value[1],TableXX)-1;
|
||||
x:=round((x/3)*4);
|
||||
//x - lenght XX line
|
||||
s:=copy(value,2,x);
|
||||
if s='' then exit;
|
||||
result:=Decode4to3(s,TableXX);
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{UpdateCrc32}
|
||||
function UpdateCrc32(value:byte;crc32:integer):integer;
|
||||
|
||||
41
synautil.pas
41
synautil.pas
@ -1,5 +1,5 @@
|
||||
{==============================================================================|
|
||||
| Project : Delphree - Synapse | 001.005.000 |
|
||||
| Project : Delphree - Synapse | 001.006.000 |
|
||||
|==============================================================================|
|
||||
| Content: support procedures and functions |
|
||||
|==============================================================================|
|
||||
@ -45,6 +45,8 @@ function getparameter(value,parameter:string):string;
|
||||
function GetEmailAddr(value:string):string;
|
||||
function GetEmailDesc(value:string):string;
|
||||
function StrToHex(value:string):string;
|
||||
function IntToBin(value:integer;digits:byte):string;
|
||||
function BinToInt(value:string):integer;
|
||||
|
||||
implementation
|
||||
|
||||
@ -296,6 +298,43 @@ begin
|
||||
Result:=Result+IntToHex(Byte(value[n]),2);
|
||||
result:=lowercase(result);
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{IntToBin}
|
||||
function IntToBin(value:integer;digits:byte):string;
|
||||
var
|
||||
x,y,n:integer;
|
||||
begin
|
||||
result:='';
|
||||
x:=value;
|
||||
repeat
|
||||
y:=x mod 2;
|
||||
x:=x div 2;
|
||||
if y>0
|
||||
then result:='1'+result
|
||||
else result:='0'+result;
|
||||
until x=0;
|
||||
x:=length(result);
|
||||
for n:=x to digits-1 do
|
||||
result:='0'+result;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
{BinToInt}
|
||||
function BinToInt(value:string):integer;
|
||||
var
|
||||
x,n:integer;
|
||||
begin
|
||||
result:=0;
|
||||
for n:=1 to length(value) do
|
||||
begin
|
||||
if value[n]='0'
|
||||
then x:=0
|
||||
else x:=1;
|
||||
result:=result*2+x;
|
||||
end;
|
||||
end;
|
||||
|
||||
{==============================================================================}
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user