pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Release 18

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@39 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2008-04-24 06:46:22 +00:00
parent a644f1e5b4
commit 09292a9c65
5 changed files with 671 additions and 262 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

217
blcksock.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 002.000.001 | | Project : Delphree - Synapse | 002.001.000 |
|==============================================================================| |==============================================================================|
| Content: Library base | | Content: Library base |
|==============================================================================| |==============================================================================|
@ -52,6 +52,10 @@ Protected
procedure SetSin (var sin:TSockAddrIn;ip,port:string); procedure SetSin (var sin:TSockAddrIn;ip,port:string);
function GetSinIP (sin:TSockAddrIn):string; function GetSinIP (sin:TSockAddrIn):string;
function GetSinPort (sin:TSockAddrIn):integer; function GetSinPort (sin:TSockAddrIn):integer;
function GetSizeRecvBuffer:integer;
procedure SetSizeRecvBuffer(size:integer);
function GetSizeSendBuffer:integer;
procedure SetSizeSendBuffer(size:integer);
public public
FWsaData : TWSADATA; FWsaData : TWSADATA;
@ -66,6 +70,7 @@ public
procedure SendByte(data:byte); virtual; procedure SendByte(data:byte); virtual;
procedure SendString(data:string); virtual; procedure SendString(data:string); virtual;
function RecvBuffer(buffer:pointer;length:integer):integer; virtual; function RecvBuffer(buffer:pointer;length:integer):integer; virtual;
function RecvBufferEx(buffer:pointer;length:integer;timeout:integer):integer; virtual;
function RecvByte(timeout:integer):byte; virtual; function RecvByte(timeout:integer):byte; virtual;
function Recvstring(timeout:integer):string; virtual; function Recvstring(timeout:integer):string; virtual;
function PeekBuffer(buffer:pointer;length:integer):integer; virtual; function PeekBuffer(buffer:pointer;length:integer):integer; virtual;
@ -85,14 +90,16 @@ public
function SendBufferTo(buffer:pointer;length:integer):integer; function SendBufferTo(buffer:pointer;length:integer):integer;
function RecvBufferFrom(buffer:pointer;length:integer):integer; function RecvBufferFrom(buffer:pointer;length:integer):integer;
published
property socket:TSocket read FSocket write FSocket;
property LocalSin:TSockAddrIn read FLocalSin; property LocalSin:TSockAddrIn read FLocalSin;
property RemoteSin:TSockAddrIn read FRemoteSin; property RemoteSin:TSockAddrIn read FRemoteSin;
published
property socket:TSocket read FSocket write FSocket;
property LastError:integer read FLastError; property LastError:integer read FLastError;
property Protocol:integer read FProtocol; property Protocol:integer read FProtocol;
property LineBuffer:string read FBuffer write FBuffer; property LineBuffer:string read FBuffer write FBuffer;
property RaiseExcept:boolean read FRaiseExcept write FRaiseExcept; property RaiseExcept:boolean read FRaiseExcept write FRaiseExcept;
property SizeRecvBuffer:integer read GetSizeRecvBuffer write SetSizeRecvBuffer;
property SizeSendBuffer:integer read GetSizeSendBuffer write SetSizeSendBuffer;
end; end;
{TUDPBlockSocket} {TUDPBlockSocket}
@ -265,6 +272,71 @@ begin
ExceptCheck; ExceptCheck;
end; end;
{TBlockSocket.RecvBufferEx}
function TBlockSocket.RecvBufferEx(buffer:pointer;length:integer;timeout:integer):integer;
var
s,ss,st:string;
x,l,lss:integer;
fb,fs:integer;
max:integer;
begin
FLastError:=0;
x:=system.length(FBuffer);
if length<=x
then
begin
fb:=length;
fs:=0;
end
else
begin
fb:=x;
fs:=length-x;
end;
ss:='';
if fb>0 then
begin
s:=copy(FBuffer,1,fb);
delete(Fbuffer,1,fb);
end;
if fs>0 then
begin
Max:=GetSizeRecvBuffer;
ss:='';
while system.length(ss)<fs do
begin
if canread(timeout) then
begin
l:=WaitingData;
if l>max
then l:=max;
if (system.length(ss)+l)>fs
then l:=fs-system.length(ss);
setlength(st,l);
x:=winsock.recv(FSocket,pointer(st)^,l,0);
if x=0
then FLastError:=WSAENOTCONN
else sockcheck(result);
if Flasterror<>0
then break;
lss:=system.length(ss);
setlength(ss,lss+x);
Move(pointer(st)^,Pointer(@ss[lss+1])^, x);
{It is 3x faster then ss:=ss+copy(st,1,x);}
sleep(0);
end
else FLastError:=WSAETIMEDOUT;
if Flasterror<>0
then break;
end;
fs:=system.length(ss);
end;
result:=fb+fs;
s:=s+ss;
move(pointer(s)^,buffer^,result);
ExceptCheck;
end;
{TBlockSocket.RecvByte} {TBlockSocket.RecvByte}
function TBlockSocket.RecvByte(timeout:integer):byte; function TBlockSocket.RecvByte(timeout:integer):byte;
var var
@ -515,6 +587,43 @@ begin
ExceptCheck; ExceptCheck;
end; end;
{TBlockSocket.GetSizeRecvBuffer}
function TBlockSocket.GetSizeRecvBuffer:integer;
var
l:integer;
begin
l:=SizeOf(result);
SockCheck(winsock.getSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @result, l));
if Flasterror<>0
then result:=1024;
ExceptCheck;
end;
{TBlockSocket.SetSizeRecvBuffer}
procedure TBlockSocket.SetSizeRecvBuffer(size:integer);
begin
SockCheck(winsock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @size, SizeOf(size)));
ExceptCheck;
end;
{TBlockSocket.GetSizeSendBuffer}
function TBlockSocket.GetSizeSendBuffer:integer;
var
l:integer;
begin
l:=SizeOf(result);
SockCheck(winsock.getSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @result, l));
if Flasterror<>0
then result:=1024;
ExceptCheck;
end;
{TBlockSocket.SetSizeSendBuffer}
procedure TBlockSocket.SetSizeSendBuffer(size:integer);
begin
SockCheck(winsock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @size, SizeOf(size)));
ExceptCheck;
end;
{======================================================================} {======================================================================}
@ -555,6 +664,7 @@ end;
procedure TTCPBlockSocket.Listen; procedure TTCPBlockSocket.Listen;
begin begin
SockCheck(winsock.listen(FSocket,SOMAXCONN)); SockCheck(winsock.listen(FSocket,SOMAXCONN));
GetSins;
ExceptCheck; ExceptCheck;
end; end;
@ -581,56 +691,57 @@ function GetErrorDesc(ErrorCode:integer): string;
begin begin
case ErrorCode of case ErrorCode of
0 : Result:= 'OK'; 0 : Result:= 'OK';
WSAEINTR : Result:= 'Interrupted system call'; WSAEINTR :{10004} Result:= 'Interrupted system call';
WSAEBADF : Result:= 'Bad file number'; WSAEBADF :{10009} Result:= 'Bad file number';
WSAEACCES : Result:= 'Permission denied'; WSAEACCES :{10013} Result:= 'Permission denied';
WSAEFAULT : Result:= 'Bad address'; WSAEFAULT :{10014} Result:= 'Bad address';
WSAEINVAL : Result:= 'Invalid argument'; WSAEINVAL :{10022} Result:= 'Invalid argument';
WSAEMFILE : Result:= 'Too many open files'; WSAEMFILE :{10024} Result:= 'Too many open files';
WSAEWOULDBLOCK : Result:= 'Operation would block'; WSAEWOULDBLOCK :{10035} Result:= 'Operation would block';
WSAEINPROGRESS : Result:= 'Operation now in progress'; WSAEINPROGRESS :{10036} Result:= 'Operation now in progress';
WSAEALREADY : Result:= 'Operation already in progress'; WSAEALREADY :{10037} Result:= 'Operation already in progress';
WSAENOTSOCK : Result:= 'Socket operation on nonsocket'; WSAENOTSOCK :{10038} Result:= 'Socket operation on nonsocket';
WSAEDESTADDRREQ : Result:= 'Destination address required'; WSAEDESTADDRREQ :{10039} Result:= 'Destination address required';
WSAEMSGSIZE : Result:= 'Message too long'; WSAEMSGSIZE :{10040} Result:= 'Message too long';
WSAEPROTOTYPE : Result:= 'Protocol wrong type for socket'; WSAEPROTOTYPE :{10041} Result:= 'Protocol wrong type for socket';
WSAENOPROTOOPT : Result:= 'Protocol not available'; WSAENOPROTOOPT :{10042} Result:= 'Protocol not available';
WSAEPROTONOSUPPORT : Result:= 'Protocol not supported'; WSAEPROTONOSUPPORT :{10043} Result:= 'Protocol not supported';
WSAESOCKTNOSUPPORT : Result:= 'Socket not supported'; WSAESOCKTNOSUPPORT :{10044} Result:= 'Socket not supported';
WSAEOPNOTSUPP : Result:= 'Operation not supported on socket'; WSAEOPNOTSUPP :{10045} Result:= 'Operation not supported on socket';
WSAEPFNOSUPPORT : Result:= 'Protocol family not supported'; WSAEPFNOSUPPORT :{10046} Result:= 'Protocol family not supported';
WSAEAFNOSUPPORT : Result:= 'Address family not supported'; WSAEAFNOSUPPORT :{10047} Result:= 'Address family not supported';
WSAEADDRINUSE : Result:= 'Address already in use'; WSAEADDRINUSE :{10048} Result:= 'Address already in use';
WSAEADDRNOTAVAIL : Result:= 'Can''t assign requested address'; WSAEADDRNOTAVAIL :{10049} Result:= 'Can''t assign requested address';
WSAENETDOWN : Result:= 'Network is down'; WSAENETDOWN :{10050} Result:= 'Network is down';
WSAENETUNREACH : Result:= 'Network is unreachable'; WSAENETUNREACH :{10051} Result:= 'Network is unreachable';
WSAENETRESET : Result:= 'Network dropped connection on reset'; WSAENETRESET :{10052} Result:= 'Network dropped connection on reset';
WSAECONNABORTED : Result:= 'Software caused connection abort'; WSAECONNABORTED :{10053} Result:= 'Software caused connection abort';
WSAECONNRESET : Result:= 'Connection reset by peer'; WSAECONNRESET :{10054} Result:= 'Connection reset by peer';
WSAENOBUFS : Result:= 'No buffer space available'; WSAENOBUFS :{10055} Result:= 'No buffer space available';
WSAEISCONN : Result:= 'Socket is already connected'; WSAEISCONN :{10056} Result:= 'Socket is already connected';
WSAENOTCONN : Result:= 'Socket is not connected'; WSAENOTCONN :{10057} Result:= 'Socket is not connected';
WSAESHUTDOWN : Result:= 'Can''t send after socket shutdown'; WSAESHUTDOWN :{10058} Result:= 'Can''t send after socket shutdown';
WSAETOOMANYREFS : Result:= 'Too many references:can''t splice'; WSAETOOMANYREFS :{10059} Result:= 'Too many references:can''t splice';
WSAETIMEDOUT : Result:= 'Connection timed out'; WSAETIMEDOUT :{10060} Result:= 'Connection timed out';
WSAECONNREFUSED : Result:= 'Connection refused'; WSAECONNREFUSED :{10061} Result:= 'Connection refused';
WSAELOOP : Result:= 'Too many levels of symbolic links'; WSAELOOP :{10062} Result:= 'Too many levels of symbolic links';
WSAENAMETOOLONG : Result:= 'File name is too long'; WSAENAMETOOLONG :{10063} Result:= 'File name is too long';
WSAEHOSTDOWN : Result:= 'Host is down'; WSAEHOSTDOWN :{10064} Result:= 'Host is down';
WSAEHOSTUNREACH : Result:= 'No route to host'; WSAEHOSTUNREACH :{10065} Result:= 'No route to host';
WSAENOTEMPTY : Result:= 'Directory is not empty'; WSAENOTEMPTY :{10066} Result:= 'Directory is not empty';
WSAEPROCLIM : Result:= 'Too many processes'; WSAEPROCLIM :{10067} Result:= 'Too many processes';
WSAEUSERS : Result:= 'Too many users'; WSAEUSERS :{10068} Result:= 'Too many users';
WSAEDQUOT : Result:= 'Disk quota exceeded'; WSAEDQUOT :{10069} Result:= 'Disk quota exceeded';
WSAESTALE : Result:= 'Stale NFS file handle'; WSAESTALE :{10070} Result:= 'Stale NFS file handle';
WSAEREMOTE : Result:= 'Too many levels of remote in path'; WSAEREMOTE :{10071} Result:= 'Too many levels of remote in path';
WSASYSNOTREADY : Result:= 'Network subsystem is unusable'; WSASYSNOTREADY :{10091} Result:= 'Network subsystem is unusable';
WSAVERNOTSUPPORTED : Result:= 'Winsock DLL cannot support this application'; WSAVERNOTSUPPORTED :{10092} Result:= 'Winsock DLL cannot support this application';
WSANOTINITIALISED : Result:= 'Winsock not initialized'; WSANOTINITIALISED :{10093} Result:= 'Winsock not initialized';
WSAHOST_NOT_FOUND : Result:= 'Host not found'; WSAEDISCON :{10101} Result:= 'WSAEDISCON-10101';
WSATRY_AGAIN : Result:= 'Non authoritative - host not found'; WSAHOST_NOT_FOUND :{11001} Result:= 'Host not found';
WSANO_RECOVERY : Result:= 'Non recoverable error'; WSATRY_AGAIN :{11002} Result:= 'Non authoritative - host not found';
WSANO_DATA : Result:= 'Valid name, no data record of requested type' WSANO_RECOVERY :{11003} Result:= 'Non recoverable error';
WSANO_DATA :{11004} Result:= 'Valid name, no data record of requested type'
else else
Result:= 'Not a Winsock error ('+IntToStr(ErrorCode)+')'; Result:= 'Not a Winsock error ('+IntToStr(ErrorCode)+')';
end; end;

422
httpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.002.000 | | Project : Delphree - Synapse | 002.000.000 |
|==============================================================================| |==============================================================================|
| Content: HTTP client | | Content: HTTP client |
|==============================================================================| |==============================================================================|
@ -33,11 +33,26 @@ const
CRLF=#13+#10; CRLF=#13+#10;
type type
TTransferEncoding=(TE_UNKNOWN,
TE_IDENTITY,
TE_CHUNKED);
THTTPSend = class THTTPSend = class
private private
Sock:TTCPBlockSocket; Sock:TTCPBlockSocket;
TransferEncoding:TTransferEncoding;
AliveHost:string;
AlivePort:string;
function ReadUnknown:boolean;
function ReadIdentity(size:integer):boolean;
function ReadChunked:boolean;
public public
timeout:integer; headers:TStringlist;
Document:TMemoryStream;
MimeType:string;
Protocol:string;
KeepAlive:boolean;
Timeout:integer;
HTTPHost:string; HTTPHost:string;
HTTPPort:string; HTTPPort:string;
ProxyHost:string; ProxyHost:string;
@ -45,15 +60,17 @@ type
ProxyUser:string; ProxyUser:string;
ProxyPass:string; ProxyPass:string;
ResultCode:integer; ResultCode:integer;
ResultString:string;
Constructor Create; Constructor Create;
Destructor Destroy; override; Destructor Destroy; override;
function Request(Query,Response:TStrings):Boolean; procedure clear;
function DoMethod(method,URL:string;Content,Response:TStrings):boolean; procedure DecodeStatus(value:string);
function HTTPmethod(method,URL:string):boolean;
end; end;
function SimpleGet(URL:string;Response:TStrings):Boolean; function HttpGetText(URL:string;Response:TStrings):Boolean;
function Get(URL:string;Response:TStrings):Boolean; function HttpGetBinary(URL:string;Response:TStream):Boolean;
function Post(URL:string;Value,Response:TStrings):Boolean; function HttpPostBinary(URL:string;Data:TStream):Boolean;
implementation implementation
@ -61,8 +78,11 @@ implementation
Constructor THTTPSend.Create; Constructor THTTPSend.Create;
begin begin
inherited Create; inherited Create;
Headers:=TStringList.create;
Document:=TMemoryStream.Create;
sock:=TTCPBlockSocket.create; sock:=TTCPBlockSocket.create;
sock.CreateSocket; sock.SizeRecvBuffer:=65536;
sock.SizeSendBuffer:=65536;
timeout:=300000; timeout:=300000;
HTTPhost:='localhost'; HTTPhost:='localhost';
HTTPPort:='80'; HTTPPort:='80';
@ -70,147 +90,333 @@ begin
ProxyPort:='8080'; ProxyPort:='8080';
ProxyUser:=''; ProxyUser:='';
ProxyPass:=''; ProxyPass:='';
AliveHost:='';
AlivePort:='';
Protocol:='1.1';
KeepAlive:=true;
Clear;
end; end;
{THTTPSend.Destroy} {THTTPSend.Destroy}
Destructor THTTPSend.Destroy; Destructor THTTPSend.Destroy;
begin begin
Sock.free; Sock.free;
Document.free;
headers.free;
inherited destroy; inherited destroy;
end; end;
{THTTPSend.Request} {THTTPSend.Clear}
function THTTPSend.Request(Query,Response:TStrings):Boolean; procedure THTTPSend.Clear;
var
s:string;
n:integer;
begin begin
Result:=False; Document.Clear;
sock.Connect(HTTPHost,HTTPPort); Headers.Clear;
if sock.lasterror<>0 then Exit; MimeType:='text/html';
for n:=0 to Query.Count-1 do
Sock.SendString(Query[n]+CRLF);
if Query[query.Count-1]<>'' then
Sock.SendString(CRLF);
if sock.lasterror<>0 then Exit;
repeat
s:=sock.recvstring(timeout);
Response.Add(s);
until sock.lasterror<>0;
Result:=True;
end; end;
{THTTPSend.DoMethod} {THTTPSend.DecodeStatus}
function THTTPSend.DoMethod(method,URL:string;Content,Response:TStrings):boolean; procedure THTTPSend.DecodeStatus(value:string);
var var
Prot,User,Pass,Host,Port,Path,Para:string; s,su:string;
Query:TstringList; begin
s:=separateright(value,' ');
su:=separateleft(s,' ');
ResultCode:=StrToIntDef(su,0);
ResultString:=separateright(s,' ');
if ResultString=s
then ResultString:='';
end;
{THTTPSend.HTTPmethod}
function THTTPSend.HTTPmethod(method,URL:string):boolean;
var
sending,receiving:boolean;
status100:boolean;
status100error:string;
ToClose:boolean;
size:integer; size:integer;
Prot,User,Pass,Host,Port,Path,Para,URI:string;
n:integer;
s,su:string;
begin
{initial values}
result:=false;
ResultCode:=500;
ResultString:='';
URI:=ParseURL(URL,Prot,User,Pass,Host,Port,Path,Para);
sending:=Document.Size>0;
{headers for sending data}
status100:=sending and (protocol='1.1');
if status100
then Headers.insert(0,'Expect: 100-continue');
if sending then
begin
Headers.insert(0,'Content-Length: '+inttostr(Document.size));
if MimeType<>''
then Headers.insert(0,'Content-Type: '+MimeType);
end;
{seting KeepAlives}
if not KeepAlive
then Headers.insert(0,'Connection: close');
{set target servers/proxy, authorisations, etc...}
if User<>''
then Headers.insert(0,'Authorization: Basic '+EncodeBase64(user+':'+pass));
if (proxyhost<>'') and (proxyUser<>'')
then Headers.insert(0,'Proxy-Authorization: Basic '+EncodeBase64(Proxyuser+':'+Proxypass));
Headers.insert(0,'Host: '+host+':'+port);
if proxyHost<>''
then URI:=prot+'://'+host+':'+port+URI;
if URI='/*'
then URI:='*';
if protocol='0.9'
then Headers.insert(0,uppercase(method)+' '+URI)
else Headers.insert(0,uppercase(method)+' '+URI+' HTTP/'+protocol);
if proxyhost=''
then
begin
HttpHost:=host;
HttpPort:=port;
end
else
begin
HttpHost:=Proxyhost;
HttpPort:=Proxyport;
end;
if headers[headers.count-1]<>''
then headers.add('');
{connect}
if (Alivehost<>HTTPhost) or (AlivePort<>HTTPport)
then
begin
sock.CloseSocket;
sock.CreateSocket;
sock.Connect(HTTPHost,HTTPPort);
if sock.lasterror<>0 then Exit;
Alivehost:=HTTPhost;
AlivePort:=HTTPport;
end
else
begin
if sock.canread(0) then
begin
sock.CloseSocket;
sock.createsocket;
sock.Connect(HTTPHost,HTTPPort);
if sock.lasterror<>0 then Exit;
end;
end;
{send headers}
Sock.SendString(Headers[0]+CRLF);
if protocol<>'0.9' then
for n:=1 to Headers.Count-1 do
Sock.SendString(Headers[n]+CRLF);
if sock.lasterror<>0 then Exit;
{reading Status}
Status100Error:='';
if status100 then
begin
repeat
s:=sock.recvstring(timeout);
if s<>'' then break;
until sock.lasterror<>0;
DecodeStatus(s);
if (ResultCode>=100) and (ResultCode<200)
then
begin
repeat
s:=sock.recvstring(timeout);
if s='' then break;
until sock.lasterror<>0;
end
else
begin
sending:=false;
Status100Error:=s;
end;
end;
{send document}
if sending then
begin
Sock.SendBuffer(Document.memory,Document.size);
if sock.lasterror<>0 then Exit;
end;
clear;
size:=-1;
TransferEncoding:=TE_UNKNOWN;
{read status}
If Status100Error=''
then
begin
repeat
s:=sock.recvstring(timeout);
if s<>'' then break;
until sock.lasterror<>0;
if pos('HTTP/',uppercase(s))=1
then
begin
Headers.add(s);
decodeStatus(s);
end
else
begin
{old HTTP 0.9 and some buggy servers not send result}
s:=s+CRLF;
document.Write(pointer(s)^,length(s));
ResultCode:=0;
end;
end
else Headers.add(Status100Error);
{if need receive hedaers, receive and parse it}
ToClose:=protocol<>'1.1';
if Headers.count>0 then
repeat
s:=sock.recvstring(timeout);
Headers.Add(s);
if s=''
then break;
su:=uppercase(s);
if pos('CONTENT-LENGTH:',su)=1 then
begin
size:=strtointdef(separateright(s,' '),-1);
TransferEncoding:=TE_IDENTITY;
end;
if pos('CONTENT-TYPE:',su)=1 then
MimeType:=separateright(s,' ');
if pos('TRANSFER-ENCODING:',su)=1 then
begin
s:=separateright(su,' ');
if pos('CHUNKED',s)>0 then
TransferEncoding:=TE_CHUNKED;
end;
if pos('CONNECTION: CLOSE',su)=1 then
ToClose:=true;
until sock.lasterror<>0;
{if need receive response body, read it}
Receiving:=Method<>'HEAD';
Receiving:=Receiving and (ResultCode<>204);
Receiving:=Receiving and (ResultCode<>304);
if Receiving then
case TransferEncoding of
TE_UNKNOWN : readunknown;
TE_IDENTITY: readidentity(size);
TE_CHUNKED : readChunked;
end;
Document.Seek(0,soFromBeginning);
result:=true;
if ToClose then
begin
sock.closesocket;
Alivehost:='';
AlivePort:='';
end;
end;
{THTTPSend.ReadUnknown}
function THTTPSend.ReadUnknown:boolean;
var
s:string; s:string;
begin begin
result:=false; result:=false;
Query:=TstringList.create; repeat
try s:=sock.recvstring(timeout);
parseURL(URL,Prot,User,Pass,Host,Port,Path,Para); s:=s+CRLF;
if content<>nil document.Write(pointer(s)^,length(s));
then query.AddStrings(content); until sock.lasterror<>0;
size:=length(query.text); result:=true;
query.insert(0,''); end;
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='' {THTTPSend.ReadIdentity}
then s:='' function THTTPSend.ReadIdentity(size:integer):boolean;
else s:='?'+para; var
s:=path+s; mem:TMemoryStream;
if proxyHost<>'' begin
then s:=prot+'://'+host+':'+port+s; mem:=TMemoryStream.create;
query.insert(0,uppercase(method)+' '+s+' HTTP/1.0'); try
if proxyhost='' mem.SetSize(size);
then sock.RecvBufferEx(mem.memory,size,timeout);
begin result:=sock.lasterror=0;
HttpHost:=host; document.CopyFrom(mem,0);
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 finally
Query.free; mem.free;
end; end;
end; end;
{THTTPSend.ReadChunked}
function THTTPSend.ReadChunked:boolean;
var
s:string;
size:integer;
begin
repeat
repeat
s:=sock.recvstring(timeout);
until s<>'';
if sock.lasterror<>0
then break;
s:=separateleft(s,' ');
size:=strtointdef('$'+s,0);
if size=0 then break;
ReadIdentity(size);
until false;
result:=sock.lasterror=0;
end;
{==============================================================================} {==============================================================================}
{SimpleGet} {HttpGetText}
function SimpleGet(URL:string;Response:TStrings):Boolean; function HttpGetText(URL:string;Response:TStrings):Boolean;
var var
HTTP:THTTPSend; 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 '+Path);
if not HTTP.Request(Query,Response) then Exit;
finally
Query.Free;
HTTP.Free;
end;
Result:=True;
end;
{get}
function Get(URL:string;Response:TStrings):Boolean;
var
HTTP:THTTPSend;
Prot,User,Pass,Host,Port,Path,Para:string;
begin begin
Result:=False; Result:=False;
HTTP:=THTTPSend.Create; HTTP:=THTTPSend.Create;
try try
result:=HTTP.DoMethod('GET',URL,nil,Response); Result:=HTTP.HTTPmethod('GET',URL);
response.LoadFromStream(HTTP.document);
finally finally
HTTP.Free; HTTP.Free;
end; end;
end; end;
{post} {HttpGetBinary}
function Post(URL:string;Value,Response:TStrings):Boolean; function HttpGetBinary(URL:string;Response:TStream):Boolean;
var var
HTTP:THTTPSend; HTTP:THTTPSend;
Prot,User,Pass,Host,Port,Path,Para:string;
begin begin
Result:=False; Result:=False;
HTTP:=THTTPSend.Create; HTTP:=THTTPSend.Create;
try try
result:=HTTP.DoMethod('POST',URL,Value,Response); Result:=HTTP.HTTPmethod('GET',URL);
Response.Seek(0,soFromBeginning);
Response.CopyFrom(HTTP.document,0);
finally
HTTP.Free;
end;
end;
{HttpPostBinary}
function HttpPostBinary(URL:string;Data:TStream):Boolean;
var
HTTP:THTTPSend;
begin
Result:=False;
HTTP:=THTTPSend.Create;
try
HTTP.Document.CopyFrom(data,0);
HTTP.MimeType:='Application/octet-stream';
Result:=HTTP.HTTPmethod('POST',URL);
data.Seek(0,soFromBeginning);
data.CopyFrom(HTTP.document,0);
finally finally
HTTP.Free; HTTP.Free;
end; end;

125
smtpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 002.000.000 | | Project : Delphree - Synapse | 002.001.000 |
|==============================================================================| |==============================================================================|
| Content: SMTP client | | Content: SMTP client |
|==============================================================================| |==============================================================================|
@ -41,6 +41,7 @@ type
public public
timeout:integer; timeout:integer;
SMTPHost:string; SMTPHost:string;
SMTPPort:string;
ResultCode:integer; ResultCode:integer;
ResultString:string; ResultString:string;
FullResult:TStringList; FullResult:TStringList;
@ -54,10 +55,14 @@ type
EnhCode1:integer; EnhCode1:integer;
EnhCode2:integer; EnhCode2:integer;
EnhCode3:integer; EnhCode3:integer;
SystemName:string;
Constructor Create; Constructor Create;
Destructor Destroy; override; Destructor Destroy; override;
function AuthLogin:Boolean; function AuthLogin:Boolean;
function AuthCram:Boolean; function AuthCram:Boolean;
function Connect:Boolean;
function Helo:Boolean;
function Ehlo:Boolean;
function login:Boolean; function login:Boolean;
procedure logout; procedure logout;
function reset:Boolean; function reset:Boolean;
@ -68,6 +73,7 @@ type
function etrn(Value:string):Boolean; function etrn(Value:string):Boolean;
function verify(Value:string):Boolean; function verify(Value:string):Boolean;
function EnhCodeString:string; function EnhCodeString:string;
function FindCap(value:string):string;
end; end;
function SendtoRaw (mailfrom,mailto,SMTPHost:string;maildata:TStrings;Username,Password:string):Boolean; function SendtoRaw (mailfrom,mailto,SMTPHost:string;maildata:TStrings;Username,Password:string):Boolean;
@ -86,8 +92,10 @@ begin
sock.CreateSocket; sock.CreateSocket;
timeout:=300000; timeout:=300000;
SMTPhost:='localhost'; SMTPhost:='localhost';
SMTPPort:='smtp';
Username:=''; Username:='';
Password:=''; Password:='';
SystemName:=sock.localname;
end; end;
{TSMTPSend.Destroy} {TSMTPSend.Destroy}
@ -181,11 +189,47 @@ begin
Result:=True; Result:=True;
end; end;
{TSMTPSend.Connect}
function TSMTPSend.Connect:Boolean;
begin
Result:=false;
sock.CloseSocket;
sock.CreateSocket;
sock.Connect(SMTPHost,SMTPPort);
if sock.lasterror<>0 then Exit;
Result:=True;
end;
{TSMTPSend.Helo}
function TSMTPSend.Helo:Boolean;
var
x:integer;
begin
Result:=false;
Sock.SendString('HELO '+SystemName+CRLF);
x:=ReadResult;
if (x<250) or (x>259) then Exit;
Result:=True;
end;
{TSMTPSend.Ehlo}
function TSMTPSend.Ehlo:Boolean;
var
x:integer;
begin
Result:=false;
Sock.SendString('EHLO '+SystemName+CRLF);
x:=ReadResult;
if (x<250) or (x>259) then Exit;
Result:=True;
end;
{TSMTPSend.login} {TSMTPSend.login}
function TSMTPSend.login:Boolean; function TSMTPSend.login:Boolean;
var var
n:integer; n:integer;
auths:string; auths:string;
s:string;
begin begin
Result:=False; Result:=False;
ESMTP:=true; ESMTP:=true;
@ -193,15 +237,12 @@ begin
ESMTPcap.clear; ESMTPcap.clear;
ESMTPSize:=false; ESMTPSize:=false;
MaxSize:=0; MaxSize:=0;
sock.Connect(SMTPHost,'smtp'); if not Connect then Exit;
if sock.lasterror<>0 then Exit;
if readresult<>220 then Exit; if readresult<>220 then Exit;
Sock.SendString('EHLO '+sock.LocalName+CRLF); if not Ehlo then
if readresult<>250 then
begin begin
ESMTP:=false; ESMTP:=false;
Sock.SendString('HELO '+sock.LocalName+CRLF); if not Helo then exit;
if readresult<>250 then Exit;
end; end;
Result:=True; Result:=True;
if ESMTP then if ESMTP then
@ -209,30 +250,27 @@ begin
for n:=1 to FullResult.count-1 do for n:=1 to FullResult.count-1 do
ESMTPcap.add(Copy(FullResult[n],5,length(Fullresult[n])-4)); ESMTPcap.add(Copy(FullResult[n],5,length(Fullresult[n])-4));
if not ((Username='') and (Password='')) then if not ((Username='') and (Password='')) then
for n:=0 to ESMTPcap.count-1 do begin
begin s:=FindCap('AUTH ');
auths:=uppercase(ESMTPcap[n]); if s=''
if pos('AUTH ',auths)=1 then then s:=FindCap('AUTH=');
begin auths:=uppercase(s);
if pos('CRAM-MD5',auths)>0 then if s<>'' then
begin begin
AuthDone:=AuthCram; if pos('CRAM-MD5',auths)>0
break; then AuthDone:=AuthCram;
end; if (pos('LOGIN',auths)>0) and (not authDone)
if pos('LOGIN',auths)>0 then then AuthDone:=AuthLogin;
begin end;
AuthDone:=AuthLogin; if AuthDone
break; then Ehlo;
end; end;
end; s:=FindCap('SIZE');
end; if s<>'' then
for n:=0 to ESMTPcap.count-1 do begin
if pos('SIZE',uppercase(ESMTPcap[n]))=1 then ESMTPsize:=true;
begin MaxSize:=StrToIntDef(copy(s,6,length(s)-5),0);
ESMTPsize:=true; end;
MaxSize:=StrToIntDef(copy(ESMTPcap[n],6,length(ESMTPcap[n])-5),0);
break;
end;
end; end;
end; end;
@ -309,19 +347,25 @@ end;
{TSMTPSend.etrn} {TSMTPSend.etrn}
function TSMTPSend.etrn(Value:string):Boolean; function TSMTPSend.etrn(Value:string):Boolean;
var
x:integer;
begin begin
Result:=false; Result:=false;
Sock.SendString('ETRN '+Value+CRLF); Sock.SendString('ETRN '+Value+CRLF);
if (readresult<250) or (readresult>259) then Exit; x:=ReadResult;
if (x<250) or (x>259) then Exit;
Result:=True; Result:=True;
end; end;
{TSMTPSend.verify} {TSMTPSend.verify}
function TSMTPSend.verify(Value:string):Boolean; function TSMTPSend.verify(Value:string):Boolean;
var
x:integer;
begin begin
Result:=false; Result:=false;
Sock.SendString('VRFY '+Value+CRLF); Sock.SendString('VRFY '+Value+CRLF);
if (readresult<250) or (readresult>259) then Exit; x:=ReadResult;
if (x<250) or (x>259) then Exit;
Result:=True; Result:=True;
end; end;
@ -388,6 +432,21 @@ begin
result:=s+t; result:=s+t;
end; end;
{TSMTPSend.FindCap}
function TSMTPSend.FindCap(value:string):string;
var
n:integer;
s:string;
begin
s:=uppercase(value);
result:='';
for n:=0 to ESMTPcap.count-1 do
if pos(s,uppercase(ESMTPcap[n]))=1 then
begin
result:=ESMTPcap[n];
break;
end;
end;
{==============================================================================} {==============================================================================}

130
synacode.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.003.000 | | Project : Delphree - Synapse | 001.003.001 |
|==============================================================================| |==============================================================================|
| Content: Coding and decoding support | | Content: Coding and decoding support |
|==============================================================================| |==============================================================================|
@ -400,73 +400,73 @@ begin
C:=Buf[2]; C:=Buf[2];
D:=Buf[3]; D:=Buf[3];
Round1(A,B,C,D, Data[ 0] + $d76aa478, 7); Round1(A,B,C,D, Data[ 0] + longint($d76aa478), 7);
Round1(D,A,B,C, Data[ 1] + $e8c7b756, 12); Round1(D,A,B,C, Data[ 1] + longint($e8c7b756), 12);
Round1(C,D,A,B, Data[ 2] + $242070db, 17); Round1(C,D,A,B, Data[ 2] + longint($242070db), 17);
Round1(B,C,D,A, Data[ 3] + $c1bdceee, 22); Round1(B,C,D,A, Data[ 3] + longint($c1bdceee), 22);
Round1(A,B,C,D, Data[ 4] + $f57c0faf, 7); Round1(A,B,C,D, Data[ 4] + longint($f57c0faf), 7);
Round1(D,A,B,C, Data[ 5] + $4787c62a, 12); Round1(D,A,B,C, Data[ 5] + longint($4787c62a), 12);
Round1(C,D,A,B, Data[ 6] + $a8304613, 17); Round1(C,D,A,B, Data[ 6] + longint($a8304613), 17);
Round1(B,C,D,A, Data[ 7] + $fd469501, 22); Round1(B,C,D,A, Data[ 7] + longint($fd469501), 22);
Round1(A,B,C,D, Data[ 8] + $698098d8, 7); Round1(A,B,C,D, Data[ 8] + longint($698098d8), 7);
Round1(D,A,B,C, Data[ 9] + $8b44f7af, 12); Round1(D,A,B,C, Data[ 9] + longint($8b44f7af), 12);
Round1(C,D,A,B, Data[10] + $ffff5bb1, 17); Round1(C,D,A,B, Data[10] + longint($ffff5bb1), 17);
Round1(B,C,D,A, Data[11] + $895cd7be, 22); Round1(B,C,D,A, Data[11] + longint($895cd7be), 22);
Round1(A,B,C,D, Data[12] + $6b901122, 7); Round1(A,B,C,D, Data[12] + longint($6b901122), 7);
Round1(D,A,B,C, Data[13] + $fd987193, 12); Round1(D,A,B,C, Data[13] + longint($fd987193), 12);
Round1(C,D,A,B, Data[14] + $a679438e, 17); Round1(C,D,A,B, Data[14] + longint($a679438e), 17);
Round1(B,C,D,A, Data[15] + $49b40821, 22); Round1(B,C,D,A, Data[15] + longint($49b40821), 22);
Round2(A,B,C,D, Data[ 1] + $f61e2562, 5); Round2(A,B,C,D, Data[ 1] + longint($f61e2562), 5);
Round2(D,A,B,C, Data[ 6] + $c040b340, 9); Round2(D,A,B,C, Data[ 6] + longint($c040b340), 9);
Round2(C,D,A,B, Data[11] + $265e5a51, 14); Round2(C,D,A,B, Data[11] + longint($265e5a51), 14);
Round2(B,C,D,A, Data[ 0] + $e9b6c7aa, 20); Round2(B,C,D,A, Data[ 0] + longint($e9b6c7aa), 20);
Round2(A,B,C,D, Data[ 5] + $d62f105d, 5); Round2(A,B,C,D, Data[ 5] + longint($d62f105d), 5);
Round2(D,A,B,C, Data[10] + $02441453, 9); Round2(D,A,B,C, Data[10] + longint($02441453), 9);
Round2(C,D,A,B, Data[15] + $d8a1e681, 14); Round2(C,D,A,B, Data[15] + longint($d8a1e681), 14);
Round2(B,C,D,A, Data[ 4] + $e7d3fbc8, 20); Round2(B,C,D,A, Data[ 4] + longint($e7d3fbc8), 20);
Round2(A,B,C,D, Data[ 9] + $21e1cde6, 5); Round2(A,B,C,D, Data[ 9] + longint($21e1cde6), 5);
Round2(D,A,B,C, Data[14] + $c33707d6, 9); Round2(D,A,B,C, Data[14] + longint($c33707d6), 9);
Round2(C,D,A,B, Data[ 3] + $f4d50d87, 14); Round2(C,D,A,B, Data[ 3] + longint($f4d50d87), 14);
Round2(B,C,D,A, Data[ 8] + $455a14ed, 20); Round2(B,C,D,A, Data[ 8] + longint($455a14ed), 20);
Round2(A,B,C,D, Data[13] + $a9e3e905, 5); Round2(A,B,C,D, Data[13] + longint($a9e3e905), 5);
Round2(D,A,B,C, Data[ 2] + $fcefa3f8, 9); Round2(D,A,B,C, Data[ 2] + longint($fcefa3f8), 9);
Round2(C,D,A,B, Data[ 7] + $676f02d9, 14); Round2(C,D,A,B, Data[ 7] + longint($676f02d9), 14);
Round2(B,C,D,A, Data[12] + $8d2a4c8a, 20); Round2(B,C,D,A, Data[12] + longint($8d2a4c8a), 20);
Round3(A,B,C,D, Data[ 5] + $fffa3942, 4); Round3(A,B,C,D, Data[ 5] + longint($fffa3942), 4);
Round3(D,A,B,C, Data[ 8] + $8771f681, 11); Round3(D,A,B,C, Data[ 8] + longint($8771f681), 11);
Round3(C,D,A,B, Data[11] + $6d9d6122, 16); Round3(C,D,A,B, Data[11] + longint($6d9d6122), 16);
Round3(B,C,D,A, Data[14] + $fde5380c, 23); Round3(B,C,D,A, Data[14] + longint($fde5380c), 23);
Round3(A,B,C,D, Data[ 1] + $a4beea44, 4); Round3(A,B,C,D, Data[ 1] + longint($a4beea44), 4);
Round3(D,A,B,C, Data[ 4] + $4bdecfa9, 11); Round3(D,A,B,C, Data[ 4] + longint($4bdecfa9), 11);
Round3(C,D,A,B, Data[ 7] + $f6bb4b60, 16); Round3(C,D,A,B, Data[ 7] + longint($f6bb4b60), 16);
Round3(B,C,D,A, Data[10] + $bebfbc70, 23); Round3(B,C,D,A, Data[10] + longint($bebfbc70), 23);
Round3(A,B,C,D, Data[13] + $289b7ec6, 4); Round3(A,B,C,D, Data[13] + longint($289b7ec6), 4);
Round3(D,A,B,C, Data[ 0] + $eaa127fa, 11); Round3(D,A,B,C, Data[ 0] + longint($eaa127fa), 11);
Round3(C,D,A,B, Data[ 3] + $d4ef3085, 16); Round3(C,D,A,B, Data[ 3] + longint($d4ef3085), 16);
Round3(B,C,D,A, Data[ 6] + $04881d05, 23); Round3(B,C,D,A, Data[ 6] + longint($04881d05), 23);
Round3(A,B,C,D, Data[ 9] + $d9d4d039, 4); Round3(A,B,C,D, Data[ 9] + longint($d9d4d039), 4);
Round3(D,A,B,C, Data[12] + $e6db99e5, 11); Round3(D,A,B,C, Data[12] + longint($e6db99e5), 11);
Round3(C,D,A,B, Data[15] + $1fa27cf8, 16); Round3(C,D,A,B, Data[15] + longint($1fa27cf8), 16);
Round3(B,C,D,A, Data[ 2] + $c4ac5665, 23); Round3(B,C,D,A, Data[ 2] + longint($c4ac5665), 23);
Round4(A,B,C,D, Data[ 0] + $f4292244, 6); Round4(A,B,C,D, Data[ 0] + longint($f4292244), 6);
Round4(D,A,B,C, Data[ 7] + $432aff97, 10); Round4(D,A,B,C, Data[ 7] + longint($432aff97), 10);
Round4(C,D,A,B, Data[14] + $ab9423a7, 15); Round4(C,D,A,B, Data[14] + longint($ab9423a7), 15);
Round4(B,C,D,A, Data[ 5] + $fc93a039, 21); Round4(B,C,D,A, Data[ 5] + longint($fc93a039), 21);
Round4(A,B,C,D, Data[12] + $655b59c3, 6); Round4(A,B,C,D, Data[12] + longint($655b59c3), 6);
Round4(D,A,B,C, Data[ 3] + $8f0ccc92, 10); Round4(D,A,B,C, Data[ 3] + longint($8f0ccc92), 10);
Round4(C,D,A,B, Data[10] + $ffeff47d, 15); Round4(C,D,A,B, Data[10] + longint($ffeff47d), 15);
Round4(B,C,D,A, Data[ 1] + $85845dd1, 21); Round4(B,C,D,A, Data[ 1] + longint($85845dd1), 21);
Round4(A,B,C,D, Data[ 8] + $6fa87e4f, 6); Round4(A,B,C,D, Data[ 8] + longint($6fa87e4f), 6);
Round4(D,A,B,C, Data[15] + $fe2ce6e0, 10); Round4(D,A,B,C, Data[15] + longint($fe2ce6e0), 10);
Round4(C,D,A,B, Data[ 6] + $a3014314, 15); Round4(C,D,A,B, Data[ 6] + longint($a3014314), 15);
Round4(B,C,D,A, Data[13] + $4e0811a1, 21); Round4(B,C,D,A, Data[13] + longint($4e0811a1), 21);
Round4(A,B,C,D, Data[ 4] + $f7537e82, 6); Round4(A,B,C,D, Data[ 4] + longint($f7537e82), 6);
Round4(D,A,B,C, Data[11] + $bd3af235, 10); Round4(D,A,B,C, Data[11] + longint($bd3af235), 10);
Round4(C,D,A,B, Data[ 2] + $2ad7d2bb, 15); Round4(C,D,A,B, Data[ 2] + longint($2ad7d2bb), 15);
Round4(B,C,D,A, Data[ 9] + $eb86d391, 21); Round4(B,C,D,A, Data[ 9] + longint($eb86d391), 21);
Inc(Buf[0],A); Inc(Buf[0],A);
Inc(Buf[1],B); Inc(Buf[1],B);

39
synautil.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.007.000 | | Project : Delphree - Synapse | 001.008.000 |
|==============================================================================| |==============================================================================|
| Content: support procedures and functions | | Content: support procedures and functions |
|==============================================================================| |==============================================================================|
@ -47,7 +47,8 @@ function GetEmailDesc(value:string):string;
function StrToHex(value:string):string; function StrToHex(value:string):string;
function IntToBin(value:integer;digits:byte):string; function IntToBin(value:integer;digits:byte):string;
function BinToInt(value:string):integer; function BinToInt(value:string):integer;
procedure ParseURL(URL:string; var Prot,User,Pass,Host,Port,Path,Para:string); function ParseURL(URL:string; var Prot,User,Pass,Host,Port,Path,Para:string):string;
function StringReplace(value,search,replace:string):string;
implementation implementation
@ -338,7 +339,7 @@ end;
{==============================================================================} {==============================================================================}
{ParseURL} {ParseURL}
procedure ParseURL(URL:string; var Prot,User,Pass,Host,Port,Path,Para:string); function ParseURL(URL:string; var Prot,User,Pass,Host,Port,Path,Para:string):string;
var var
x:integer; x:integer;
sURL:string; sURL:string;
@ -389,6 +390,7 @@ begin
port:=separateright(s1,':'); port:=separateright(s1,':');
end end
else host:=s1; else host:=s1;
result:='/'+s2;
x:=pos('?',s2); x:=pos('?',s2);
if x>0 then if x>0 then
begin begin
@ -400,6 +402,37 @@ begin
then host:='localhost'; then host:='localhost';
end; end;
{==============================================================================}
{StringReplace}
function StringReplace(value,search,replace:string):string;
var
x,l,ls,lr:integer;
begin
if (value='') or (Search='') then
begin
result:=value;
Exit;
end;
ls:=length(search);
lr:=length(replace);
result:='';
x:=pos(search,value);
while x>0 do
begin
l:=length(result);
setlength(result,l+x-1);
Move(pointer(value)^,Pointer(@result[l+1])^, x-1);
// result:=result+copy(value,1,x-1);
l:=length(result);
setlength(result,l+lr);
Move(pointer(replace)^,Pointer(@result[l+1])^, lr);
// result:=result+replace;
delete(value,1,x-1+ls);
x:=pos(search,value);
end;
result:=result+value;
end;
{==============================================================================} {==============================================================================}
end. end.