pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Release 14

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@31 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2008-04-23 20:51:17 +00:00
parent e9e1d8f75a
commit 318575bb8e
6 changed files with 313 additions and 238 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
asn1util.pas
View File

@ -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

173
mimeinln.pas Normal file
View File

@ -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.

13
mimemess.pas
View File

@ -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;
s:string;
x:integer;
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;
bound,s:string;
x,i:integer;
bound:string;
begin
l:=tstringlist.create;
m:=tmimepart.create;

140
mimepart.pas
View File

@ -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;

4
synacode.pas
View File

@ -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);

105
synautil.pas
View File

@ -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;