pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Release 24

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@51 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2008-04-24 07:07:45 +00:00
parent df848de345
commit 155969aef8
17 changed files with 1270 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
blcksock.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 003.002.000 | | Project : Delphree - Synapse | 003.003.000 |
|==============================================================================| |==============================================================================|
| Content: Library base | | Content: Library base |
|==============================================================================| |==============================================================================|
@ -49,8 +49,27 @@ type
ErrorMessage: string; ErrorMessage: string;
end; end;
THookSocketReason = (
HR_ResolvingBegin,
HR_ResolvingEnd,
HR_SocketCreate,
HR_SocketClose,
HR_Bind,
HR_Connect,
HR_CanRead,
HR_CanWrite,
HR_Listen,
HR_Accept,
HR_ReadCount,
HR_WriteCount
);
THookSocketStatus = procedure(Sender: TObject; Reason: THookSocketReason;
const Value: string) of object;
TBlockSocket = class(TObject) TBlockSocket = class(TObject)
private private
FOnStatus: THookSocketStatus;
FWsaData: TWSADATA; FWsaData: TWSADATA;
FLocalSin: TSockAddrIn; FLocalSin: TSockAddrIn;
FRemoteSin: TSockAddrIn; FRemoteSin: TSockAddrIn;
@ -68,6 +87,7 @@ type
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;
procedure DoStatus(Reason: THookSocketReason; const Value: string);
public public
constructor Create; constructor Create;
constructor CreateAlternate(Stub: string); constructor CreateAlternate(Stub: string);
@ -118,6 +138,7 @@ type
property SizeRecvBuffer: Integer read GetSizeRecvBuffer write SetSizeRecvBuffer; property SizeRecvBuffer: Integer read GetSizeRecvBuffer write SetSizeRecvBuffer;
property SizeSendBuffer: Integer read GetSizeSendBuffer write SetSizeSendBuffer; property SizeSendBuffer: Integer read GetSizeSendBuffer write SetSizeSendBuffer;
property WSAData: TWSADATA read FWsaData; property WSAData: TWSADATA read FWsaData;
property OnStatus: THookSocketStatus read FOnStatus write FOnStatus;
end; end;
TUDPBlockSocket = class(TBlockSocket) TUDPBlockSocket = class(TBlockSocket)
@ -205,6 +226,7 @@ end;
destructor TBlockSocket.Destroy; destructor TBlockSocket.Destroy;
begin begin
CloseSocket; CloseSocket;
synsock.WSACleanup;
DestroySocketInterface; DestroySocketInterface;
inherited Destroy; inherited Destroy;
end; end;
@ -215,6 +237,7 @@ var
ServEnt: PServEnt; ServEnt: PServEnt;
HostEnt: PHostEnt; HostEnt: PHostEnt;
begin begin
DoStatus(HR_ResolvingBegin, IP + ':' + Port);
FillChar(Sin, Sizeof(Sin), 0); FillChar(Sin, Sizeof(Sin), 0);
Sin.sin_family := AF_INET; Sin.sin_family := AF_INET;
ProtoEnt := synsock.GetProtoByNumber(FProtocol); ProtoEnt := synsock.GetProtoByNumber(FProtocol);
@ -237,6 +260,7 @@ begin
SIn.sin_addr.S_addr := Longint(PLongint(HostEnt^.h_addr_list^)^); SIn.sin_addr.S_addr := Longint(PLongint(HostEnt^.h_addr_list^)^);
end; end;
end; end;
DoStatus(HR_ResolvingEnd, IP+':'+Port);
end; end;
function TBlockSocket.GetSinIP(Sin: TSockAddrIn): string; function TBlockSocket.GetSinIP(Sin: TSockAddrIn): string;
@ -263,11 +287,13 @@ begin
else else
FLastError := 0; FLastError := 0;
ExceptCheck; ExceptCheck;
DoStatus(HR_SocketCreate, '');
end; end;
procedure TBlockSocket.CloseSocket; procedure TBlockSocket.CloseSocket;
begin begin
synsock.CloseSocket(FSocket); synsock.CloseSocket(FSocket);
DoStatus(HR_SocketClose, '');
end; end;
procedure TBlockSocket.Bind(IP, Port: string); procedure TBlockSocket.Bind(IP, Port: string);
@ -281,6 +307,7 @@ begin
synsock.GetSockName(FSocket, FLocalSin, Len); synsock.GetSockName(FSocket, FLocalSin, Len);
FBuffer := ''; FBuffer := '';
ExceptCheck; ExceptCheck;
DoStatus(HR_Bind, IP + ':' + Port);
end; end;
procedure TBlockSocket.Connect(IP, Port: string); procedure TBlockSocket.Connect(IP, Port: string);
@ -292,6 +319,7 @@ begin
GetSins; GetSins;
FBuffer := ''; FBuffer := '';
ExceptCheck; ExceptCheck;
DoStatus(HR_Connect, IP + ':' + Port);
end; end;
procedure TBlockSocket.GetSins; procedure TBlockSocket.GetSins;
@ -309,18 +337,21 @@ begin
Result := synsock.Send(FSocket, Buffer^, Length, 0); Result := synsock.Send(FSocket, Buffer^, Length, 0);
SockCheck(Result); SockCheck(Result);
ExceptCheck; ExceptCheck;
DoStatus(HR_WriteCount, IntToStr(Result));
end; end;
procedure TBlockSocket.SendByte(Data: Byte); procedure TBlockSocket.SendByte(Data: Byte);
begin begin
sockcheck(synsock.Send(FSocket, Data, 1, 0)); sockcheck(synsock.Send(FSocket, Data, 1, 0));
ExceptCheck; ExceptCheck;
DoStatus(HR_WriteCount, '1');
end; end;
procedure TBlockSocket.SendString(const Data: string); procedure TBlockSocket.SendString(const Data: string);
begin begin
SockCheck(synsock.Send(FSocket, PChar(Data)^, Length(Data), 0)); SockCheck(synsock.Send(FSocket, PChar(Data)^, Length(Data), 0));
ExceptCheck; ExceptCheck;
DoStatus(HR_WriteCount, IntToStr(Length(Data)));
end; end;
function TBlockSocket.RecvBuffer(Buffer: Pointer; Length: Integer): Integer; function TBlockSocket.RecvBuffer(Buffer: Pointer; Length: Integer): Integer;
@ -331,6 +362,7 @@ begin
else else
SockCheck(Result); SockCheck(Result);
ExceptCheck; ExceptCheck;
DoStatus(HR_ReadCount, IntToStr(Result));
end; end;
function TBlockSocket.RecvBufferEx(Buffer: Pointer; Length: Integer; function TBlockSocket.RecvBufferEx(Buffer: Pointer; Length: Integer;
@ -380,6 +412,7 @@ begin
SockCheck(x); SockCheck(x);
if FLastError <> 0 then if FLastError <> 0 then
Break; Break;
DoStatus(HR_ReadCount, IntToStr(x));
lss := system.Length(ss); lss := system.Length(ss);
SetLength(ss, lss + x); SetLength(ss, lss + x);
Move(Pointer(st)^, Pointer(@ss[lss + 1])^, x); Move(Pointer(st)^, Pointer(@ss[lss + 1])^, x);
@ -414,6 +447,7 @@ begin
else else
SockCheck(y); SockCheck(y);
Result := Data; Result := Data;
DoStatus(HR_ReadCount, '1');
end end
else else
FLastError := WSAETIMEDOUT; FLastError := WSAETIMEDOUT;
@ -456,6 +490,7 @@ begin
FLastError := WSAENOTCONN; FLastError := WSAENOTCONN;
if FLastError <> 0 then if FLastError <> 0 then
Break; Break;
DoStatus(HR_ReadCount, IntToStr(r));
if r < x then if r < x then
SetLength(FBuffer, r); SetLength(FBuffer, r);
end; end;
@ -650,6 +685,8 @@ begin
x := 0; x := 0;
Result := x > 0; Result := x > 0;
ExceptCheck; ExceptCheck;
if Result then
DoStatus(HR_CanRead, '');
end; end;
function TBlockSocket.CanWrite(Timeout: Integer): Boolean; function TBlockSocket.CanWrite(Timeout: Integer): Boolean;
@ -672,6 +709,8 @@ begin
x := 0; x := 0;
Result := x > 0; Result := x > 0;
ExceptCheck; ExceptCheck;
if Result then
DoStatus(HR_CanWrite, '');
end; end;
function TBlockSocket.SendBufferTo(Buffer: Pointer; Length: Integer): Integer; function TBlockSocket.SendBufferTo(Buffer: Pointer; Length: Integer): Integer;
@ -775,6 +814,13 @@ begin
CanReadList.Add(TBlockSocket(SocketList.Items[n])); CanReadList.Add(TBlockSocket(SocketList.Items[n]));
end; end;
procedure TBlockSocket.DoStatus(Reason: THookSocketReason; const Value: string);
begin
if assigned(OnStatus) then
OnStatus(Self, Reason, Value);
end;
class function TBlockSocket.GetErrorDesc(ErrorCode: Integer): string; class function TBlockSocket.GetErrorDesc(ErrorCode: Integer): string;
begin begin
case ErrorCode of case ErrorCode of
@ -928,6 +974,7 @@ begin
SockCheck(synsock.Listen(FSocket, SOMAXCONN)); SockCheck(synsock.Listen(FSocket, SOMAXCONN));
GetSins; GetSins;
ExceptCheck; ExceptCheck;
DoStatus(HR_Listen, '');
end; end;
function TTCPBlockSocket.Accept: TSocket; function TTCPBlockSocket.Accept: TSocket;
@ -938,6 +985,7 @@ begin
Result := synsock.Accept(FSocket, @FRemoteSin, @Len); Result := synsock.Accept(FSocket, @FRemoteSin, @Len);
SockCheck(Result); SockCheck(Result);
ExceptCheck; ExceptCheck;
DoStatus(HR_Accept, '');
end; end;
{======================================================================} {======================================================================}

3
dnssend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.001.002 | | Project : Delphree - Synapse | 001.001.003 |
|==============================================================================| |==============================================================================|
| Content: DNS client | | Content: DNS client |
|==============================================================================| |==============================================================================|
@ -103,6 +103,7 @@ type
property Timeout: Integer read FTimeout Write FTimeout; property Timeout: Integer read FTimeout Write FTimeout;
property DNSHost: string read FDNSHost Write FDNSHost; property DNSHost: string read FDNSHost Write FDNSHost;
property RCode: Integer read FRCode; property RCode: Integer read FRCode;
property Sock: TUDPBlockSocket read FSock;
end; end;
function GetMailServers(const DNSHost, Domain: string; function GetMailServers(const DNSHost, Domain: string;

793
ftpsend.pas Normal file
View File

@ -0,0 +1,793 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.000 |
|==============================================================================|
| Content: FTP client |
|==============================================================================|
| The contents of this file are Subject to the Mozilla Public License Ver. 1.1 |
| (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) 1999,2000,2001. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
| Petr Esner <petr.esner@atlas.cz> |
|==============================================================================|
| History: see HISTORY.HTM from distribution package |
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{$WEAKPACKAGEUNIT ON}
unit FTPsend;
interface
uses
SysUtils, Classes,
blcksock, SynaUtil, SynaCode;
const
cFtpProtocol = 'ftp';
cFtpDataProtocol = 'ftp-data';
FTP_OK = 255;
FTP_ERR = 254;
type
TLogonActions = array [0..17] of byte;
TFTPSend = class(TObject)
private
FSock: TTCPBlockSocket;
FDSock: TTCPBlockSocket;
FTimeout: Integer;
FFTPHost: string;
FFTPPort: string;
FResultCode: Integer;
FResultString: string;
FFullResult: TStringList;
FUsername: string;
FPassword: string;
FAccount: string;
FFWHost: string;
FFWPort: string;
FFWUsername: string;
FFWPassword: string;
FFWMode: integer;
FDataStream: TMemoryStream;
FDataIP: string;
FDataPort: string;
FDirectFile: Boolean;
FDirectFileName: string;
FCanResume: Boolean;
FPassiveMode: Boolean;
FForceDefaultPort: Boolean;
function Auth(Mode: integer): Boolean;
function Connect: Boolean;
function InternalStor(const Command: string; RestoreAt: integer): Boolean;
function DataSocket: Boolean;
function AcceptDataSocket: Boolean;
function DataRead(const DestStream: TStream): Boolean;
function DataWrite(const SourceStream: TStream): Boolean;
public
CustomLogon: TLogonActions;
constructor Create;
destructor Destroy; override;
function ReadResult: Integer;
procedure ParseRemote(Value: string);
function FTPCommand(const Value: string): integer;
function Login: Boolean;
procedure Logout;
function List(Directory: string; NameList: Boolean): Boolean;
function RetriveFile(const FileName: string; Restore: Boolean): Boolean;
function StoreFile(const FileName: string; Restore: Boolean): Boolean;
function StoreUniqueFile: Boolean;
function AppendFile(const FileName: string): Boolean;
function RenameFile(const OldName, NewName: string): Boolean;
function DeleteFile(const FileName: string): Boolean;
function FileSize(const FileName: string): integer;
function NoOp: Boolean;
function ChangeWorkingDir(const Directory: string): Boolean;
function ChangeToRootDir: Boolean;
function DeleteDir(const Directory: string): Boolean;
function CreateDir(const Directory: string): Boolean;
function GetCurrentDir: String;
published
property Timeout: Integer read FTimeout Write FTimeout;
property FTPHost: string read FFTPHost Write FFTPHost;
property FTPPort: string read FFTPPort Write FFTPPort;
property ResultCode: Integer read FResultCode;
property ResultString: string read FResultString;
property FullResult: TStringList read FFullResult;
property Username: string read FUsername Write FUsername;
property Password: string read FPassword Write FPassword;
property Account: string read FAccount Write FAccount;
property FWHost: string read FFWHost Write FFWHost;
property FWPort: string read FFWPort Write FFWPort;
property FWUsername: string read FFWUsername Write FFWUsername;
property FWPassword: string read FFWPassword Write FFWPassword;
property FWMode: integer read FFWMode Write FFWMode;
property Sock: TTCPBlockSocket read FSock;
property DSock: TTCPBlockSocket read FDSock;
property DataStream: TMemoryStream read FDataStream;
property DataIP: string read FDataIP;
property DataPort: string read FDataPort;
property DirectFile: Boolean read FDirectFile Write FDirectFile;
property DirectFileName: string read FDirectFileName Write FDirectFileName;
property CanResume: Boolean read FCanResume;
property PassiveMode: Boolean read FPassiveMode Write FPassiveMode;
property ForceDefaultPort: Boolean read FForceDefaultPort Write FForceDefaultPort;
end;
function FtpGetFile(const IP, Port, FileName, LocalFile,
User, Pass: string): Boolean;
function FtpPutFile(const IP, Port, FileName, LocalFile,
User, Pass: string): Boolean;
function FtpInterServerTransfer(
const FromIP, FromPort, FromFile, FromUser, FromPass: string;
const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean;
implementation
const
CRLF = #13#10;
constructor TFTPSend.Create;
begin
inherited Create;
FFullResult := TStringList.Create;
FDataStream := TMemoryStream.Create;
FSock := TTCPBlockSocket.Create;
FDSock := TTCPBlockSocket.Create;
FTimeout := 300000;
FFTPHost := cLocalhost;
FFTPPort := cFtpProtocol;
FUsername := 'anonymous';
FPassword := 'anonymous@' + FSock.LocalName;
FDirectFile := False;
FPassiveMode := True;
FForceDefaultPort := False;
FAccount := '';
FFWHost := '';
FFWPort := cFtpProtocol;
FFWUsername := '';
FFWPassword := '';
FFWMode := 0;
end;
destructor TFTPSend.Destroy;
begin
FDSock.Free;
FSock.Free;
FDataStream.Free;
FFullResult.Free;
inherited Destroy;
end;
function TFTPSend.ReadResult: Integer;
var
s,c: string;
begin
Result := 0;
FFullResult.Clear;
c := '';
repeat
s := FSock.RecvString(FTimeout);
if c = '' then
c :=Copy(s, 1, 3)+' ';
FResultString := s;
FFullResult.Add(s);
if FSock.LastError <> 0 then
Break;
until Pos(c, s) = 1;
s := FFullResult[0];
if Length(s) >= 3 then
Result := StrToIntDef(Copy(s, 1, 3), 0);
FResultCode := Result;
end;
function TFTPSend.FTPCommand(const Value: string): integer;
begin
FSock.SendString(Value + CRLF);
Result := ReadResult;
end;
// based on idea by Petr Esner <petr.esner@atlas.cz>
function TFTPSend.Auth(Mode: integer): Boolean;
const
// Direct connection USER[+PASS[+ACCT]]
Action0: TLogonActions =
(0, FTP_OK, 3, 1, FTP_OK, 6, 2, FTP_OK, FTP_ERR, 0, 0, 0, 0, 0, 0, 0, 0, 0);
// SITE <hostname>
Action1: TLogonActions =
(3, 6, 3, 4, 6, FTP_ERR, 5, FTP_ERR, 9, 0, FTP_OK, 12, 1, FTP_OK, 15, 2,
FTP_OK, FTP_ERR);
// USER after logon
Action2: TLogonActions =
(3, 6, 3, 4, 6, FTP_ERR, 6, FTP_OK, 9, 1, FTP_OK, 12, 2, FTP_OK, FTP_ERR,
0, 0, 0);
// Transparent
Action3: TLogonActions =
(3, 6, 3, 4, 6, FTP_ERR, 0, FTP_OK, 9, 1, FTP_OK, 12, 2, FTP_OK, FTP_ERR,
0, 0, 0);
// proxy OPEN
Action4: TLogonActions =
(7, 3, 3, 0, FTP_OK, 6, 1, FTP_OK, 9, 2, FTP_OK, FTP_ERR,
0, 0, 0, 0, 0, 0);
// USER with no logon
Action5: TLogonActions =
(6, FTP_OK, 3, 1, FTP_OK, 6, 2, FTP_OK, FTP_ERR, 0, 0, 0, 0, 0, 0, 0, 0, 0);
// USER fireID@remotehost
Action6: TLogonActions =
(8, 6, 3, 4, 6, FTP_ERR, 0, FTP_OK, 9, 1, FTP_OK, 12, 2, FTP_OK, FTP_ERR,
0, 0, 0);
// USER remoteID@remotehost fireID
Action7: TLogonActions =
(9, FTP_ERR, 3, 1, FTP_OK, 6, 2, FTP_OK, FTP_ERR, 0, 0, 0, 0, 0, 0, 0, 0, 0);
// USER remoteID@fireID@remotehost
Action8: TLogonActions =
(10, FTP_OK, 3, 11, FTP_OK, 6, 2, FTP_OK, FTP_ERR, 0, 0, 0, 0, 0, 0, 0, 0, 0);
var
FTPServer: string;
LogonActions: TLogonActions;
i: integer;
s: string;
x: integer;
begin
Result := False;
if FFWHost = '' then
Mode := 0;
if (FFTPPort = cFtpProtocol) or (FFTPPort = '21') then
FTPServer := FFTPHost
else
FTPServer := FFTPHost + ':' + FFTPPort;
case Mode of
-1:
LogonActions := CustomLogon;
1:
LogonActions := Action1;
2:
LogonActions := Action2;
3:
LogonActions := Action3;
4:
LogonActions := Action4;
5:
LogonActions := Action5;
6:
LogonActions := Action6;
7:
LogonActions := Action7;
8:
LogonActions := Action8;
else
LogonActions := Action0;
end;
i := 0;
repeat
case LogonActions[i] of
0: s := 'USER ' + FUserName;
1: s := 'PASS ' + FPassword;
2: s := 'ACCT ' + FAccount;
3: s := 'USER ' + FFWUserName;
4: s := 'PASS ' + FFWPassword;
5: s := 'SITE ' + FTPServer;
6: s := 'USER ' + FUserName + '@' + FTPServer;
7: s := 'OPEN ' + FTPServer;
8: s := 'USER ' + FFWUserName + '@' + FTPServer;
9: s := 'USER ' + FUserName + '@' + FTPServer + ' ' + FFWUserName;
10: s := 'USER ' + FUserName + '@' + FFWUserName + '@' + FTPServer;
11: s := 'PASS ' + FPassword + '@' + FFWPassword;
end;
x := FTPCommand(s);
x := x div 100;
if (x <> 2) and (x <> 3) then
Exit;
i := LogonActions[i + x - 1];
case i of
FTP_ERR:
Exit;
FTP_OK:
begin
Result := True;
Exit;
end;
end;
until False;
end;
function TFTPSend.Connect: Boolean;
begin
FSock.CloseSocket;
FSock.CreateSocket;
if FFWHost = '' then
FSock.Connect(FFTPHost, FFTPPort)
else
FSock.Connect(FFWHost, FFWPort);
Result := FSock.LastError = 0;
end;
function TFTPSend.Login: Boolean;
begin
Result := False;
FCanResume := False;
if not Connect then
Exit;
if ReadResult <> 220 then
Exit;
if not Auth(FFWMode) then
Exit;
FTPCommand('TYPE I');
FTPCommand('STRU F');
FTPCommand('MODE S');
if FTPCommand('REST 1') = 350 then
begin
FTPCommand('REST 0');
FCanResume := True;
end;
Result := True;
end;
procedure TFTPSend.Logout;
begin
FTPCommand('QUIT');
FSock.CloseSocket;
end;
procedure TFTPSend.ParseRemote(Value: string);
var
n: integer;
nb, ne: integer;
s: string;
x: integer;
begin
Value := trim(Value);
nb := Pos('(',Value);
ne := Pos(')',Value);
if (nb = 0) or (ne = 0) then
begin
nb:=RPos(' ',Value);
s:=Copy(Value, nb + 1, Length(Value) - nb);
end
else
begin
s:=Copy(Value,nb+1,ne-nb-1);
end;
for n := 1 to 4 do
if n = 1 then
FDataIP := Fetch(s, ',')
else
FDataIP := FDataIP + '.' + Fetch(s, ',');
x := StrToIntDef(Fetch(s, ','), 0) * 256;
x := x + StrToIntDef(Fetch(s, ','), 0);
FDataPort := IntToStr(x);
end;
function TFTPSend.DataSocket: boolean;
var
s: string;
begin
Result := False;
if FPassiveMode then
begin
if FTPCommand('PASV') <> 227 then
Exit;
ParseRemote(FResultString);
FDSock.CloseSocket;
FDSock.CreateSocket;
FDSock.Connect(FDataIP, FDataPort);
Result := FDSock.LastError = 0;
end
else
begin
FDSock.CloseSocket;
FDSock.CreateSocket;
if FForceDefaultPort then
s := cFtpDataProtocol
else
s := '0';
FDSock.Bind(FDSock.LocalName, s);
if FDSock.LastError <> 0 then
Exit;
FDSock.Listen;
FDSock.GetSins;
FDataIP := FDSock.GetLocalSinIP;
FDataPort := IntToStr(FDSock.GetLocalSinPort);
s := StringReplace(FDataIP, '.', ',');
s := 'PORT ' + s + ',' + IntToStr(FDSock.GetLocalSinPort div 256)
+ ',' + IntToStr(FDSock.GetLocalSinPort mod 256);
Result := FTPCommand(s) = 200;
end;
end;
function TFTPSend.AcceptDataSocket: Boolean;
var
x: integer;
begin
if FPassiveMode then
Result := True
else
begin
Result := False;
if FDSock.CanRead(FTimeout) then
begin
x := FDSock.Accept;
FDSock.CloseSocket;
FDSock.Socket := x;
Result := True;
end;
end;
end;
function TFTPSend.DataRead(const DestStream: TStream): Boolean;
var
x, y: integer;
buf: string;
begin
Result := False;
try
if not AcceptDataSocket then
Exit;
repeat
if FDSock.CanRead(1000) then
begin
x := FDSock.WaitingData;
if x = 0 then
break
else
begin
setlength(buf, x);
y := FDSock.RecvBuffer(Pchar(buf),x);
DestStream.Write(Pointer(buf)^, y);
end;
end;
until FDSock.LastError <> 0;
x := ReadResult;
if (x = 226) or (x = 250) then
Result := True;
finally
FDSock.CloseSocket;
end;
end;
function TFTPSend.DataWrite(const SourceStream: TStream): Boolean;
const
BufSize = 8192;
var
Bytes: integer;
bc, lb: integer;
n, x: integer;
Buf: string;
begin
Result := False;
try
if not AcceptDataSocket then
Exit;
Bytes := SourceStream.Size - SourceStream.Position;
bc := Bytes div BufSize;
lb := Bytes mod BufSize;
SetLength(Buf, BufSize);
for n := 1 to bc do
begin
SourceStream.read(Pointer(buf)^, BufSize);
FDSock.SendBuffer(Pchar(buf), BufSize);
if FDSock.LastError <> 0 then
Exit;
end;
SetLength(Buf, lb);
SourceStream.read(Pointer(buf)^, lb);
FDSock.SendBuffer(Pchar(buf), lb);
if FDSock.LastError <> 0 then
Exit;
FDSock.CloseSocket;
x := ReadResult;
if (x = 226) or (x = 250) then
Result := True;
finally
FDSock.CloseSocket;
end;
end;
function TFTPSend.List(Directory: string; NameList: Boolean): Boolean;
begin
Result := False;
FDataStream.Clear;
if Directory <> '' then
Directory := ' ' + Directory;
if not DataSocket then
Exit;
FTPCommand('TYPE A');
if NameList then
FTPCommand('NLST' + Directory)
else
FTPCommand('LIST' + Directory);
Result := DataRead(FDataStream);
FDataStream.Seek(0, soFromBeginning);
end;
function TFTPSend.RetriveFile(const FileName: string; Restore: Boolean): Boolean;
var
RetrStream: TStream;
begin
Result := False;
if FileName = '' then
Exit;
Restore := Restore and FCanResume;
if FDirectFile then
if Restore and FileExists(FDirectFileName) then
RetrStream := TFileStream.Create(FDirectFileName,
fmOpenReadWrite or fmShareExclusive)
else
RetrStream := TFileStream.Create(FDirectFileName,
fmCreate or fmShareDenyWrite)
else
RetrStream := FDataStream;
try
if not DataSocket then
Exit;
FTPCommand('TYPE I');
if Restore then
begin
RetrStream.Seek(0, soFromEnd);
if FTPCommand('REST ' + IntToStr(RetrStream.Size)) <> 350 then
Exit;
end
else
if RetrStream is TMemoryStream then
TMemoryStream(RetrStream).Clear;
if (FTPCommand('RETR ' + FileName) div 100) <> 1 then
Exit;
Result := DataRead(RetrStream);
if not FDirectFile then
RetrStream.Seek(0, soFromBeginning);
finally
if FDirectFile then
RetrStream.Free;
end;
end;
function TFTPSend.InternalStor(const Command: string; RestoreAt: integer): Boolean;
var
SendStream: TStream;
StorSize: integer;
begin
Result := False;
if FDirectFile then
if not FileExists(FDirectFileName) then
Exit
else
SendStream := TFileStream.Create(FDirectFileName,
fmOpenRead or fmShareDenyWrite)
else
SendStream := FDataStream;
try
if not DataSocket then
Exit;
FTPCommand('TYPE I');
StorSize := SendStream.Size;
if not FCanResume then
RestoreAt := 0;
if RestoreAt = StorSize then
begin
Result := True;
Exit;
end;
if RestoreAt > StorSize then
RestoreAt := 0;
FTPCommand('ALLO ' + IntToStr(StorSize - RestoreAt));
if FCanResume then
if FTPCommand('REST ' + IntToStr(RestoreAt)) <> 350 then
Exit;
SendStream.Seek(RestoreAt, soFromBeginning);
if (FTPCommand(Command) div 100) <> 1 then
Exit;
Result := DataWrite(SendStream);
finally
if FDirectFile then
SendStream.Free;
end;
end;
function TFTPSend.StoreFile(const FileName: string; Restore: Boolean): Boolean;
var
RestoreAt: integer;
begin
Result := False;
if FileName = '' then
Exit;
RestoreAt := 0;
Restore := Restore and FCanResume;
if Restore then
begin
RestoreAt := Self.FileSize(FileName);
if RestoreAt < 0 then
RestoreAt := 0;
end;
Result := InternalStor('STOR ' + FileName, RestoreAt);
end;
function TFTPSend.StoreUniqueFile: Boolean;
begin
Result := InternalStor('STOU', 0);
end;
function TFTPSend.AppendFile(const FileName: string): Boolean;
begin
Result := False;
if FileName = '' then
Exit;
Result := InternalStor('APPE '+FileName, 0);
end;
function TFTPSend.NoOp: Boolean;
begin
Result := FTPCommand('NOOP') = 250;
end;
function TFTPSend.RenameFile(const OldName, NewName: string): Boolean;
begin
Result := False;
if FTPCommand('RNFR ' + OldName) <> 350 then
Exit;
Result := FTPCommand('RNTO ' + NewName) = 250;
end;
function TFTPSend.DeleteFile(const FileName: string): Boolean;
begin
Result := FTPCommand('DELE ' + FileName) = 250;
end;
function TFTPSend.FileSize(const FileName: string): integer;
var
s: string;
begin
Result := -1;
if FTPCommand('SIZE ' + FileName) = 213 then
begin
s := SeparateRight(ResultString, ' ');
s := SeparateLeft(s, ' ');
Result := StrToIntDef(s, -1);
end;
end;
function TFTPSend.ChangeWorkingDir(const Directory: string): Boolean;
begin
Result := FTPCommand('CWD ' + Directory) = 250;
end;
function TFTPSend.ChangeToRootDir: Boolean;
begin
Result := FTPCommand('CDUP') = 200;
end;
function TFTPSend.DeleteDir(const Directory: string): Boolean;
begin
Result := FTPCommand('RMD ' + Directory) = 250;
end;
function TFTPSend.CreateDir(const Directory: string): Boolean;
begin
Result := FTPCommand('MKD ' + Directory) = 257;
end;
function TFTPSend.GetCurrentDir: String;
begin
Result := '';
if FTPCommand('PWD') = 257 then
begin
Result := SeparateRight(FResultString, '"');
Result := Separateleft(Result, '"');
end;
end;
{==============================================================================}
function FtpGetFile(const IP, Port, FileName, LocalFile,
User, Pass: string): Boolean;
begin
Result := False;
with TFTPSend.Create do
try
if User <> '' then
begin
Username := User;
Password := Pass;
end;
if not Login then
Exit;
DirectFileName := LocalFile;
DirectFile:=True;
Result := RetriveFile(FileName, False);
Logout;
finally
Free;
end;
end;
function FtpPutFile(const IP, Port, FileName, LocalFile,
User, Pass: string): Boolean;
begin
Result := False;
with TFTPSend.Create do
try
if User <> '' then
begin
Username := User;
Password := Pass;
end;
if not Login then
Exit;
DirectFileName := LocalFile;
DirectFile:=True;
Result := StoreFile(FileName, False);
Logout;
finally
Free;
end;
end;
function FtpInterServerTransfer(
const FromIP, FromPort, FromFile, FromUser, FromPass: string;
const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean;
var
FromFTP, ToFTP: TFTPSend;
s: string;
x: integer;
begin
Result := False;
FromFTP := TFTPSend.Create;
toFTP := TFTPSend.Create;
try
if FromUser <> '' then
begin
FromFTP.Username := FromUser;
FromFTP.Password := FromPass;
end;
if ToUser <> '' then
begin
ToFTP.Username := ToUser;
ToFTP.Password := ToPass;
end;
if not FromFTP.Login then
Exit;
if not ToFTP.Login then
Exit;
if FromFTP.FTPCommand('PASV') <> 227 then
Exit;
FromFTP.ParseRemote(FromFTP.ResultString);
s := StringReplace(FromFTP.DataIP, '.', ',');
s := 'PORT ' + s + ',' + IntToStr(StrToIntDef(FromFTP.DataPort, 0) div 256)
+ ',' + IntToStr(StrToIntDef(FromFTP.DataPort, 0) mod 256);
if ToFTP.FTPCommand(s) <> 200 then
Exit;
x := FromFTP.FTPCommand('STOR ' + FromFile);
if (x <> 125) and (x <> 150) then
Exit;
x := ToFTP.FTPCommand('RETR ' + ToFile);
if (x <> 125) and (x <> 150) then
Exit;
FromFTP.Timeout := 21600000;
x := FromFTP.ReadResult;
if (x <> 226) and (x <> 250) then
Exit;
ToFTP.Timeout := 21600000;
x := ToFTP.ReadResult;
if (x <> 226) and (x <> 250) then
Exit;
Result := True;
finally
ToFTP.Free;
FromFTP.Free;
end;
end;
end.

33
httpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 002.001.001 | | Project : Delphree - Synapse | 002.002.000 |
|==============================================================================| |==============================================================================|
| Content: HTTP client | | Content: HTTP client |
|==============================================================================| |==============================================================================|
@ -83,12 +83,15 @@ type
property ProxyPass: string read FProxyPass Write FProxyPass; property ProxyPass: string read FProxyPass Write FProxyPass;
property ResultCode: Integer read FResultCode; property ResultCode: Integer read FResultCode;
property ResultString: string read FResultString; property ResultString: string read FResultString;
property Sock: TTCPBlockSocket read FSock;
end; end;
function HttpGetText(const URL: string; const Response: TStrings): Boolean; function HttpGetText(const URL: string; const Response: TStrings): Boolean;
function HttpGetBinary(const URL: string; const Response: TStream): Boolean; function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
function HttpPostBinary(const URL: string; const Data: TStream): Boolean; function HttpPostBinary(const URL: string; const Data: TStream): Boolean;
function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean; function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
function HttpPostFile(const URL, FieldName, FileName: string;
const Data: TStream; const ResultData: TStringList): Boolean;
implementation implementation
@ -444,11 +447,37 @@ begin
HTTP.Document.Write(Pointer(URLData)^, Length(URLData)); HTTP.Document.Write(Pointer(URLData)^, Length(URLData));
HTTP.MimeType := 'application/x-url-encoded'; HTTP.MimeType := 'application/x-url-encoded';
Result := HTTP.HTTPMethod('POST', URL); Result := HTTP.HTTPMethod('POST', URL);
Data.Seek(0, soFromBeginning);
Data.CopyFrom(HTTP.Document, 0); Data.CopyFrom(HTTP.Document, 0);
finally finally
HTTP.Free; HTTP.Free;
end; end;
end; end;
function HttpPostFile(const URL, FieldName, FileName: string;
const Data: TStream; const ResultData: TStringList): Boolean;
const
CRLF = #$0D + #$0A;
var
HTTP: THTTPSend;
Bound, s: string;
begin
Bound := '--' + IntToHex(Random(MaxInt), 8) + '_Synapse_boundary';
HTTP := THTTPSend.Create;
try
s := Bound + CRLF;
s := s + 'content-disposition: form-data; name="' + FieldName + '";';
s := s + ' filename="' + FileName +'"' + CRLF;
s := s + 'Content-Type: Application/octet-string' + CRLF + CRLF;
HTTP.Document.Write(Pointer(s)^, Length(s));
HTTP.Document.CopyFrom(Data, 0);
s := CRLF + Bound + '--' + CRLF;
HTTP.Document.Write(Pointer(s)^, Length(s));
HTTP.MimeType := 'multipart/form-data, boundary=' + Bound;
Result := HTTP.HTTPMethod('POST', URL);
ResultData.LoadFromStream(HTTP.Document);
finally
HTTP.Free;
end;
end;
end. end.

174
mimemess.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.004.000 | | Project : Delphree - Synapse | 001.005.000 |
|==============================================================================| |==============================================================================|
| Content: MIME message object | | Content: MIME message object |
|==============================================================================| |==============================================================================|
@ -40,15 +40,19 @@ type
FToList: TStringList; FToList: TStringList;
FSubject: string; FSubject: string;
FOrganization: string; FOrganization: string;
FCustomHeaders: TStringList;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure Clear; procedure Clear;
procedure EncodeHeaders(Value: TStringList);
procedure DecodeHeaders(Value: TStringList);
published published
property From: string read FFrom Write FFrom; property From: string read FFrom Write FFrom;
property ToList: TStringList read FToList Write FToList; property ToList: TStringList read FToList;
property Subject: string read FSubject Write FSubject; property Subject: string read FSubject Write FSubject;
property Organization: string read FOrganization Write FOrganization; property Organization: string read FOrganization Write FOrganization;
property CustomHeaders: TStringList read FCustomHeaders;
end; end;
TMimeMess = class(TObject) TMimeMess = class(TObject)
@ -56,6 +60,7 @@ type
FPartList: TList; FPartList: TList;
FLines: TStringList; FLines: TStringList;
FHeader: TMessHeader; FHeader: TMessHeader;
FMultipartType: string;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -70,9 +75,10 @@ type
procedure ParseHeaders; procedure ParseHeaders;
procedure DecodeMessage; procedure DecodeMessage;
published published
property PartList: TList read FPartList Write FPartList; property PartList: TList read FPartList;
property Lines: TStringList read FLines Write FLines; property Lines: TStringList read FLines;
property Header: TMessHeader read FHeader Write FHeader; property Header: TMessHeader read FHeader;
property MultipartType: string read FMultipartType Write FMultipartType;
end; end;
implementation implementation
@ -83,10 +89,12 @@ constructor TMessHeader.Create;
begin begin
inherited Create; inherited Create;
FToList := TStringList.Create; FToList := TStringList.Create;
FCustomHeaders := TStringList.Create;
end; end;
destructor TMessHeader.Destroy; destructor TMessHeader.Destroy;
begin begin
FCustomHeaders.Free;
FToList.Free; FToList.Free;
inherited Destroy; inherited Destroy;
end; end;
@ -99,6 +107,64 @@ begin
FToList.Clear; FToList.Clear;
FSubject := ''; FSubject := '';
FOrganization := ''; FOrganization := '';
FCustomHeaders.Clear;
end;
procedure TMessHeader.EncodeHeaders(Value: TStringList);
var
n: Integer;
begin
for n := FCustomHeaders.Count - 1 downto 0 do
if FCustomHeaders[n] <> '' then
Value.Insert(0, FCustomHeaders[n]);
Value.Insert(0, 'x-mailer: Synapse - Delphi TCP/IP library by Lukas Gebauer');
Value.Insert(0, 'MIME-Version: 1.0 (produced by Synapse)');
Value.Insert(0, 'date: ' + Rfc822DateTime(Now));
if FOrganization <> '' then
Value.Insert(0, 'Organization: ' + InlineCode(FOrganization));
if FSubject <> '' then
Value.Insert(0, 'Subject: ' + InlineCode(FSubject));
for n := 0 to FToList.Count - 1 do
Value.Insert(0, 'To: ' + InlineEmail(FToList[n]));
Value.Insert(0, 'From: ' + InlineEmail(FFrom));
end;
procedure TMessHeader.DecodeHeaders(Value: TStringList);
var
s: string;
x: Integer;
cp: TMimeChar;
begin
cp := GetCurCP;
Clear;
x := 0;
while Value.Count > x do
begin
s := NormalizeHeader(Value, x);
if s = '' then
Break;
if Pos('FROM:', UpperCase(s)) = 1 then
begin
FFrom := InlineDecode(SeparateRight(s, ':'), cp);
continue;
end;
if Pos('SUBJECT:', UpperCase(s)) = 1 then
begin
FSubject := InlineDecode(SeparateRight(s, ':'), cp);
continue;
end;
if Pos('ORGANIZATION:', UpperCase(s)) = 1 then
begin
FOrganization := InlineDecode(SeparateRight(s, ':'), cp);
continue;
end;
if Pos('TO:', UpperCase(s)) = 1 then
begin
FToList.Add(InlineDecode(SeparateRight(s, ':'), cp));
continue;
end;
FCustomHeaders.Add(s);
end;
end; end;
{==============================================================================} {==============================================================================}
@ -109,6 +175,7 @@ begin
FPartList := TList.Create; FPartList := TList.Create;
FLines := TStringList.Create; FLines := TStringList.Create;
FHeader := TMessHeader.Create; FHeader := TMessHeader.Create;
FMultipartType := 'Mixed';
end; end;
destructor TMimeMess.Destroy; destructor TMimeMess.Destroy;
@ -125,31 +192,26 @@ procedure TMimeMess.Clear;
var var
n: Integer; n: Integer;
begin begin
FMultipartType := 'Mixed';
Lines.Clear; Lines.Clear;
for n := 0 to PartList.Count - 1 do for n := 0 to FPartList.Count - 1 do
TMimePart(PartList[n]).Free; TMimePart(FPartList[n]).Free;
PartList.Clear; FPartList.Clear;
FHeader.Clear; FHeader.Clear;
end; end;
{==============================================================================} {==============================================================================}
function TMimeMess.AddPart: Integer; function TMimeMess.AddPart: Integer;
var
mp: TMimePart;
begin begin
mp := TMimePart.Create; Result := FPartList.Add(TMimePart.Create);
Result := PartList.Add(mp);
end; end;
{==============================================================================} {==============================================================================}
procedure TMimeMess.AddPartText(Value: TStringList); procedure TMimeMess.AddPartText(Value: TStringList);
var
x: Integer;
begin begin
x := AddPart; with TMimePart(FPartList[AddPart]) do
with TMimePart(PartList[x]) do
begin begin
Value.SaveToStream(DecodedLines); Value.SaveToStream(DecodedLines);
Primary := 'text'; Primary := 'text';
@ -167,11 +229,8 @@ end;
{==============================================================================} {==============================================================================}
procedure TMimeMess.AddPartHTML(Value: TStringList); procedure TMimeMess.AddPartHTML(Value: TStringList);
var
x: Integer;
begin begin
x := AddPart; with TMimePart(FPartList[AddPart]) do
with TMimePart(PartList[x]) do
begin begin
Value.SaveToStream(DecodedLines); Value.SaveToStream(DecodedLines);
Primary := 'text'; Primary := 'text';
@ -188,11 +247,9 @@ end;
procedure TMimeMess.AddPartBinary(Value: string); procedure TMimeMess.AddPartBinary(Value: string);
var var
x: Integer;
s: string; s: string;
begin begin
x := AddPart; with TMimePart(FPartList[AddPart]) do
with TMimePart(PartList[x]) do
begin begin
DecodedLines.LoadFromFile(Value); DecodedLines.LoadFromFile(Value);
s := ExtractFileName(Value); s := ExtractFileName(Value);
@ -207,18 +264,16 @@ end;
procedure TMimeMess.AddPartHTMLBinary(Value, Cid: string); procedure TMimeMess.AddPartHTMLBinary(Value, Cid: string);
var var
x: Integer;
s: string; s: string;
begin begin
x := AddPart; with TMimePart(FPartList[AddPart]) do
with TMimePart(PartList[x]) do
begin begin
DecodedLines.LoadFromFile(Value); DecodedLines.LoadFromFile(Value);
s := ExtractFileName(Value); s := ExtractFileName(Value);
MimeTypeFromExt(s); MimeTypeFromExt(s);
Description := 'Included file: ' + s; Description := 'Included file: ' + s;
Disposition := 'inline'; Disposition := 'inline';
ContentID := cid; ContentID := Cid;
FileName := s; FileName := s;
EncodingCode := ME_BASE64; EncodingCode := ME_BASE64;
EncodePart; EncodePart;
@ -232,27 +287,27 @@ var
bound: string; bound: string;
n: Integer; n: Integer;
begin begin
Lines.Clear; FLines.Clear;
if PartList.Count = 1 then if FPartList.Count = 1 then
Lines.Assign(TMimePart(PartList[0]).Lines) FLines.Assign(TMimePart(FPartList[0]).Lines)
else else
begin begin
bound := GenerateBoundary; bound := GenerateBoundary;
for n := 0 to PartList.Count - 1 do for n := 0 to FPartList.Count - 1 do
begin begin
Lines.Add('--' + bound); FLines.Add('--' + bound);
Lines.AddStrings(TMimePart(PartList[n]).Lines); FLines.AddStrings(TMimePart(FPartList[n]).Lines);
end; end;
Lines.Add('--' + bound); FLines.Add('--' + bound + '--');
with TMimePart.Create do with TMimePart.Create do
try try
Self.Lines.SaveToStream(DecodedLines); Self.FLines.SaveToStream(DecodedLines);
Primary := 'Multipart'; Primary := 'Multipart';
Secondary := 'mixed'; Secondary := FMultipartType;
Description := 'Multipart message'; Description := 'Multipart message';
Boundary := bound; Boundary := bound;
EncodePart; EncodePart;
Self.Lines.Assign(Lines); Self.FLines.Assign(Lines);
finally finally
Free; Free;
end; end;
@ -262,46 +317,15 @@ end;
{==============================================================================} {==============================================================================}
procedure TMimeMess.FinalizeHeaders; procedure TMimeMess.FinalizeHeaders;
var
n: Integer;
begin begin
Lines.Insert(0, 'x-mailer: Synapse - Delphi TCP/IP library by Lukas Gebauer'); FHeader.EncodeHeaders(FLines);
Lines.Insert(0, 'MIME-Version: 1.0 (produced by Synapse)');
Lines.Insert(0, 'date: ' + Rfc822DateTime(Now));
if FHeader.Organization <> '' then
Lines.Insert(0, 'Organization: ' + InlineCode(Header.Organization));
if Header.Subject <> '' then
FLines.Insert(0, 'Subject: ' + InlineCode(Header.Subject));
for n := 0 to FHeader.ToList.Count - 1 do
Lines.Insert(0, 'To: ' + InlineEmail(FHeader.ToList[n]));
Lines.Insert(0, 'From: ' + InlineEmail(FHeader.From));
end; end;
{==============================================================================} {==============================================================================}
procedure TMimeMess.ParseHeaders; procedure TMimeMess.ParseHeaders;
var
s: string;
x: Integer;
cp: TMimeChar;
begin begin
cp := GetCurCP; FHeader.DecodeHeaders(FLines);
FHeader.Clear;
x := 0;
while Lines.Count > x do
begin
s := NormalizeHeader(Lines, x);
if s = '' then
Break;
if Pos('FROM:', UpperCase(s)) = 1 then
FHeader.From := InlineDecode(SeparateRight(s, ':'), cp);
if Pos('SUBJECT:', UpperCase(s)) = 1 then
FHeader.Subject := InlineDecode(SeparateRight(s, ':'), cp);
if Pos('ORGANIZATION:', UpperCase(s)) = 1 then
FHeader.Organization := InlineDecode(SeparateRight(s, ':'), cp);
if Pos('TO:', UpperCase(s)) = 1 then
FHeader.ToList.Add(InlineDecode(SeparateRight(s, ':'), cp));
end;
end; end;
{==============================================================================} {==============================================================================}
@ -310,13 +334,13 @@ procedure TMimeMess.DecodeMessage;
var var
l: TStringList; l: TStringList;
m: TMimePart; m: TMimePart;
x, i: Integer; i: Integer;
bound: string; bound: string;
begin begin
l := TStringList.Create; l := TStringList.Create;
m := TMimePart.Create; m := TMimePart.Create;
try try
l.Assign(Lines); l.Assign(FLines);
FHeader.Clear; FHeader.Clear;
ParseHeaders; ParseHeaders;
m.ExtractPart(l, 0); m.ExtractPart(l, 0);
@ -325,8 +349,7 @@ begin
bound := m.Boundary; bound := m.Boundary;
i := 0; i := 0;
repeat repeat
x := AddPart; with TMimePart(PartList[AddPart]) do
with TMimePart(PartList[x]) do
begin begin
Boundary := bound; Boundary := bound;
i := ExtractPart(l, i); i := ExtractPart(l, i);
@ -336,8 +359,7 @@ begin
end end
else else
begin begin
x := AddPart; with TMimePart(PartList[AddPart]) do
with TMimePart(PartList[x]) do
begin begin
ExtractPart(l, 0); ExtractPart(l, 0);
DecodePart; DecodePart;

49
mimepart.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.004.001 | | Project : Delphree - Synapse | 001.005.000 |
|==============================================================================| |==============================================================================|
| Content: MIME support procedures and functions | | Content: MIME support procedures and functions |
|==============================================================================| |==============================================================================|
@ -81,8 +81,8 @@ type
property ContentID: string read FContentID Write FContentID; property ContentID: string read FContentID Write FContentID;
property Boundary: string read FBoundary Write FBoundary; property Boundary: string read FBoundary Write FBoundary;
property FileName: string read FFileName Write FFileName; property FileName: string read FFileName Write FFileName;
property Lines: TStringList read FLines Write FLines; property Lines: TStringList read FLines;
property DecodedLines: TMemoryStream read FDecodedLines Write FDecodedLines; property DecodedLines: TMemoryStream read FDecodedLines;
end; end;
const const
@ -212,12 +212,13 @@ begin
fn := ''; fn := '';
x := BeginLine; x := BeginLine;
b := FBoundary; b := FBoundary;
{ if multipart - skip pre-part }
if b <> '' then if b <> '' then
while Value.Count > x do while Value.Count > x do
begin begin
s := Value[x]; s := Value[x];
Inc(x); Inc(x);
if Pos('--' + b, s) > 0 then if Pos('--' + b, s) = 1 then
Break; Break;
end; end;
@ -234,7 +235,8 @@ begin
st2 := SeparateLeft(st, ';'); st2 := SeparateLeft(st, ';');
Primary := SeparateLeft(st2, '/'); Primary := SeparateLeft(st2, '/');
FSecondary := SeparateRight(st2, '/'); FSecondary := SeparateRight(st2, '/');
if (FSecondary = Primary) and (Pos('/', st2) < 1) then FSecondary := ''; if (FSecondary = Primary) and (Pos('/', st2) < 1) then
FSecondary := '';
case FPrimaryCode of case FPrimaryCode of
MP_TEXT: MP_TEXT:
Charset := UpperCase(GetParameter(s, 'charset=')); Charset := UpperCase(GetParameter(s, 'charset='));
@ -266,27 +268,30 @@ begin
FFileName := InlineDecode(FFileName, getCurCP); FFileName := InlineDecode(FFileName, getCurCP);
FFileName := ExtractFileName(FFileName); FFileName := ExtractFileName(FFileName);
{ finding part content x1-begin x2-end }
x1 := x; x1 := x;
x2 := Value.Count - 1; x2 := Value.Count - 1;
{ if multipart - end is before next boundary }
if b <> '' then if b <> '' then
begin begin
for n := x to Value.Count - 1 do for n := x to Value.Count - 1 do
begin begin
x2 := n; x2 := n;
s := Value[n]; s := Value[n];
if Pos('--' + b, s) > 0 then if Pos('--' + b, s) = 1 then
begin begin
Dec(x2); Dec(x2);
Break; Break;
end; end;
end; end;
end; end;
{ if content is multipart - content is delimited by their boundaries }
if FPrimaryCode = MP_MULTIPART then if FPrimaryCode = MP_MULTIPART then
begin begin
for n := x to Value.Count - 1 do for n := x to Value.Count - 1 do
begin begin
s := Value[n]; s := Value[n];
if Pos('--' + Boundary, s) > 0 then if Pos('--' + FBoundary, s) = 1 then
begin begin
x1 := n; x1 := n;
Break; Break;
@ -295,21 +300,23 @@ begin
for n := Value.Count - 1 downto x do for n := Value.Count - 1 downto x do
begin begin
s := Value[n]; s := Value[n];
if Pos('--' + Boundary, s) > 0 then if Pos('--' + FBoundary, s) = 1 then
begin begin
x2 := n; x2 := n;
Break; Break;
end; end;
end; end;
end; end;
{ copy content }
for n := x1 to x2 do for n := x1 to x2 do
FLines.Add(Value[n]); FLines.Add(Value[n]);
Result := x2; Result := x2;
{ if content is multipart - find real end }
if FPrimaryCode = MP_MULTIPART then if FPrimaryCode = MP_MULTIPART then
begin begin
e := False; e := False;
for n := x2 + 1 to Value.Count - 1 do for n := x2 + 1 to Value.Count - 1 do
if Pos('--' + Boundary, Value[n]) > 0 then if Pos('--' + FBoundary, Value[n]) = 1 then
begin begin
e := True; e := True;
Break; Break;
@ -317,6 +324,24 @@ begin
if not e then if not e then
Result := Value.Count - 1; Result := Value.Count - 1;
end; end;
{ if multipart - skip ending postpart}
if b <> '' then
begin
x1 := Result;
for n := x1 to Value.Count - 1 do
begin
s := Value[n];
if Pos('--' + b, s) = 1 then
begin
s := TrimRight(s);
x := Length(s);
if x > 4 then
if (s[x] = '-') and (S[x-1] = '-') then
Result := Value.Count - 1;
Break;
end;
end;
end;
finally finally
t.Free; t.Free;
end; end;
@ -465,7 +490,7 @@ begin
MP_TEXT: MP_TEXT:
s := FPrimary + '/' + FSecondary + '; charset=' + GetIDfromCP(FCharsetCode); s := FPrimary + '/' + FSecondary + '; charset=' + GetIDfromCP(FCharsetCode);
MP_MULTIPART: MP_MULTIPART:
s := FPrimary + '/' + FSecondary + '; boundary="' + Boundary + '"'; s := FPrimary + '/' + FSecondary + '; boundary="' + FBoundary + '"';
MP_MESSAGE: MP_MESSAGE:
s := FPrimary + '/' + FSecondary + ''; s := FPrimary + '/' + FSecondary + '';
MP_BINARY: MP_BINARY:
@ -500,7 +525,7 @@ begin
if Primary = '' then if Primary = '' then
Primary := 'application'; Primary := 'application';
if FSecondary = '' then if FSecondary = '' then
FSecondary := 'mixed'; FSecondary := 'octet-string';
end; end;
{==============================================================================} {==============================================================================}
@ -553,7 +578,7 @@ var
begin begin
Randomize; Randomize;
x := Random(MaxInt); x := Random(MaxInt);
Result := '----' + IntToHex(x, 8) + '_Synapse_message_boundary'; Result := '--' + IntToHex(x, 8) + '_Synapse_message_boundary--';
end; end;
end. end.

3
pingsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 002.001.000 | | Project : Delphree - Synapse | 002.001.001 |
|==============================================================================| |==============================================================================|
| Content: PING sender | | Content: PING sender |
|==============================================================================| |==============================================================================|
@ -79,6 +79,7 @@ type
property Timeout: Integer read FTimeout Write FTimeout; property Timeout: Integer read FTimeout Write FTimeout;
property PacketSize: Integer read FPacketSize Write FPacketSize; property PacketSize: Integer read FPacketSize Write FPacketSize;
property PingTime: Integer read FPingTime; property PingTime: Integer read FPingTime;
property Sock: TICMPBlockSocket read FSock;
end; end;
function PingHost(const Host: string): Integer; function PingHost(const Host: string): Integer;

3
pop3send.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.001.001 | | Project : Delphree - Synapse | 001.001.002 |
|==============================================================================| |==============================================================================|
| Content: POP3 client | | Content: POP3 client |
|==============================================================================| |==============================================================================|
@ -84,6 +84,7 @@ type
property StatSize: Integer read FStatSize; property StatSize: Integer read FStatSize;
property TimeStamp: string read FTimeStamp; property TimeStamp: string read FTimeStamp;
property AuthType: TPOP3AuthType read FAuthType Write FAuthType; property AuthType: TPOP3AuthType read FAuthType Write FAuthType;
property Sock: TTCPBlockSocket read FSock;
end; end;
implementation implementation

3
smtpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 002.001.003 | | Project : Delphree - Synapse | 002.001.004 |
|==============================================================================| |==============================================================================|
| Content: SMTP client | | Content: SMTP client |
|==============================================================================| |==============================================================================|
@ -96,6 +96,7 @@ type
property EnhCode2: Integer read FEnhCode2; property EnhCode2: Integer read FEnhCode2;
property EnhCode3: Integer read FEnhCode3; property EnhCode3: Integer read FEnhCode3;
property SystemName: string read FSystemName Write FSystemName; property SystemName: string read FSystemName Write FSystemName;
property Sock: TTCPBlockSocket read FSock;
end; end;
function SendToRaw(const MailFrom, MailTo, SMTPHost: string; function SendToRaw(const MailFrom, MailTo, SMTPHost: string;

3
snmpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 002.003.002 | | Project : Delphree - Synapse | 002.003.003 |
|==============================================================================| |==============================================================================|
| Content: SNMP client | | Content: SNMP client |
|==============================================================================| |==============================================================================|
@ -112,6 +112,7 @@ type
property HostIP: string read FHostIP; property HostIP: string read FHostIP;
property Query: TSNMPRec read FQuery; property Query: TSNMPRec read FQuery;
property Reply: TSNMPRec read FReply; property Reply: TSNMPRec read FReply;
property Sock: TUDPBlockSocket read FSock;
end; end;
function SNMPGet(const Oid, Community, SNMPHost: string; function SNMPGet(const Oid, Community, SNMPHost: string;

3
snmptrap.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 002.002.002 | | Project : Delphree - Synapse | 002.002.003 |
|==============================================================================| |==============================================================================|
| Content: SNMP traps | | Content: SNMP traps |
|==============================================================================| |==============================================================================|
@ -97,6 +97,7 @@ type
property Trap: TTrapPDU read FTrap; property Trap: TTrapPDU read FTrap;
property SNMPHost: string read FSNMPHost Write FSNMPHost; property SNMPHost: string read FSNMPHost Write FSNMPHost;
property Timeout: Integer read FTimeout Write FTimeout; property Timeout: Integer read FTimeout Write FTimeout;
property Sock: TUDPBlockSocket read FSock;
end; end;
function SendTrap(const Dest, Source, Enterprise, Community: string; function SendTrap(const Dest, Source, Enterprise, Community: string;

3
sntpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 002.000.001 | | Project : Delphree - Synapse | 002.000.002 |
|==============================================================================| |==============================================================================|
| Content: SNTP client | | Content: SNTP client |
|==============================================================================| |==============================================================================|
@ -76,6 +76,7 @@ type
property NTPTime: TDateTime read FNTPTime; property NTPTime: TDateTime read FNTPTime;
property SntpHost: string read FSntpHost write FSntpHost; property SntpHost: string read FSntpHost write FSntpHost;
property Timeout: Integer read FTimeout write FTimeout; property Timeout: Integer read FTimeout write FTimeout;
property Sock: TUDPBlockSocket read FSock;
end; end;
implementation implementation

91
synachar.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 003.001.000 | | Project : Delphree - Synapse | 003.002.000 |
|==============================================================================| |==============================================================================|
| Content: Charset conversion support | | Content: Charset conversion support |
|==============================================================================| |==============================================================================|
@ -33,10 +33,10 @@ interface
type type
TMimeChar = (ISO_8859_1, ISO_8859_2, ISO_8859_3, TMimeChar = (ISO_8859_1, ISO_8859_2, ISO_8859_3,
ISO_8859_4, ISO_8859_5, ISO_8859_6, ISO_8859_7, ISO_8859_4, ISO_8859_5, ISO_8859_6, ISO_8859_7,
ISO_8859_8, ISO_8859_9, ISO_8859_10, CP1250, ISO_8859_8, ISO_8859_9, ISO_8859_10, ISO_8859_13,
CP1251, CP1252, CP1253, CP1254, CP1255, CP1256, ISO_8859_14, ISO_8859_15, CP1250, CP1251, CP1252,
CP1257, CP1258, KOI8_R, CP895, CP852, CP1253, CP1254, CP1255, CP1256, CP1257, CP1258,
UCS_2, UCS_4, UTF_8, UTF_7); KOI8_R, CP895, CP852, UCS_2, UCS_4, UTF_8, UTF_7);
TMimeSetChar = set of TMimeChar; TMimeSetChar = set of TMimeChar;
@ -297,6 +297,66 @@ const
$00F8, $0173, $00FA, $00FB, $00FC, $00FD, $00FE, $0138 $00F8, $0173, $00FA, $00FB, $00FC, $00FD, $00FE, $0138
); );
CharISO_8859_13: array[128..255] of Word =
(
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
$00A0, $201D, $00A2, $00A3, $00A4, $201E, $00A6, $00A7,
$00D8, $00A9, $0156, $00AB, $00AC, $00AD, $00AE, $00C6,
$00B0, $00B1, $00B2, $00B3, $201C, $00B5, $00B6, $00B7,
$00F8, $00B9, $0157, $00BB, $00BC, $00BD, $00BE, $00E6,
$0104, $012E, $0100, $0106, $00C4, $00C5, $0118, $0112,
$010C, $00C9, $0179, $0116, $0122, $0136, $012A, $013B,
$0160, $0143, $0145, $00D3, $014C, $00D5, $00D6, $00D7,
$0172, $0141, $015A, $016A, $00DC, $017B, $017D, $00DF,
$0105, $012F, $0101, $0107, $00E4, $00E5, $0119, $0113,
$010D, $00E9, $017A, $0117, $0123, $0137, $012B, $013C,
$0161, $0144, $0146, $00F3, $014D, $00F5, $00F6, $00F7,
$0173, $0142, $015B, $016B, $00FC, $017C, $017E, $2019
);
CharISO_8859_14: array[128..255] of Word =
(
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
$00A0, $1E02, $1E03, $00A3, $010A, $010B, $1E0A, $00A7,
$1E80, $00A9, $1E82, $1E0B, $1EF2, $00AD, $00AE, $0178,
$1E1E, $1E1F, $0120, $0121, $1E40, $1E41, $00B6, $1E56,
$1E81, $1E57, $1E83, $1E60, $1EF3, $1E84, $1E85, $1E61,
$00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
$00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
$0174, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $1E6A,
$00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $0176, $00DF,
$00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
$00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
$0175, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $1E6B,
$00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $0177, $00FF
);
CharISO_8859_15: array[128..255] of Word =
(
$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
$00A0, $00A1, $00A2, $00A3, $20AC, $00A5, $0160, $00A7,
$0161, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
$00B0, $00B1, $00B2, $00B3, $017D, $00B5, $00B6, $00B7,
$017E, $00B9, $00BA, $00BB, $0152, $0153, $0178, $00BF,
$00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
$00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
$00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
$00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
$00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
$00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
$00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
$00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
);
{Eastern European {Eastern European
} }
CharCP_1250: array[128..255] of Word = CharCP_1250: array[128..255] of Word =
@ -629,6 +689,12 @@ begin
CopyArray(CharISO_8859_9, Result); CopyArray(CharISO_8859_9, Result);
ISO_8859_10: ISO_8859_10:
CopyArray(CharISO_8859_10, Result); CopyArray(CharISO_8859_10, Result);
ISO_8859_13:
CopyArray(CharISO_8859_13, Result);
ISO_8859_14:
CopyArray(CharISO_8859_14, Result);
ISO_8859_15:
CopyArray(CharISO_8859_15, Result);
CP1250: CP1250:
CopyArray(CharCP_1250, Result); CopyArray(CharCP_1250, Result);
CP1251: CP1251:
@ -1004,6 +1070,15 @@ begin
if Pos('ISO-8859-10', Value) = 1 then if Pos('ISO-8859-10', Value) = 1 then
Result := ISO_8859_10 Result := ISO_8859_10
else else
if Pos('ISO-8859-13', Value) = 1 then
Result := ISO_8859_13
else
if Pos('ISO-8859-14', Value) = 1 then
Result := ISO_8859_14
else
if Pos('ISO-8859-15', Value) = 1 then
Result := ISO_8859_15
else
if Pos('ISO-8859-2', Value) = 1 then if Pos('ISO-8859-2', Value) = 1 then
Result := ISO_8859_2 Result := ISO_8859_2
else else
@ -1103,6 +1178,12 @@ begin
Result := 'ISO-8859-9'; Result := 'ISO-8859-9';
ISO_8859_10: ISO_8859_10:
Result := 'ISO-8859-10'; Result := 'ISO-8859-10';
ISO_8859_13:
Result := 'ISO-8859-13';
ISO_8859_14:
Result := 'ISO-8859-14';
ISO_8859_15:
Result := 'ISO-8859-15';
CP1250: CP1250:
Result := 'WINDOWS-1250'; Result := 'WINDOWS-1250';
CP1251: CP1251:

1
synacode.pas
View File

@ -217,7 +217,6 @@ begin
end; end;
{==============================================================================} {==============================================================================}
{DecodeQuotedPrintable}
function DecodeQuotedPrintable(const Value: string): string; function DecodeQuotedPrintable(const Value: string): string;
begin begin

21
synahook.pas
View File

@ -1,21 +0,0 @@
unit SynaHook;
interface
type
THookReason = (
HR_connect,
HR_login,
HR_logout,
HR_command,
HR_result,
HR_beginTransfer,
HR_endTransfer,
HR_TransferCounter
);
THookEvent = procedure(Sender: TObject; Reason: THookReason; Value: string) of object;
implementation
end.

31
synautil.pas
View File

@ -1,5 +1,5 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 002.000.001 | | Project : Delphree - Synapse | 002.001.000 |
|==============================================================================| |==============================================================================|
| Content: support procedures and functions | | Content: support procedures and functions |
|==============================================================================| |==============================================================================|
@ -57,6 +57,8 @@ function BinToInt(const Value: string): Integer;
function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path, function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path,
Para: string): string; Para: string): string;
function StringReplace(Value, Search, Replace: string): string; function StringReplace(Value, Search, Replace: string): string;
function RPos(const Sub, Value: String): Integer;
function Fetch(var Value: string; const Delimiter: string): string;
implementation implementation
@ -475,4 +477,31 @@ begin
Result := Result + Value; Result := Result + Value;
end; end;
{==============================================================================}
function RPos(const Sub, Value: String): Integer;
var
n: Integer;
l: Integer;
begin
result := 0;
l := Length(Sub);
for n := Length(Value) - l + 1 downto 1 do
begin
if Copy(Value, n, l) = Sub then
begin
result := n;
break;
end;
end;
end;
{==============================================================================}
function Fetch(var Value: string; const Delimiter: string): string;
begin
Result := SeparateLeft(Value, Delimiter);
Value := SeparateRight(Value, Delimiter);
end;
end. end.

175
synsock.pas
View File

@ -1,7 +1,7 @@
{==============================================================================| {==============================================================================|
| Project : Delphree - Synapse | 001.000.002 | | Project : Delphree - Synapse | 002.001.000 |
|==============================================================================| |==============================================================================|
| Content: Socket Independent Platform | | Content: Socket Independent Platform Layer |
|==============================================================================| |==============================================================================|
| The contents of this file are subject to the Mozilla Public License Ver. 1.1 | | The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
| (the "License"); you may not use this file except in compliance with the | | (the "License"); you may not use this file except in compliance with the |
@ -23,7 +23,11 @@
| (Found at URL: http://www.ararat.cz/synapse/) | | (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================} |==============================================================================}
{$WEAKPACKAGEUNIT ON} { Comment next line if you need dynamic loading of winsock under Windows
or any another DLL stack by CreateAlternate constructor of TBlockSocket Class.
if next line stay uncommented, is used static mapping. This is fater method.
Under Linx is always used static maping to Libc. }
{$DEFINE STATICWINSOCK}
unit synsock; unit synsock;
@ -252,6 +256,16 @@ function LSSelect(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
implementation implementation
{$IFNDEF LINUX}
{$IFNDEF STATICWINSOCK}
uses syncobjs;
var
SynSockCS: TCriticalSection;
SynSockCount: Integer = 0;
{$ENDIF}
{$ENDIF}
{$IFDEF LINUX} {$IFDEF LINUX}
function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
@ -472,60 +486,135 @@ begin
WSAStartup := LSWSAStartup; WSAStartup := LSWSAStartup;
WSACleanup := LSWSACleanup; WSACleanup := LSWSACleanup;
Result := True; Result := True;
{$ELSE}
{$IFDEF STATICWINSOCK}
Accept := Winsock.Accept;
Bind := Winsock.Bind;
CloseSocket := Winsock.CloseSocket;
Connect := Winsock.Connect;
GetPeerName := Winsock.GetPeerName;
GetSockName := Winsock.GetSockName;
GetSockOpt := Winsock.GetSockOpt;
Htonl := Winsock.htonl;
Htons := Winsock.htons;
Inet_Addr := Winsock.inet_addr;
Inet_Ntoa := Winsock.inet_ntoa;
IoctlSocket := Winsock.ioctlsocket;
Listen := Winsock.listen;
Ntohl := Winsock.ntohl;
Ntohs := Winsock.ntohs;
Recv := Winsock.recv;
RecvFrom := Winsock.recvfrom;
Select := Winsock.select;
Send := Winsock.send;
SendTo := Winsock.sendto;
SetSockOpt := Winsock.setsockopt;
ShutDown := Winsock.shutdown;
Socket := Winsock.socket;
GetHostByAddr := Winsock.GetHostByAddr;
GetHostByName := Winsock.GetHostByName;
GetProtoByName := Winsock.GetProtoByName;
GetProtoByNumber := Winsock.GetProtoByNumber;
GetServByName := Winsock.GetServByName;
GetServByPort := Winsock.GetServByPort;
GetHostName := Winsock.GetHostName;
WSAGetLastError := Winsock.WSAGetLastError;
WSAStartup := Winsock.WSAStartup;
WSACleanup := Winsock.WSACleanup;
Result := True;
{$ELSE} {$ELSE}
Result := False; Result := False;
if stack = '' then if stack = '' then
stack := DLLStackName; stack := DLLStackName;
LibHandle := Windows.LoadLibrary(PChar(Stack)); SynSockCS.Enter;
if LibHandle <> 0 then try
begin if SynSockCount = 0 then
Accept := Windows.GetProcAddress(LibHandle, PChar('accept')); begin
Bind := Windows.GetProcAddress(LibHandle, PChar('bind')); LibHandle := Windows.LoadLibrary(PChar(Stack));
CloseSocket := Windows.GetProcAddress(LibHandle, PChar('closesocket')); if LibHandle <> 0 then
Connect := Windows.GetProcAddress(LibHandle, PChar('connect')); begin
GetPeerName := Windows.GetProcAddress(LibHandle, PChar('getpeername')); Accept := Windows.GetProcAddress(LibHandle, PChar('accept'));
GetSockName := Windows.GetProcAddress(LibHandle, PChar('getsockname')); Bind := Windows.GetProcAddress(LibHandle, PChar('bind'));
GetSockOpt := Windows.GetProcAddress(LibHandle, PChar('getsockopt')); CloseSocket := Windows.GetProcAddress(LibHandle, PChar('closesocket'));
Htonl := Windows.GetProcAddress(LibHandle, PChar('htonl')); Connect := Windows.GetProcAddress(LibHandle, PChar('connect'));
Htons := Windows.GetProcAddress(LibHandle, PChar('htons')); GetPeerName := Windows.GetProcAddress(LibHandle, PChar('getpeername'));
Inet_Addr := Windows.GetProcAddress(LibHandle, PChar('inet_addr')); GetSockName := Windows.GetProcAddress(LibHandle, PChar('getsockname'));
Inet_Ntoa := Windows.GetProcAddress(LibHandle, PChar('inet_ntoa')); GetSockOpt := Windows.GetProcAddress(LibHandle, PChar('getsockopt'));
IoctlSocket := Windows.GetProcAddress(LibHandle, PChar('ioctlsocket')); Htonl := Windows.GetProcAddress(LibHandle, PChar('htonl'));
Listen := Windows.GetProcAddress(LibHandle, PChar('listen')); Htons := Windows.GetProcAddress(LibHandle, PChar('htons'));
Ntohl := Windows.GetProcAddress(LibHandle, PChar('ntohl')); Inet_Addr := Windows.GetProcAddress(LibHandle, PChar('inet_addr'));
Ntohs := Windows.GetProcAddress(LibHandle, PChar('ntohs')); Inet_Ntoa := Windows.GetProcAddress(LibHandle, PChar('inet_ntoa'));
Recv := Windows.GetProcAddress(LibHandle, PChar('recv')); IoctlSocket := Windows.GetProcAddress(LibHandle, PChar('ioctlsocket'));
RecvFrom := Windows.GetProcAddress(LibHandle, PChar('recvfrom')); Listen := Windows.GetProcAddress(LibHandle, PChar('listen'));
Select := Windows.GetProcAddress(LibHandle, PChar('select')); Ntohl := Windows.GetProcAddress(LibHandle, PChar('ntohl'));
Send := Windows.GetProcAddress(LibHandle, PChar('send')); Ntohs := Windows.GetProcAddress(LibHandle, PChar('ntohs'));
SendTo := Windows.GetProcAddress(LibHandle, PChar('sendto')); Recv := Windows.GetProcAddress(LibHandle, PChar('recv'));
SetSockOpt := Windows.GetProcAddress(LibHandle, PChar('setsockopt')); RecvFrom := Windows.GetProcAddress(LibHandle, PChar('recvfrom'));
ShutDown := Windows.GetProcAddress(LibHandle, PChar('shutdown')); Select := Windows.GetProcAddress(LibHandle, PChar('select'));
Socket := Windows.GetProcAddress(LibHandle, PChar('socket')); Send := Windows.GetProcAddress(LibHandle, PChar('send'));
GetHostByAddr := Windows.GetProcAddress(LibHandle, PChar('gethostbyaddr')); SendTo := Windows.GetProcAddress(LibHandle, PChar('sendto'));
GetHostByName := Windows.GetProcAddress(LibHandle, PChar('gethostbyname')); SetSockOpt := Windows.GetProcAddress(LibHandle, PChar('setsockopt'));
GetProtoByName := Windows.GetProcAddress(LibHandle, PChar('getprotobyname')); ShutDown := Windows.GetProcAddress(LibHandle, PChar('shutdown'));
GetProtoByNumber := Windows.GetProcAddress(LibHandle, PChar('getprotobynumber')); Socket := Windows.GetProcAddress(LibHandle, PChar('socket'));
GetServByName := Windows.GetProcAddress(LibHandle, PChar('getservbyname')); GetHostByAddr := Windows.GetProcAddress(LibHandle, PChar('gethostbyaddr'));
GetServByPort := Windows.GetProcAddress(LibHandle, PChar('getservbyport')); GetHostByName := Windows.GetProcAddress(LibHandle, PChar('gethostbyname'));
GetHostName := Windows.GetProcAddress(LibHandle, PChar('gethostname')); GetProtoByName := Windows.GetProcAddress(LibHandle, PChar('getprotobyname'));
WSAGetLastError := Windows.GetProcAddress(LibHandle, PChar('WSAGetLastError')); GetProtoByNumber := Windows.GetProcAddress(LibHandle, PChar('getprotobynumber'));
WSAStartup := Windows.GetProcAddress(LibHandle, PChar('WSAStartup')); GetServByName := Windows.GetProcAddress(LibHandle, PChar('getservbyname'));
WSACleanup := Windows.GetProcAddress(LibHandle, PChar('WSACleanup')); GetServByPort := Windows.GetProcAddress(LibHandle, PChar('getservbyport'));
Result := True; 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;
end
else Result := True;
if Result then
Inc(SynSockCount);
finally
SynSockCS.Leave;
end; end;
{$ENDIF} {$ENDIF}
{$ENDIF}
end; end;
function DestroySocketInterface: Boolean; function DestroySocketInterface: Boolean;
begin begin
{$IFDEF LINUX} {$IFDEF LINUX}
{$ELSE} {$ELSE}
if LibHandle <> 0 then {$IFNDEF STATICWINSOCK}
Windows.FreeLibrary(libHandle); SynSockCS.Enter;
LibHandle := 0; try
Dec(SynSockCount);
if SynSockCount < 0 then
SynSockCount := 0;
if SynSockCount = 0 then
if LibHandle <> 0 then
begin
Windows.FreeLibrary(libHandle);
LibHandle := 0;
end;
finally
SynSockCS.Leave;
end;
{$ENDIF}
{$ENDIF} {$ENDIF}
Result := True; Result := True;
end; end;
{$IFNDEF LINUX}
{$IFNDEF STATICWINSOCK}
initialization
begin
SynSockCS:= TCriticalSection.Create;
end;
finalization
begin
SynSockCS.Free;
end;
{$ENDIF}
{$ENDIF}
end. end.