pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Release 15

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@33 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2008-04-24 06:40:58 +00:00
parent 318575bb8e
commit 7daa8087a7
5 changed files with 473 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

356
mimechar.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.001.000 | | Project : Delphree - Synapse | 002.000.000 |
|==============================================================================| |==============================================================================|
| Content: MIME support character conversion tables | | Content: MIME support character conversion tables |
|==============================================================================| |==============================================================================|
@ -49,15 +49,24 @@ TMimeChar=(
CP1256, CP1256,
CP1257, CP1257,
CP1258, CP1258,
KOI8_R KOI8_R,
UCS_2,
UCS_4,
UTF_8,
UTF_7
); );
TSetChar=set of TMimeChar; TSetChar=set of TMimeChar;
var
SetTwo:set of TMimeChar=[UCS_2, UTF_7];
SetFour:set of TMimeChar=[UCS_4, UTF_8];
const const
NotFoundChar='_'; NotFoundChar='_';
//character transcoding tables X to UCS-2
{ {
//dummy table //dummy table
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
@ -515,24 +524,28 @@ Lappish, Latvian, Lithuanian, Norwegian and Swedish.
CharKOI8_R:array [128..255] of word = CharKOI8_R:array [128..255] of word =
( (
$2500, $2502, $250c, $2510, $2514, $2518, $251c, $2524, $2500, $2502, $250c, $2510, $2514, $2518, $251c, $2524,
$252c, $2534, $253c, $2580, $2584, $2588, $258c, $2590, $252c, $2534, $253c, $2580, $2584, $2588, $258c, $2590,
$2591, $2592, $2593, $2320, $25a0, $2219, $221a, $2248, $2591, $2592, $2593, $2320, $25a0, $2219, $221a, $2248,
$2264, $2265, $00a0, $2321, $00b0, $00b2, $00b7, $00f7, $2264, $2265, $00a0, $2321, $00b0, $00b2, $00b7, $00f7,
$2550, $2551, $2552, $0451, $2553, $2554, $2555, $2556, $2550, $2551, $2552, $0451, $2553, $2554, $2555, $2556,
$2557, $2558, $2559, $255a, $255b, $255c, $255d, $255e, $2557, $2558, $2559, $255a, $255b, $255c, $255d, $255e,
$255f, $2560, $2561, $0401, $2562, $2563, $2564, $2565, $255f, $2560, $2561, $0401, $2562, $2563, $2564, $2565,
$2566, $2567, $2568, $2569, $256a, $256b, $256c, $00a9, $2566, $2567, $2568, $2569, $256a, $256b, $256c, $00a9,
$044e, $0430, $0431, $0446, $0434, $0435, $0444, $0433, $044e, $0430, $0431, $0446, $0434, $0435, $0444, $0433,
$0445, $0438, $0439, $043a, $043b, $043c, $043d, $043e, $0445, $0438, $0439, $043a, $043b, $043c, $043d, $043e,
$043f, $044f, $0440, $0441, $0442, $0443, $0436, $0432, $043f, $044f, $0440, $0441, $0442, $0443, $0436, $0432,
$044c, $044b, $0437, $0448, $044d, $0449, $0447, $044a, $044c, $044b, $0437, $0448, $044d, $0449, $0447, $044a,
$042e, $0410, $0411, $0426, $0414, $0415, $0424, $0413, $042e, $0410, $0411, $0426, $0414, $0415, $0424, $0413,
$0425, $0418, $0419, $041a, $041b, $041c, $041d, $041e, $0425, $0418, $0419, $041a, $041b, $041c, $041d, $041e,
$041f, $042f, $0420, $0421, $0422, $0423, $0416, $0412, $041f, $042f, $0420, $0421, $0422, $0423, $0416, $0412,
$042c, $042b, $0417, $0428, $042d, $0429, $0427, $042a $042c, $042b, $0417, $0428, $042d, $0429, $0427, $042a
); );
{==============================================================================} {==============================================================================}
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 DecodeChar(value:string;CharFrom:TMimeChar;CharTo:TMimeChar):string;
Function GetCurCP:TMimeChar; Function GetCurCP:TMimeChar;
Function GetCPfromID(value:string):TMimeChar; Function GetCPfromID(value:string):TMimeChar;
@ -544,7 +557,7 @@ Function IdealCoding(value:string;CharFrom:TMimeChar;CharTo:TSetChar):TMimeChar;
implementation implementation
uses uses
windows, sysutils; windows, sysutils, synautil, synacode;
{==============================================================================} {==============================================================================}
procedure CopyArray(var SourceTable, TargetTable:array of word); procedure CopyArray(var SourceTable, TargetTable:array of word);
@ -582,6 +595,213 @@ begin
end; end;
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} {DecodeChar}
Function DecodeChar(value:string;CharFrom:TMimeChar;CharTo:TMimeChar):string; Function DecodeChar(value:string;CharFrom:TMimeChar;CharTo:TMimeChar):string;
@ -589,29 +809,74 @@ var
uni:word; uni:word;
n,m:integer; n,m:integer;
b:byte; b:byte;
b1,b2,b3,b4:byte;
SourceTable,TargetTable:array [128..255] of word; SourceTable,TargetTable:array [128..255] of word;
mbf,mbt:byte;
begin begin
GetArray(CharFrom,SourceTable); GetArray(CharFrom,SourceTable);
GetArray(CharTo,TargetTable); 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:=''; result:='';
for n:=1 to length(value) do
n:=1;
while length(value)>=n do
begin begin
b:=ord(value[n]); Readmulti(value,n,mbf,b1,b2,b3,b4);
if b>128 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 then
begin begin
uni:=SourceTable[b]; b1:=ord(NotFoundChar);
b:=ord(NotFoundChar); b2:=0;
for m:=128 to 255 do b3:=0;
if TargetTable[m]=uni b4:=0;
then end
begin else
b:=m; if mbt=1 then
break; if uni>127 then
end; begin
end; b:=ord(NotFoundChar);
result:=result+char(b); for m:=128 to 255 do
if TargetTable[m]=uni
then
begin
b:=m;
break;
end;
b1:=b;
b2:=0;
end
else b1:=lo(uni);
result:=result+writemulti(b1,b2,b3,b4,mbt)
end; end;
if CharTo=UTF_7
then result:=UCS2toUTF7(result);
if CharTo=UTF_8
then result:=UCS4toUTF8(result);
end; end;
{==============================================================================} {==============================================================================}
@ -742,6 +1007,31 @@ begin
Result:=KOI8_R; Result:=KOI8_R;
exit; exit;
end; 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; end;
{==============================================================================} {==============================================================================}
@ -767,6 +1057,10 @@ begin
CP1257 : result:='WINDOWS-1257'; CP1257 : result:='WINDOWS-1257';
CP1258 : result:='WINDOWS-1258'; CP1258 : result:='WINDOWS-1258';
KOI8_R : result:='KOI8-R'; 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'; else result:='ISO-8859-1';
end; end;
end; end;

10
mimemess.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.000.001 | | Project : Delphree - Synapse | 001.001.000 |
|==============================================================================| |==============================================================================|
| Content: MIME message object | | Content: MIME message object |
|==============================================================================| |==============================================================================|
@ -206,14 +206,15 @@ end;
procedure TMimeMess.ParseHeaders; procedure TMimeMess.ParseHeaders;
var var
s:string; s:string;
n:integer; x:integer;
cp:TMimeChar; cp:TMimeChar;
begin begin
cp:=getCurCP; cp:=getCurCP;
header.ToList.clear; header.ToList.clear;
for n:=0 to lines.count-1 do x:=0;
while lines.count>x do
begin begin
s:=lines[n]; s:=normalizeheader(lines,x);
if s='' if s=''
then break; then break;
If pos('FROM:',uppercase(s))=1 If pos('FROM:',uppercase(s))=1
@ -240,7 +241,6 @@ begin
m:=tmimepart.create; m:=tmimepart.create;
try try
l.assign(lines); l.assign(lines);
normalizepart(l);
with header do with header do
begin begin
from:=''; from:='';

86
mimepart.pas
View File

@ -1,7 +1,7 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.001.000 | | Project : Delphree - Synapse | 001.002.000 |
|==============================================================================| |==============================================================================|
| Content: MIME support procedures and functions | | Content: MIME support procedures and functions |
|==============================================================================| |==============================================================================|
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 | | 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 | | (the "License"); you may not use this file except in compliance with the |
@ -28,7 +28,7 @@ unit MIMEpart;
interface interface
uses uses
sysutils, classes, windows, MIMEchar, SynaCode, SynaUtil; sysutils, classes, windows, MIMEchar, SynaCode, SynaUtil, MIMEinLn;
type type
@ -40,7 +40,9 @@ TMimePrimary=(MP_TEXT,
TMimeEncoding=(ME_7BIT, TMimeEncoding=(ME_7BIT,
ME_8BIT, ME_8BIT,
ME_QUOTED_PRINTABLE, ME_QUOTED_PRINTABLE,
ME_BASE64); ME_BASE64,
ME_UU,
ME_XX);
TMimePart=class TMimePart=class
private private
@ -109,40 +111,37 @@ const
('ZIP','application','ZIP') ('ZIP','application','ZIP')
); );
procedure NormalizePart(value:Tstringlist); function NormalizeHeader(value:TStringList;var index:integer):string;
function GenerateBoundary:string; function GenerateBoundary:string;
implementation implementation
procedure NormalizePart(value:Tstringlist); function NormalizeHeader(value:TStringList;var index:integer):string;
var var
t:tstringlist; s,t:string;
s:string; n:integer;
begin begin
t:=tstringlist.create; s:=value[index];
try inc(index);
while (value.Count-1) > 0 do if s<>''
begin then
s:=value[0]; while (value.Count-1) > index do
if s='' begin
then break; t:=value[index];
if (s[1]=' ') or (s[1]=#9) if t=''
then then break;
begin for n:=1 to length(t) do
s:=' '+trim(s); if t[n]=#9
if t.count=0 then t[n]:=' ';
then t.add(s) if t[1]<>' '
else t[t.count-1]:=t[t.count-1]+s; then break
end else
else begin
t.add(s); s:=s+' '+trim(t);
value.Delete(0); inc(index);
end; end;
t.AddStrings(value); end;
value.assign(t); result:=s;
finally
t.free;
end;
end; end;
{==============================================================================} {==============================================================================}
@ -219,8 +218,7 @@ begin
{parse header} {parse header}
while value.count>x do while value.count>x do
begin begin
s:=value[x]; s:=normalizeheader(value,x);
inc(x);
if s='' if s=''
then break; then break;
su:=uppercase(s); su:=uppercase(s);
@ -266,6 +264,8 @@ begin
if (primarycode=MP_BINARY) and (filename='') if (primarycode=MP_BINARY) and (filename='')
then filename:=fn; then filename:=fn;
filename:=InlineDecode(filename,getCurCP);
filename:=extractfilename(filename);
x1:=x; x1:=x;
x2:=value.count-1; x2:=value.count-1;
@ -364,6 +364,16 @@ begin
if PrimaryCode=MP_TEXT if PrimaryCode=MP_TEXT
then s:=decodeChar(s,CharsetCode,TargetCharset); then s:=decodeChar(s,CharsetCode,TargetCharset);
end; end;
ME_UU:
begin
if s<>''
then s:=DecodeUU(s);
end;
ME_XX:
begin
if s<>''
then s:=DecodeXX(s);
end;
end; end;
Decodedlines.Write(pointer(s)^,length(s)); Decodedlines.Write(pointer(s)^,length(s));
end; end;
@ -378,6 +388,10 @@ var
s,buff:string; s,buff:string;
n,x:integer; n,x:integer;
begin begin
if EncodingCode=ME_UU
then encoding:='base64';
if EncodingCode=ME_XX
then encoding:='base64';
l:=tstringlist.create; l:=tstringlist.create;
Lines.clear; Lines.clear;
decodedlines.Seek(0,soFromBeginning); decodedlines.Seek(0,soFromBeginning);
@ -511,6 +525,10 @@ begin
then EncodingCode:=ME_QUOTED_PRINTABLE; then EncodingCode:=ME_QUOTED_PRINTABLE;
if Pos('BASE64',s)=1 if Pos('BASE64',s)=1
then EncodingCode:=ME_BASE64; 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; end;
{TMIMEPart.SetCharset} {TMIMEPart.SetCharset}

55
synacode.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.001.001 | | Project : Delphree - Synapse | 001.002.000 |
|==============================================================================| |==============================================================================|
| Content: Coding and decoding support | | Content: Coding and decoding support |
|==============================================================================| |==============================================================================|
@ -36,11 +36,11 @@ const
TableBase64= TableBase64=
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/='; 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
{ TableUU= TableUU=
'`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'; '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
TableXX= TableXX=
'+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'; '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_';
}
Crc32Tab: array[0..255] of integer = ( Crc32Tab: array[0..255] of integer = (
$00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3, $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3,
@ -126,6 +126,8 @@ function EncodeQuotedPrintable(value:string):string;
function Decode4to3(value,table:string):string; function Decode4to3(value,table:string):string;
function DecodeBase64(value:string):string; function DecodeBase64(value:string):string;
function EncodeBase64(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 UpdateCrc32(value:byte;crc32:integer):integer;
function Crc32(value:string):integer; function Crc32(value:string):integer;
function UpdateCrc16(value:byte;crc16:word):word; function UpdateCrc16(value:byte;crc16:word):word;
@ -265,6 +267,51 @@ begin
end; end;
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} {UpdateCrc32}
function UpdateCrc32(value:byte;crc32:integer):integer; function UpdateCrc32(value:byte;crc32:integer):integer;

41
synautil.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.005.000 | | Project : Delphree - Synapse | 001.006.000 |
|==============================================================================| |==============================================================================|
| Content: support procedures and functions | | Content: support procedures and functions |
|==============================================================================| |==============================================================================|
@ -45,6 +45,8 @@ function getparameter(value,parameter:string):string;
function GetEmailAddr(value:string):string; function GetEmailAddr(value:string):string;
function GetEmailDesc(value:string):string; function GetEmailDesc(value:string):string;
function StrToHex(value:string):string; function StrToHex(value:string):string;
function IntToBin(value:integer;digits:byte):string;
function BinToInt(value:string):integer;
implementation implementation
@ -296,6 +298,43 @@ begin
Result:=Result+IntToHex(Byte(value[n]),2); Result:=Result+IntToHex(Byte(value[n]),2);
result:=lowercase(result); result:=lowercase(result);
end; 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. end.