pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Release 21

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@45 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2008-04-24 06:59:26 +00:00
parent 0e6f0baa79
commit 18bbf79351
14 changed files with 790 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
blcksck2.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.001.000 |
| Project : Delphree - Synapse | 002.000.000 |
|==============================================================================|
| Content: Library base for RAW sockets |
|==============================================================================|
@ -26,7 +26,8 @@
{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Remember, this unit work only with Winsock2! (on Win98 and WinNT 4.0 or higher)
Remember, this unit work only on Linux or Windows with Winsock2!
(on Win98 and WinNT 4.0 or higher)
If you must use this unit on Win95, download Wínsock2 from Microsoft
and distribute it with your application!
@ -49,7 +50,12 @@ unit blcksck2;
interface
uses
winsock, SysUtils, windows, blcksock;
synsock, SysUtils, blcksock,
{$IFDEF LINUX}
libc, kernelioctl;
{$ELSE}
winsock, windows;
{$ENDIF}
type
@ -89,7 +95,7 @@ implementation
{TICMPBlockSocket.CreateSocket}
Procedure TICMPBlockSocket.CreateSocket;
begin
FSocket:=winsock.socket(PF_INET,SOCK_RAW,IPPROTO_ICMP);
FSocket:=synsock.socket(PF_INET,integer(SOCK_RAW),IPPROTO_ICMP);
FProtocol:=IPPROTO_ICMP;
inherited createSocket;
end;
@ -100,7 +106,7 @@ end;
{TRAWBlockSocket.CreateSocket}
Procedure TRAWBlockSocket.CreateSocket;
begin
FSocket:=winsock.socket(PF_INET,SOCK_RAW,IPPROTO_RAW);
FSocket:=synsock.socket(PF_INET,integer(SOCK_RAW),IPPROTO_RAW);
FProtocol:=IPPROTO_RAW;
inherited createSocket;
end;
@ -118,9 +124,9 @@ begin
r2:=False;
Value:=Timeout;
len:=SizeOf(Value);
Res:=Winsock.setsockopt(sock,SOL_SOCKET,SO_RCVTIMEO,@Value,len);
Res:=synsock.setsockopt(sock,SOL_SOCKET,SO_RCVTIMEO,@Value,len);
r1:=res<>SOCKET_ERROR;
Res:=Winsock.setsockopt(sock,SOL_SOCKET,SO_SNDTIMEO,@Value,len);
Res:=synsock.setsockopt(sock,SOL_SOCKET,SO_SNDTIMEO,@Value,len);
r2:=res<>SOCKET_ERROR;
Result:=r1 and r2;
end;

192
blcksock.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.001.001 |
| Project : Delphree - Synapse | 003.001.000 |
|==============================================================================|
| Content: Library base |
|==============================================================================|
@ -28,7 +28,12 @@ unit blcksock;
interface
uses
winsock, SysUtils, windows;
synsock, SysUtils, classes,
{$IFDEF LINUX}
libc, kernelioctl;
{$ELSE}
winsock, windows;
{$ENDIF}
type
@ -60,6 +65,7 @@ public
FWsaData : TWSADATA;
constructor Create;
constructor CreateAlternate(stub:string);
destructor Destroy; override;
Procedure CreateSocket; virtual;
@ -81,6 +87,7 @@ public
function SockCheck(SockResult:integer):integer;
procedure ExceptCheck;
function LocalName:string;
procedure ResolveNameToIP(Name:string;IPlist:TStringlist);
function GetLocalSinIP:string;
function GetRemoteSinIP:string;
function GetLocalSinPort:integer;
@ -123,13 +130,45 @@ implementation
{TBlockSocket.Create}
constructor TBlockSocket.Create;
var
e:ESynapseError;
begin
inherited create;
FRaiseExcept:=false;
FSocket:=INVALID_SOCKET;
FProtocol:=IPPROTO_IP;
Fbuffer:='';
SockCheck(winsock.WSAStartup($101, FWsaData));
if not InitSocketInterface('')
then
begin
e:=ESynapseError.Create('Error loading Winsock DLL!');
e.ErrorCode:=0;
e.ErrorMessage:='Error loading Winsock DLL!';
raise e;
end;
SockCheck(synsock.WSAStartup($101, FWsaData));
ExceptCheck;
end;
{TBlockSocket.CreateAlternate}
constructor TBlockSocket.CreateAlternate(stub:string);
var
e:ESynapseError;
begin
inherited create;
FRaiseExcept:=false;
FSocket:=INVALID_SOCKET;
FProtocol:=IPPROTO_IP;
Fbuffer:='';
if not InitSocketInterface(stub)
then
begin
e:=ESynapseError.Create('Error loading alternate Winsock DLL ('+stub+')!');
e.ErrorCode:=0;
e.ErrorMessage:='Error loading Winsock DLL ('+stub+')!';
raise e;
end;
SockCheck(synsock.WSAStartup($101, FWsaData));
ExceptCheck;
end;
@ -137,6 +176,7 @@ end;
destructor TBlockSocket.Destroy;
begin
CloseSocket;
DestroySocketInterface;
inherited destroy;
end;
@ -149,22 +189,22 @@ var
begin
FillChar(sin,Sizeof(sin),0);
sin.sin_family := AF_INET;
ProtoEnt:= getprotobynumber(FProtocol);
ProtoEnt:= synsock.getprotobynumber(FProtocol);
ServEnt:=nil;
If ProtoEnt <> nil then
ServEnt:= getservbyname(PChar(port), ProtoEnt^.p_name);
ServEnt:= synsock.getservbyname(PChar(port), ProtoEnt^.p_name);
if ServEnt = nil then
Sin.sin_port:= htons(StrToIntDef(Port,0))
Sin.sin_port:= synsock.htons(StrToIntDef(Port,0))
else
Sin.sin_port:= ServEnt^.s_port;
if ip='255.255.255.255'
then Sin.sin_addr.s_addr:=u_long(INADDR_BROADCAST)
else
begin
Sin.sin_addr.s_addr:= inet_addr(PChar(ip));
Sin.sin_addr.s_addr:= synsock.inet_addr(PChar(ip));
if SIn.sin_addr.s_addr = u_long(INADDR_NONE) then
begin
HostEnt:= gethostbyname(PChar(ip));
HostEnt:= synsock.gethostbyname(PChar(ip));
if HostEnt <> nil then
SIn.sin_addr.S_addr:= longint(plongint(HostEnt^.h_addr_list^)^);
end;
@ -176,7 +216,7 @@ function TBlockSocket.GetSinIP (sin:TSockAddrIn):string;
var
p:pchar;
begin
p:=inet_ntoa(Sin.sin_addr);
p:=synsock.inet_ntoa(Sin.sin_addr);
if p=nil then result:=''
else result:=p;
end;
@ -184,14 +224,14 @@ end;
{TBlockSocket.GetSinPort}
function TBlockSocket.GetSinPort (sin:TSockAddrIn):integer;
begin
result:=ntohs(Sin.sin_port);
result:=synsock.ntohs(Sin.sin_port);
end;
{TBlockSocket.CreateSocket}
Procedure TBlockSocket.CreateSocket;
begin
Fbuffer:='';
if FSocket=INVALID_SOCKET then FLastError:=winsock.WSAGetLastError
if FSocket=INVALID_SOCKET then FLastError:=synsock.WSAGetLastError
else FLastError:=0;
ExceptCheck;
end;
@ -200,7 +240,7 @@ end;
{TBlockSocket.CloseSocket}
Procedure TBlockSocket.CloseSocket;
begin
winsock.CloseSocket(FSocket);
synsock.CloseSocket(FSocket);
end;
{TBlockSocket.Bind}
@ -210,9 +250,9 @@ var
len:integer;
begin
SetSin(sin,ip,port);
SockCheck(winsock.bind(FSocket,sin,sizeof(sin)));
SockCheck(synsock.bind(FSocket,sin,sizeof(sin)));
len:=sizeof(FLocalSin);
Winsock.GetSockName(FSocket,FLocalSin,Len);
synsock.GetSockName(FSocket,FLocalSin,Len);
Fbuffer:='';
ExceptCheck;
end;
@ -223,7 +263,7 @@ var
sin:TSockAddrIn;
begin
SetSin(sin,ip,port);
SockCheck(winsock.connect(FSocket,sin,sizeof(sin)));
SockCheck(synsock.connect(FSocket,sin,sizeof(sin)));
GetSins;
Fbuffer:='';
ExceptCheck;
@ -235,15 +275,15 @@ var
len:integer;
begin
len:=sizeof(FLocalSin);
Winsock.GetSockName(FSocket,FLocalSin,Len);
synsock.GetSockName(FSocket,FLocalSin,Len);
len:=sizeof(FRemoteSin);
Winsock.GetPeerName(FSocket,FremoteSin,Len);
synsock.GetPeerName(FSocket,FremoteSin,Len);
end;
{TBlockSocket.SendBuffer}
function TBlockSocket.SendBuffer(buffer:pointer;length:integer):integer;
begin
result:=winsock.send(FSocket,buffer^,length,0);
result:=synsock.send(FSocket,buffer^,length,0);
sockcheck(result);
ExceptCheck;
end;
@ -251,21 +291,21 @@ end;
{TBlockSocket.SendByte}
procedure TBlockSocket.SendByte(data:byte);
begin
sockcheck(winsock.send(FSocket,data,1,0));
sockcheck(synsock.send(FSocket,data,1,0));
ExceptCheck;
end;
{TBlockSocket.SendString}
procedure TBlockSocket.SendString(data:string);
begin
sockcheck(winsock.send(FSocket,pchar(data)^,length(data),0));
sockcheck(synsock.send(FSocket,pchar(data)^,length(data),0));
ExceptCheck;
end;
{TBlockSocket.RecvBuffer}
function TBlockSocket.RecvBuffer(buffer:pointer;length:integer):integer;
begin
result:=winsock.recv(FSocket,buffer^,length,0);
result:=synsock.recv(FSocket,buffer^,length,0);
if result=0
then FLastError:=WSAENOTCONN
else sockcheck(result);
@ -313,7 +353,7 @@ begin
if (system.length(ss)+l)>fs
then l:=fs-system.length(ss);
setlength(st,l);
x:=winsock.recv(FSocket,pointer(st)^,l,0);
x:=synsock.recv(FSocket,pointer(st)^,l,0);
if x=0
then FLastError:=WSAENOTCONN
else sockcheck(x);
@ -347,7 +387,7 @@ begin
result:=0;
if CanRead(timeout) then
begin
y:=winsock.recv(FSocket,data,1,0);
y:=synsock.recv(FSocket,data,1,0);
if y=0 then FLastError:=WSAENOTCONN
else sockcheck(y);
result:=data;
@ -384,14 +424,16 @@ begin
else
begin
setlength(Fbuffer,x);
r:=Winsock.recv(FSocket,pointer(FBuffer)^,x,0);
r:=synsock.recv(FSocket,pointer(FBuffer)^,x,0);
SockCheck(r);
if r=0 then FLastError:=WSAENOTCONN;
if FLastError<>0 then break;
if r<x
then setlength(FBuffer,r);
end;
end;
x:=pos(#10,Fbuffer);
if x<=0 then x:=length(Fbuffer);
if x<1 then x:=length(Fbuffer);
s:=s+copy(Fbuffer,1,x-1);
c:=Fbuffer[x];
delete(Fbuffer,1,x);
@ -400,7 +442,11 @@ begin
if FLastError=0 then
begin
{$IFDEF LINUX}
s:=AdjustLineBreaks(s,tlbsCRLF);
{$ELSE}
s:=AdjustLineBreaks(s);
{$ENDIF}
x:=pos(#13+#10,s);
if x>0 then s:=copy(s,1,x-1);
result:=s;
@ -412,7 +458,7 @@ end;
{TBlockSocket.PeekBuffer}
function TBlockSocket.PeekBuffer(buffer:pointer;length:integer):integer;
begin
result:=winsock.recv(FSocket,buffer^,length,MSG_PEEK);
result:=synsock.recv(FSocket,buffer^,length,MSG_PEEK);
sockcheck(result);
ExceptCheck;
end;
@ -427,7 +473,7 @@ begin
result:=0;
if CanRead(timeout) then
begin
y:=winsock.recv(FSocket,data,1,MSG_PEEK);
y:=synsock.recv(FSocket,data,1,MSG_PEEK);
if y=0 then FLastError:=WSAENOTCONN;
sockcheck(y);
result:=data;
@ -439,7 +485,7 @@ end;
{TBlockSocket.SockCheck}
function TBlockSocket.SockCheck(SockResult:integer):integer;
begin
if SockResult=SOCKET_ERROR then result:=winsock.WSAGetLastError
if SockResult=SOCKET_ERROR then result:=synsock.WSAGetLastError
else result:=0;
FLastError:=result;
end;
@ -465,7 +511,7 @@ function TBlockSocket.WaitingData:integer;
var
x:integer;
begin
winsock.ioctlsocket(FSocket,FIONREAD,x);
synsock.ioctlsocket(FSocket,FIONREAD,u_long(x));
result:=x;
end;
@ -476,28 +522,66 @@ var
begin
li.l_onoff := ord(enable);
li.l_linger := Linger div 1000;
SockCheck(winsock.SetSockOpt(FSocket, SOL_SOCKET, SO_LINGER, @li, SizeOf(li)));
SockCheck(synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_LINGER, @li, SizeOf(li)));
ExceptCheck;
end;
{TBlockSocket.LocalName}
function TBlockSocket.LocalName:string;
var
buf: array[0..255] of char;
buf:array[0..255] of char;
Pbuf:pchar;
RemoteHost : PHostEnt;
RemoteHost:PHostEnt;
begin
pbuf:=buf;
result:='';
winsock.gethostname(pbuf,255);
synsock.gethostname(pbuf,255);
if pbuf<>'' then
begin
RemoteHost:=Winsock.GetHostByName(pbuf);
if remoteHost<>nil then result:=pchar(RemoteHost^.h_name);
//try get Fully Qualified Domain Name
RemoteHost:=synsock.GetHostByName(pbuf);
if remoteHost<>nil then
result:=pchar(RemoteHost^.h_name);
end;
if result='' then result:='127.0.0.1';
end;
{TBlockSocket.ResolveNameToIP}
procedure TBlockSocket.ResolveNameToIP(Name:string;IPlist:TStringlist);
type
TaPInAddr = Array[0..250] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
RemoteHost:PHostEnt;
IP:u_long;
PAdrPtr:PaPInAddr;
i:integer;
s:string;
InAddr:TInAddr;
begin
IPList.Clear;
IP := synsock.inet_addr(PChar(name));
if IP = u_long(INADDR_NONE)
then
begin
RemoteHost:=synsock.gethostbyname(PChar(name));
if RemoteHost <> nil then
begin
PAdrPtr:=PAPInAddr(remoteHost^.h_addr_list);
i:=0;
while PAdrPtr^[i]<>nil do
begin
InAddr:=PAdrPtr^[i]^;
with InAddr.S_un_b do
s:=IntToStr(Ord(s_b1))+'.'+IntToStr(Ord(s_b2))+'.'
+IntToStr(Ord(s_b3))+'.'+IntToStr(Ord(s_b4));
IPList.Add(s);
Inc(i);
end;
end;
end
else IPList.Add(name);
end;
{TBlockSocket.GetLocalSinIP}
function TBlockSocket.GetLocalSinIP:string;
@ -535,9 +619,9 @@ begin
Timev.tv_sec:=Timeout div 1000;
TimeVal:=@TimeV;
if timeout = -1 then Timeval:=nil;
Winsock.FD_Zero(FDSet);
Winsock.FD_Set(FSocket,FDSet);
x:=winsock.Select(0,@FDSet,nil,nil,TimeVal);
FD_Zero(FDSet);
FD_Set(FSocket,FDSet);
x:=synsock.Select(FSocket+1,@FDSet,nil,nil,TimeVal);
SockCheck(x);
If FLastError<>0 then x:=0;
result:=x>0;
@ -556,9 +640,9 @@ begin
Timev.tv_sec:=Timeout div 1000;
TimeVal:=@TimeV;
if timeout = -1 then Timeval:=nil;
Winsock.FD_Zero(FDSet);
Winsock.FD_Set(FSocket,FDSet);
x:=winsock.Select(0,nil,@FDSet,nil,TimeVal);
FD_Zero(FDSet);
FD_Set(FSocket,FDSet);
x:=synsock.Select(FSocket+1,nil,@FDSet,nil,TimeVal);
SockCheck(x);
If FLastError<>0 then x:=0;
result:=x>0;
@ -571,7 +655,7 @@ var
len:integer;
begin
len:=sizeof(FRemoteSin);
result:=winsock.sendto(FSocket,buffer^,length,0,FRemoteSin,len);
result:=synsock.sendto(FSocket,buffer^,length,0,FRemoteSin,len);
sockcheck(result);
ExceptCheck;
end;
@ -582,7 +666,7 @@ var
len:integer;
begin
len:=sizeof(FRemoteSin);
result:=winsock.recvfrom(FSocket,buffer^,length,0,FRemoteSin,len);
result:=synsock.recvfrom(FSocket,buffer^,length,0,FRemoteSin,len);
sockcheck(result);
ExceptCheck;
end;
@ -593,7 +677,7 @@ var
l:integer;
begin
l:=SizeOf(result);
SockCheck(winsock.getSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @result, l));
SockCheck(synsock.getSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @result, l));
if Flasterror<>0
then result:=1024;
ExceptCheck;
@ -602,7 +686,7 @@ end;
{TBlockSocket.SetSizeRecvBuffer}
procedure TBlockSocket.SetSizeRecvBuffer(size:integer);
begin
SockCheck(winsock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @size, SizeOf(size)));
SockCheck(synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @size, SizeOf(size)));
ExceptCheck;
end;
@ -612,7 +696,7 @@ var
l:integer;
begin
l:=SizeOf(result);
SockCheck(winsock.getSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @result, l));
SockCheck(synsock.getSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @result, l));
if Flasterror<>0
then result:=1024;
ExceptCheck;
@ -621,7 +705,7 @@ end;
{TBlockSocket.SetSizeSendBuffer}
procedure TBlockSocket.SetSizeSendBuffer(size:integer);
begin
SockCheck(winsock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @size, SizeOf(size)));
SockCheck(synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @size, SizeOf(size)));
ExceptCheck;
end;
@ -631,7 +715,7 @@ end;
{TUDPBlockSocket.CreateSocket}
Procedure TUDPBlockSocket.CreateSocket;
begin
FSocket:=winsock.socket(PF_INET,SOCK_DGRAM,IPPROTO_UDP);
FSocket:=synsock.socket(PF_INET,integer(SOCK_DGRAM),IPPROTO_UDP);
FProtocol:=IPPROTO_UDP;
inherited createSocket;
end;
@ -643,7 +727,7 @@ var
Res:integer;
begin
opt:=Ord(Value);
Res:=winsock.SetSockOpt(FSocket, SOL_SOCKET, SO_BROADCAST, @opt, SizeOf(opt));
Res:=synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_BROADCAST, @opt, SizeOf(opt));
SockCheck(Res);
Result:=res=0;
ExceptCheck;
@ -655,7 +739,7 @@ end;
{TTCPBlockSocket.CreateSocket}
Procedure TTCPBlockSocket.CreateSocket;
begin
FSocket:=winsock.socket(PF_INET,SOCK_STREAM,IPPROTO_TCP);
FSocket:=synsock.socket(PF_INET,integer(SOCK_STREAM),IPPROTO_TCP);
FProtocol:=IPPROTO_TCP;
inherited createSocket;
end;
@ -663,7 +747,7 @@ end;
{TTCPBlockSocket.Listen}
procedure TTCPBlockSocket.Listen;
begin
SockCheck(winsock.listen(FSocket,SOMAXCONN));
SockCheck(synsock.listen(FSocket,SOMAXCONN));
GetSins;
ExceptCheck;
end;
@ -674,11 +758,7 @@ var
len:integer;
begin
len:=sizeof(FRemoteSin);
{$IFDEF VER090}
result:=winsock.accept(FSocket,TSockAddr(FRemoteSin),len));
{$ELSE}
result:=winsock.accept(FSocket,@FRemoteSin,@len);
{$ENDIF}
result:=synsock.accept(FSocket,@FRemoteSin,@len);
SockCheck(result);
ExceptCheck;
end;

4
dnssend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.001.000 |
| Project : Delphree - Synapse | 001.001.001 |
|==============================================================================|
| Content: DNS client |
|==============================================================================|
@ -29,7 +29,7 @@ unit DNSsend;
interface
uses
Blcksock, sysutils, classes, SynaUtil, dialogs;
Blcksock, sysutils, classes, SynaUtil;
const
Qtype_A =1;

4
httpsend.pas
View File

@ -23,11 +23,11 @@
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
unit HTTPsend;
unit HTTPSend;
interface
uses
Blcksock, sysutils, classes, windows, SynaUtil, SynaCode;
Blcksock, sysutils, classes, SynaUtil, SynaCode;
const
CRLF=#13+#10;

19
mimechar.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.000.000 |
| Project : Delphree - Synapse | 003.000.000 |
|==============================================================================|
| Content: MIME support character conversion tables |
|==============================================================================|
@ -27,6 +27,11 @@ unit MIMEchar;
interface
{$IFDEF LINUX}
uses
libc;
{$ENDIF}
type
TMimeChar=(
@ -557,10 +562,13 @@ Function IdealCoding(value:string;CharFrom:TMimeChar;CharTo:TSetChar):TMimeChar;
implementation
uses
windows, sysutils, synautil, synacode;
{$IFNDEF LINUX}
windows,
{$ENDIF}
sysutils, synautil, synacode;
{==============================================================================}
procedure CopyArray(var SourceTable, TargetTable:array of word);
procedure CopyArray(const SourceTable:array of word; var TargetTable:array of word);
var
n:integer;
begin
@ -882,6 +890,10 @@ end;
{==============================================================================}
{GetCurChar}
Function GetCurCP:TMimeChar;
{$IFDEF LINUX}
begin
result:=GetCPFromID(nl_langinfo(_NL_CTYPE_CODESET_NAME));
{$ELSE}
var
x:integer;
begin
@ -895,6 +907,7 @@ begin
if x=1256 then result:=CP1256;
if x=1257 then result:=CP1257;
if x=1258 then result:=CP1258;
{$ENDIF}
end;
{==============================================================================}

6
mimeinln.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.000 |
| Project : Delphree - Synapse | 001.000.001 |
|==============================================================================|
| Content: Inline MIME support procedures and functions |
|==============================================================================|
@ -23,12 +23,12 @@
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
unit MIMEinLN;
unit MIMEinLn;
interface
uses
sysutils, classes, windows, MIMEchar, SynaCode, SynaUtil;
sysutils, classes, MIMEchar, SynaCode, SynaUtil;
function InlineDecode(value:string;CP:TMimeChar):string;
function InlineEncode(value:string;CP,MimeP:TMimeChar):string;

24
mimemess.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.002.000 |
| Project : Delphree - Synapse | 001.003.000 |
|==============================================================================|
| Content: MIME message object |
|==============================================================================|
@ -52,6 +52,7 @@ TMimeMess=class(TObject)
function AddPart:integer;
procedure AddPartText(value:tstringList);
procedure AddPartHTML(value:tstringList);
procedure AddPartHTMLBinary(Value,Cid:string);
procedure AddPartBinary(value:string);
procedure EncodeMessage;
procedure FinalizeHeaders;
@ -172,6 +173,27 @@ begin
end;
end;
{TMimeMess.AddPartHTMLBinary}
procedure TMimeMess.AddPartHTMLBinary(Value,Cid:string);
var
x:integer;
s:string;
begin
x:=Addpart;
with TMimePart(PartList[x]) do
begin
DecodedLines.LoadFromFile(Value);
s:=ExtractFileName(value);
MimeTypeFromExt(s);
description:='Included file: '+s;
disposition:='inline';
contentID:=cid;
filename:=s;
EncodingCode:=ME_BASE64;
EncodePart;
end;
end;
{==============================================================================}
{TMimeMess.Encodemessage}
procedure TMimeMess.Encodemessage;

14
mimepart.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.003.000 |
| Project : Delphree - Synapse | 001.004.000 |
|==============================================================================|
| Content: MIME support procedures and functions |
|==============================================================================|
@ -28,7 +28,7 @@ unit MIMEpart;
interface
uses
sysutils, classes, windows, MIMEchar, SynaCode, SynaUtil, MIMEinLn;
sysutils, classes, MIMEchar, SynaCode, SynaUtil, MIMEinLn;
type
@ -61,6 +61,7 @@ TMimePart=class
secondary:string;
description:string;
disposition:string;
contentID:string;
boundary:string;
FileName:string;
Lines:TStringList;
@ -176,6 +177,7 @@ begin
TargetCharset:=GetCurCP;
secondary:='';
disposition:='';
contentID:='';
description:='';
boundary:='';
FileName:='';
@ -264,6 +266,10 @@ begin
disposition:=trim(separateleft(disposition,';'));
fn:=getparameter(s,'filename=');
end;
if pos('CONTENT-ID:',su)=1 then
begin
contentID:=separateright(s,':');
end;
end;
if (primarycode=MP_BINARY) and (filename='')
@ -458,7 +464,8 @@ begin
then s:='; filename="'+filename+'"';
lines.insert(0,'Content-Disposition: '+lowercase(disposition)+s);
end;
if contentID<>''
then lines.insert(0,'Content-ID: '+contentID);
case EncodingCode of
ME_7BIT: s:='7bit';
@ -494,6 +501,7 @@ begin
s:=uppercase(extractfileext(value));
if s=''
then s:=uppercase(value);
s:=separateright(s,'.');
for n:=0 to MaxMimeType do
if MimeType[n,0]=s then
begin

31
pingsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.001.000 |
| Project : Delphree - Synapse | 002.000.000 |
|==============================================================================|
| Content: PING sender |
|==============================================================================|
@ -26,7 +26,8 @@
{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Remember, this unit work only with Winsock2! (on Win98 and WinNT 4.0 or higher)
Remember, this unit work only on Linux or Windows with Winsock2!
(on Win98 and WinNT 4.0 or higher)
If you must use this unit on Win95, download Wínsock2 from Microsoft
and distribute it with your application!
@ -49,7 +50,12 @@ unit PINGsend;
interface
uses
winsock, SysUtils, windows, blcksck2, Synautil, dialogs;
{$IFDEF LINUX}
libc,
{$ELSE}
windows,
{$ENDIF}
synsock, SysUtils, blcksck2, Synautil;
const
ICMP_ECHO=8;
@ -73,6 +79,7 @@ TPINGSend=class(TObject)
seq:integer;
id:integer;
function checksum:integer;
function GetTick:cardinal;
public
timeout:integer;
PacketSize:integer;
@ -124,7 +131,7 @@ begin
i_CheckSum:=0;
id:=Random(32767);
i_Id:=id;
TimeStamp:=GetTickcount;
TimeStamp:=GetTick;
Inc(Seq);
i_Seq:=Seq;
for n:=Succ(SizeOf(TicmpEchoHeader)) to Length(Buffer) do
@ -140,10 +147,12 @@ begin
PIpHeader:=Pointer(Buffer);
IpHdrLen:=(PIpHeader^.VerLen and $0F)*4;
PIcmpEchoHeader:=@Buffer[IpHdrLen+1];
if (PIcmpEchoHeader^.i_type=ICMP_ECHOREPLY) then
if (PIcmpEchoHeader^.i_type=ICMP_ECHOREPLY)
// Linux return from localhost ECHO instead ECHOREPLY???
or (PIcmpEchoHeader^.i_type=ICMP_ECHO) then
if (PIcmpEchoHeader^.i_id=id) then
begin
PingTime:=GetTickCount-PIcmpEchoHeader^.TimeStamp;
PingTime:=GetTick-PIcmpEchoHeader^.TimeStamp;
Result:=True;
end;
end;
@ -172,6 +181,16 @@ begin
Result:=Word(not CkSum);
end;
{TPINGSend.GetTick}
function TPINGSend.GetTick:cardinal;
begin
{$IFDEF LINUX}
result:=clock div (CLOCKS_PER_SEC div 1000);
{$ELSE}
result:=windows.GetTickCount;
{$ENDIF}
end;
{==============================================================================}
function PingHost(host:string):integer;

20
pop3send.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.001 |
| Project : Delphree - Synapse | 001.001.000 |
|==============================================================================|
| Content: POP3 client |
|==============================================================================|
@ -27,16 +27,19 @@ unit POP3send;
interface
uses
Blcksock, sysutils, classes, windows, SynaUtil, SynaCode;
Blcksock, sysutils, classes, SynaUtil, SynaCode;
const
CRLF=#13+#10;
type
TPOP3AuthType = (POP3AuthAll,POP3AuthLogin,POP3AuthAPOP);
TPOP3Send = class
private
Sock:TTCPBlockSocket;
function ReadResult(full:boolean):integer;
function Connect:Boolean;
public
timeout:integer;
POP3Host:string;
@ -49,11 +52,11 @@ type
StatCount:integer;
StatSize:integer;
TimeStamp:string;
AuthType:TPOP3AuthType;
Constructor Create;
Destructor Destroy; override;
function AuthLogin:Boolean;
function AuthApop:Boolean;
function Connect:Boolean;
function login:Boolean;
procedure logout;
function reset:Boolean;
@ -82,6 +85,7 @@ begin
Password:='';
StatCount:=0;
StatSize:=0;
AuthType:=POP3AuthAll;
end;
{TPOP3Send.Destroy}
@ -140,7 +144,7 @@ end;
{TPOP3Send.Connect}
function TPOP3Send.Connect:Boolean;
begin
//Do not call this function! It is calling by LOGIn method!
//Do not call this function! It is calling by LOGIN method!
Result:=false;
StatCount:=0;
StatSize:=0;
@ -169,9 +173,9 @@ begin
then TimeStamp:='<'+s1+'>';
end;
result:=false;
if TimeStamp<>''
if (TimeStamp<>'') and not(AuthType=POP3AuthLogin)
then result:=AuthApop;
if not result
if not(Result) and not(AuthType=POP3AuthAPOP)
then result:=AuthLogin;
end;
@ -222,7 +226,7 @@ begin
if value=0
then Sock.SendString('LIST'+CRLF)
else Sock.SendString('LIST '+IntToStr(value)+CRLF);
if readresult(true)<>1 then Exit;
if readresult(value=0)<>1 then Exit;
Result:=True;
end;
@ -260,7 +264,7 @@ begin
if value=0
then Sock.SendString('UIDL'+CRLF)
else Sock.SendString('UIDL '+IntToStr(value)+CRLF);
if readresult(true)<>1 then Exit;
if readresult(value=0)<>1 then Exit;
Result:=True;
end;

4
smtpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.001.001 |
| Project : Delphree - Synapse | 002.001.002 |
|==============================================================================|
| Content: SMTP client |
|==============================================================================|
@ -27,7 +27,7 @@ unit SMTPsend;
interface
uses
Blcksock, sysutils, classes, windows, SynaUtil, SynaCode;
Blcksock, sysutils, classes, SynaUtil, SynaCode;
const
CRLF=#13+#10;

8
sntpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.001.000 |
| Project : Delphree - Synapse | 002.000.000 |
|==============================================================================|
| Content: SNTP client |
|==============================================================================|
@ -29,7 +29,7 @@ unit SNTPsend;
interface
uses
winsock, SysUtils, windows, blcksock;
synsock, SysUtils, blcksock;
type
@ -91,8 +91,8 @@ const
var
d, d1: double;
begin
nsec:=htonl(nsec);
nfrac:=htonl(nfrac);
nsec:=synsock.htonl(nsec);
nfrac:=synsock.htonl(nfrac);
d:=nsec;
if d<0
then d:=maxi+d-1;

23
synautil.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.008.000 |
| Project : Delphree - Synapse | 002.000.000 |
|==============================================================================|
| Content: support procedures and functions |
|==============================================================================|
@ -30,7 +30,12 @@ unit SynaUtil;
interface
uses
sysutils, classes, windows;
sysutils, classes,
{$IFDEF LINUX}
libc;
{$ELSE}
windows;
{$ENDIF}
function timezone:string;
function Rfc822DateTime(t:TDateTime):String;
@ -55,6 +60,19 @@ implementation
{==============================================================================}
{timezone}
function timezone:string;
{$IFDEF LINUX}
var
t: TTime_T;
UT: TUnixTime;
bias:integer;
h,m:integer;
begin
__time(@T);
localtime_r(@T,UT);
bias:=ut.__tm_gmtoff div 60;
if bias>=0 then result:='+'
else result:='-';
{$ELSE}
var
zoneinfo:TTimeZoneInformation;
bias:integer;
@ -68,6 +86,7 @@ begin
end;
if bias<=0 then result:='+'
else result:='-';
{$ENDIF}
bias:=abs(bias);
h:=bias div 60;
m:=bias mod 60;

520
synsock.pas Normal file
View File

@ -0,0 +1,520 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.000 |
|==============================================================================|
| Content: Socket Independent Platform |
|==============================================================================|
| 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)2001. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
|==============================================================================|
| History: see HISTORY.HTM from distribution package |
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
unit synsock;
interface
uses
{$IFDEF LINUX}
libc, kernelioctl;
{$ELSE}
winsock, windows;
{$ENDIF}
{$IFDEF LINUX}
const
WSAEINTR = EINTR;
WSAEBADF = EBADF;
WSAEACCES = EACCES;
WSAEFAULT = EFAULT;
WSAEINVAL = EINVAL;
WSAEMFILE = EMFILE;
WSAEWOULDBLOCK = EWOULDBLOCK;
WSAEINPROGRESS = EINPROGRESS;
WSAEALREADY = EALREADY;
WSAENOTSOCK = ENOTSOCK;
WSAEDESTADDRREQ = EDESTADDRREQ;
WSAEMSGSIZE = EMSGSIZE;
WSAEPROTOTYPE = EPROTOTYPE;
WSAENOPROTOOPT = ENOPROTOOPT;
WSAEPROTONOSUPPORT = EPROTONOSUPPORT;
WSAESOCKTNOSUPPORT = ESOCKTNOSUPPORT;
WSAEOPNOTSUPP = EOPNOTSUPP;
WSAEPFNOSUPPORT = EPFNOSUPPORT;
WSAEAFNOSUPPORT = EAFNOSUPPORT;
WSAEADDRINUSE = EADDRINUSE;
WSAEADDRNOTAVAIL = EADDRNOTAVAIL;
WSAENETDOWN = ENETDOWN;
WSAENETUNREACH = ENETUNREACH;
WSAENETRESET = ENETRESET;
WSAECONNABORTED = ECONNABORTED;
WSAECONNRESET = ECONNRESET;
WSAENOBUFS = ENOBUFS;
WSAEISCONN = EISCONN;
WSAENOTCONN = ENOTCONN;
WSAESHUTDOWN = ESHUTDOWN;
WSAETOOMANYREFS = ETOOMANYREFS;
WSAETIMEDOUT = ETIMEDOUT;
WSAECONNREFUSED = ECONNREFUSED;
WSAELOOP = ELOOP;
WSAENAMETOOLONG = ENAMETOOLONG;
WSAEHOSTDOWN = EHOSTDOWN;
WSAEHOSTUNREACH = EHOSTUNREACH;
WSAENOTEMPTY = ENOTEMPTY;
WSAEPROCLIM = -1;
WSAEUSERS = EUSERS;
WSAEDQUOT = EDQUOT;
WSAESTALE = ESTALE;
WSAEREMOTE = EREMOTE;
WSASYSNOTREADY = -2;
WSAVERNOTSUPPORTED = -3;
WSANOTINITIALISED = -4;
WSAEDISCON = -5;
WSAHOST_NOT_FOUND = HOST_NOT_FOUND;
WSATRY_AGAIN = TRY_AGAIN;
WSANO_RECOVERY = NO_RECOVERY;
// WSANO_DATA = NO_DATA;
WSANO_DATA = -6;
{$ELSE}
const
DLLStackName = 'wsock32.dll';
var
LibHandle : THandle = 0;
{$ENDIF}
{$IFDEF LINUX}
const
WSADESCRIPTION_LEN = 256;
WSASYS_STATUS_LEN = 128;
type
PWSAData = ^TWSAData;
TWSAData = packed record
wVersion: Word;
wHighVersion: Word;
szDescription: array[0..WSADESCRIPTION_LEN] of Char;
szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
iMaxSockets: Word;
iMaxUdpDg: Word;
lpVendorInfo: PChar;
end;
DWORD=integer;
TLinger=Linger;
{$ENDIF}
type
TWSAStartup = function (wVersionRequired: word;
var WSData: TWSAData): Integer; stdcall;
TWSACleanup = function : Integer; stdcall;
TWSAGetLastError = function : Integer; stdcall;
TGetServByName = function (name, proto: PChar): PServEnt; stdcall;
TGetServByPort = function (port: Integer; proto: PChar): PServEnt; stdcall;
TGetProtoByName = function (name: PChar): PProtoEnt; stdcall;
TGetProtoByNumber = function (proto: Integer): PProtoEnt; stdcall;
TGetHostByName = function (name: PChar): PHostEnt; stdcall;
TGetHostByAddr = function (addr: Pointer; len, Struct: Integer): PHostEnt; stdcall;
TGetHostName = function (name: PChar; len: Integer): Integer; stdcall;
TShutdown = function (s: TSocket; how: Integer): Integer; stdcall;
TSetSockOpt = function (s: TSocket; level, optname: Integer;
optval: PChar;
optlen: Integer): Integer; stdcall;
TGetSockOpt = function (s: TSocket; level, optname: Integer;
optval: PChar;
var optlen: Integer): Integer; stdcall;
TSendTo = function (s: TSocket; var Buf;
len, flags: Integer;
var addrto: TSockAddr;
tolen: Integer): Integer; stdcall;
TSend = function (s: TSocket; var Buf;
len, flags: Integer): Integer; stdcall;
TRecv = function (s: TSocket;
var Buf;
len, flags: Integer): Integer; stdcall;
TRecvFrom = function (s: TSocket;
var Buf; len, flags: Integer;
var from: TSockAddr;
var fromlen: Integer): Integer; stdcall;
Tntohs = function (netshort: u_short): u_short; stdcall;
Tntohl = function (netlong: u_long): u_long; stdcall;
TListen = function (s: TSocket;
backlog: Integer): Integer; stdcall;
TIoctlSocket = function (s: TSocket; cmd: DWORD;
var arg: u_long): Integer; stdcall;
TInet_ntoa = function (inaddr: TInAddr): PChar; stdcall;
TInet_addr = function (cp: PChar): u_long; stdcall;
Thtons = function (hostshort: u_short): u_short; stdcall;
Thtonl = function (hostlong: u_long): u_long; stdcall;
TGetSockName = function (s: TSocket; var name: TSockAddr;
var namelen: Integer): Integer; stdcall;
TGetPeerName = function (s: TSocket; var name: TSockAddr;
var namelen: Integer): Integer; stdcall;
TConnect = function (s: TSocket; var name: TSockAddr;
namelen: Integer): Integer; stdcall;
TCloseSocket = function (s: TSocket): Integer; stdcall;
TBind = function (s: TSocket; var addr: TSockAddr;
namelen: Integer): Integer; stdcall;
TAccept = function (s: TSocket; addr: PSockAddr;
addrlen: PInteger): TSocket; stdcall;
TSocketProc = function (af, Struct, protocol: Integer): TSocket; stdcall;
TSelect = function (nfds: Integer; readfds, writefds, exceptfds: PFDSet;
timeout: PTimeVal): Longint; stdcall;
var
WSAStartup : TWSAStartup =nil;
WSACleanup : TWSACleanup =nil;
WSAGetLastError : TWSAGetLastError =nil;
GetServByName : TGetServByName =nil;
GetServByPort : TGetServByPort =nil;
GetProtoByName : TGetProtoByName =nil;
GetProtoByNumber : TGetProtoByNumber =nil;
GetHostByName : TGetHostByName =nil;
GetHostByAddr : TGetHostByAddr =nil;
GetHostName : TGetHostName =nil;
Shutdown : TShutdown =nil;
SetSockOpt : TSetSockOpt =nil;
GetSockOpt : TGetSockOpt =nil;
SendTo : TSendTo =nil;
Send : TSend =nil;
Recv : TRecv =nil;
RecvFrom : TRecvFrom =nil;
ntohs : Tntohs =nil;
ntohl : Tntohl =nil;
Listen : TListen =nil;
IoctlSocket : TIoctlSocket =nil;
Inet_ntoa : TInet_ntoa =nil;
Inet_addr : TInet_addr =nil;
htons : Thtons =nil;
htonl : Thtonl =nil;
GetSockName : TGetSockName =nil;
GetPeerName : TGetPeerName =nil;
Connect : TConnect =nil;
CloseSocket : TCloseSocket =nil;
Bind : TBind =nil;
Accept : TAccept =nil;
Socket : TSocketProc =nil;
Select : TSelect =nil;
function InitSocketInterface(stack:string):Boolean;
function DestroySocketInterface:Boolean;
{$IFDEF LINUX}
function LSWSAStartup (wVersionRequired: Word; var WSData: TWSAData): Integer; stdcall;
function LSWSACleanup : Integer; stdcall;
function LSWSAGetLastError : Integer; stdcall;
function LSGetServByName (name, proto: PChar): PServEnt; stdcall;
function LSGetServByPort (port: Integer; proto: PChar): PServEnt; stdcall;
function LSGetProtoByName (name: PChar): PProtoEnt; stdcall;
function LSGetProtoByNumber (proto: Integer): PProtoEnt; stdcall;
function LSGetHostByName (name: PChar): PHostEnt; stdcall;
function LSGetHostByAddr (addr: Pointer; len, Struct: Integer): PHostEnt; stdcall;
function LSGetHostName (name: PChar; len: Integer): Integer; stdcall;
function LSShutdown (s: TSocket; how: Integer): Integer; stdcall;
function LSSetSockOpt (s: TSocket; level, optname: Integer; optval: PChar; optlen: Integer): Integer; stdcall;
function LSGetSockOpt (s: TSocket; level, optname: Integer; optval: PChar; var optlen: Integer): Integer; stdcall;
function LSSendTo (s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr; tolen: Integer): Integer; stdcall;
function LSSend (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
function LSRecv (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
function LSRecvFrom (s: TSocket; var Buf; len, flags: Integer; var from: TSockAddr; var fromlen: Integer): Integer; stdcall;
function LSntohs (netshort: u_short): u_short; stdcall;
function LSntohl (netlong: u_long): u_long; stdcall;
function LSListen (s: TSocket; backlog: Integer): Integer; stdcall;
function LSIoctlSocket (s: TSocket; cmd: DWORD; var arg: u_long): Integer; stdcall;
function LSInet_ntoa (inaddr: TInAddr): PChar; stdcall;
function LSInet_addr (cp: PChar): u_long; stdcall;
function LShtons (hostshort: u_short): u_short; stdcall;
function LShtonl (hostlong: u_long): u_long; stdcall;
function LSGetSockName (s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; stdcall;
function LSGetPeerName (s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; stdcall;
function LSConnect (s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
function LSCloseSocket (s: TSocket): Integer; stdcall;
function LSBind (s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall;
function LSAccept (s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall;
function LSSocketProc (af, Struct, protocol: Integer): TSocket; stdcall;
function LSSelect (nfds: Integer; readfds, writefds, exceptfds: PFDSet; timeout: PTimeVal): Longint; stdcall;
{$ENDIF}
implementation
{$IFDEF LINUX}
function LSWSAStartup (wVersionRequired: Word; var WSData: TWSAData): Integer;
begin
WSData.wVersion:=wVersionRequired;
WSData.wHighVersion:=wVersionRequired;
WSData.szDescription:='Synapse Platform Independent Socket Layer';
WSData.szSystemStatus:='On Linux';
result:=0;
end;
function LSWSACleanup : Integer;
begin
Result:=0;
end;
function LSWSAGetLastError : Integer;
begin
result:=System.GetLastError;
end;
function LSGetServByName (name, proto: PChar): PServEnt;
begin
result:=libc.GetServByName(name,proto);
end;
function LSGetServByPort (port: Integer; proto: PChar): PServEnt;
begin
result:=libc.GetServByPort(port,proto);
end;
function LSGetProtoByName (name: PChar): PProtoEnt;
begin
result:=libc.getprotobyname(Name);
end;
function LSGetProtoByNumber (proto: Integer): PProtoEnt;
begin
result:=libc.getprotobynumber(proto);
end;
function LSGetHostByName (name: PChar): PHostEnt;
begin
result:=libc.GetHostByName(Name);
end;
function LSGetHostByAddr (addr: Pointer; len, Struct: Integer): PHostEnt;
begin
Result:=libc.GetHostByAddr(Addr,len,struct);
end;
function LSGetHostName (name: PChar; len: Integer): Integer;
begin
Result:=libc.GetHostName(Name,Len);
end;
function LSShutdown (s: TSocket; how: Integer): Integer;
begin
result:=libc.Shutdown(S,How);
end;
function LSSetSockOpt (s: TSocket; level, optname: Integer; optval: PChar; optlen: Integer): Integer;
begin
result:=libc.SetSockOpt(S,Level,OptName,OptVal,OptLen);
end;
function LSGetSockOpt (s: TSocket; level, optname: Integer; optval: PChar; var optlen: Integer): Integer;
begin
result:=libc.getsockopt(s,level,optname,optval,cardinal(optlen));
end;
function LSSendTo (s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr; tolen: Integer): Integer;
begin
result:=libc.SendTo(S,Buf,Len,Flags,Addrto,Tolen);
end;
function LSSend (s: TSocket; var Buf; len, flags: Integer): Integer;
begin
result:=libc.Send(S,Buf,Len,Flags);
end;
function LSRecv (s: TSocket; var Buf; len, flags: Integer): Integer;
begin
result:=libc.Recv(S,Buf,Len,Flags);
end;
function LSRecvFrom (s: TSocket; var Buf; len, flags: Integer; var from: TSockAddr; var fromlen: Integer): Integer;
begin
result:=libc.RecvFrom(S,Buf,Len,Flags,@from,@fromlen);
end;
function LSntohs (netshort: u_short): u_short;
begin
Result:=libc.NToHS(netshort);
end;
function LSntohl (netlong: u_long): u_long;
begin
Result:=libc.NToHL(netlong);
end;
function LSListen (s: TSocket; backlog: Integer): Integer;
begin
result:=libc.Listen(S,Backlog);
end;
function LSIoctlSocket (s: TSocket; cmd: DWORD; var arg: u_long): Integer;
begin
result:=libc.ioctl(s,cmd,@arg);
end;
function LSInet_ntoa (inaddr: TInAddr): PChar;
begin
result:=libc.inet_ntoa(inaddr);
end;
function LSInet_addr (cp: PChar): u_long;
begin
result:=libc.inet_addr(cp);
end;
function LShtons (hostshort: u_short): u_short;
begin
result:=libc.HToNs(HostShort);
end;
function LShtonl (hostlong: u_long): u_long;
begin
Result:=libc.HToNL(HostLong);
end;
function LSGetSockName (s: TSocket; var name: TSockAddr; var namelen: Integer): Integer;
begin
Result:=libc.GetSockName(S,Name,cardinal(namelen));
end;
function LSGetPeerName (s: TSocket; var name: TSockAddr; var namelen: Integer): Integer;
begin
Result:=libc.GetPeerName(S,Name,cardinal(namelen));
end;
function LSConnect (s: TSocket; var name: TSockAddr; namelen: Integer): Integer;
begin
result:=libc.Connect(S,name,namelen);
end;
function LSCloseSocket (s: TSocket): Integer;
begin
result:=libc.__close(s);
end;
function LSBind (s: TSocket; var addr: TSockAddr; namelen: Integer): Integer;
begin
result:=libc.Bind(S,addr,namelen);
end;
function LSAccept (s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket;
begin
result:=libc.Accept(S,addr,psocketlength(addrlen));
end;
function LSSocketProc (af, Struct, protocol: Integer): TSocket;
begin
result:=libc.Socket(Af,Struct,Protocol);
end;
function LSSelect (nfds: Integer; readfds, writefds, exceptfds: PFDSet; timeout: PTimeVal): Longint;
begin
Result:=libc.Select(nfds,readfds,writefds,exceptfds,timeout);
end;
{$ENDIF}
function InitSocketInterface(stack:string):Boolean;
begin
{$IFDEF LINUX}
Accept := LSAccept;
Bind := LSBind;
CloseSocket := LSCloseSocket;
Connect := LSConnect;
GetPeerName := LSGetPeerName;
GetSockName := LSGetSockName;
GetSockOpt := LSGetSockOpt;
Htonl := LShtonl;
Htons := LShtons;
Inet_Addr := LSinet_addr;
Inet_Ntoa := LSinet_ntoa;
IoctlSocket := LSioctlsocket;
Listen := LSlisten;
Ntohl := LSntohl;
Ntohs := LSntohs;
Recv := LSrecv;
RecvFrom := LSrecvfrom;
Select := LSselect;
Send := LSsend;
SendTo := LSsendto;
SetSockOpt := LSsetsockopt;
ShutDown := LSshutdown;
Socket := LSsocketProc;
GetHostByAddr := LSgethostbyaddr;
GetHostByName := LSgethostbyname;
GetProtoByName := LSgetprotobyname;
GetProtoByNumber := LSgetprotobynumber;
GetServByName := LSgetservbyname;
GetServByPort := LSgetservbyport;
GetHostName := LSgethostname;
WSAGetLastError := LSWSAGetLastError;
WSAStartup := LSWSAStartup;
WSACleanup := LSWSACleanup;
Result:=True;
{$ELSE}
Result:=False;
if stack=''
then stack:=DLLStackName;
LibHandle := Windows.LoadLibrary(PChar(Stack));
if LibHandle <> 0 then begin
Accept := Windows.GetProcAddress (LibHandle, PChar('accept'));
Bind := Windows.GetProcAddress (LibHandle, PChar('bind'));
CloseSocket := Windows.GetProcAddress (LibHandle, PChar('closesocket'));
Connect := Windows.GetProcAddress (LibHandle, PChar('connect'));
GetPeerName := Windows.GetProcAddress (LibHandle, PChar('getpeername'));
GetSockName := Windows.GetProcAddress (LibHandle, PChar('getsockname'));
GetSockOpt := Windows.GetProcAddress (LibHandle, PChar('getsockopt'));
Htonl := Windows.GetProcAddress (LibHandle, PChar('htonl'));
Htons := Windows.GetProcAddress (LibHandle, PChar('htons'));
Inet_Addr := Windows.GetProcAddress (LibHandle, PChar('inet_addr'));
Inet_Ntoa := Windows.GetProcAddress (LibHandle, PChar('inet_ntoa'));
IoctlSocket := Windows.GetProcAddress (LibHandle, PChar('ioctlsocket'));
Listen := Windows.GetProcAddress (LibHandle, PChar('listen'));
Ntohl := Windows.GetProcAddress (LibHandle, PChar('ntohl'));
Ntohs := Windows.GetProcAddress (LibHandle, PChar('ntohs'));
Recv := Windows.GetProcAddress (LibHandle, PChar('recv'));
RecvFrom := Windows.GetProcAddress (LibHandle, PChar('recvfrom'));
Select := Windows.GetProcAddress (LibHandle, PChar('select'));
Send := Windows.GetProcAddress (LibHandle, PChar('send'));
SendTo := Windows.GetProcAddress (LibHandle, PChar('sendto'));
SetSockOpt := Windows.GetProcAddress (LibHandle, PChar('setsockopt'));
ShutDown := Windows.GetProcAddress (LibHandle, PChar('shutdown'));
Socket := Windows.GetProcAddress (LibHandle, PChar('socket'));
GetHostByAddr := Windows.GetProcAddress (LibHandle, PChar('gethostbyaddr'));
GetHostByName := Windows.GetProcAddress (LibHandle, PChar('gethostbyname'));
GetProtoByName := Windows.GetProcAddress (LibHandle, PChar('getprotobyname'));
GetProtoByNumber := Windows.GetProcAddress (LibHandle, PChar('getprotobynumber'));
GetServByName := Windows.GetProcAddress (LibHandle, PChar('getservbyname'));
GetServByPort := Windows.GetProcAddress (LibHandle, PChar('getservbyport'));
GetHostName := Windows.GetProcAddress (LibHandle, PChar('gethostname'));
WSAGetLastError := Windows.GetProcAddress (LibHandle, PChar('WSAGetLastError'));
WSAStartup := Windows.GetProcAddress (LibHandle, PChar('WSAStartup'));
WSACleanup := Windows.GetProcAddress (LibHandle, PChar('WSACleanup'));
Result:=True;
end;
{$ENDIF}
end;
function DestroySocketInterface:Boolean;
begin
{$IFDEF LINUX}
{$ELSE}
if LibHandle <> 0 then begin
Windows.FreeLibrary(libHandle);
end;
LibHandle := 0;
{$ENDIF}
Result:=True;
end;
end.