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 |
|==============================================================================|
@ -49,8 +49,27 @@ type
ErrorMessage: string;
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)
private
FOnStatus: THookSocketStatus;
FWsaData: TWSADATA;
FLocalSin: TSockAddrIn;
FRemoteSin: TSockAddrIn;
@ -68,6 +87,7 @@ type
procedure SetSin(var Sin: TSockAddrIn; IP, Port: string);
function GetSinIP(Sin: TSockAddrIn): string;
function GetSinPort(Sin: TSockAddrIn): Integer;
procedure DoStatus(Reason: THookSocketReason; const Value: string);
public
constructor Create;
constructor CreateAlternate(Stub: string);
@ -118,6 +138,7 @@ type
property SizeRecvBuffer: Integer read GetSizeRecvBuffer write SetSizeRecvBuffer;
property SizeSendBuffer: Integer read GetSizeSendBuffer write SetSizeSendBuffer;
property WSAData: TWSADATA read FWsaData;
property OnStatus: THookSocketStatus read FOnStatus write FOnStatus;
end;
TUDPBlockSocket = class(TBlockSocket)
@ -205,6 +226,7 @@ end;
destructor TBlockSocket.Destroy;
begin
CloseSocket;
synsock.WSACleanup;
DestroySocketInterface;
inherited Destroy;
end;
@ -215,6 +237,7 @@ var
ServEnt: PServEnt;
HostEnt: PHostEnt;
begin
DoStatus(HR_ResolvingBegin, IP + ':' + Port);
FillChar(Sin, Sizeof(Sin), 0);
Sin.sin_family := AF_INET;
ProtoEnt := synsock.GetProtoByNumber(FProtocol);
@ -237,6 +260,7 @@ begin
SIn.sin_addr.S_addr := Longint(PLongint(HostEnt^.h_addr_list^)^);
end;
end;
DoStatus(HR_ResolvingEnd, IP+':'+Port);
end;
function TBlockSocket.GetSinIP(Sin: TSockAddrIn): string;
@ -263,11 +287,13 @@ begin
else
FLastError := 0;
ExceptCheck;
DoStatus(HR_SocketCreate, '');
end;
procedure TBlockSocket.CloseSocket;
begin
synsock.CloseSocket(FSocket);
DoStatus(HR_SocketClose, '');
end;
procedure TBlockSocket.Bind(IP, Port: string);
@ -281,6 +307,7 @@ begin
synsock.GetSockName(FSocket, FLocalSin, Len);
FBuffer := '';
ExceptCheck;
DoStatus(HR_Bind, IP + ':' + Port);
end;
procedure TBlockSocket.Connect(IP, Port: string);
@ -292,6 +319,7 @@ begin
GetSins;
FBuffer := '';
ExceptCheck;
DoStatus(HR_Connect, IP + ':' + Port);
end;
procedure TBlockSocket.GetSins;
@ -309,18 +337,21 @@ begin
Result := synsock.Send(FSocket, Buffer^, Length, 0);
SockCheck(Result);
ExceptCheck;
DoStatus(HR_WriteCount, IntToStr(Result));
end;
procedure TBlockSocket.SendByte(Data: Byte);
begin
sockcheck(synsock.Send(FSocket, Data, 1, 0));
ExceptCheck;
DoStatus(HR_WriteCount, '1');
end;
procedure TBlockSocket.SendString(const Data: string);
begin
SockCheck(synsock.Send(FSocket, PChar(Data)^, Length(Data), 0));
ExceptCheck;
DoStatus(HR_WriteCount, IntToStr(Length(Data)));
end;
function TBlockSocket.RecvBuffer(Buffer: Pointer; Length: Integer): Integer;
@ -331,6 +362,7 @@ begin
else
SockCheck(Result);
ExceptCheck;
DoStatus(HR_ReadCount, IntToStr(Result));
end;
function TBlockSocket.RecvBufferEx(Buffer: Pointer; Length: Integer;
@ -380,6 +412,7 @@ begin
SockCheck(x);
if FLastError <> 0 then
Break;
DoStatus(HR_ReadCount, IntToStr(x));
lss := system.Length(ss);
SetLength(ss, lss + x);
Move(Pointer(st)^, Pointer(@ss[lss + 1])^, x);
@ -414,6 +447,7 @@ begin
else
SockCheck(y);
Result := Data;
DoStatus(HR_ReadCount, '1');
end
else
FLastError := WSAETIMEDOUT;
@ -456,6 +490,7 @@ begin
FLastError := WSAENOTCONN;
if FLastError <> 0 then
Break;
DoStatus(HR_ReadCount, IntToStr(r));
if r < x then
SetLength(FBuffer, r);
end;
@ -650,6 +685,8 @@ begin
x := 0;
Result := x > 0;
ExceptCheck;
if Result then
DoStatus(HR_CanRead, '');
end;
function TBlockSocket.CanWrite(Timeout: Integer): Boolean;
@ -672,6 +709,8 @@ begin
x := 0;
Result := x > 0;
ExceptCheck;
if Result then
DoStatus(HR_CanWrite, '');
end;
function TBlockSocket.SendBufferTo(Buffer: Pointer; Length: Integer): Integer;
@ -775,6 +814,13 @@ begin
CanReadList.Add(TBlockSocket(SocketList.Items[n]));
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;
begin
case ErrorCode of
@ -928,6 +974,7 @@ begin
SockCheck(synsock.Listen(FSocket, SOMAXCONN));
GetSins;
ExceptCheck;
DoStatus(HR_Listen, '');
end;
function TTCPBlockSocket.Accept: TSocket;
@ -938,6 +985,7 @@ begin
Result := synsock.Accept(FSocket, @FRemoteSin, @Len);
SockCheck(Result);
ExceptCheck;
DoStatus(HR_Accept, '');
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 |
|==============================================================================|
@ -103,6 +103,7 @@ type
property Timeout: Integer read FTimeout Write FTimeout;
property DNSHost: string read FDNSHost Write FDNSHost;
property RCode: Integer read FRCode;
property Sock: TUDPBlockSocket read FSock;
end;
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 |
|==============================================================================|
@ -83,12 +83,15 @@ type
property ProxyPass: string read FProxyPass Write FProxyPass;
property ResultCode: Integer read FResultCode;
property ResultString: string read FResultString;
property Sock: TTCPBlockSocket read FSock;
end;
function HttpGetText(const URL: string; const Response: TStrings): Boolean;
function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
function HttpPostBinary(const URL: 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
@ -444,11 +447,37 @@ begin
HTTP.Document.Write(Pointer(URLData)^, Length(URLData));
HTTP.MimeType := 'application/x-url-encoded';
Result := HTTP.HTTPMethod('POST', URL);
Data.Seek(0, soFromBeginning);
Data.CopyFrom(HTTP.Document, 0);
finally
HTTP.Free;
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.

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 |
|==============================================================================|
@ -40,15 +40,19 @@ type
FToList: TStringList;
FSubject: string;
FOrganization: string;
FCustomHeaders: TStringList;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure EncodeHeaders(Value: TStringList);
procedure DecodeHeaders(Value: TStringList);
published
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 Organization: string read FOrganization Write FOrganization;
property CustomHeaders: TStringList read FCustomHeaders;
end;
TMimeMess = class(TObject)
@ -56,6 +60,7 @@ type
FPartList: TList;
FLines: TStringList;
FHeader: TMessHeader;
FMultipartType: string;
public
constructor Create;
destructor Destroy; override;
@ -70,9 +75,10 @@ type
procedure ParseHeaders;
procedure DecodeMessage;
published
property PartList: TList read FPartList Write FPartList;
property Lines: TStringList read FLines Write FLines;
property Header: TMessHeader read FHeader Write FHeader;
property PartList: TList read FPartList;
property Lines: TStringList read FLines;
property Header: TMessHeader read FHeader;
property MultipartType: string read FMultipartType Write FMultipartType;
end;
implementation
@ -83,10 +89,12 @@ constructor TMessHeader.Create;
begin
inherited Create;
FToList := TStringList.Create;
FCustomHeaders := TStringList.Create;
end;
destructor TMessHeader.Destroy;
begin
FCustomHeaders.Free;
FToList.Free;
inherited Destroy;
end;
@ -99,6 +107,64 @@ begin
FToList.Clear;
FSubject := '';
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;
{==============================================================================}
@ -109,6 +175,7 @@ begin
FPartList := TList.Create;
FLines := TStringList.Create;
FHeader := TMessHeader.Create;
FMultipartType := 'Mixed';
end;
destructor TMimeMess.Destroy;
@ -125,31 +192,26 @@ procedure TMimeMess.Clear;
var
n: Integer;
begin
FMultipartType := 'Mixed';
Lines.Clear;
for n := 0 to PartList.Count - 1 do
TMimePart(PartList[n]).Free;
PartList.Clear;
for n := 0 to FPartList.Count - 1 do
TMimePart(FPartList[n]).Free;
FPartList.Clear;
FHeader.Clear;
end;
{==============================================================================}
function TMimeMess.AddPart: Integer;
var
mp: TMimePart;
begin
mp := TMimePart.Create;
Result := PartList.Add(mp);
Result := FPartList.Add(TMimePart.Create);
end;
{==============================================================================}
procedure TMimeMess.AddPartText(Value: TStringList);
var
x: Integer;
begin
x := AddPart;
with TMimePart(PartList[x]) do
with TMimePart(FPartList[AddPart]) do
begin
Value.SaveToStream(DecodedLines);
Primary := 'text';
@ -167,11 +229,8 @@ end;
{==============================================================================}
procedure TMimeMess.AddPartHTML(Value: TStringList);
var
x: Integer;
begin
x := AddPart;
with TMimePart(PartList[x]) do
with TMimePart(FPartList[AddPart]) do
begin
Value.SaveToStream(DecodedLines);
Primary := 'text';
@ -188,11 +247,9 @@ end;
procedure TMimeMess.AddPartBinary(Value: string);
var
x: Integer;
s: string;
begin
x := AddPart;
with TMimePart(PartList[x]) do
with TMimePart(FPartList[AddPart]) do
begin
DecodedLines.LoadFromFile(Value);
s := ExtractFileName(Value);
@ -207,18 +264,16 @@ end;
procedure TMimeMess.AddPartHTMLBinary(Value, Cid: string);
var
x: Integer;
s: string;
begin
x := AddPart;
with TMimePart(PartList[x]) do
with TMimePart(FPartList[AddPart]) do
begin
DecodedLines.LoadFromFile(Value);
s := ExtractFileName(Value);
MimeTypeFromExt(s);
Description := 'Included file: ' + s;
Disposition := 'inline';
ContentID := cid;
ContentID := Cid;
FileName := s;
EncodingCode := ME_BASE64;
EncodePart;
@ -232,27 +287,27 @@ var
bound: string;
n: Integer;
begin
Lines.Clear;
if PartList.Count = 1 then
Lines.Assign(TMimePart(PartList[0]).Lines)
FLines.Clear;
if FPartList.Count = 1 then
FLines.Assign(TMimePart(FPartList[0]).Lines)
else
begin
bound := GenerateBoundary;
for n := 0 to PartList.Count - 1 do
for n := 0 to FPartList.Count - 1 do
begin
Lines.Add('--' + bound);
Lines.AddStrings(TMimePart(PartList[n]).Lines);
FLines.Add('--' + bound);
FLines.AddStrings(TMimePart(FPartList[n]).Lines);
end;
Lines.Add('--' + bound);
FLines.Add('--' + bound + '--');
with TMimePart.Create do
try
Self.Lines.SaveToStream(DecodedLines);
Self.FLines.SaveToStream(DecodedLines);
Primary := 'Multipart';
Secondary := 'mixed';
Secondary := FMultipartType;
Description := 'Multipart message';
Boundary := bound;
EncodePart;
Self.Lines.Assign(Lines);
Self.FLines.Assign(Lines);
finally
Free;
end;
@ -262,46 +317,15 @@ end;
{==============================================================================}
procedure TMimeMess.FinalizeHeaders;
var
n: Integer;
begin
Lines.Insert(0, 'x-mailer: Synapse - Delphi TCP/IP library by Lukas Gebauer');
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));
FHeader.EncodeHeaders(FLines);
end;
{==============================================================================}
procedure TMimeMess.ParseHeaders;
var
s: string;
x: Integer;
cp: TMimeChar;
begin
cp := GetCurCP;
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;
FHeader.DecodeHeaders(FLines);
end;
{==============================================================================}
@ -310,13 +334,13 @@ procedure TMimeMess.DecodeMessage;
var
l: TStringList;
m: TMimePart;
x, i: Integer;
i: Integer;
bound: string;
begin
l := TStringList.Create;
m := TMimePart.Create;
try
l.Assign(Lines);
l.Assign(FLines);
FHeader.Clear;
ParseHeaders;
m.ExtractPart(l, 0);
@ -325,8 +349,7 @@ begin
bound := m.Boundary;
i := 0;
repeat
x := AddPart;
with TMimePart(PartList[x]) do
with TMimePart(PartList[AddPart]) do
begin
Boundary := bound;
i := ExtractPart(l, i);
@ -336,8 +359,7 @@ begin
end
else
begin
x := AddPart;
with TMimePart(PartList[x]) do
with TMimePart(PartList[AddPart]) do
begin
ExtractPart(l, 0);
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 |
|==============================================================================|
@ -81,8 +81,8 @@ type
property ContentID: string read FContentID Write FContentID;
property Boundary: string read FBoundary Write FBoundary;
property FileName: string read FFileName Write FFileName;
property Lines: TStringList read FLines Write FLines;
property DecodedLines: TMemoryStream read FDecodedLines Write FDecodedLines;
property Lines: TStringList read FLines;
property DecodedLines: TMemoryStream read FDecodedLines;
end;
const
@ -212,12 +212,13 @@ begin
fn := '';
x := BeginLine;
b := FBoundary;
{ if multipart - skip pre-part }
if b <> '' then
while Value.Count > x do
begin
s := Value[x];
Inc(x);
if Pos('--' + b, s) > 0 then
if Pos('--' + b, s) = 1 then
Break;
end;
@ -234,7 +235,8 @@ begin
st2 := SeparateLeft(st, ';');
Primary := SeparateLeft(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
MP_TEXT:
Charset := UpperCase(GetParameter(s, 'charset='));
@ -266,27 +268,30 @@ begin
FFileName := InlineDecode(FFileName, getCurCP);
FFileName := ExtractFileName(FFileName);
{ finding part content x1-begin x2-end }
x1 := x;
x2 := Value.Count - 1;
{ if multipart - end is before next boundary }
if b <> '' then
begin
for n := x to Value.Count - 1 do
begin
x2 := n;
s := Value[n];
if Pos('--' + b, s) > 0 then
if Pos('--' + b, s) = 1 then
begin
Dec(x2);
Break;
end;
end;
end;
{ if content is multipart - content is delimited by their boundaries }
if FPrimaryCode = MP_MULTIPART then
begin
for n := x to Value.Count - 1 do
begin
s := Value[n];
if Pos('--' + Boundary, s) > 0 then
if Pos('--' + FBoundary, s) = 1 then
begin
x1 := n;
Break;
@ -295,21 +300,23 @@ begin
for n := Value.Count - 1 downto x do
begin
s := Value[n];
if Pos('--' + Boundary, s) > 0 then
if Pos('--' + FBoundary, s) = 1 then
begin
x2 := n;
Break;
end;
end;
end;
{ copy content }
for n := x1 to x2 do
FLines.Add(Value[n]);
Result := x2;
{ if content is multipart - find real end }
if FPrimaryCode = MP_MULTIPART then
begin
e := False;
for n := x2 + 1 to Value.Count - 1 do
if Pos('--' + Boundary, Value[n]) > 0 then
if Pos('--' + FBoundary, Value[n]) = 1 then
begin
e := True;
Break;
@ -317,6 +324,24 @@ begin
if not e then
Result := Value.Count - 1;
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
t.Free;
end;
@ -465,7 +490,7 @@ begin
MP_TEXT:
s := FPrimary + '/' + FSecondary + '; charset=' + GetIDfromCP(FCharsetCode);
MP_MULTIPART:
s := FPrimary + '/' + FSecondary + '; boundary="' + Boundary + '"';
s := FPrimary + '/' + FSecondary + '; boundary="' + FBoundary + '"';
MP_MESSAGE:
s := FPrimary + '/' + FSecondary + '';
MP_BINARY:
@ -500,7 +525,7 @@ begin
if Primary = '' then
Primary := 'application';
if FSecondary = '' then
FSecondary := 'mixed';
FSecondary := 'octet-string';
end;
{==============================================================================}
@ -553,7 +578,7 @@ var
begin
Randomize;
x := Random(MaxInt);
Result := '----' + IntToHex(x, 8) + '_Synapse_message_boundary';
Result := '--' + IntToHex(x, 8) + '_Synapse_message_boundary--';
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 |
|==============================================================================|
@ -79,6 +79,7 @@ type
property Timeout: Integer read FTimeout Write FTimeout;
property PacketSize: Integer read FPacketSize Write FPacketSize;
property PingTime: Integer read FPingTime;
property Sock: TICMPBlockSocket read FSock;
end;
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 |
|==============================================================================|
@ -84,6 +84,7 @@ type
property StatSize: Integer read FStatSize;
property TimeStamp: string read FTimeStamp;
property AuthType: TPOP3AuthType read FAuthType Write FAuthType;
property Sock: TTCPBlockSocket read FSock;
end;
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 |
|==============================================================================|
@ -96,6 +96,7 @@ type
property EnhCode2: Integer read FEnhCode2;
property EnhCode3: Integer read FEnhCode3;
property SystemName: string read FSystemName Write FSystemName;
property Sock: TTCPBlockSocket read FSock;
end;
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 |
|==============================================================================|
@ -112,6 +112,7 @@ type
property HostIP: string read FHostIP;
property Query: TSNMPRec read FQuery;
property Reply: TSNMPRec read FReply;
property Sock: TUDPBlockSocket read FSock;
end;
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 |
|==============================================================================|
@ -97,6 +97,7 @@ type
property Trap: TTrapPDU read FTrap;
property SNMPHost: string read FSNMPHost Write FSNMPHost;
property Timeout: Integer read FTimeout Write FTimeout;
property Sock: TUDPBlockSocket read FSock;
end;
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 |
|==============================================================================|
@ -76,6 +76,7 @@ type
property NTPTime: TDateTime read FNTPTime;
property SntpHost: string read FSntpHost write FSntpHost;
property Timeout: Integer read FTimeout write FTimeout;
property Sock: TUDPBlockSocket read FSock;
end;
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 |
|==============================================================================|
@ -33,10 +33,10 @@ interface
type
TMimeChar = (ISO_8859_1, ISO_8859_2, ISO_8859_3,
ISO_8859_4, ISO_8859_5, ISO_8859_6, ISO_8859_7,
ISO_8859_8, ISO_8859_9, ISO_8859_10, CP1250,
CP1251, CP1252, CP1253, CP1254, CP1255, CP1256,
CP1257, CP1258, KOI8_R, CP895, CP852,
UCS_2, UCS_4, UTF_8, UTF_7);
ISO_8859_8, ISO_8859_9, ISO_8859_10, ISO_8859_13,
ISO_8859_14, ISO_8859_15, CP1250, CP1251, CP1252,
CP1253, CP1254, CP1255, CP1256, CP1257, CP1258,
KOI8_R, CP895, CP852, UCS_2, UCS_4, UTF_8, UTF_7);
TMimeSetChar = set of TMimeChar;
@ -297,6 +297,66 @@ const
$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
}
CharCP_1250: array[128..255] of Word =
@ -629,6 +689,12 @@ begin
CopyArray(CharISO_8859_9, Result);
ISO_8859_10:
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:
CopyArray(CharCP_1250, Result);
CP1251:
@ -1004,6 +1070,15 @@ begin
if Pos('ISO-8859-10', Value) = 1 then
Result := ISO_8859_10
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
Result := ISO_8859_2
else
@ -1103,6 +1178,12 @@ begin
Result := 'ISO-8859-9';
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:
Result := 'WINDOWS-1250';
CP1251:

1
synacode.pas
View File

@ -217,7 +217,6 @@ begin
end;
{==============================================================================}
{DecodeQuotedPrintable}
function DecodeQuotedPrintable(const Value: string): string;
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 |
|==============================================================================|
@ -57,6 +57,8 @@ function BinToInt(const Value: string): Integer;
function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path,
Para: 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
@ -475,4 +477,31 @@ begin
Result := Result + Value;
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.

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 "License"); you may not use this file except in compliance with the |
@ -23,7 +23,11 @@
| (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;
@ -252,6 +256,16 @@ function LSSelect(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
implementation
{$IFNDEF LINUX}
{$IFNDEF STATICWINSOCK}
uses syncobjs;
var
SynSockCS: TCriticalSection;
SynSockCount: Integer = 0;
{$ENDIF}
{$ENDIF}
{$IFDEF LINUX}
function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
@ -472,60 +486,135 @@ begin
WSAStartup := LSWSAStartup;
WSACleanup := LSWSACleanup;
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}
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;
SynSockCS.Enter;
try
if SynSockCount = 0 then
begin
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;
end
else Result := True;
if Result then
Inc(SynSockCount);
finally
SynSockCS.Leave;
end;
{$ENDIF}
{$ENDIF}
end;
function DestroySocketInterface: Boolean;
begin
{$IFDEF LINUX}
{$ELSE}
if LibHandle <> 0 then
Windows.FreeLibrary(libHandle);
LibHandle := 0;
{$IFNDEF STATICWINSOCK}
SynSockCS.Enter;
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}
Result := True;
end;
{$IFNDEF LINUX}
{$IFNDEF STATICWINSOCK}
initialization
begin
SynSockCS:= TCriticalSection.Create;
end;
finalization
begin
SynSockCS.Free;
end;
{$ENDIF}
{$ENDIF}
end.