pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Release 31

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@68 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2008-04-24 07:23:38 +00:00
parent 9f400a899b
commit 7960ad4609
24 changed files with 3242 additions and 1108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
asn1util.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.003.005 |
| Project : Delphree - Synapse | 001.003.006 |
|==============================================================================|
| Content: support for ASN.1 BER coding and decoding |
|==============================================================================|
@ -45,7 +45,6 @@
|==============================================================================}
{$Q-}
{$WEAKPACKAGEUNIT ON}
unit ASN1Util;

1366
blcksock.pas
View File

File diff suppressed because it is too large Load Diff

73
dnssend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.001.001 |
| Project : Delphree - Synapse | 002.002.002 |
|==============================================================================|
| Content: DNS client |
|==============================================================================|
@ -45,7 +45,6 @@
// RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
{$Q-}
{$WEAKPACKAGEUNIT ON}
unit DNSsend;
@ -53,7 +52,7 @@ interface
uses
SysUtils, Classes,
blcksock, SynaUtil;
blcksock, SynaUtil, synsock;
const
cDnsProtocol = 'domain';
@ -86,7 +85,7 @@ const
QTYPE_KEY = 25; // RFC-2065
QTYPE_PX = 26;
QTYPE_GPOS = 27;
QTYPE_AAAA = 28; // IP6 Address [Susan Thomson]
QTYPE_AAAA = 28;
QTYPE_LOC = 29; // RFC-1876
QTYPE_NXT = 30; // RFC-2065
@ -112,6 +111,8 @@ type
FNameserverInfo: TStringList;
FAdditionalInfo: TStringList;
FAuthoritative: Boolean;
function ReverseIP(Value: string): string;
function ReverseIP6(Value: string): string;
function CompressName(const Value: string): string;
function CodeHeader: string;
function CodeQuery(const Name: string; QType: Integer): string;
@ -167,6 +168,44 @@ begin
inherited Destroy;
end;
function TDNSSend.ReverseIP(Value: string): string;
var
x: Integer;
begin
Result := '';
repeat
x := LastDelimiter('.', Value);
Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x);
Delete(Value, x, Length(Value) - x + 1);
until x < 1;
if Length(Result) > 0 then
if Result[1] = '.' then
Delete(Result, 1, 1);
end;
function TDNSSend.ReverseIP6(Value: string): string;
var
ip6: TSockAddrIn6;
begin
ip6 := FSock.StrToIP6(Value);
Result := ip6.sin6_addr.S_un_b.s_b16
+ '.' + ip6.sin6_addr.S_un_b.s_b15
+ '.' + ip6.sin6_addr.S_un_b.s_b14
+ '.' + ip6.sin6_addr.S_un_b.s_b13
+ '.' + ip6.sin6_addr.S_un_b.s_b12
+ '.' + ip6.sin6_addr.S_un_b.s_b11
+ '.' + ip6.sin6_addr.S_un_b.s_b10
+ '.' + ip6.sin6_addr.S_un_b.s_b9
+ '.' + ip6.sin6_addr.S_un_b.s_b8
+ '.' + ip6.sin6_addr.S_un_b.s_b7
+ '.' + ip6.sin6_addr.S_un_b.s_b6
+ '.' + ip6.sin6_addr.S_un_b.s_b5
+ '.' + ip6.sin6_addr.S_un_b.s_b4
+ '.' + ip6.sin6_addr.S_un_b.s_b3
+ '.' + ip6.sin6_addr.S_un_b.s_b2
+ '.' + ip6.sin6_addr.S_un_b.s_b1;
end;
function TDNSSend.CompressName(const Value: string): string;
var
n: Integer;
@ -258,6 +297,7 @@ var
RType, Len, j, x, n: Integer;
R: string;
t1, t2, ttl: integer;
ip6: TSockAddrIn6;
begin
Result := '';
R := '';
@ -273,6 +313,7 @@ begin
Inc(i, 2); // i point to begin of data
j := i;
i := i + len; // i point to next record
if Length(FBuffer) >= i then
case RType of
QTYPE_A:
begin
@ -284,6 +325,28 @@ begin
Inc(j);
R := R + '.' + IntToStr(Ord(FBuffer[j]));
end;
QTYPE_AAAA:
begin
FillChar(ip6, SizeOf(ip6), 0);
ip6.sin6_addr.S_un_b.s_b1 := FBuffer[j];
ip6.sin6_addr.S_un_b.s_b2 := FBuffer[j + 1];
ip6.sin6_addr.S_un_b.s_b3 := FBuffer[j + 2];
ip6.sin6_addr.S_un_b.s_b4 := FBuffer[j + 3];
ip6.sin6_addr.S_un_b.s_b5 := FBuffer[j + 4];
ip6.sin6_addr.S_un_b.s_b6 := FBuffer[j + 5];
ip6.sin6_addr.S_un_b.s_b7 := FBuffer[j + 6];
ip6.sin6_addr.S_un_b.s_b8 := FBuffer[j + 7];
ip6.sin6_addr.S_un_b.s_b9 := FBuffer[j + 8];
ip6.sin6_addr.S_un_b.s_b10 := FBuffer[j + 9];
ip6.sin6_addr.S_un_b.s_b11 := FBuffer[j + 10];
ip6.sin6_addr.S_un_b.s_b12 := FBuffer[j + 11];
ip6.sin6_addr.S_un_b.s_b13 := FBuffer[j + 12];
ip6.sin6_addr.S_un_b.s_b14 := FBuffer[j + 13];
ip6.sin6_addr.S_un_b.s_b15 := FBuffer[j + 14];
ip6.sin6_addr.S_un_b.s_b16 := FBuffer[j + 15];
ip6.sin6_family := AF_INET6;
R := FSock.IP6ToStr(ip6);
end;
QTYPE_NS, QTYPE_MD, QTYPE_MF, QTYPE_CNAME, QTYPE_MB,
QTYPE_MG, QTYPE_MR, QTYPE_PTR, QTYPE_X25, QTYPE_NSAP,
QTYPE_NSAPPTR:
@ -415,6 +478,8 @@ begin
Result := False;
if IsIP(Name) then
Name := ReverseIP(Name) + '.in-addr.arpa';
if IsIP6(Name) then
Name := ReverseIP6(Name) + '.ip6.int';
FBuffer := CodeHeader + CodeQuery(Name, QType);
if FUseTCP then
WorkSock := FTCPSock

66
ftpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.005.004 |
| Project : Delphree - Synapse | 002.006.006 |
|==============================================================================|
| Content: FTP client |
|==============================================================================|
@ -43,8 +43,6 @@
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{$WEAKPACKAGEUNIT ON}
unit FTPsend;
interface
@ -121,8 +119,6 @@ type
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;
protected
procedure DoStatus(Response: Boolean; const Value: string);
public
@ -131,12 +127,13 @@ type
destructor Destroy; override;
function ReadResult: Integer;
procedure ParseRemote(Value: string);
procedure ParseRemoteEPSV(Value: string);
function FTPCommand(const Value: string): integer;
function Login: Boolean;
procedure Logout;
procedure Abort;
function List(Directory: string; NameList: Boolean): Boolean;
function RetriveFile(const FileName: string; Restore: Boolean): Boolean;
function RetrieveFile(const FileName: string; Restore: Boolean): Boolean;
function StoreFile(const FileName: string; Restore: Boolean): Boolean;
function StoreUniqueFile: Boolean;
function AppendFile(const FileName: string): Boolean;
@ -149,6 +146,8 @@ type
function DeleteDir(const Directory: string): Boolean;
function CreateDir(const Directory: string): Boolean;
function GetCurrentDir: String;
function DataRead(const DestStream: TStream): Boolean;
function DataWrite(const SourceStream: TStream): Boolean;
published
property ResultCode: Integer read FResultCode;
property ResultString: string read FResultString;
@ -447,10 +446,10 @@ end;
function TFTPSend.Connect: Boolean;
begin
FSock.CloseSocket;
FSock.CreateSocket;
FSock.Bind(FIPInterface, cAnyPort);
if FFullSSL then
FSock.SSLEnabled := True;
FSock.Bind(FIPInterface, cAnyPort);
if FSock.LastError = 0 then
if FFWHost = '' then
FSock.Connect(FTargetHost, FTargetPort)
else
@ -527,26 +526,56 @@ begin
FDataPort := IntToStr(x);
end;
procedure TFTPSend.ParseRemoteEPSV(Value: string);
var
n: integer;
s, v: string;
begin
s := SeparateRight(Value, '(');
s := SeparateLeft(s, ')');
Delete(s, Length(s), 1);
v := '';
for n := Length(s) downto 1 do
if s[n] in ['0'..'9'] then
v := s[n] + v
else
Break;
FDataPort := v;
FDataIP := FTargetHost;
end;
function TFTPSend.DataSocket: boolean;
var
s: string;
begin
Result := False;
if FPassiveMode then
begin
if FSock.IP6used then
s := '2'
else
s := '1';
if (FTPCommand('EPSV ' + s) div 100) = 2 then
begin
ParseRemoteEPSV(FResultString);
end
else
if FSock.IP6used then
Exit
else
begin
if (FTPCommand('PASV') div 100) <> 2 then
Exit;
ParseRemote(FResultString);
end;
FDSock.CloseSocket;
FDSock.CreateSocket;
FSock.Bind(FIPInterface, cAnyPort);
FDSock.Bind(FIPInterface, cAnyPort);
FDSock.Connect(FDataIP, FDataPort);
Result := FDSock.LastError = 0;
end
else
begin
FDSock.CloseSocket;
FDSock.CreateSocket;
if FForceDefaultPort then
s := cFtpDataProtocol
else
@ -555,7 +584,7 @@ begin
if FIPInterface = cAnyHost then
FDSock.Bind(FDSock.LocalName, s)
else
FSock.Bind(FIPInterface, s);
FDSock.Bind(FIPInterface, s);
if FDSock.LastError <> 0 then
Exit;
FDSock.SetLinger(True, 10);
@ -564,11 +593,20 @@ begin
FDataIP := FDSock.GetLocalSinIP;
FDataIP := FDSock.ResolveName(FDataIP);
FDataPort := IntToStr(FDSock.GetLocalSinPort);
if IsIp6(FDataIP) then
s := '2'
else
s := '1';
s := 'EPRT |' + s +'|' + FDataIP + '|' + FDataPort + '|';
Result := (FTPCommand(s) div 100) = 2;
if not Result and IsIP(FDataIP) then
begin
s := ReplaceString(FDataIP, '.', ',');
s := 'PORT ' + s + ',' + IntToStr(FDSock.GetLocalSinPort div 256)
+ ',' + IntToStr(FDSock.GetLocalSinPort mod 256);
Result := (FTPCommand(s) div 100) = 2;
end;
end;
end;
function TFTPSend.AcceptDataSocket: Boolean;
@ -687,7 +725,7 @@ begin
FDataStream.Seek(0, soFromBeginning);
end;
function TFTPSend.RetriveFile(const FileName: string; Restore: Boolean): Boolean;
function TFTPSend.RetrieveFile(const FileName: string; Restore: Boolean): Boolean;
var
RetrStream: TStream;
begin
@ -1156,7 +1194,7 @@ begin
Exit;
DirectFileName := LocalFile;
DirectFile:=True;
Result := RetriveFile(FileName, False);
Result := RetrieveFile(FileName, False);
Logout;
finally
Free;

71
httpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 003.004.004 |
| Project : Delphree - Synapse | 003.006.004 |
|==============================================================================|
| Content: HTTP client |
|==============================================================================|
@ -42,14 +42,15 @@
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{$WEAKPACKAGEUNIT ON}
unit HTTPSend;
interface
uses
SysUtils, Classes,
{$IFDEF STREAMSEC}
TlsInternalServer, TlsSynaSock,
{$ENDIF}
blcksock, SynaUtil, SynaCode;
const
@ -60,7 +61,12 @@ type
THTTPSend = class(TSynaClient)
private
{$IFDEF STREAMSEC}
FSock: TSsTCPBlockSocket;
FTLSServer: TCustomTLSInternalServer;
{$ELSE}
FSock: TTCPBlockSocket;
{$ENDIF}
FTransferEncoding: TTransferEncoding;
FAliveHost: string;
FAlivePort: string;
@ -69,6 +75,7 @@ type
FMimeType: string;
FProtocol: string;
FKeepAlive: Boolean;
FStatus100: Boolean;
FProxyHost: string;
FProxyPort: string;
FProxyUser: string;
@ -101,6 +108,7 @@ type
property MimeType: string read FMimeType Write FMimeType;
property Protocol: string read FProtocol Write FProtocol;
property KeepAlive: Boolean read FKeepAlive Write FKeepAlive;
property Status100: Boolean read FStatus100 Write FStatus100;
property ProxyHost: string read FProxyHost Write FProxyHost;
property ProxyPort: string read FProxyPort Write FProxyPort;
property ProxyUser: string read FProxyUser Write FProxyUser;
@ -110,7 +118,12 @@ type
property ResultString: string read FResultString;
property DownloadSize: integer read FDownloadSize;
property UploadSize: integer read FUploadSize;
{$IFDEF STREAMSEC}
property Sock: TSsTCPBlockSocket read FSock;
property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
{$ELSE}
property Sock: TTCPBlockSocket read FSock;
{$ENDIF}
end;
function HttpGetText(const URL: string; const Response: TStrings): Boolean;
@ -128,11 +141,17 @@ begin
FHeaders := TStringList.Create;
FCookies := TStringList.Create;
FDocument := TMemoryStream.Create;
{$IFDEF STREAMSEC}
FTLSServer := GlobalTLSInternalServer;
FSock := TSsTCPBlockSocket.Create;
FSock.BlockingRead := True;
{$ELSE}
FSock := TTCPBlockSocket.Create;
{$ENDIF}
FSock.ConvertLineEnd := True;
FSock.SizeRecvBuffer := 65536;
FSock.SizeSendBuffer := 65536;
FTimeout := 300000;
FTimeout := 90000;
FTargetPort := cHttpProtocol;
FProxyHost := '';
FProxyPort := '8080';
@ -142,6 +161,7 @@ begin
FAlivePort := '';
FProtocol := '1.0';
FKeepAlive := True;
FStatus100 := False;
FUserAgent := 'Mozilla/4.0 (compatible; Synapse)';
FDownloadSize := 0;
FUploadSize := 0;
@ -198,10 +218,8 @@ begin
FUploadSize := 0;
URI := ParseURL(URL, Prot, User, Pass, Host, Port, Path, Para);
if UpperCase(Prot) = 'HTTPS' then
begin
FSock.SSLEnabled := True;
HttpTunnel := FProxyHost <> '';
FSock.HTTPTunnelIP := FProxyHost;
FSock.HTTPTunnelPort := FProxyPort;
@ -210,7 +228,6 @@ begin
end
else
begin
FSock.SSLEnabled := False;
HttpTunnel := False;
FSock.HTTPTunnelIP := '';
FSock.HTTPTunnelPort := '';
@ -220,7 +237,7 @@ begin
Sending := Document.Size > 0;
{Headers for Sending data}
status100 := Sending and (FProtocol = '1.1');
status100 := FStatus100 and Sending and (FProtocol = '1.1');
if status100 then
FHeaders.Insert(0, 'Expect: 100-continue');
if Sending then
@ -247,12 +264,16 @@ begin
if (FProxyHost <> '') and (FProxyUser <> '') and not(HttpTunnel) then
FHeaders.Insert(0, 'Proxy-Authorization: Basic ' +
EncodeBase64(FProxyUser + ':' + FProxyPass));
if Port<>'80' then
FHeaders.Insert(0, 'Host: ' + Host + ':' + Port)
if isIP6(Host) then
s := '[' + Host + ']'
else
FHeaders.Insert(0, 'Host: ' + Host);
s := Host;
if Port<>'80' then
FHeaders.Insert(0, 'Host: ' + s + ':' + Port)
else
FHeaders.Insert(0, 'Host: ' + s);
if (FProxyHost <> '') and not(HttpTunnel)then
URI := Prot + '://' + Host + ':' + Port + URI;
URI := Prot + '://' + s + ':' + Port + URI;
if URI = '/*' then
URI := '*';
if FProtocol = '0.9' then
@ -276,10 +297,21 @@ begin
if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort) then
begin
FSock.CloseSocket;
FSock.CreateSocket;
FSock.Bind(FIPInterface, cAnyPort);
if FSock.LastError <> 0 then
Exit;
{$IFDEF STREAMSEC}
FSock.TLSServer := nil;
if UpperCase(Prot) = 'HTTPS' then
if assigned(FTLSServer) then
FSock.TLSServer := FTLSServer
else
exit;
{$ELSE}
FSock.SSLEnabled := UpperCase(Prot) = 'HTTPS';
{$ENDIF}
if FSock.LastError <> 0 then
Exit;
FSock.Connect(FTargetHost, FTargetPort);
if FSock.LastError <> 0 then
Exit;
@ -291,10 +323,21 @@ begin
if FSock.CanRead(0) then
begin
FSock.CloseSocket;
FSock.CreateSocket;
FSock.Bind(FIPInterface, cAnyPort);
if FSock.LastError <> 0 then
Exit;
{$IFDEF STREAMSEC}
FSock.TLSServer := nil;
if UpperCase(Prot) = 'HTTPS' then
if assigned(FTLSServer) then
FSock.TLSServer := FTLSServer
else
exit;
{$ELSE}
FSock.SSLEnabled := UpperCase(Prot) = 'HTTPS';
{$ENDIF}
if FSock.LastError <> 0 then
Exit;
FSock.Connect(FTargetHost, FTargetPort);
if FSock.LastError <> 0 then
Exit;

112
imapsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.002.002 |
| Project : Delphree - Synapse | 002.003.005 |
|==============================================================================|
| Content: IMAP4rev1 client |
|==============================================================================|
@ -42,8 +42,6 @@
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{$WEAKPACKAGEUNIT ON}
//RFC-2060
//RFC-2595
@ -53,6 +51,9 @@ interface
uses
SysUtils, Classes,
{$IFDEF STREAMSEC}
TlsInternalServer, TlsSynaSock,
{$ENDIF}
blcksock, SynaUtil, SynaCode;
const
@ -61,7 +62,12 @@ const
type
TIMAPSend = class(TSynaClient)
private
{$IFDEF STREAMSEC}
FSock: TSsTCPBlockSocket;
FTLSServer: TCustomTLSInternalServer;
{$ELSE}
FSock: TTCPBlockSocket;
{$ENDIF}
FTagCommand: integer;
FResultString: string;
FFullResult: TStringList;
@ -83,6 +89,7 @@ type
procedure ParseFolderList(Value:TStrings);
procedure ParseSelect;
procedure ParseSearch(Value:TStrings);
procedure ProcessLiterals;
public
constructor Create;
destructor Destroy; override;
@ -125,13 +132,18 @@ type
property Password: string read FPassword Write FPassword;
property AuthDone: Boolean read FAuthDone;
property UID: Boolean read FUID Write FUID;
property Sock: TTCPBlockSocket read FSock;
property SelectedFolder: string read FSelectedFolder;
property SelectedCount: integer read FSelectedCount;
property SelectedRecent: integer read FSelectedRecent;
property SelectedUIDvalidity: integer read FSelectedUIDvalidity;
property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
property FullSSL: Boolean read FFullSSL Write FFullSSL;
{$IFDEF STREAMSEC}
property Sock: TSsTCPBlockSocket read FSock;
property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
{$ELSE}
property Sock: TTCPBlockSocket read FSock;
{$ENDIF}
end;
implementation
@ -141,12 +153,17 @@ begin
inherited Create;
FFullResult := TStringList.Create;
FIMAPcap := TStringList.Create;
{$IFDEF STREAMSEC}
FTLSServer := GlobalTLSInternalServer;
FSock := TSsTCPBlockSocket.Create;
FSock.BlockingRead := True;
{$ELSE}
FSock := TTCPBlockSocket.Create;
{$ENDIF}
FSock.ConvertLineEnd := True;
FSock.CreateSocket;
FSock.SizeRecvBuffer := 32768;
FSock.SizeSendBuffer := 32768;
FTimeout := 300000;
FTimeout := 60000;
FTargetPort := cIMAPProtocol;
FUsername := '';
FPassword := '';
@ -203,6 +220,47 @@ begin
Result:=uppercase(separateleft(s, ' '));
end;
procedure TIMAPSend.ProcessLiterals;
var
l: TStringList;
n, x: integer;
b: integer;
s: string;
begin
l := TStringList.Create;
try
l.Assign(FFullResult);
FFullResult.Clear;
b := 0;
for n := 0 to l.Count - 1 do
begin
s := l[n];
if b > 0 then
begin
FFullResult[FFullresult.Count - 1] :=
FFullResult[FFullresult.Count - 1] + s;
inc(b);
if b > 2 then
b := 0;
end
else
begin
if (s <> '') and (s[Length(s)]='}') then
begin
x := RPos('{', s);
Delete(s, x, Length(s) - x + 1);
b := 1;
end
else
b := 0;
FFullResult.Add(s);
end;
end;
finally
l.Free;
end;
end;
function TIMAPSend.IMAPcommand(Value: string): string;
begin
Inc(FTagCommand);
@ -240,6 +298,7 @@ var
n, x: integer;
s: string;
begin
ProcessLiterals;
Value.Clear;
for n := 0 to FFullResult.Count - 1 do
begin
@ -264,6 +323,7 @@ var
n: integer;
s, t: string;
begin
ProcessLiterals;
FSelectedCount := 0;
FSelectedRecent := 0;
FSelectedUIDvalidity := 0;
@ -296,6 +356,7 @@ var
n: integer;
s: string;
begin
ProcessLiterals;
Value.Clear;
for n := 0 to FFullResult.Count - 1 do
begin
@ -326,16 +387,31 @@ end;
function TIMAPSend.AuthLogin: Boolean;
begin
Result := IMAPcommand('LOGIN ' + FUsername + ' ' + FPassword) = 'OK';
Result := IMAPcommand('LOGIN "' + FUsername + '" "' + FPassword + '"') = 'OK';
end;
function TIMAPSend.Connect: Boolean;
begin
FSock.CloseSocket;
FSock.CreateSocket;
FSock.Bind(FIPInterface, cAnyPort);
{$IFDEF STREAMSEC}
if FFullSSL then
begin
if assigned(FTLSServer) then
FSock.TLSServer := FTLSServer
else
begin
Result := false;
exit;
end;
end
else
FSock.TLSServer := nil;
{$ELSE}
if FFullSSL then
FSock.SSLEnabled := True;
FSock.Bind(FIPInterface, cAnyPort);
{$ENDIF}
if FSock.LastError = 0 then
FSock.Connect(FTargetHost, FTargetPort);
Result := FSock.LastError = 0;
end;
@ -350,6 +426,7 @@ begin
s := IMAPcommand('CAPABILITY');
if s = 'OK' then
begin
ProcessLiterals;
for n := 0 to FFullResult.Count - 1 do
if Pos('* CAPABILITY ', FFullResult[n]) = 1 then
begin
@ -475,10 +552,12 @@ begin
Result := -1;
Value := Uppercase(Value);
if IMAPcommand('STATUS "' + FolderName + '" (' + Value + ')' ) = 'OK' then
begin
ProcessLiterals;
for n := 0 to FFullResult.Count - 1 do
begin
s := UpperCase(FFullResult[n]);
if (Pos(FolderName, s) >= 1) and (Pos(Value, s) > 0 ) then
if (Pos('* ', s) = 1) and (Pos(FolderName, s) >= 1) and (Pos(Value, s) > 0 ) then
begin
t := SeparateRight(s, Value);
t := SeparateLeft(t, ')');
@ -487,6 +566,7 @@ begin
Break;
end;
end;
end;
end;
function TIMAPSend.ExpungeFolder: Boolean;
@ -546,6 +626,8 @@ begin
if FUID then
s := 'UID ' + s;
if IMAPcommand(s) = 'OK' then
begin
ProcessLiterals;
for n := 0 to FFullResult.Count - 1 do
begin
s := UpperCase(FFullResult[n]);
@ -558,6 +640,7 @@ begin
Break;
end;
end;
end;
end;
function TIMAPSend.CopyMess(MessID: integer; ToFolder: string): Boolean;
@ -601,6 +684,7 @@ begin
if FUID then
s := 'UID ' + s;
Result := IMAPcommand(s) = 'OK';
ProcessLiterals;
for n := 0 to FFullResult.Count - 1 do
begin
s := uppercase(FFullResult[n]);
@ -620,7 +704,14 @@ begin
begin
if IMAPcommand('STARTTLS') = 'OK' then
begin
{$IFDEF STREAMSEC}
if not assigned(FTLSServer) then
Exit;
Fsock.TLSServer := FTLSServer;
FSock.Connect('','');
{$ELSE}
Fsock.SSLDoConnect;
{$ENDIF}
Result := FSock.LastError = 0;
end;
end;
@ -635,6 +726,7 @@ begin
sUID := '';
s := 'FETCH ' + IntToStr(MessID) + ' UID';
Result := IMAPcommand(s) = 'OK';
ProcessLiterals;
for n := 0 to FFullResult.Count - 1 do
begin
s := uppercase(FFullResult[n]);

7
mimeinln.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.005 |
| Project : Delphree - Synapse | 001.000.007 |
|==============================================================================|
| Content: Inline MIME support procedures and functions |
|==============================================================================|
@ -42,8 +42,6 @@
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{$WEAKPACKAGEUNIT ON}
unit MIMEinLn;
interface
@ -92,6 +90,9 @@ begin
v := Value;
x := Pos('=?', v);
y := SearchEndInline(v, x);
//fix for broken coding with begin, but not with end.
if (x > 0) and (y <= 0) then
y := Length(Result);
while (y > x) and (x > 0) do
begin
s := Copy(v, 1, x - 1);

4
mimemess.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.001.002 |
| Project : Delphree - Synapse | 002.001.003 |
|==============================================================================|
| Content: MIME message object |
|==============================================================================|
@ -42,8 +42,6 @@
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{$WEAKPACKAGEUNIT ON}
unit MIMEmess;
interface

7
mimepart.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.003.002 |
| Project : Delphree - Synapse | 002.003.004 |
|==============================================================================|
| Content: MIME support procedures and functions |
|==============================================================================|
@ -695,7 +695,8 @@ begin
s := CharsetConversion(s, FTargetCharset, FCharsetCode);
if FEncodingCode = ME_QUOTED_PRINTABLE then
begin
s := EncodeQuotedPrintable(s);
s := EncodeTriplet(s, '=', [Char(1)..Char(31), '=', Char(128)..Char(255)]);
// s := EncodeQuotedPrintable(s);
repeat
if Length(s) < FMaxLineLength then
begin
@ -813,7 +814,7 @@ begin
if Primary = '' then
Primary := 'application';
if FSecondary = '' then
FSecondary := 'octet-string';
FSecondary := 'octet-stream';
end;
{==============================================================================}

107
nntpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.002.003 |
| Project : Delphree - Synapse | 001.003.001 |
|==============================================================================|
| Content: NNTP client |
|==============================================================================|
@ -42,14 +42,15 @@
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{$WEAKPACKAGEUNIT ON}
unit NNTPsend;
interface
uses
SysUtils, Classes,
{$IFDEF STREAMSEC}
TlsInternalServer, TlsSynaSock,
{$ENDIF}
blcksock, SynaUtil, SynaCode;
const
@ -58,13 +59,21 @@ const
type
TNNTPSend = class(TSynaClient)
private
{$IFDEF STREAMSEC}
FSock: TSsTCPBlockSocket;
FTLSServer: TCustomTLSInternalServer;
{$ELSE}
FSock: TTCPBlockSocket;
{$ENDIF}
FResultCode: Integer;
FResultString: string;
FData: TStringList;
FDataToSend: TStringList;
FUsername: string;
FPassword: string;
FAutoTLS: Boolean;
FFullSSL: Boolean;
FNNTPcap: TStringList;
function ReadResult: Integer;
function ReadData: boolean;
function SendData: boolean;
@ -91,13 +100,23 @@ type
function PostArticle: Boolean;
function SwitchToSlave: Boolean;
function Xover(xoStart, xoEnd: string): boolean;
function StartTLS: Boolean;
function FindCap(const Value: string): string;
function ListExtensions: Boolean;
published
property Username: string read FUsername write FUsername;
property Password: string read FPassword write FPassword;
property ResultCode: Integer read FResultCode;
property ResultString: string read FResultString;
property Data: TStringList read FData;
property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
property FullSSL: Boolean read FFullSSL Write FFullSSL;
{$IFDEF STREAMSEC}
property Sock: TSsTCPBlockSocket read FSock;
property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
{$ELSE}
property Sock: TTCPBlockSocket read FSock;
{$ENDIF}
end;
implementation
@ -105,14 +124,23 @@ implementation
constructor TNNTPSend.Create;
begin
inherited Create;
{$IFDEF STREAMSEC}
FTLSServer := GlobalTLSInternalServer;
FSock := TSsTCPBlockSocket.Create;
FSock.BlockingRead := True;
{$ELSE}
FSock := TTCPBlockSocket.Create;
{$ENDIF}
FData := TStringList.Create;
FDataToSend := TStringList.Create;
FSock := TTCPBlockSocket.Create;
FNNTPcap := TStringList.Create;
FSock.ConvertLineEnd := True;
FTimeout := 300000;
FTimeout := 60000;
FTargetPort := cNNTPProtocol;
FUsername := '';
FPassword := '';
FAutoTLS := False;
FFullSSL := False;
end;
destructor TNNTPSend.Destroy;
@ -120,6 +148,7 @@ begin
FSock.Free;
FDataToSend.Free;
FData.Free;
FNNTPcap.Free;
inherited Destroy;
end;
@ -179,6 +208,24 @@ function TNNTPSend.Connect: Boolean;
begin
FSock.CloseSocket;
FSock.Bind(FIPInterface, cAnyPort);
{$IFDEF STREAMSEC}
if FFullSSL then
begin
if assigned(FTLSServer) then
FSock.TLSServer := FTLSServer;
else
begin
result := False;
Exit;
end;
end
else
FSock.TLSServer := nil;
{$ELSE}
if FFullSSL then
FSock.SSLEnabled := True;
{$ENDIF}
if FSock.LastError = 0 then
FSock.Connect(FTargetHost, FTargetPort);
Result := FSock.LastError = 0;
end;
@ -186,9 +233,15 @@ end;
function TNNTPSend.Login: Boolean;
begin
Result := False;
FNNTPcap.Clear;
if not Connect then
Exit;
Result := (ReadResult div 100) = 2;
ListExtensions;
FNNTPcap.Assign(Fdata);
if result then
if (not FullSSL) and FAutoTLS and (FindCap('STARTTLS') <> '') then
result := StartTLS;
if (FUsername <> '') and Result then
begin
FSock.SendString('AUTHINFO USER ' + FUsername + CRLF);
@ -335,6 +388,50 @@ begin
Result := DoCommandRead(s);
end;
function TNNTPSend.StartTLS: Boolean;
begin
Result := False;
if FindCap('STARTTLS') <> '' then
begin
if DoCommand('STARTTLS') then
begin
{$IFDEF STREAMSEC}
if (Assigned(FTLSServer) then
begin
Fsock.TLSServer := FTLSServer;
Fsock.Connect('','');
Result := FSock.LastError = 0;
end
else
Result := False;
{$ELSE}
Fsock.SSLDoConnect;
Result := FSock.LastError = 0;
{$ENDIF}
end;
end;
end;
function TNNTPSend.ListExtensions: Boolean;
begin
Result := DoCommandRead('LIST EXTENSIONS');
end;
function TNNTPSend.FindCap(const Value: string): string;
var
n: Integer;
s: string;
begin
s := UpperCase(Value);
Result := '';
for n := 0 to FNNTPcap.Count - 1 do
if Pos(s, UpperCase(FNNTPcap[n])) = 1 then
begin
Result := FNNTPcap[n];
Break;
end;
end;
{==============================================================================}
end.

120
pingsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.003.001 |
| Project : Delphree - Synapse | 003.000.002 |
|==============================================================================|
| Content: PING sender |
|==============================================================================|
@ -42,14 +42,8 @@
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
See 'winsock2.txt' file in distribute package!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
}
{$Q-}
{$WEAKPACKAGEUNIT ON}
{$R-}
unit PINGsend;
@ -67,6 +61,8 @@ uses
const
ICMP_ECHO = 8;
ICMP_ECHOREPLY = 0;
ICMP6_ECHO = 128;
ICMP6_ECHOREPLY = 129;
type
TIcmpEchoHeader = record
@ -75,7 +71,17 @@ type
i_checkSum: Word;
i_Id: Word;
i_seq: Word;
TimeStamp: ULONG;
TimeStamp: ULong;
end;
TICMP6Packet = record
in_source: TInAddr6;
in_dest: TInAddr6;
Length: integer;
free0: Byte;
free1: Byte;
free2: Byte;
proto: Byte;
end;
TPINGSend = class(TSynaClient)
@ -86,7 +92,10 @@ type
FId: Integer;
FPacketSize: Integer;
FPingTime: Integer;
function Checksum: Integer;
FIcmpEcho: Byte;
FIcmpEchoReply: Byte;
function Checksum(Value: string): Word;
function Checksum6(Value: string): Word;
function ReadPacket: Boolean;
public
function Ping(const Host: string): Boolean;
@ -108,7 +117,6 @@ constructor TPINGSend.Create;
begin
inherited Create;
FSock := TICMPBlockSocket.Create;
FSock.CreateSocket;
FTimeout := 5000;
FPacketSize := 32;
FSeq := 0;
@ -136,13 +144,27 @@ var
t: Boolean;
begin
Result := False;
FPingTime := -1;
FSock.Bind(FIPInterface, cAnyPort);
FSock.Connect(Host, '0');
if FSock.LastError <> 0 then
Exit;
FSock.SizeRecvBuffer := 60 * 1024;
if FSock.IP6used then
begin
FIcmpEcho := ICMP6_ECHO;
FIcmpEchoReply := ICMP6_ECHOREPLY;
end
else
begin
FIcmpEcho := ICMP_ECHO;
FIcmpEchoReply := ICMP_ECHOREPLY;
end;
FBuffer := StringOfChar(#0, SizeOf(TICMPEchoHeader) + FPacketSize);
IcmpEchoHeaderPtr := Pointer(FBuffer);
with IcmpEchoHeaderPtr^ do
begin
i_type := ICMP_ECHO;
i_type := FIcmpEcho;
i_code := 0;
i_CheckSum := 0;
FId := Random(32767);
@ -152,28 +174,43 @@ begin
i_Seq := FSeq;
for n := Succ(SizeOf(TIcmpEchoHeader)) to Length(FBuffer) do
FBuffer[n] := #$55;
i_CheckSum := CheckSum;
end;
if fSock.IP6used then
IcmpEchoHeaderPtr^.i_CheckSum := CheckSum6(FBuffer)
else
IcmpEchoHeaderPtr^.i_CheckSum := CheckSum(FBuffer);
FSock.SendString(FBuffer);
repeat
t := ReadPacket;
if not t then
break;
if fSock.IP6used then
begin
{$IFDEF LINUX}
IcmpEchoHeaderPtr := Pointer(FBuffer);
{$ELSE}
FBuffer := StringOfChar(#0, 4) + FBuffer;
IcmpEchoHeaderPtr := Pointer(FBuffer);
IcmpEchoHeaderPtr^.i_type := FIcmpEchoReply;
{$ENDIF}
end
else
begin
IPHeadPtr := Pointer(FBuffer);
IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4;
IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1];
until (IcmpEchoHeaderPtr^.i_type <> ICMP_ECHO) and (IcmpEchoHeaderPtr^.i_id = FId);
end;
until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho) and (IcmpEchoHeaderPtr^.i_id = FId);
//it discard sometimes possible 'echoes' of previosly sended packet...
if t then
if (IcmpEchoHeaderPtr^.i_type = ICMP_ECHOREPLY) then
if (IcmpEchoHeaderPtr^.i_id = FId) then
if (IcmpEchoHeaderPtr^.i_type = FIcmpEchoReply) then
begin
FPingTime := GetTick - IcmpEchoHeaderPtr^.TimeStamp;
FPingTime := TickDelta(IcmpEchoHeaderPtr^.TimeStamp, GetTick);
Result := True;
end;
end;
function TPINGSend.Checksum: Integer;
function TPINGSend.Checksum(Value: string): Word;
type
TWordArray = array[0..0] of Word;
var
@ -182,29 +219,60 @@ var
Num, Remain: Integer;
n: Integer;
begin
Num := Length(FBuffer) div 2;
Remain := Length(FBuffer) mod 2;
WordArr := Pointer(FBuffer);
Num := Length(Value) div 2;
Remain := Length(Value) mod 2;
WordArr := Pointer(Value);
CkSum := 0;
for n := 0 to Num - 1 do
CkSum := CkSum + WordArr^[n];
if Remain <> 0 then
CkSum := CkSum + Ord(FBuffer[Length(FBuffer)]);
CkSum := CkSum + Ord(Value[Length(Value)]);
CkSum := (CkSum shr 16) + (CkSum and $FFFF);
CkSum := CkSum + (CkSum shr 16);
Result := Word(not CkSum);
end;
function TPINGSend.Checksum6(Value: string): Word;
const
IOC_OUT = $40000000;
IOC_IN = $80000000;
IOC_INOUT = (IOC_IN or IOC_OUT);
IOC_WS2 = $08000000;
SIO_ROUTING_INTERFACE_QUERY = 20 or IOC_WS2 or IOC_INOUT;
var
ICMP6Ptr: ^TICMP6Packet;
s: string;
b: integer;
ip6: TSockAddrIn6;
x: integer;
begin
{$IFDEF LINUX}
Result := 0;
{$ELSE}
s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value;
ICMP6Ptr := Pointer(s);
x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY,
@FSock.RemoteSin.IP6, SizeOf(FSock.RemoteSin.IP6),
@ip6, SizeOf(ip6), @b, nil, nil);
if x <> -1 then
ICMP6Ptr^.in_dest := ip6.sin6_addr
else
ICMP6Ptr^.in_dest := FSock.LocalSin.IP6.sin6_addr;
ICMP6Ptr^.in_source := FSock.RemoteSin.IP6.sin6_addr;
ICMP6Ptr^.Length := synsock.htonl(Length(Value));
ICMP6Ptr^.proto := IPPROTO_ICMPV6;
Result := Checksum(s);
{$ENDIF}
end;
{==============================================================================}
function PingHost(const Host: string): Integer;
begin
with TPINGSend.Create do
try
if Ping(Host) then
Result := PingTime
else
Result := -1;
Ping(Host);
Result := PingTime;
finally
Free;
end;

58
pop3send.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.001.004 |
| Project : Delphree - Synapse | 002.001.008 |
|==============================================================================|
| Content: POP3 client |
|==============================================================================|
@ -42,8 +42,6 @@
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{$WEAKPACKAGEUNIT ON}
//RFC-1734
//RFC-1939
//RFC-2195
@ -56,6 +54,9 @@ interface
uses
SysUtils, Classes,
{$IFDEF STREAMSEC}
TlsInternalServer, TlsSynaSock,
{$ENDIF}
blcksock, SynaUtil, SynaCode;
const
@ -66,7 +67,12 @@ type
TPOP3Send = class(TSynaClient)
private
{$IFDEF STREAMSEC}
FSock: TSsTCPBlockSocket;
FTLSServer: TCustomTLSInternalServer;
{$ELSE}
FSock: TTCPBlockSocket;
{$ENDIF}
FResultCode: Integer;
FResultString: string;
FFullResult: TStringList;
@ -109,9 +115,14 @@ type
property StatSize: Integer read FStatSize;
property TimeStamp: string read FTimeStamp;
property AuthType: TPOP3AuthType read FAuthType Write FAuthType;
property Sock: TTCPBlockSocket read FSock;
property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
property FullSSL: Boolean read FFullSSL Write FFullSSL;
{$IFDEF STREAMSEC}
property Sock: TSsTCPBlockSocket read FSock;
property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
{$ELSE}
property Sock: TTCPBlockSocket read FSock;
{$ENDIF}
end;
implementation
@ -121,10 +132,15 @@ begin
inherited Create;
FFullResult := TStringList.Create;
FPOP3cap := TStringList.Create;
{$IFDEF STREAMSEC}
FTLSServer := GlobalTLSInternalServer;
FSock := TSsTCPBlockSocket.Create;
FSock.BlockingRead := True;
{$ELSE}
FSock := TTCPBlockSocket.Create;
FSock.CreateSocket;
{$ENDIF}
FSock.ConvertLineEnd := true;
FTimeout := 300000;
FTimeout := 60000;
FTargetPort := cPop3Protocol;
FUsername := '';
FPassword := '';
@ -192,10 +208,25 @@ begin
FStatSize := 0;
FSock.CloseSocket;
FSock.LineBuffer := '';
FSock.CreateSocket;
FSock.Bind(FIPInterface, cAnyPort);
{$IFDEF STREAMSEC}
if FFullSSL then
begin
if Assigned(FTLSServer) then
FSock.TLSServer := FTLSServer
else
begin
Result := false;
Exit;
end;
end
else
FSock.TLSServer := nil;
{$ELSE}
if FFullSSL then
FSock.SSLEnabled := True;
FSock.Bind(FIPInterface, cAnyPort);
{$ENDIF}
if FSock.LastError = 0 then
FSock.Connect(FTargetHost, FTargetPort);
Result := FSock.LastError = 0;
end;
@ -321,8 +352,19 @@ begin
FSock.SendString('STLS' + CRLF);
if ReadResult(False) = 1 then
begin
{$IFDEF STREAMSEC}
if Assigned(FTLSServer) then
begin
Fsock.TLSServer := FTLSServer;
Fsock.Connect('','');
Result := FSock.LastError = 0;
end
else
Result := false;
{$ELSE}
Fsock.SSLDoConnect;
Result := FSock.LastError = 0;
{$ENDIF}
end;
end;

11
slogsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.001.001 |
| Project : Delphree - Synapse | 001.001.004 |
|==============================================================================|
| Content: SysLog client |
|==============================================================================|
@ -45,7 +45,6 @@
// RFC-3164
{$Q-}
{$WEAKPACKAGEUNIT ON}
unit SLogSend;
@ -114,13 +113,11 @@ constructor TSyslogSend.Create;
begin
inherited Create;
FSock := TUDPBlockSocket.Create;
FSock.CreateSocket;
FTargetPort := cSysLogProtocol;
FFacility := FCL_Local0;
FSeverity := Debug;
FTag := ExtractFileName(ParamStr(0));
FMessage := '';
FIPInterface := cAnyHost;
end;
destructor TSyslogSend.Destroy;
@ -152,9 +149,9 @@ begin
Buf := Buf + Tag + ': ' + FMessage;
if Length(Buf) <= 1024 then
begin
if FSock.EnableReuse(True) then
Fsock.Bind(FIPInterface, FTargetPort)
else
FSock.EnableReuse(True);
Fsock.Bind(FIPInterface, FTargetPort);
if FSock.LastError <> 0 then
FSock.Bind(FIPInterface, cAnyPort);
FSock.Connect(FTargetHost, FTargetPort);
FSock.SendString(Buf);

58
smtpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 003.002.004 |
| Project : Delphree - Synapse | 003.002.008 |
|==============================================================================|
| Content: SMTP client |
|==============================================================================|
@ -42,14 +42,15 @@
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{$WEAKPACKAGEUNIT ON}
unit SMTPsend;
interface
uses
SysUtils, Classes,
{$IFDEF STREAMSEC}
TlsInternalServer, TlsSynaSock,
{$ENDIF}
blcksock, SynaUtil, SynaCode;
const
@ -58,7 +59,12 @@ const
type
TSMTPSend = class(TSynaClient)
private
{$IFDEF STREAMSEC}
FSock: TSsTCPBlockSocket;
FTLSServer: TCustomTLSInternalServer;
{$ELSE}
FSock: TTCPBlockSocket;
{$ENDIF}
FResultCode: Integer;
FResultString: string;
FFullResult: TStringList;
@ -112,9 +118,14 @@ type
property EnhCode2: Integer read FEnhCode2;
property EnhCode3: Integer read FEnhCode3;
property SystemName: string read FSystemName Write FSystemName;
property Sock: TTCPBlockSocket read FSock;
property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
property FullSSL: Boolean read FFullSSL Write FFullSSL;
{$IFDEF STREAMSEC}
property Sock: TSsTCPBlockSocket read FSock;
property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
{$ELSE}
property Sock: TTCPBlockSocket read FSock;
{$ENDIF}
end;
function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
@ -131,10 +142,15 @@ begin
inherited Create;
FFullResult := TStringList.Create;
FESMTPcap := TStringList.Create;
{$IFDEF STREAMSEC}
FTLSServer := GlobalTLSInternalServer;
FSock := TSsTCPBlockSocket.Create;
FSock.BlockingRead := True;
{$ELSE}
FSock := TTCPBlockSocket.Create;
FSock.CreateSocket;
{$ENDIF}
FSock.ConvertLineEnd := true;
FTimeout := 300000;
FTimeout := 60000;
FTargetPort := cSmtpProtocol;
FUsername := '';
FPassword := '';
@ -239,10 +255,25 @@ end;
function TSMTPSend.Connect: Boolean;
begin
FSock.CloseSocket;
FSock.CreateSocket;
FSock.Bind(FIPInterface, cAnyPort);
{$IFDEF STREAMSEC}
if FFullSSL then
begin
if assigned(FTLSServer) then
FSock.TLSServer := FTLSServer;
else
begin
result := False;
Exit;
end;
end
else
FSock.TLSServer := nil;
{$ELSE}
if FFullSSL then
FSock.SSLEnabled := True;
FSock.Bind(FIPInterface, cAnyPort);
{$ENDIF}
if FSock.LastError = 0 then
FSock.Connect(FTargetHost, FTargetPort);
Result := FSock.LastError = 0;
end;
@ -406,8 +437,19 @@ begin
FSock.SendString('STARTTLS' + CRLF);
if (ReadResult = 220) and (FSock.LastError = 0) then
begin
{$IFDEF STREAMSEC}
if (Assigned(FTLSServer) then
begin
Fsock.TLSServer := FTLSServer;
Fsock.Connect('','');
Result := FSock.LastError = 0;
end
else
Result := False;
{$ELSE}
Fsock.SSLDoConnect;
Result := FSock.LastError = 0;
{$ENDIF}
end;
end;
end;

4
snmpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.006.000 |
| Project : Delphree - Synapse | 002.006.002 |
|==============================================================================|
| Content: SNMP client |
|==============================================================================|
@ -44,7 +44,6 @@
|==============================================================================}
{$Q-}
{$WEAKPACKAGEUNIT ON}
unit SNMPSend;
@ -308,7 +307,6 @@ begin
FQuery.Clear;
FReply.Clear;
FSock := TUDPBlockSocket.Create;
FSock.CreateSocket;
FTimeout := 5000;
FTargetPort := cSnmpProtocol;
FHostIP := '';

4
snmptrap.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.003.000 |
| Project : Delphree - Synapse | 002.003.002 |
|==============================================================================|
| Content: SNMP traps |
|==============================================================================|
@ -44,7 +44,6 @@
|==============================================================================}
{$Q-}
{$WEAKPACKAGEUNIT ON}
unit SNMPTrap;
@ -272,7 +271,6 @@ constructor TTrapSNMP.Create;
begin
inherited Create;
FSock := TUDPBlockSocket.Create;
FSock.CreateSocket;
FTrap := TTrapPDU.Create;
FTimeout := 5000;
FTargetPort := cSnmpTrapProtocol;

4
sntpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.002.001 |
| Project : Delphree - Synapse | 002.002.003 |
|==============================================================================|
| Content: SNTP client |
|==============================================================================|
@ -44,7 +44,6 @@
|==============================================================================}
{$Q-}
{$WEAKPACKAGEUNIT ON}
unit SNTPsend;
@ -112,7 +111,6 @@ constructor TSNTPSend.Create;
begin
inherited Create;
FSock := TUDPBlockSocket.Create;
FSock.CreateSocket;
FTimeout := 5000;
FTargetPort := cNtpProtocol;
FMaxSyncDiff := 3600;

93
synachar.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 004.000.003 |
| Project : Delphree - Synapse | 004.000.005 |
|==============================================================================|
| Content: Charset conversion support |
|==============================================================================|
@ -43,7 +43,6 @@
|==============================================================================}
{$Q-}
{$WEAKPACKAGEUNIT ON}
unit SynaChar;
@ -797,51 +796,71 @@ end;
{==============================================================================}
procedure ReadMulti(const Value: string; var Index: Integer; mb: Byte;
var b1, b2, b3, b4: Byte);
var
b: array[0..3] of Byte;
n: Integer;
s: string;
begin
b[0] := 0;
b[1] := 0;
b[2] := 0;
b[3] := 0;
Begin
b1 := 0;
b2 := 0;
b3 := 0;
b4 := 0;
if length(Value) < (Index + mb - 1) then
if Index < 0 then
Index := 1;
if mb > 4 then
mb := 1;
if (Index + mb - 1) <= Length(Value) then
begin
Inc(index, mb);
Exit;
Case mb Of
1:
b1 := Ord(Value[Index]);
2:
Begin
b1 := Ord(Value[Index]);
b2 := Ord(Value[Index + 1]);
End;
3:
Begin
b1 := Ord(Value[Index]);
b2 := Ord(Value[Index + 1]);
b3 := Ord(Value[Index + 2]);
End;
4:
Begin
b1 := Ord(Value[Index]);
b2 := Ord(Value[Index + 1]);
b3 := Ord(Value[Index + 2]);
b4 := Ord(Value[Index + 3]);
End;
end;
s := '';
for n := 1 to mb do
begin
s := Value[Index] + s;
Inc(Index);
end;
for n := 1 to mb do
b[n - 1] := Ord(s[n]);
b1 := b[0];
b2 := b[1];
b3 := b[2];
b4 := b[3];
end;
Inc(Index, mb);
End;
End;
{==============================================================================}
function WriteMulti(b1, b2, b3, b4: Byte; mb: Byte): string;
var
b: array[0..3] of Byte;
n: Integer;
begin
Result := '';
b[0] := b1;
b[1] := b2;
b[2] := b3;
b[3] := b4;
for n := 1 to mb do
Result := Char(b[n - 1]) + Result;
if mb > 4 then
mb := 1;
SetLength(Result, mb);
case mb Of
1:
Result[1] := Char(b1);
2:
begin
Result[1] := Char(b1);
Result[2] := Char(b2);
end;
3:
begin
Result[1] := Char(b1);
Result[2] := Char(b2);
Result[3] := Char(b3);
end;
4:
begin
Result[1] := Char(b1);
Result[2] := Char(b2);
Result[3] := Char(b3);
Result[4] := Char(b4);
end;
end;
end;
{==============================================================================}

28
synacode.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.006.001 |
| Project : Delphree - Synapse | 001.007.001 |
|==============================================================================|
| Content: Coding and decoding support |
|==============================================================================|
@ -43,7 +43,6 @@
|==============================================================================}
{$Q-}
{$WEAKPACKAGEUNIT ON}
unit SynaCode;
@ -115,6 +114,7 @@ function EncodeBase64(const Value: string): string;
function DecodeUU(const Value: string): string;
function EncodeUU(const Value: string): string;
function DecodeXX(const Value: string): string;
function DecodeYEnc(const Value: string): string;
function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
function Crc32(const Value: string): Integer;
function UpdateCrc16(Value: Byte; Crc16: Word): Word;
@ -559,6 +559,30 @@ end;
{==============================================================================}
function DecodeYEnc(const Value: string): string;
var
C : Byte;
i: integer;
begin
Result := '';
i := 1;
while i <= Length(Value) do
begin
c := Ord(Value[i]);
Inc(i);
if c = Ord('=') then
begin
c := Ord(Value[i]);
Inc(i);
Dec(c, 64);
end;
Dec(C, 42);
Result := Result + Char(C);
end;
end;
{==============================================================================}
function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
begin
Result := ((Crc32 shr 8) and Integer($00FFFFFF)) xor

10
synamisc.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.004 |
| Project : Delphree - Synapse | 001.000.006 |
|==============================================================================|
| Content: misc. procedures and functions |
|==============================================================================|
@ -48,6 +48,14 @@ unit SynaMisc;
interface
{$IFDEF VER125}
{$DEFINE BCB}
{$ENDIF}
{$IFDEF BCB}
{$ObjExportAll On}
{$HPPEMIT '#pragma comment( lib , "wininet.lib" )'}
{$ENDIF}
uses
SynaUtil, blcksock, SysUtils, Classes,
{$IFDEF LINUX}

10
synassl.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.007.000 |
| Project : Delphree - Synapse | 001.007.001 |
|==============================================================================|
| Content: SSL support |
|==============================================================================|
@ -47,6 +47,14 @@ Special thanks to Gregor Ibic <gregor.ibic@intelicom.si>
for good inspiration about SSL programming.
}
{$IFDEF VER125}
{$DEFINE BCB}
{$ENDIF}
{$IFDEF BCB}
{$ObjExportAll On}
(*$HPPEMIT 'namespace Synassl { using System::Shortint; }' *)
{$ENDIF}
unit SynaSSL;
interface

96
synautil.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 003.003.000 |
| Project : Delphree - Synapse | 003.005.001 |
|==============================================================================|
| Content: support procedures and functions |
|==============================================================================|
@ -45,6 +45,7 @@
|==============================================================================}
{$Q-}
{$R-}
unit SynaUtil;
@ -70,11 +71,12 @@ function GetDateMDYFromStr(Value: string): TDateTime;
function DecodeRfcDateTime(Value: string): TDateTime;
function GetUTTime: TDateTime;
function SetUTTime(Newdt: TDateTime): Boolean;
function GetTick: Cardinal;
function GetTick: ULong;
function TickDelta(TickOld, TickNew: ULong): ULong;
function CodeInt(Value: Word): string;
function DecodeInt(const Value: string; Index: Integer): Word;
function IsIP(const Value: string): Boolean;
function ReverseIP(Value: string): string;
function IsIP6(const Value: string): Boolean;
function IPToID(Host: string): string;
procedure Dump(const Buffer, DumpFile: string);
procedure DumpEx(const Buffer, DumpFile: string);
@ -479,7 +481,7 @@ end;
{==============================================================================}
{$IFDEF LINUX}
function GetTick: Cardinal;
function GetTick: ULong;
var
Stamp: TTimeStamp;
begin
@ -487,7 +489,7 @@ begin
Result := Stamp.Time;
end;
{$ELSE}
function GetTick: Cardinal;
function GetTick: ULong;
begin
Result := Windows.GetTickCount;
end;
@ -495,6 +497,27 @@ end;
{==============================================================================}
function TickDelta(TickOld, TickNew: ULong): ULong;
begin
//if DWord is signed type (older Deplhi),
// then it not work properly on differencies larger then maxint!
Result := 0;
if TickOld <> TickNew then
begin
if TickNew < TickOld then
begin
TickNew := TickNew + ULong(MaxInt) + 1;
TickOld := TickOld + ULong(MaxInt) + 1;
end;
Result := TickNew - TickOld;
if TickNew < TickOld then
if Result > 0 then
Result := 0 - Result;
end;
end;
{==============================================================================}
function CodeInt(Value: Word): string;
begin
Result := Chr(Hi(Value)) + Chr(Lo(Value))
@ -522,7 +545,6 @@ end;
function IsIP(const Value: string): Boolean;
var
TempIP: string;
function ByteIsOk(const Value: string): Boolean;
var
x, n: integer;
@ -539,7 +561,6 @@ var
Break;
end;
end;
begin
TempIP := Value;
Result := False;
@ -555,19 +576,47 @@ end;
{==============================================================================}
function ReverseIP(Value: string): string;
function IsIP6(const Value: string): Boolean;
var
x: Integer;
TempIP: string;
s,t: string;
x: integer;
partcount: integer;
zerocount: integer;
First: Boolean;
begin
Result := '';
repeat
x := LastDelimiter('.', Value);
Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x);
Delete(Value, x, Length(Value) - x + 1);
until x < 1;
if Length(Result) > 0 then
if Result[1] = '.' then
Delete(Result, 1, 1);
TempIP := Value;
Result := False;
partcount := 0;
zerocount := 0;
First := True;
while tempIP <> '' do
begin
s := fetch(TempIP, ':');
if not(First) and (s = '') then
Inc(zerocount);
First := False;
if zerocount > 1 then
break;
Inc(partCount);
if s = '' then
Continue;
if partCount > 8 then
break;
if tempIP = '' then
begin
t := SeparateRight(s, '%');
s := SeparateLeft(s, '%');
x := StrToIntDef('$' + t, -1);
if (x < 0) or (x > $ffff) then
break;
end;
x := StrToIntDef('$' + s, -1);
if (x < 0) or (x > $ffff) then
break;
if tempIP = '' then
Result := True;
end;
end;
{==============================================================================}
@ -878,6 +927,16 @@ begin
s1 := sURL;
s2 := '';
end;
if Pos('[', s1) = 1 then
begin
Host := Separateleft(s1, ']');
Delete(Host, 1, 1);
s1 := SeparateRight(s1, ']');
if Pos(':', s1) = 1 then
Port := SeparateRight(s1, ':');
end
else
begin
x := Pos(':', s1);
if x > 0 then
begin
@ -886,6 +945,7 @@ begin
end
else
Host := s1;
end;
Result := '/' + s2;
x := Pos('?', s2);
if x > 0 then

1555
synsock.pas
View File

File diff suppressed because it is too large Load Diff

11
tlntsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.002 |
| Project : Delphree - Synapse | 001.001.001 |
|==============================================================================|
| Content: TELNET client |
|==============================================================================|
@ -42,8 +42,6 @@
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{$WEAKPACKAGEUNIT ON}
//RFC-854
unit TlntSend;
@ -87,6 +85,7 @@ type
FSessionLog: string;
FSubNeg: string;
FSubType: char;
FTermType: string;
function Connect: Boolean;
function Negotiate(const Buf: string): string;
procedure FilterHook(Sender: TObject; var Value: string);
@ -102,6 +101,7 @@ type
published
property Sock: TTCPBlockSocket read FSock;
property SessionLog: string read FSessionLog write FSessionLog;
property TermType: string read FTermType write FTermType;
end;
implementation
@ -111,10 +111,11 @@ begin
inherited Create;
FSock := TTCPBlockSocket.Create;
FSock.OnReadFilter := FilterHook;
FTimeout := 300000;
FTimeout := 60000;
FTargetPort := cTelnetProtocol;
FSubNeg := '';
FSubType := #0;
FTermType := 'SYNAPSE';
end;
destructor TTelnetSend.Destroy;
@ -265,7 +266,7 @@ begin
#24: //termtype
begin
if (FSubNeg <> '') and (FSubNeg[1] = #1) then
SubReply := #0 + 'SYNAPSE';
SubReply := #0 + FTermType;
end;
end;
Sock.SendString(TLNT_IAC + TLNT_SB + FSubType + SubReply + TLNT_IAC + TLNT_SE);