From 7daa8087a78efcf01de8d59c04118742803e71a3 Mon Sep 17 00:00:00 2001 From: geby Date: Thu, 24 Apr 2008 06:40:58 +0000 Subject: [PATCH] Release 15 git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@33 7c85be65-684b-0410-a082-b2ed4fbef004 --- mimechar.pas | 356 ++++++++++++++++++++++++++++++++++++++++++++++----- mimemess.pas | 10 +- mimepart.pas | 86 ++++++++----- synacode.pas | 55 +++++++- synautil.pas | 41 +++++- 5 files changed, 473 insertions(+), 75 deletions(-) diff --git a/mimechar.pas b/mimechar.pas index 92f45dc..d16f947 100644 --- a/mimechar.pas +++ b/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, @@ -515,24 +524,28 @@ Lappish, Latvian, Lithuanian, Norwegian and Swedish. 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, + $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 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)=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,29 +809,74 @@ 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]; - b:=ord(NotFoundChar); - for m:=128 to 255 do - if TargetTable[m]=uni - then - begin - b:=m; - break; - end; - end; - result:=result+char(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 + then + begin + b:=m; + break; + end; + b1:=b; + b2:=0; + end + else b1:=lo(uni); + result:=result+writemulti(b1,b2,b3,b4,mbt) 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; diff --git a/mimemess.pas b/mimemess.pas index 01c441e..df266fa 100644 --- a/mimemess.pas +++ b/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:=''; diff --git a/mimepart.pas b/mimepart.pas index 72d1780..8264a6f 100644 --- a/mimepart.pas +++ b/mimepart.pas @@ -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 "License"); you may not use this file except in compliance with the | @@ -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) - then - begin - s:=' '+trim(s); - if t.count=0 - then t.add(s) - else t[t.count-1]:=t[t.count-1]+s; - end - else - t.add(s); - value.Delete(0); - end; - t.AddStrings(value); - value.assign(t); - finally - t.free; - end; + s:=value[index]; + inc(index); + if s<>'' + then + while (value.Count-1) > index do + begin + 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 + begin + s:=s+' '+trim(t); + inc(index); + end; + 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} diff --git a/synacode.pas b/synacode.pas index 4d03b40..20d4005 100644 --- a/synacode.pas +++ b/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; diff --git a/synautil.pas b/synautil.pas index 8d30bcf..6e9cba7 100644 --- a/synautil.pas +++ b/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.