Release 14

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@31 7c85be65-684b-0410-a082-b2ed4fbef004

asn1util.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.002.000 |
+| Project : Delphree - Synapse                                   | 001.003.000 |
 |==============================================================================|
 | Content: support for ASN.1 coding and decoding                               |
 |==============================================================================|
@@ -30,7 +30,7 @@ unit ASN1Util;
 interface
 
 uses
-  SysUtils, SynaUtil;
+  SysUtils;
 
 const
   ASN1_INT = $02;
@@ -52,9 +52,15 @@ 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;
+Function MibToId(mib:string):string;
+Function IdToMib(id:string):string;
+Function IntMibToStr(int:string):string;
+function IPToID(Host: string): string;
 
 implementation
 
+{==============================================================================}
+{ASNEncOIDitem}
 function ASNEncOIDitem(Value: integer): string;
 var
   x,xm:integer;
@@ -74,6 +80,8 @@ begin
   until x=0;
 end;
 
+{==============================================================================}
+{ASNDecOIDitem}
 function ASNDecOIDitem(var Start: integer; Buffer: string): integer;
 var
   x:integer;
@@ -92,6 +100,8 @@ begin
   until false
 end;
 
+{==============================================================================}
+{ASNEncLen}
 function ASNEncLen(Len: integer): string;
 var
   x, y: integer;
@@ -113,6 +123,8 @@ begin
       end;
 end;
 
+{==============================================================================}
+{ASNDecLen}
 function ASNDecLen(var Start: integer; Buffer: string): integer;
 var
   x,n: integer;
@@ -135,6 +147,8 @@ begin
       end;
 end;
 
+{==============================================================================}
+{ASNEncInt}
 function ASNEncInt(Value: integer): string;
 var
   x,y:cardinal;
@@ -154,6 +168,8 @@ begin
     then result:=#0+result;
 end;
 
+{==============================================================================}
+{ASNEncUInt}
 function ASNEncUInt(Value: integer): string;
 var
   x,y:integer;
@@ -173,11 +189,15 @@ begin
     then result[1]:=char(ord(result[1]) or $80);
 end;
 
+{==============================================================================}
+{ASNObject}
 function ASNObject(Data: string; ASNType: integer): string;
 begin
   Result := Char(ASNType) + ASNEncLen(Length(Data)) + Data;
 end;
 
+{==============================================================================}
+{ASNItem}
 function ASNItem(var Start: integer; Buffer: string; var ValueType:integer): string;
 var
   ASNType: integer;
@@ -269,6 +289,98 @@ begin
     end;
 end;
 
+{==============================================================================}
+{MibToId}
+function MibToId(mib:string):string;
+var
+  x:integer;
+
+  Function walkInt(var s:string):integer;
+  var
+    x:integer;
+    t:string;
+  begin
+    x:=pos('.',s);
+    if x<1 then
+      begin
+        t:=s;
+        s:='';
+      end
+      else
+      begin
+        t:=copy(s,1,x-1);
+        s:=copy(s,x+1,length(s)-x);
+      end;
+    result:=StrToIntDef(t,0);
+  end;
+begin
+  result:='';
+  x:=walkint(mib);
+  x:=x*40+walkint(mib);
+  result:=ASNEncOIDItem(x);
+  while mib<>'' do
+    begin
+      x:=walkint(mib);
+      result:=result+ASNEncOIDItem(x);
+    end;
+end;
+
+{==============================================================================}
+{IdToMib}
+Function IdToMib(id:string):string;
+var
+  x,y,n:integer;
+begin
+  result:='';
+  n:=1;
+  while length(id)+1>n do
+    begin
+      x:=ASNDecOIDItem(n,id);
+      if (n-1)=1 then
+        begin
+          y:=x div 40;
+          x:=x mod 40;
+          result:=IntTostr(y);
+        end;
+      result:=result+'.'+IntToStr(x);
+    end;
+end;
+
+{==============================================================================}
+{IntMibToStr}
+Function IntMibToStr(int:string):string;
+Var
+  n,y:integer;
+begin
+  y:=0;
+  for n:=1 to length(int)-1 do
+    y:=y*256+ord(int[n]);
+  result:=IntToStr(y);
+end;
+
+{==============================================================================}
+{IPToID} //Hernan Sanchez
+function IPToID(Host: string): string;
+var
+  s, t: string;
+  i, x: integer;
+begin
+  Result := '';
+  for x:= 1 to 3 do
+    begin
+      t := '';
+      s := StrScan(PChar(Host), '.');
+      t := Copy(Host, 1, (Length(Host) - Length(s)));
+      Delete(Host, 1, (Length(Host) - Length(s) + 1));
+      i := StrTointDef(t, 0);
+      Result := Result + Chr(i);
+    end;
+  i := StrTointDef(Host, 0);
+  Result := Result + Chr(i);
+end;
+
+{==============================================================================}
+
 begin
   exit;
   asm

mimeinln.pas

@@ -0,0 +1,173 @@
+{==============================================================================|
+| Project : Delphree - Synapse                                   | 001.000.000 |
+|==============================================================================|
+| Content: Inline 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     |
+| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
+|                                                                              |
+| Software distributed under the License is distributed on an "AS IS" basis,   |
+| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
+| the specific language governing rights and limitations under the License.    |
+|==============================================================================|
+| The Original Code is Synapse Delphi Library.                                 |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000.                     |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+unit MIMEinLN;
+
+interface
+
+uses
+  sysutils, classes, windows, MIMEchar, SynaCode, SynaUtil;
+
+function InlineDecode(value:string;CP:TMimeChar):string;
+function InlineEncode(value:string;CP,MimeP:TMimeChar):string;
+Function NeedInline(value:string):boolean;
+function InlineCode(value:string):string;
+function InlineEmail(value:string):string;
+
+implementation
+
+{==============================================================================}
+{InlineDecode}
+function InlineDecode(value:string;CP:TMimeChar):string;
+var
+  s,su:string;
+  x,y,z,n:integer;
+  ichar:TMimeChar;
+  c:char;
+
+  function SearchEndInline(value:string;be:integer):integer;
+  var
+    n,q:integer;
+  begin
+    q:=0;
+    result:=0;
+    for n:=be+2 to length(value)-1 do
+      if value[n]='?' then
+        begin
+          inc(q);
+          if (q>2) and (value[n+1]='=') then
+            begin
+              result:=n;
+              break;
+            end;
+        end;
+  end;
+
+begin
+  result:=value;
+  x:=pos('=?',result);
+  y:=SearchEndInline(result,x);
+  while y>x do
+    begin
+      s:=copy(result,x,y-x+2);
+      su:=copy(s,3,length(s)-4);
+      ichar:=GetCPfromID(su);
+      z:=pos('?',su);
+      if (length(su)>=(z+2)) and (su[z+2]='?') then
+        begin
+          c:=uppercase(su)[z+1];
+          su:=copy(su,z+3,length(su)-z-2);
+          if c='B' then
+            begin
+              s:=DecodeBase64(su);
+              s:=DecodeChar(s,ichar,CP);
+            end;
+          if c='Q' then
+            begin
+              s:='';
+              for n:=1 to length(su) do
+                if su[n]='_'
+                  then s:=s+' '
+                  else s:=s+su[n];
+              s:=DecodeQuotedprintable(s);
+              s:=DecodeChar(s,ichar,CP);
+            end;
+        end;
+      result:=copy(result,1,x-1)+s+copy(result,y+2,length(result)-y-1);
+      x:=pos('=?',result);
+      y:=SearchEndInline(result,x);
+    end;
+end;
+
+{==============================================================================}
+{InlineEncode}
+function InlineEncode(value:string;CP,MimeP:TMimeChar):string;
+var
+  s,s1:string;
+  n:integer;
+begin
+  s:=DecodeChar(value,CP,MimeP);
+  s:=EncodeQuotedPrintable(s);
+  s1:='';
+  for n:=1 to length(s) do
+    if s[n]=' '
+      then s1:=s1+'=20'
+      else s1:=s1+s[n];
+  result:='=?'+GetIdFromCP(MimeP)+'?Q?'+s1+'?=';
+end;
+
+{==============================================================================}
+{NeedInline}
+Function NeedInline(value:string):boolean;
+var
+  n:integer;
+begin
+  result:=false;
+  for n:=1 to length(value) do
+    if value[n] in (SpecialChar+[char(1)..char(31),char(128)..char(255)]) then
+      begin
+        result:=true;
+        break;
+      end;
+end;
+
+{==============================================================================}
+{InlineCode}
+function InlineCode(value:string):string;
+var
+  c:TMimeChar;
+begin
+  if NeedInline(value)
+    then
+      begin
+        c:=IdealCoding(value,GetCurCP,
+          [ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
+          ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10]);
+        result:=InlineEncode(value,GetCurCP,c);
+      end
+    else result:=value;
+end;
+
+{==============================================================================}
+{InlineEmail}
+function InlineEmail(value:string):string;
+var
+  sd,se:string;
+begin
+  sd:=getEmaildesc(value);
+  se:=getEmailAddr(value);
+  if sd=''
+    then result:=se
+    else result:='"'+InlineCode(sd)+'"<'+se+'>';
+end;
+
+{==============================================================================}
+
+begin
+  exit;
+  asm
+    db 'Synapse Inline MIME encoding and decoding library by Lukas Gebauer',0
+  end;
+end.

mimemess.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.000 |
+| Project : Delphree - Synapse                                   | 001.000.001 |
 |==============================================================================|
 | Content: MIME message object                                                 |
 |==============================================================================|
@@ -29,7 +29,7 @@ unit MIMEmess;
 interface
 
 uses
-  classes, Sysutils, MimePart, MimeChar, SynaUtil;
+  classes, Sysutils, MimePart, MimeChar, SynaUtil, MIMEInLn;
 
 type
 
@@ -103,7 +103,6 @@ end;
 function TMimeMess.AddPart:integer;
 var
   mp:TMimePart;
-  n:integer;
 begin
   mp:=TMimePart.create;
   result:=PartList.Add(mp);
@@ -134,8 +133,7 @@ end;
 {TMimeMess.AddPartBinary}
 procedure TMimeMess.AddPartBinary(value:string);
 var
-  n,x:integer;
+  x:integer;
-  s:string;
 begin
   x:=Addpart;
   with TMimePart(PartList[x]) do
@@ -189,7 +187,6 @@ end;
 {TMimeMess.FinalizeHeaders}
 procedure TMimeMess.FinalizeHeaders;
 var
-  s:string;
   n:integer;
 begin
   Lines.Insert(0,'x-mailer: Synapse - Delphi TCP/IP library by Lukas Gebauer');
@@ -236,8 +233,8 @@ procedure TMimeMess.DecodeMessage;
 var
   l:tstringlist;
   m:tmimepart;
-  x,i,n:integer;
+  x,i:integer;
-  bound,s:string;
+  bound:string;
 begin
   l:=tstringlist.create;
   m:=tmimepart.create;

mimepart.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.001 |
+| Project : Delphree - Synapse                                   | 001.001.000 |
 |==============================================================================|
 | Content: MIME support procedures and functions                                    |
 |==============================================================================|
@@ -78,33 +78,38 @@ TMimePart=class
 end;
 
 const
-  MaxMimeType=15;
+  MaxMimeType=25;
   MimeType:array [0..MaxMimeType,0..2] of string=
     (
+      ('AU','audio','basic'),
+      ('AVI','video','x-msvideo'),
+      ('BMP','image','BMP'),
       ('DOC','application','MSWord'),
+      ('EPS','application','Postscript'),
       ('GIF','image','GIF'),
       ('JPEG','image','JPEG'),
       ('JPG','image','JPEG'),
+      ('MID','audio','midi'),
+      ('MOV','video','quicktime'),
       ('MPEG','video','MPEG'),
       ('MPG','video','MPEG'),
+      ('MP2','audio','mpeg'),
+      ('MP3','audio','mpeg'),
       ('PDF','application','PDF'),
       ('PNG','image','PNG'),
       ('PS','application','Postscript'),
-      ('MOV','video','quicktime'),
+      ('QT','video','quicktime'),
+      ('RA','audio','x-realaudio'),
       ('RTF','application','RTF'),
+      ('SND','audio','basic'),
       ('TIF','image','TIFF'),
       ('TIFF','image','TIFF'),
-      ('WAV','audio','basic'),
+      ('WAV','audio','x-wav'),
       ('WPD','application','Wordperfect5.1'),
       ('ZIP','application','ZIP')
     );
 
 procedure NormalizePart(value:Tstringlist);
-function InlineDecode(value:string;CP:TMimeChar):string;
-function InlineEncode(value:string;CP,MimeP:TMimeChar):string;
-Function NeedInline(value:string):boolean;
-function InlineCode(value:string):string;
-function InlineEmail(value:string):string;
 function GenerateBoundary:string;
 
 implementation
@@ -112,12 +117,10 @@ implementation
 procedure NormalizePart(value:Tstringlist);
 var
   t:tstringlist;
-  x:integer;
   s:string;
 begin
   t:=tstringlist.create;
   try
-    x:=0;
     while (value.Count-1) > 0 do
       begin
         s:=value[0];
@@ -183,7 +186,7 @@ end;
 {TMIMEPart.ExtractPart}
 function TMIMEPart.ExtractPart(value:TStringList; BeginLine:integer):integer;
 var
-  n,x,y,x1,x2:integer;
+  n,x,x1,x2:integer;
   t:tstringlist;
   s,su,b:string;
   st,st2:string;
@@ -512,128 +515,15 @@ end;
 
 {TMIMEPart.SetCharset}
 procedure TMIMEPart.SetCharset(Value:string);
-var
-  s:string;
 begin
   FCharset:=Value;
   CharsetCode:=GetCPfromID(value);
 end;
 
-{==============================================================================}
-{InlineDecode}
-function InlineDecode(value:string;CP:TMimeChar):string;
-var
-  s,su:string;
-  x,y,z,n:integer;
-  ichar:TMimeChar;
-  c:char;
-begin
-  result:=value;
-  x:=pos('=?',uppercase(value));
-  y:=pos('?=',value);
-  if y>x then
-    begin
-      s:=copy(value,x,y-x+2);
-      su:=copy(s,3,length(s)-4);
-      ichar:=GetCPfromID(su);
-      z:=pos('?',su);
-      if (length(su)>=(z+2)) and (su[z+2]='?') then
-        begin
-          c:=uppercase(su)[z+1];
-          su:=copy(su,z+3,length(su)-z-2);
-          if c='B' then
-            begin
-              s:=DecodeBase64(su);
-              s:=DecodeChar(s,ichar,CP);
-            end;
-          if c='Q' then
-            begin
-              s:='';
-              for n:=1 to length(su) do
-                if su[n]='_'
-                  then s:=s+' '
-                  else s:=s+su[n];
-              s:=DecodeQuotedprintable(s);
-              s:=DecodeChar(s,ichar,CP);
-            end;
-        end;
-      result:=copy(value,1,x-1)+s+copy(value,y+2,length(value)-y-1);
-      repeat
-        s:=InlineDecode(result,CP);
-        if s=result
-          then break;
-        result:=s;
-      until false;
-    end;
-end;
-
-{==============================================================================}
-{InlineEncode}
-function InlineEncode(value:string;CP,MimeP:TMimeChar):string;
-var
-  s,s1:string;
-  n:integer;
-begin
-  s:=DecodeChar(value,CP,MimeP);
-  s:=EncodeQuotedPrintable(s);
-  s1:='';
-  for n:=1 to length(s) do
-    if s[n]=' '
-      then s1:=s1+'=20'
-      else s1:=s1+s[n];
-  result:='=?'+GetIdFromCP(MimeP)+'?Q?'+s1+'?=';
-end;
-
-{==============================================================================}
-{NeedInline}
-Function NeedInline(value:string):boolean;
-var
-  n:integer;
-begin
-  result:=false;
-  for n:=1 to length(value) do
-    if value[n] in (SpecialChar+[char(1)..char(31),char(128)..char(255)]) then
-      begin
-        result:=true;
-        break;
-      end;
-end;
-
-{==============================================================================}
-{InlineCode}
-function InlineCode(value:string):string;
-var
-  c:TMimeChar;
-begin
-  if NeedInline(value)
-    then
-      begin
-        c:=IdealCoding(value,GetCurCP,
-          [ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
-          ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10]);
-        result:=InlineEncode(value,GetCurCP,c);
-      end
-    else result:=value;
-end;
-
-{==============================================================================}
-{InlineEmail}
-function InlineEmail(value:string):string;
-var
-  sd,se:string;
-begin
-  sd:=getEmaildesc(value);
-  se:=getEmailAddr(value);
-  if sd=''
-    then result:=se
-    else result:='"'+InlineCode(sd)+'"<'+se+'>';
-end;
-
 {==============================================================================}
 {GenerateBoundary}
 function GenerateBoundary:string;
 var
-  s:string;
   x:integer;
 begin
   randomize;

synacode.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.001.000 |
+| Project : Delphree - Synapse                                   | 001.001.001 |
 |==============================================================================|
 | Content: Coding and decoding support                                         |
 |==============================================================================|
@@ -151,7 +151,7 @@ begin
       if c<>'='
         then result:=result+c
         else
-          if (x+1)<length(value)
+          if x<length(value)
             then
               begin
                 s:=copy(value,x,2);

synautil.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.004.000 |
+| Project : Delphree - Synapse                                   | 001.005.000 |
 |==============================================================================|
 | Content: support procedures and functions                                    |
 |==============================================================================|
@@ -30,7 +30,7 @@ unit SynaUtil;
 interface
 
 uses
-  Blcksock, sysutils, classes, windows;
+  sysutils, classes, windows;
 
 function timezone:string;
 function Rfc822DateTime(t:TDateTime):String;
@@ -39,10 +39,6 @@ function DeCodeInt(Value:string;Index:integer):word;
 function IsIP(Value:string):Boolean;
 function ReverseIP(Value:string):string;
 procedure Dump (Buffer:string;DumpFile:string);
-Function MibToId(mib:string):string;
-Function IdToMib(id:string):string;
-Function IntMibToStr(int:string):string;
-function IPToID(Host: string): string;
 function SeparateLeft(value,delimiter:string):string;
 function SeparateRight(value,delimiter:string):string;
 function getparameter(value,parameter:string):string;
@@ -52,9 +48,6 @@ function StrToHex(value:string):string;
 
 implementation
 
-uses
-  ASN1util;
-
 {==============================================================================}
 {timezone}
 function timezone:string;
@@ -199,98 +192,6 @@ begin
   end;
 end;
 
-{==============================================================================}
-
-{MibToId}
-function MibToId(mib:string):string;
-var
-  x:integer;
-
-  Function walkInt(var s:string):integer;
-  var
-    x:integer;
-    t:string;
-  begin
-    x:=pos('.',s);
-    if x<1 then
-      begin
-        t:=s;
-        s:='';
-      end
-      else
-      begin
-        t:=copy(s,1,x-1);
-        s:=copy(s,x+1,length(s)-x);
-      end;
-    result:=StrToIntDef(t,0);
-  end;
-begin
-  result:='';
-  x:=walkint(mib);
-  x:=x*40+walkint(mib);
-  result:=ASNEncOIDItem(x);
-  while mib<>'' do
-    begin
-      x:=walkint(mib);
-      result:=result+ASNEncOIDItem(x);
-    end;
-end;
-
-{==============================================================================}
-
-{IdToMib}
-Function IdToMib(id:string):string;
-var
-  x,y,n:integer;
-begin
-  result:='';
-  n:=1;
-  while length(id)+1>n do
-    begin
-      x:=ASNDecOIDItem(n,id);
-      if (n-1)=1 then
-        begin
-          y:=x div 40;
-          x:=x mod 40;
-          result:=IntTostr(y);
-        end;
-      result:=result+'.'+IntToStr(x);
-    end;
-end;
-
-{==============================================================================}
-{IntMibToStr}
-Function IntMibToStr(int:string):string;
-Var
-  n,y:integer;
-begin
-  y:=0;
-  for n:=1 to length(int)-1 do
-    y:=y*256+ord(int[n]);
-  result:=IntToStr(y);
-end;
-
-{==============================================================================}
-{IPToID} //Hernan Sanchez
-function IPToID(Host: string): string;
-var
-  s, t: string;
-  i, x: integer;
-begin
-  Result := '';
-  for x:= 1 to 3 do
-    begin
-      t := '';
-      s := StrScan(PChar(Host), '.');
-      t := Copy(Host, 1, (Length(Host) - Length(s)));
-      Delete(Host, 1, (Length(Host) - Length(s) + 1));
-      i := StrTointDef(t, 0);
-      Result := Result + Chr(i);
-    end;
-  i := StrTointDef(Host, 0);
-  Result := Result + Chr(i);
-end;
-
 {==============================================================================}
 {SeparateLeft}
 function SeparateLeft(value,delimiter:string):string;
@@ -310,6 +211,8 @@ var
   x:integer;
 begin
   x:=pos(delimiter,value);
+  if x>0
+    then x:=x+length(delimiter)-1;
   result:=trim(copy(value,x+1,length(value)-x));
 end;