diff --git a/httpsend.pas b/httpsend.pas index 65f640a..b65bf2c 100644 --- a/httpsend.pas +++ b/httpsend.pas @@ -1,7 +1,7 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.001.000 | +| Project : Delphree - Synapse | 001.002.000 | |==============================================================================| -| Content: HTTP client | +| Content: HTTP client | |==============================================================================| | 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 | @@ -14,7 +14,7 @@ | 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) 1999. | +| Portions created by Lukas Gebauer are Copyright (c) 1999,2000,2001. | | All Rights Reserved. | |==============================================================================| | Contributor(s): | @@ -27,7 +27,7 @@ unit HTTPsend; interface uses - Blcksock, sysutils, classes, windows, SynaUtil; + Blcksock, sysutils, classes, windows, SynaUtil, SynaCode; const CRLF=#13+#10; @@ -39,13 +39,21 @@ type public timeout:integer; HTTPHost:string; - HTTPPort:integer; + HTTPPort:string; + ProxyHost:string; + ProxyPort:string; + ProxyUser:string; + ProxyPass:string; + ResultCode:integer; Constructor Create; Destructor Destroy; override; function Request(Query,Response:TStrings):Boolean; + function DoMethod(method,URL:string;Content,Response:TStrings):boolean; end; -function get(Host,URI:string;Response:TStrings):Boolean; +function SimpleGet(URL:string;Response:TStrings):Boolean; +function Get(URL:string;Response:TStrings):Boolean; +function Post(URL:string;Value,Response:TStrings):Boolean; implementation @@ -57,7 +65,11 @@ begin sock.CreateSocket; timeout:=300000; HTTPhost:='localhost'; - HTTPPort:=80; + HTTPPort:='80'; + ProxyHost:=''; + ProxyPort:='8080'; + ProxyUser:=''; + ProxyPass:=''; end; {THTTPSend.Destroy} @@ -74,7 +86,7 @@ var n:integer; begin Result:=False; - sock.Connect(HTTPHost,IntToStr(HTTPPort)); + sock.Connect(HTTPHost,HTTPPort); if sock.lasterror<>0 then Exit; for n:=0 to Query.Count-1 do Sock.SendString(Query[n]+CRLF); @@ -88,20 +100,84 @@ begin Result:=True; end; +{THTTPSend.DoMethod} +function THTTPSend.DoMethod(method,URL:string;Content,Response:TStrings):boolean; +var + Prot,User,Pass,Host,Port,Path,Para:string; + Query:TstringList; + size:integer; + s:string; +begin + result:=false; + Query:=TstringList.create; + try + parseURL(URL,Prot,User,Pass,Host,Port,Path,Para); + if content<>nil + then query.AddStrings(content); + size:=length(query.text); + query.insert(0,''); + query.insert(0,'User-Agent: Synapse/1.1'); + query.insert(0,'Connection: close'); + query.insert(0,'Accept-Encoding: identity'); + if User<>'' + then query.insert(0,'Authorization: Basic '+EncodeBase64(user+':'+pass)); + if (proxyhost<>'') and (proxyUser<>'') + then query.insert(0,'Proxy-Authorization: Basic '+EncodeBase64(Proxyuser+':'+Proxypass)); + if size>0 + then query.insert(0,'Content-Length: '+inttostr(size)); + query.insert(0,'Host: '+host+':'+port); + + if para='' + then s:='' + else s:='?'+para; + s:=path+s; + if proxyHost<>'' + then s:=prot+'://'+host+':'+port+s; + query.insert(0,uppercase(method)+' '+s+' HTTP/1.0'); + if proxyhost='' + then + begin + HttpHost:=host; + HttpPort:=port; + end + else + begin + HttpHost:=Proxyhost; + HttpPort:=Proxyport; + end; + result:=request(query,response); + ResultCode:=0; + if response.count>0 + then if pos('HTTP/',uppercase(response[0]))=1 + then + begin + s:=separateright(response[0],' '); + s:=separateleft(s,' '); + ResultCode:=StrToIntDef(s,0); + end; + finally + Query.free; + end; +end; + {==============================================================================} -{get} -function get(Host,URI:string;Response:TStrings):Boolean; +{SimpleGet} +function SimpleGet(URL:string;Response:TStrings):Boolean; var HTTP:THTTPSend; Query:TStringList; + Prot,User,Pass,Host,Port,Path,Para:string; begin + parseURL(URL,Prot,User,Pass,Host,Port,Path,Para); + if para<>'' + then path:=path+'?'+para; Result:=False; HTTP:=THTTPSend.Create; Query:=TStringList.create; try HTTP.HTTPhost:=Host; - Query.Add('GET '+URI+' HTTP/0.9'); + Query.Add('GET '+Path); if not HTTP.Request(Query,Response) then Exit; finally Query.Free; @@ -110,4 +186,35 @@ begin Result:=True; end; +{get} +function Get(URL:string;Response:TStrings):Boolean; +var + HTTP:THTTPSend; + Prot,User,Pass,Host,Port,Path,Para:string; +begin + Result:=False; + HTTP:=THTTPSend.Create; + try + result:=HTTP.DoMethod('GET',URL,nil,Response); + finally + HTTP.Free; + end; +end; + +{post} +function Post(URL:string;Value,Response:TStrings):Boolean; +var + HTTP:THTTPSend; + Prot,User,Pass,Host,Port,Path,Para:string; +begin + Result:=False; + HTTP:=THTTPSend.Create; + try + result:=HTTP.DoMethod('POST',URL,Value,Response); + finally + HTTP.Free; + end; +end; + + end. diff --git a/smtpsend.pas b/smtpsend.pas index 27341ce..0bf8508 100644 --- a/smtpsend.pas +++ b/smtpsend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.003.000 | +| Project : Delphree - Synapse | 002.000.000 | |==============================================================================| | Content: SMTP client | |==============================================================================| @@ -14,7 +14,7 @@ | 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) 1999. | +| Portions created by Lukas Gebauer are Copyright (c) 1999,2000,2001. | | All Rights Reserved. | |==============================================================================| | Contributor(s): | @@ -27,7 +27,7 @@ unit SMTPsend; interface uses - Blcksock, sysutils, classes, windows, SynaUtil; + Blcksock, sysutils, classes, windows, SynaUtil, SynaCode; const CRLF=#13+#10; @@ -36,25 +36,43 @@ type TSMTPSend = class private Sock:TTCPBlockSocket; + procedure EnhancedCode(value:string); function ReadResult:integer; public timeout:integer; SMTPHost:string; ResultCode:integer; ResultString:string; + FullResult:TStringList; + ESMTPcap:TStringList; + ESMTP:boolean; + Username:string; + Password:string; + AuthDone:boolean; + ESMTPSize:boolean; + MaxSize:integer; + EnhCode1:integer; + EnhCode2:integer; + EnhCode3:integer; Constructor Create; Destructor Destroy; override; + function AuthLogin:Boolean; + function AuthCram:Boolean; function login:Boolean; procedure logout; function reset:Boolean; function noop:Boolean; - function mailfrom(Value:string):Boolean; + function mailfrom(Value:string; size:integer):Boolean; function mailto(Value:string):Boolean; function maildata(Value:Tstrings):Boolean; + function etrn(Value:string):Boolean; + function verify(Value:string):Boolean; + function EnhCodeString:string; end; -function SendtoRaw (mailfrom,mailto,SMTPHost:string;maildata:TStrings):Boolean; +function SendtoRaw (mailfrom,mailto,SMTPHost:string;maildata:TStrings;Username,Password:string):Boolean; function Sendto (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean; +function SendtoEx (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings;Username,Password:string):Boolean; implementation @@ -62,50 +80,160 @@ implementation Constructor TSMTPSend.Create; begin inherited Create; + FullResult:=TStringList.create; + ESMTPcap:=TStringList.create; sock:=TTCPBlockSocket.create; sock.CreateSocket; timeout:=300000; SMTPhost:='localhost'; + Username:=''; + Password:=''; end; {TSMTPSend.Destroy} Destructor TSMTPSend.Destroy; begin Sock.free; + ESMTPcap.free; + FullResult.free; inherited destroy; end; +{TSMTPSend.EnhancedCode} +procedure TSMTPSend.EnhancedCode (value:string); +var + s,t:string; + e1,e2,e3:integer; +begin + EnhCode1:=0; + EnhCode2:=0; + EnhCode3:=0; + s:=copy(value,5,length(value)-4); + t:=separateleft(s,'.'); + s:=separateright(s,'.'); + if t='' then exit; + if length(t)>1 then exit; + e1:=strtointdef(t,0); + if e1=0 then exit; + t:=separateleft(s,'.'); + s:=separateright(s,'.'); + if t='' then exit; + if length(t)>3 then exit; + e2:=strtointdef(t,0); + t:=separateleft(s,' '); + if t='' then exit; + if length(t)>3 then exit; + e3:=strtointdef(t,0); + EnhCode1:=e1; + EnhCode2:=e2; + EnhCode3:=e3; +end; + {TSMTPSend.ReadResult} function TSMTPSend.ReadResult:integer; var s:string; begin Result:=0; - s:=sock.recvstring(timeout); - ResultString:=s; + FullResult.Clear; + repeat + s:=sock.recvstring(timeout); + ResultString:=s; + FullResult.add(s); + if sock.LastError<>0 then + break; + until pos('-',s)<>4; + s:=FullResult[0]; if Length(s)>=3 then Result:=Strtointdef(Copy(s,1,3),0); - while pos('-',s)=4 do - begin - s:=sock.recvstring(timeout); - if sock.LastError<>0 then - begin - Result:=0; - break; - end; - end; ResultCode:=Result; + EnhancedCode(s); +end; + +{TSMTPSend.AuthLogin} +function TSMTPSend.AuthLogin:Boolean; +begin + Result:=false; + Sock.SendString('AUTH LOGIN'+CRLF); + if readresult<>334 then Exit; + Sock.SendString(Encodebase64(username)+CRLF); + if readresult<>334 then Exit; + Sock.SendString(Encodebase64(password)+CRLF); + if readresult<>235 then Exit; + Result:=True; +end; + +{TSMTPSend.AuthCram} +function TSMTPSend.AuthCram:Boolean; +var + s,sm:string; + ipad,opad:string; + n,x:integer; +begin + Result:=false; + Sock.SendString('AUTH CRAM-MD5'+CRLF); + if readresult<>334 then Exit; + s:=copy(ResultString,5,length(ResultString)-4); + s:=DecodeBase64(s); + s:=HMAC_MD5(s,password); + s:=Username+' '+strtohex(s); + Sock.SendString(Encodebase64(s)+CRLF); + if readresult<>235 then Exit; + Result:=True; end; {TSMTPSend.login} function TSMTPSend.login:Boolean; +var + n:integer; + auths:string; begin Result:=False; + ESMTP:=true; + AuthDone:=false; + ESMTPcap.clear; + ESMTPSize:=false; + MaxSize:=0; sock.Connect(SMTPHost,'smtp'); if sock.lasterror<>0 then Exit; if readresult<>220 then Exit; - Sock.SendString('HELO '+sock.LocalName+CRLF); - if readresult<>250 then Exit; + Sock.SendString('EHLO '+sock.LocalName+CRLF); + if readresult<>250 then + begin + ESMTP:=false; + Sock.SendString('HELO '+sock.LocalName+CRLF); + if readresult<>250 then Exit; + end; Result:=True; + if ESMTP then + begin + for n:=1 to FullResult.count-1 do + ESMTPcap.add(Copy(FullResult[n],5,length(Fullresult[n])-4)); + if not ((Username='') and (Password='')) then + for n:=0 to ESMTPcap.count-1 do + begin + auths:=uppercase(ESMTPcap[n]); + if pos('AUTH ',auths)=1 then + begin + if pos('CRAM-MD5',auths)>0 then + begin + AuthDone:=AuthCram; + break; + end; + if pos('LOGIN',auths)>0 then + begin + AuthDone:=AuthLogin; + break; + end; + end; + end; + for n:=0 to ESMTPcap.count-1 do + if pos('SIZE',uppercase(ESMTPcap[n]))=1 then + begin + ESMTPsize:=true; + MaxSize:=StrToIntDef(copy(ESMTPcap[n],6,length(ESMTPcap[n])-5),0); + break; + end; + end; end; {TSMTPSend.logout} @@ -136,10 +264,15 @@ end; {TSMTPSend.mailfrom} -function TSMTPSend.mailfrom(Value:string):Boolean; +function TSMTPSend.mailfrom(Value:string; size:integer):Boolean; +var + s:string; begin Result:=false; - Sock.SendString('MAIL FROM:<'+Value+'>'+CRLF); + s:='MAIL FROM:<'+Value+'>'; + if ESMTPsize and (size>0) + then s:=s+' SIZE='+IntToStr(size); + Sock.SendString(s+CRLF); if readresult<>250 then Exit; Result:=True; end; @@ -174,18 +307,105 @@ begin Result:=True; end; +{TSMTPSend.etrn} +function TSMTPSend.etrn(Value:string):Boolean; +begin + Result:=false; + Sock.SendString('ETRN '+Value+CRLF); + if (readresult<250) or (readresult>259) then Exit; + Result:=True; +end; + +{TSMTPSend.verify} +function TSMTPSend.verify(Value:string):Boolean; +begin + Result:=false; + Sock.SendString('VRFY '+Value+CRLF); + if (readresult<250) or (readresult>259) then Exit; + Result:=True; +end; + +{TSMTPSend.EnhCodeString} +function TSMTPSend.EnhCodeString:string; +var + s,t:string; +begin + s:=inttostr(EnhCode2)+'.'+inttostr(EnhCode3); + t:=''; + if s='0.0' then t:='Other undefined Status'; + if s='1.0' then t:='Other address status'; + if s='1.1' then t:='Bad destination mailbox address'; + if s='1.2' then t:='Bad destination system address'; + if s='1.3' then t:='Bad destination mailbox address syntax'; + if s='1.4' then t:='Destination mailbox address ambiguous'; + if s='1.5' then t:='Destination mailbox address valid'; + if s='1.6' then t:='Mailbox has moved'; + if s='1.7' then t:='Bad sender''s mailbox address syntax'; + if s='1.8' then t:='Bad sender''s system address'; + if s='2.0' then t:='Other or undefined mailbox status'; + if s='2.1' then t:='Mailbox disabled, not accepting messages'; + if s='2.2' then t:='Mailbox full'; + if s='2.3' then t:='Message length exceeds administrative limit'; + if s='2.4' then t:='Mailing list expansion problem'; + if s='3.0' then t:='Other or undefined mail system status'; + if s='3.1' then t:='Mail system full'; + if s='3.2' then t:='System not accepting network messages'; + if s='3.3' then t:='System not capable of selected features'; + if s='3.4' then t:='Message too big for system'; + if s='3.5' then t:='System incorrectly configured'; + if s='4.0' then t:='Other or undefined network or routing status'; + if s='4.1' then t:='No answer from host'; + if s='4.2' then t:='Bad connection'; + if s='4.3' then t:='Routing server failure'; + if s='4.4' then t:='Unable to route'; + if s='4.5' then t:='Network congestion'; + if s='4.6' then t:='Routing loop detected'; + if s='4.7' then t:='Delivery time expired'; + if s='5.0' then t:='Other or undefined protocol status'; + if s='5.1' then t:='Invalid command'; + if s='5.2' then t:='Syntax error'; + if s='5.3' then t:='Too many recipients'; + if s='5.4' then t:='Invalid command arguments'; + if s='5.5' then t:='Wrong protocol version'; + if s='6.0' then t:='Other or undefined media error'; + if s='6.1' then t:='Media not supported'; + if s='6.2' then t:='Conversion required and prohibited'; + if s='6.3' then t:='Conversion required but not supported'; + if s='6.4' then t:='Conversion with loss performed'; + if s='6.5' then t:='Conversion failed'; + if s='7.0' then t:='Other or undefined security status'; + if s='7.1' then t:='Delivery not authorized, message refused'; + if s='7.2' then t:='Mailing list expansion prohibited'; + if s='7.3' then t:='Security conversion required but not possible'; + if s='7.4' then t:='Security features not supported'; + if s='7.5' then t:='Cryptographic failure'; + if s='7.6' then t:='Cryptographic algorithm not supported'; + if s='7.7' then t:='Message integrity failure'; + s:='???-'; + if EnhCode1=2 then s:='Success-'; + if EnhCode1=4 then s:='Persistent Transient Failure-'; + if EnhCode1=5 then s:='Permanent Failure-'; + result:=s+t; +end; + + {==============================================================================} -function SendtoRaw (mailfrom,mailto,SMTPHost:string;maildata:TStrings):Boolean; +function SendtoRaw (mailfrom,mailto,SMTPHost:string;maildata:TStrings; + Username,Password:string):Boolean; var SMTP:TSMTPSend; + size:integer; begin Result:=False; SMTP:=TSMTPSend.Create; try SMTP.SMTPHost:=SMTPHost; + SMTP.Username:=Username; + SMTP.Password:=Password; if not SMTP.login then Exit; - if not SMTP.mailfrom(mailfrom) then Exit; + size:=length(maildata.text); + if not SMTP.mailfrom(mailfrom,size) then Exit; if not SMTP.mailto(mailto) then Exit; if not SMTP.maildata(Maildata) then Exit; SMTP.logout; @@ -195,7 +415,8 @@ begin end; end; -function Sendto (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean; +function SendtoEx (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings; + Username,Password:string):Boolean; var t:TStrings; begin @@ -209,11 +430,15 @@ begin t.Insert(0,'date: '+Rfc822DateTime(now)); t.Insert(0,'to: '+mailto); t.Insert(0,'from: '+mailfrom); - result:=SendToRaw(mailfrom,mailto,SMTPHost,t); + result:=SendToRaw(mailfrom,mailto,SMTPHost,t,Username,Password); finally t.Free; end; end; +function Sendto (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean; +begin + result:=SendToEx(mailfrom,mailto,subject,SMTPHost,maildata,'',''); +end; end. diff --git a/synacode.pas b/synacode.pas index 20d4005..9b1d669 100644 --- a/synacode.pas +++ b/synacode.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.002.000 | +| Project : Delphree - Synapse | 001.003.000 | |==============================================================================| | Content: Coding and decoding support | |==============================================================================| @@ -14,7 +14,7 @@ | 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. | +| Portions created by Lukas Gebauer are Copyright (c)2000, 2001. | | All Rights Reserved. | |==============================================================================| | Contributor(s): | @@ -133,6 +133,7 @@ function Crc32(value:string):integer; function UpdateCrc16(value:byte;crc16:word):word; function Crc16(value:string):word; function MD5(value:string):string; +function HMAC_MD5(text,key:string):string; implementation @@ -557,6 +558,37 @@ begin result:=MD5Final(MD5Context); end; +{==============================================================================} +{HMAC_MD5} +function HMAC_MD5(text,key:string):string; +var + ipad,opad,s:string; + n:integer; + MD5Context : TMD5Ctx; +begin + if length(key)>64 then + key:=md5(key); + ipad:=''; + for n:=1 to 64 do + ipad:=ipad+#$36; + opad:=''; + for n:=1 to 64 do + opad:=opad+#$5c; + for n:=1 to length(key) do + begin + ipad[n]:=char(byte(ipad[n]) xor byte(key[n])); + opad[n]:=char(byte(opad[n]) xor byte(key[n])); + end; + MD5Init(MD5Context); + MD5Update(MD5Context,ipad); + MD5Update(MD5Context,text); + s:=MD5Final(MD5Context); + MD5Init(MD5Context); + MD5Update(MD5Context,opad); + MD5Update(MD5Context,s); + result:=MD5Final(MD5Context); +end; + {==============================================================================} begin diff --git a/synautil.pas b/synautil.pas index 6e9cba7..fb10fc8 100644 --- a/synautil.pas +++ b/synautil.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.006.000 | +| Project : Delphree - Synapse | 001.007.000 | |==============================================================================| | Content: support procedures and functions | |==============================================================================| @@ -14,7 +14,7 @@ | 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) 1999, 2000. | +| Portions created by Lukas Gebauer are Copyright (c) 1999,2000,2001. | | Portions created by Hernan Sanchez are Copyright (c) 2000. | | All Rights Reserved. | |==============================================================================| @@ -47,6 +47,7 @@ function GetEmailDesc(value:string):string; function StrToHex(value:string):string; function IntToBin(value:integer;digits:byte):string; function BinToInt(value:string):integer; +procedure ParseURL(URL:string; var Prot,User,Pass,Host,Port,Path,Para:string); implementation @@ -335,6 +336,70 @@ begin end; end; +{==============================================================================} +{ParseURL} +procedure ParseURL(URL:string; var Prot,User,Pass,Host,Port,Path,Para:string); +var + x:integer; + sURL:string; + s:string; + s1,s2:string; +begin + prot:='http'; + user:=''; + pass:=''; + port:='80'; + para:=''; + + x:=pos('://',URL); + if x>0 then + begin + prot:=separateleft(URL,'://'); + sURL:=separateright(URL,'://'); + end + else sURL:=URL; + x:=pos('@',sURL); + if x>0 then + begin + s:=separateleft(sURL,'@'); + sURL:=separateright(sURL,'@'); + x:=pos(':',s); + if x>0 then + begin + user:=separateleft(s,':'); + pass:=separateright(s,':'); + end + else user:=s; + end; + x:=pos('/',sURL); + if x>0 then + begin + s1:=separateleft(sURL,'/'); + s2:=separateright(sURL,'/'); + end + else + begin + s1:=sURL; + s2:=''; + end; + x:=pos(':',s1); + if x>0 then + begin + host:=separateleft(s1,':'); + port:=separateright(s1,':'); + end + else host:=s1; + x:=pos('?',s2); + if x>0 then + begin + path:='/'+separateleft(s2,'?'); + para:=separateright(s2,'?'); + end + else path:='/'+s2; + if host='' + then host:='localhost'; +end; + {==============================================================================} end.