pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Release 25

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

34
asn1util.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.003.003 |
| Project : Delphree - Synapse | 001.003.004 |
|==============================================================================|
| Content: support for ASN.1 coding and decoding |
|==============================================================================|
@ -59,12 +59,10 @@ function ASNItem(var Start: Integer; const Buffer: string;
function MibToId(Mib: string): string;
function IdToMib(const Id: string): string;
function IntMibToStr(const Value: string): string;
function IPToID(Host: string): string;
implementation
{==============================================================================}
function ASNEncOIDItem(Value: Integer): string;
var
x, xm: Integer;
@ -85,7 +83,6 @@ begin
end;
{==============================================================================}
function ASNDecOIDItem(var Start: Integer; const Buffer: string): Integer;
var
x: Integer;
@ -103,7 +100,6 @@ begin
end;
{==============================================================================}
function ASNEncLen(Len: Integer): string;
var
x, y: Integer;
@ -126,7 +122,6 @@ begin
end;
{==============================================================================}
function ASNDecLen(var Start: Integer; const Buffer: string): Integer;
var
x, n: Integer;
@ -150,7 +145,6 @@ begin
end;
{==============================================================================}
function ASNEncInt(Value: Integer): string;
var
x, y: Cardinal;
@ -171,7 +165,6 @@ begin
end;
{==============================================================================}
function ASNEncUInt(Value: Integer): string;
var
x, y: Integer;
@ -192,14 +185,12 @@ begin
end;
{==============================================================================}
function ASNObject(const Data: string; ASNType: Integer): string;
begin
Result := Char(ASNType) + ASNEncLen(Length(Data)) + Data;
end;
{==============================================================================}
function ASNItem(var Start: Integer; const Buffer: string;
var ValueType: Integer): string;
var
@ -298,7 +289,6 @@ begin
end;
{==============================================================================}
function MibToId(Mib: string): string;
var
x: Integer;
@ -335,7 +325,6 @@ begin
end;
{==============================================================================}
function IdToMib(const Id: string): string;
var
x, y, n: Integer;
@ -356,7 +345,6 @@ begin
end;
{==============================================================================}
function IntMibToStr(const Value: string): string;
var
n, y: Integer;
@ -368,25 +356,5 @@ begin
end;
{==============================================================================}
//Hernan Sanchez
function IPToID(Host: string): string;
var
s, t: string;
i, x: Integer;
begin
Result := '';
for x := 1 to 3 do
begin
t := '';
s := StrScan(PChar(Host), '.');
t := Copy(Host, 1, (Length(Host) - Length(s)));
Delete(Host, 1, (Length(Host) - Length(s) + 1));
i := StrToIntDef(t, 0);
Result := Result + Chr(i);
end;
i := StrToIntDef(Host, 0);
Result := Result + Chr(i);
end;
end.

526
blcksock.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 003.003.000 |
| Project : Delphree - Synapse | 004.000.000 |
|==============================================================================|
| Content: Library base |
|==============================================================================|
@ -36,7 +36,7 @@ uses
{$ELSE}
Windows, WinSock,
{$ENDIF}
synsock;
synsock, SynaUtil;
const
cLocalhost = 'localhost';
@ -94,7 +94,7 @@ type
destructor Destroy; override;
procedure CloseSocket; virtual;
procedure Bind(IP, Port: string);
procedure Connect(IP, Port: string);
procedure Connect(IP, Port: string); virtual;
function SendBuffer(Buffer: Pointer; Length: Integer): Integer; virtual;
procedure SendByte(Data: Byte); virtual;
procedure SendString(const Data: string); virtual;
@ -103,6 +103,7 @@ type
Timeout: Integer): Integer; virtual;
function RecvByte(Timeout: Integer): Byte; virtual;
function RecvString(Timeout: Integer): string; virtual;
function RecvPacket(Timeout: Integer): string; virtual;
function PeekBuffer(Buffer: Pointer; Length: Integer): Integer; virtual;
function PeekByte(Timeout: Integer): Byte; virtual;
function WaitingData: Integer;
@ -112,19 +113,24 @@ type
procedure ExceptCheck;
function LocalName: string;
procedure ResolveNameToIP(Name: string; IPList: TStrings);
function GetLocalSinIP: string;
function GetRemoteSinIP: string;
function GetLocalSinPort: Integer;
function GetRemoteSinPort: Integer;
function ResolveName(Name: string): string;
function ResolvePort(Port: string): Word;
procedure SetRemoteSin(IP, Port: string);
function GetLocalSinIP: string; virtual;
function GetRemoteSinIP: string; virtual;
function GetLocalSinPort: Integer; virtual;
function GetRemoteSinPort: Integer; virtual;
function CanRead(Timeout: Integer): Boolean;
function CanWrite(Timeout: Integer): Boolean;
function SendBufferTo(Buffer: Pointer; Length: Integer): Integer;
function RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer;
function SendBufferTo(Buffer: Pointer; Length: Integer): Integer; virtual;
function RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer; virtual;
function GroupCanRead(const SocketList: TList; Timeout: Integer;
const CanReadList: TList): Boolean;
//See 'winsock2.txt' file in distribute package!
function SetTimeout(Timeout: Integer): Boolean;
function SetSendTimeout(Timeout: Integer): Boolean;
function SetRecvTimeout(Timeout: Integer): Boolean;
property LocalSin: TSockAddrIn read FLocalSin;
property RemoteSin: TSockAddrIn read FRemoteSin;
@ -141,18 +147,65 @@ type
property OnStatus: THookSocketStatus read FOnStatus write FOnStatus;
end;
TUDPBlockSocket = class(TBlockSocket)
TSocksBlockSocket = class(TBlockSocket)
protected
FSocksIP: string;
FSocksPort: string;
FSocksTimeout: integer;
FSocksUsername: string;
FSocksPassword: string;
FUsingSocks: Boolean;
FSocksResolver: Boolean;
FSocksLastError: integer;
FSocksResponseIP: string;
FSocksResponsePort: string;
FSocksLocalIP: string;
FSocksLocalPort: string;
FSocksRemoteIP: string;
FSocksRemotePort: string;
function SocksCode(IP, Port: string): string;
function SocksDecode(Value: string): integer;
public
procedure CreateSocket; override;
function EnableBroadcast(Value: Boolean): Boolean;
constructor Create;
function SocksOpen: Boolean;
function SocksRequest(Cmd: Byte; const IP, Port: string): Boolean;
function SocksResponse: Boolean;
published
property SocksIP: string read FSocksIP write FSocksIP;
property SocksPort: string read FSocksPort write FSocksPort;
property SocksUsername: string read FSocksUsername write FSocksUsername;
property SocksPassword: string read FSocksPassword write FSocksPassword;
property UsingSocks: Boolean read FUsingSocks;
property SocksResolver: Boolean read FSocksResolver write FSocksResolver;
property SocksLastError: integer read FSocksLastError;
end;
TTCPBlockSocket = class(TBlockSocket)
TTCPBlockSocket = class(TSocksBlockSocket)
public
procedure CreateSocket; override;
procedure CloseSocket; override;
procedure Listen;
function Accept: TSocket;
procedure Connect(IP, Port: string); override;
function GetLocalSinIP: string; override;
function GetRemoteSinIP: string; override;
function GetLocalSinPort: Integer; override;
function GetRemoteSinPort: Integer; override;
end;
TUDPBlockSocket = class(TSocksBlockSocket)
protected
FSocksControlSock: TTCPBlockSocket;
function UdpAssociation: Boolean;
public
destructor Destroy; override;
procedure CreateSocket; override;
function EnableBroadcast(Value: Boolean): Boolean;
procedure Connect(IP, Port: string); override;
function SendBuffer(Buffer: Pointer; Length: Integer): Integer; override;
function RecvBuffer(Buffer: Pointer; Length: Integer): Integer; override;
function SendBufferTo(Buffer: Pointer; Length: Integer): Integer; override;
function RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer; override;
end;
//See 'winsock2.txt' file in distribute package!
@ -342,23 +395,19 @@ end;
procedure TBlockSocket.SendByte(Data: Byte);
begin
sockcheck(synsock.Send(FSocket, Data, 1, 0));
ExceptCheck;
DoStatus(HR_WriteCount, '1');
SendBuffer(@Data, 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)));
SendBuffer(PChar(Data), Length(Data));
end;
function TBlockSocket.RecvBuffer(Buffer: Pointer; Length: Integer): Integer;
begin
Result := synsock.Recv(FSocket, Buffer^, Length, 0);
if Result = 0 then
FLastError := WSAENOTCONN
FLastError := WSAECONNRESET
else
SockCheck(Result);
ExceptCheck;
@ -407,7 +456,7 @@ begin
SetLength(st, l);
x := synsock.Recv(FSocket, Pointer(st)^, l, 0);
if x = 0 then
FLastError := WSAENOTCONN
FLastError := WSAECONNRESET
else
SockCheck(x);
if FLastError <> 0 then
@ -432,6 +481,38 @@ begin
ExceptCheck;
end;
function TBlockSocket.RecvPacket(Timeout: Integer): string;
var
x: integer;
s: string;
begin
Result := '';
FLastError := 0;
x := -1;
if FBuffer <> '' then
begin
Result := FBuffer;
FBuffer := '';
end
else
if CanRead(Timeout) then
begin
x := WaitingData;
if x > 0 then
begin
SetLength(s, x);
x := RecvBuffer(Pointer(s), x);
Result := Copy(s, 1, x);
end;
end
else
FLastError := WSAETIMEDOUT;
ExceptCheck;
if x = 0 then
FLastError := WSAECONNRESET;
end;
function TBlockSocket.RecvByte(Timeout: Integer): Byte;
var
y: Integer;
@ -443,7 +524,7 @@ begin
begin
y := synsock.Recv(FSocket, Data, 1, 0);
if y = 0 then
FLastError := WSAENOTCONN
FLastError := WSAECONNRESET
else
SockCheck(y);
Result := Data;
@ -487,7 +568,7 @@ begin
r := synsock.Recv(FSocket, Pointer(FBuffer)^, x, 0);
SockCheck(r);
if r = 0 then
FLastError := WSAENOTCONN;
FLastError := WSAECONNRESET;
if FLastError <> 0 then
Break;
DoStatus(HR_ReadCount, IntToStr(r));
@ -538,7 +619,7 @@ begin
begin
y := synsock.Recv(FSocket, Data, 1, MSG_PEEK);
if y = 0 then
FLastError := WSAENOTCONN;
FLastError := WSAECONNRESET;
SockCheck(y);
Result := Data;
end
@ -640,11 +721,46 @@ begin
Inc(i);
end;
end;
if IPList.Count = 0 then
IPList.Add('0.0.0.0');
end
else
IPList.Add(Name);
end;
function TBlockSocket.ResolveName(Name: string): string;
var
l: TStringList;
begin
l := TStringList.Create;
try
ResolveNameToIP(Name, l);
Result := l[0];
finally
l.Free;
end;
end;
function TBlockSocket.ResolvePort(Port: string): Word;
var
ProtoEnt: PProtoEnt;
ServEnt: PServEnt;
begin
ProtoEnt := synsock.GetProtoByNumber(FProtocol);
ServEnt := nil;
if ProtoEnt <> nil then
ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
if ServEnt = nil then
Result := synsock.htons(StrToIntDef(Port, 0))
else
Result := ServEnt^.s_port;
end;
procedure TBlockSocket.SetRemoteSin(IP, Port: string);
begin
SetSin(FRemoteSin, IP, Port);
end;
function TBlockSocket.GetLocalSinIP: string;
begin
Result := GetSinIP(FLocalSin);
@ -768,13 +884,23 @@ begin
end;
//See 'winsock2.txt' file in distribute package!
function TBlockSocket.SetTimeout(Timeout: Integer): Boolean;
begin
Result := synsock.SetSockOpt(FSocket, SOL_SOCKET,
SO_RCVTIMEO, @Timeout, SizeOf(Timeout)) <> SOCKET_ERROR;
Result := Result and (synsock.SetSockOpt(FSocket, SOL_SOCKET,
SO_SNDTIMEO, @Timeout, SizeOf(Timeout)) <> SOCKET_ERROR);
Result := SetSendTimeout(Timeout) and SetRecvTimeout(Timeout);
end;
//See 'winsock2.txt' file in distribute package!
function TBlockSocket.SetSendTimeout(Timeout: Integer): Boolean;
begin
Result := synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDTIMEO,
@Timeout, SizeOf(Timeout)) <> SOCKET_ERROR;
end;
//See 'winsock2.txt' file in distribute package!
function TBlockSocket.SetRecvTimeout(Timeout: Integer): Boolean;
begin
Result := synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVTIMEO,
@Timeout, SizeOf(Timeout)) <> SOCKET_ERROR;
end;
function TBlockSocket.GroupCanRead(const SocketList: TList; Timeout: Integer;
@ -820,7 +946,6 @@ begin
OnStatus(Self, Reason, Value);
end;
class function TBlockSocket.GetErrorDesc(ErrorCode: Integer): string;
begin
case ErrorCode of
@ -935,6 +1060,156 @@ end;
{======================================================================}
constructor TSocksBlockSocket.Create;
begin
inherited Create;
FSocksIP:= '';
FSocksPort:= '1080';
FSocksTimeout:= 300000;
FSocksUsername:= '';
FSocksPassword:= '';
FUsingSocks := False;
FSocksResolver := True;
FSocksLastError := 0;
FSocksResponseIP := '';
FSocksResponsePort := '';
FSocksLocalIP := '';
FSocksLocalPort := '';
FSocksRemoteIP := '';
FSocksRemotePort := '';
end;
function TSocksBlockSocket.SocksOpen: boolean;
var
Buf: string;
n: integer;
begin
Result := False;
FUsingSocks := False;
if FSocksUsername = '' then
Buf := #5 + #1 + #0
else
Buf := #5 + #2 + #2 +#0;
SendString(Buf);
Buf := RecvPacket(FSocksTimeout);
FBuffer := Copy(Buf, 3, Length(buf) - 2);
if Length(Buf) < 2 then
Exit;
if Buf[1] <> #5 then
Exit;
n := Ord(Buf[2]);
case n of
0: //not need authorisation
;
2:
begin
Buf := #1 + char(Length(FSocksUsername)) + FSocksUsername
+ char(Length(FSocksPassword)) + FSocksPassword;
SendString(Buf);
Buf := RecvPacket(FSocksTimeout);
FBuffer := Copy(Buf, 3, Length(buf) - 2);
if Length(Buf) < 2 then
Exit;
if Buf[2] <> #0 then
Exit;
end;
else
Exit;
end;
FUsingSocks := True;
Result := True;
end;
function TSocksBlockSocket.SocksRequest(Cmd: Byte;
const IP, Port: string): Boolean;
var
Buf: string;
begin
Result := False;
Buf := #5 + char(Cmd) + #0 + SocksCode(IP, Port);
SendString(Buf);
Result := FLastError = 0;
end;
function TSocksBlockSocket.SocksResponse: Boolean;
var
Buf: string;
x: integer;
begin
Result := False;
FSocksResponseIP := '';
FSocksResponsePort := '';
Buf := RecvPacket(FSocksTimeout);
if FLastError <> 0 then
Exit;
if Length(Buf) < 5 then
Exit;
if Buf[1] <> #5 then
Exit;
FSocksLastError := Ord(Buf[2]);
if FSocksLastError <> 0 then
Exit;
x := SocksDecode(Buf);
FBuffer := Copy(Buf, x, Length(buf) - x + 1);
Result := True;
end;
function TSocksBlockSocket.SocksCode(IP, Port: string): string;
begin
if IsIP(IP) then
Result := #1 + IPToID(IP)
else
if FSocksResolver then
Result := #3 + char(Length(IP)) + IP
else
Result := #1 + IPToID(ResolveName(IP));
Result := Result + CodeInt(synsock.htons(ResolvePort(Port)));
end;
function TSocksBlockSocket.SocksDecode(Value: string): integer;
var
Atyp: Byte;
y, n: integer;
w: Word;
begin
FSocksResponsePort := '0';
Atyp := Ord(Value[4]);
Result := 5;
case Atyp of
1:
begin
if Length(Value) < 10 then
Exit;
FSocksResponseIP := Format('%d.%d.%d.%d',
[Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]);
Result := 9;
end;
3:
begin
y := Ord(Value[5]);
if Length(Value) < (5 + y + 2) then
Exit;
for n := 6 to 6 + y do
FSocksResponseIP := FSocksResponseIP + Value[n];
Result := 5 + y +1;
end;
else
Exit;
end;
w := DecodeInt(Value, Result);
FSocksResponsePort := IntToStr(w);
Result := Result + 2;
end;
{======================================================================}
destructor TUDPBlockSocket.Destroy;
begin
if Assigned(FSocksControlSock) then
FSocksControlSock.Free;
inherited;
end;
procedure TUDPBlockSocket.CreateSocket;
begin
FSocket := synsock.Socket(PF_INET, Integer(SOCK_DGRAM), IPPROTO_UDP);
@ -954,6 +1229,102 @@ begin
ExceptCheck;
end;
procedure TUDPBlockSocket.Connect(IP, Port: string);
begin
SetRemoteSin(IP, Port);
FBuffer := '';
DoStatus(HR_Connect, IP + ':' + Port);
end;
function TUDPBlockSocket.RecvBuffer(Buffer: Pointer; Length: Integer): Integer;
begin
Result := RecvBufferFrom(Buffer, Length);
end;
function TUDPBlockSocket.SendBuffer(Buffer: Pointer; Length: Integer): Integer;
begin
Result := SendBufferTo(Buffer, Length);
end;
function TUDPBlockSocket.UdpAssociation: Boolean;
var
b: Boolean;
begin
Result := True;
FUsingSocks := False;
if FSocksIP <> '' then
begin
Result := False;
if not Assigned(FSocksControlSock) then
FSocksControlSock := TTCPBlockSocket.Create;
FSocksControlSock.CloseSocket;
FSocksControlSock.CreateSocket;
FSocksControlSock.Connect(FSocksIP, FSocksPort);
if FSocksControlSock.LastError <> 0 then
Exit;
// if not assigned local port, assign it!
if GetLocalSinPort = 0 then
Bind(GetLocalSinIP, '0');
GetSins;
//open control TCP connection to SOCKS
b := FSocksControlSock.SocksOpen;
if b then
b := FSocksControlSock.SocksRequest(3, GetLocalSinIP,
IntToStr(GetLocalSinPort));
if b then
b := FSocksControlSock.SocksResponse;
if not b and (FLastError = 0) then
FLastError := WSANO_RECOVERY;
FUsingSocks :=FSocksControlSock.UsingSocks;
FSocksRemoteIP := FSocksControlSock.FSocksResponseIP;
FSocksRemotePort := FSocksControlSock.FSocksResponsePort;
Result := True;
end;
end;
function TUDPBlockSocket.SendBufferTo(Buffer: Pointer; Length: Integer): Integer;
var
SIp: string;
SPort: integer;
Buf: string;
begin
UdpAssociation;
if FUsingSocks then
begin
Sip := GetRemoteSinIp;
SPort := GetRemoteSinPort;
SetRemoteSin(FSocksRemoteIP, FSocksRemotePort);
SetLength(Buf,Length);
Move(Buffer^, PChar(Buf)^, Length);
Buf := #0 + #0 + #0 + SocksCode(Sip, IntToStr(SPort)) + Buf;
Result := inherited SendBufferTo(PChar(Buf), System.Length(buf));
SetRemoteSin(Sip, IntToStr(SPort));
end
else
begin
Result := inherited SendBufferTo(Buffer, Length);
GetSins;
end;
end;
function TUDPBlockSocket.RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer;
var
Buf: string;
x: integer;
begin
Result := inherited RecvBufferFrom(Buffer, Length);
if FUsingSocks then
begin
SetLength(Buf, Result);
Move(Buffer^, PChar(Buf)^, Result);
x := SocksDecode(Buf);
Result := Result - x + 1;
Buf := Copy(Buf, x, Result);
Move(PChar(Buf)^, Buffer^, Result);
SetRemoteSin(FSocksResponseIP, FSocksResponsePort);
end;
end;
{======================================================================}
procedure TTCPBlockSocket.CreateSocket;
@ -970,9 +1341,36 @@ begin
end;
procedure TTCPBlockSocket.Listen;
var
b: Boolean;
Sip,SPort: string;
begin
if FSocksIP = '' then
begin
SockCheck(synsock.Listen(FSocket, SOMAXCONN));
GetSins;
end
else
begin
Sip := GetLocalSinIP;
if Sip = '0.0.0.0' then
Sip := LocalName;
SPort := IntToStr(GetLocalSinPort);
Connect(FSocksIP, FSocksPort);
b := SocksOpen;
if b then
b := SocksRequest(2, Sip, SPort);
if b then
b := SocksResponse;
if not b and (FLastError = 0) then
FLastError := WSANO_RECOVERY;
FSocksLocalIP := FSocksResponseIP;
if FSocksLocalIP = '0.0.0.0' then
FSocksLocalIP := FSocksIP;
FSocksLocalPort := FSocksResponsePort;
FSocksRemoteIP := '';
FSocksRemotePort := '';
end;
ExceptCheck;
DoStatus(HR_Listen, '');
end;
@ -980,14 +1378,82 @@ end;
function TTCPBlockSocket.Accept: TSocket;
var
Len: Integer;
begin
if FUsingSocks then
begin
if not SocksResponse and (FLastError = 0) then
FLastError := WSANO_RECOVERY;
FSocksRemoteIP := FSocksResponseIP;
FSocksRemotePort := FSocksResponsePort;
Result := FSocket;
end
else
begin
Len := SizeOf(FRemoteSin);
Result := synsock.Accept(FSocket, @FRemoteSin, @Len);
SockCheck(Result);
end;
ExceptCheck;
DoStatus(HR_Accept, '');
end;
procedure TTCPBlockSocket.Connect(IP, Port: string);
var
b: Boolean;
begin
if FSocksIP = '' then
inherited Connect(IP, Port)
else
begin
inherited Connect(FSocksIP, FSocksPort);
b := SocksOpen;
if b then
b := SocksRequest(1, IP, Port);
if b then
b := SocksResponse;
if not b and (FLastError = 0) then
FLastError := WSANO_RECOVERY;
FSocksLocalIP := FSocksResponseIP;
FSocksLocalPort := FSocksResponsePort;
FSocksRemoteIP := IP;
FSocksRemotePort := Port;
ExceptCheck;
DoStatus(HR_Connect, IP + ':' + Port);
end;
end;
function TTCPBlockSocket.GetLocalSinIP: string;
begin
if FUsingSocks then
Result := FSocksLocalIP
else
Result := inherited GetLocalSinIP;
end;
function TTCPBlockSocket.GetRemoteSinIP: string;
begin
if FUsingSocks then
Result := FSocksRemoteIP
else
Result := inherited GetRemoteSinIP;
end;
function TTCPBlockSocket.GetLocalSinPort: Integer;
begin
if FUsingSocks then
Result := StrToIntDef(FSocksLocalPort, 0)
else
Result := inherited GetLocalSinPort;
end;
function TTCPBlockSocket.GetRemoteSinPort: Integer;
begin
if FUsingSocks then
Result := StrToIntDef(FSocksRemotePort, 0)
else
Result := inherited GetRemoteSinPort;
end;
{======================================================================}
//See 'winsock2.txt' file in distribute package!

12
dnssend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.001.003 |
| Project : Delphree - Synapse | 001.001.004 |
|==============================================================================|
| Content: DNS client |
|==============================================================================|
@ -37,7 +37,7 @@ uses
blcksock, SynaUtil;
const
cDnsProtocol = 'Domain';
cDnsProtocol = 'domain';
QTYPE_A = 1;
QTYPE_NS = 2;
@ -281,7 +281,7 @@ end;
function TDNSSend.DNSQuery(Name: string; QType: Integer;
const Reply: TStrings): Boolean;
var
x, n, i: Integer;
n, i: Integer;
flag, qdcount, ancount, nscount, arcount: Integer;
s: string;
begin
@ -292,11 +292,9 @@ begin
FBuffer := CodeHeader + CodeQuery(Name, QType);
FSock.Connect(FDNSHost, cDnsProtocol);
FSock.SendString(FBuffer);
if FSock.CanRead(FTimeout) then
FBuffer := FSock.RecvPacket(FTimeout);
if (FSock.LastError = 0) and (Length(FBuffer) > 13) then
begin
x := FSock.WaitingData;
SetLength(FBuffer, x);
FSock.RecvBuffer(Pointer(FBuffer), x);
flag := DecodeInt(FBuffer, 3);
FRCode := Flag and $000F;
if FRCode = 0 then

44
ftpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.000 |
| Project : Delphree - Synapse | 001.002.000 |
|==============================================================================|
| Content: FTP client |
|==============================================================================|
@ -44,8 +44,12 @@ const
type
TLogonActions = array [0..17] of byte;
TFTPStatus = procedure(Sender: TObject; Response: Boolean;
const Value: string) of object;
TFTPSend = class(TObject)
private
FOnStatus: TFTPStatus;
FSock: TTCPBlockSocket;
FDSock: TTCPBlockSocket;
FTimeout: Integer;
@ -77,6 +81,8 @@ type
function AcceptDataSocket: Boolean;
function DataRead(const DestStream: TStream): Boolean;
function DataWrite(const SourceStream: TStream): Boolean;
protected
procedure DoStatus(Response: Boolean; const Value: string);
public
CustomLogon: TLogonActions;
constructor Create;
@ -125,6 +131,7 @@ type
property CanResume: Boolean read FCanResume;
property PassiveMode: Boolean read FPassiveMode Write FPassiveMode;
property ForceDefaultPort: Boolean read FForceDefaultPort Write FForceDefaultPort;
property OnStatus: TFTPStatus read FOnStatus write FOnStatus;
end;
function FtpGetFile(const IP, Port, FileName, LocalFile,
@ -172,6 +179,12 @@ begin
inherited Destroy;
end;
procedure TFTPSend.DoStatus(Response: Boolean; const Value: string);
begin
if assigned(OnStatus) then
OnStatus(Self, Response, Value);
end;
function TFTPSend.ReadResult: Integer;
var
s,c: string;
@ -197,7 +210,9 @@ end;
function TFTPSend.FTPCommand(const Value: string): integer;
begin
FSock.SendString(Value + CRLF);
DoStatus(False, Value);
Result := ReadResult;
DoStatus(True, FResultString);
end;
// based on idea by Petr Esner <petr.esner@atlas.cz>
@ -401,6 +416,7 @@ begin
FDSock.Listen;
FDSock.GetSins;
FDataIP := FDSock.GetLocalSinIP;
FDataIP := FDSock.ResolveName(FDataIP);
FDataPort := IntToStr(FDSock.GetLocalSinPort);
s := StringReplace(FDataIP, '.', ',');
s := 'PORT ' + s + ',' + IntToStr(FDSock.GetLocalSinPort div 256)
@ -421,6 +437,7 @@ begin
if FDSock.CanRead(FTimeout) then
begin
x := FDSock.Accept;
if not FDSock.UsingSocks then
FDSock.CloseSocket;
FDSock.Socket := x;
Result := True;
@ -430,7 +447,7 @@ end;
function TFTPSend.DataRead(const DestStream: TStream): Boolean;
var
x, y: integer;
x: integer;
buf: string;
begin
Result := False;
@ -438,18 +455,9 @@ begin
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;
buf := FDSock.RecvPacket(FTimeout);
if FDSock.LastError = 0 then
DestStream.Write(Pointer(buf)^, Length(buf));
until FDSock.LastError <> 0;
x := ReadResult;
if (x = 226) or (x = 250) then
@ -702,6 +710,8 @@ begin
Username := User;
Password := Pass;
end;
FTPHost := IP;
FTPPort := Port;
if not Login then
Exit;
DirectFileName := LocalFile;
@ -724,6 +734,8 @@ begin
Username := User;
Password := Pass;
end;
FTPHost := IP;
FTPPort := Port;
if not Login then
Exit;
DirectFileName := LocalFile;
@ -757,6 +769,10 @@ begin
ToFTP.Username := ToUser;
ToFTP.Password := ToPass;
end;
FromFTP.FTPHost := FromIP;
FromFTP.FTPPort := FromPort;
ToFTP.FTPHost := ToIP;
ToFTP.FTPPort := ToPort;
if not FromFTP.Login then
Exit;
if not ToFTP.Login then

12
httpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.002.000 |
| Project : Delphree - Synapse | 002.003.000 |
|==============================================================================|
| Content: HTTP client |
|==============================================================================|
@ -184,7 +184,10 @@ begin
if (FProxyHost <> '') and (FProxyUser <> '') then
FHeaders.Insert(0, 'Proxy-Authorization: Basic ' +
EncodeBase64(FProxyUser + ':' + FProxyPass));
FHeaders.Insert(0, 'Host: ' + Host + ':' + Port);
if Port<>'80' then
FHeaders.Insert(0, 'Host: ' + Host + ':' + Port)
else
FHeaders.Insert(0, 'Host: ' + Host);
if FProxyHost <> '' then
URI := Prot + '://' + Host + ':' + Port + URI;
if URI = '/*' then
@ -308,6 +311,7 @@ begin
if Pos('CONTENT-LENGTH:', su) = 1 then
begin
Size := StrToIntDef(SeparateRight(s, ' '), -1);
if Size <> -1 then
FTransferEncoding := TE_IDENTITY;
end;
if Pos('CONTENT-TYPE:', su) = 1 then
@ -351,8 +355,8 @@ var
s: string;
begin
repeat
s := FSock.RecvString(FTimeout);
s := s + CRLF;
s := FSock.RecvPacket(FTimeout);
if FSock.LastError = 0 then
FDocument.Write(Pointer(s)^, Length(s));
until FSock.LastError <> 0;
Result := True;

9
mimepart.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.005.000 |
| Project : Delphree - Synapse | 001.005.002 |
|==============================================================================|
| Content: MIME support procedures and functions |
|==============================================================================|
@ -239,7 +239,10 @@ begin
FSecondary := '';
case FPrimaryCode of
MP_TEXT:
begin
Charset := UpperCase(GetParameter(s, 'charset='));
FFileName := GetParameter(s, 'name=');
end;
MP_MULTIPART:
FBoundary := GetParameter(s, 'Boundary=');
MP_MESSAGE:
@ -316,7 +319,7 @@ begin
begin
e := False;
for n := x2 + 1 to Value.Count - 1 do
if Pos('--' + FBoundary, Value[n]) = 1 then
if Pos('--' + b, Value[n]) = 1 then
begin
e := True;
Break;
@ -428,8 +431,6 @@ begin
if FPrimaryCode = MP_TEXT then
s := CharsetConversion(s, FTargetCharset, FCharsetCode);
s := EncodeBase64(s);
if x <> 54 then
s := s + '=';
FLines.Add(s);
end;
end

13
pingsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.001.001 |
| Project : Delphree - Synapse | 002.001.002 |
|==============================================================================|
| Content: PING sender |
|==============================================================================|
@ -106,16 +106,9 @@ begin
end;
function TPINGSend.ReadPacket: Boolean;
var
x: Integer;
begin
Result := FSock.CanRead(FTimeout);
if Result then
begin
x := FSock.WaitingData;
SetLength(FBuffer, x);
FSock.RecvBuffer(Pointer(FBuffer), x);
end;
FBuffer := FSock.RecvPacket(Ftimeout);
Result := FSock.LastError = 0;
end;
function TPINGSend.Ping(const Host: string): Boolean;

164
slogsend.pas Normal file
View File

@ -0,0 +1,164 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.000 |
|==============================================================================|
| Content: SysLog 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)2001. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
|==============================================================================|
| History: see HISTORY.HTM from distribution package |
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
// RFC-3164
{$Q-}
{$WEAKPACKAGEUNIT ON}
unit SLogSend;
interface
uses
SysUtils, Classes,
blcksock, SynaUtil;
const
cSysLogProtocol = '514';
FCL_Kernel = 0;
FCL_UserLevel = 1;
FCL_MailSystem = 2;
FCL_System = 3;
FCL_Security = 4;
FCL_Syslogd = 5;
FCL_Printer = 6;
FCL_News = 7;
FCL_UUCP = 8;
FCL_Clock = 9;
FCL_Authorization = 10;
FCL_FTP = 11;
FCL_NTP = 12;
FCL_LogAudit = 13;
FCL_LogAlert = 14;
FCL_Time = 15;
FCL_Local0 = 16;
FCL_Local1 = 17;
FCL_Local2 = 18;
FCL_Local3 = 19;
FCL_Local4 = 20;
FCL_Local5 = 21;
FCL_Local6 = 22;
FCL_Local7 = 23;
type
TSyslogSeverity = (Emergency, Alert, Critical, Error, Warning, Notice, Info,
Debug);
TSyslogSend = class(TObject)
private
FSyslogHost: string;
FSyslogPort: string;
FSock: TUDPBlockSocket;
FFacility: Byte;
FSeverity: TSyslogSeverity;
FTag: string;
FMessage: string;
public
constructor Create;
destructor Destroy; override;
function DoIt: Boolean;
published
property SyslogHost: string read FSyslogHost Write FSyslogHost;
property SyslogPort: string read FSyslogPort Write FSyslogPort;
property Facility: Byte read FFacility Write FFacility;
property Severity: TSyslogSeverity read FSeverity Write FSeverity;
property Tag: string read FTag Write FTag;
property LogMessage: string read FMessage Write FMessage;
end;
function ToSysLog(const SyslogServer: string; Facil: Byte;
Sever: TSyslogSeverity; const Content: string): Boolean;
implementation
constructor TSyslogSend.Create;
begin
inherited Create;
FSock := TUDPBlockSocket.Create;
FSock.CreateSocket;
FSyslogHost := cLocalhost;
FSyslogPort := cSysLogProtocol;
FFacility := FCL_Local0;
FSeverity := Debug;
FTag := ExtractFileName(ParamStr(0));
FMessage := '';
end;
destructor TSyslogSend.Destroy;
begin
FSock.Free;
inherited Destroy;
end;
function TSyslogSend.DoIt: Boolean;
var
Buf: string;
S: string;
L: TStringList;
begin
Result := False;
Buf := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>';
Buf := Buf + CDateTime(now) + ' ';
L := TStringList.Create;
try
FSock.ResolveNameToIP(FSock.Localname, L);
if L.Count < 1 then
S := '0.0.0.0'
else
S := L[0];
finally
L.Free;
end;
Buf := Buf + S + ' ';
Buf := Buf + Tag + ': ' + FMessage;
if Length(Buf) <= 1024 then
begin
FSock.Connect(FSyslogHost, FSyslogPort);
FSock.SendString(Buf);
Result := FSock.LastError = 0;
end;
end;
{==============================================================================}
function ToSysLog(const SyslogServer: string; Facil: Byte;
Sever: TSyslogSeverity; const Content: string): Boolean;
begin
Result := False;
with TSyslogSend.Create do
try
SyslogHost :=SyslogServer;
Facility := Facil;
Severity := Sever;
LogMessage := Content;
Result := DoIt;
finally
Free;
end;
end;
end.

16
snmpsend.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.003.003 |
| Project : Delphree - Synapse | 002.003.005 |
|==============================================================================|
| Content: SNMP client |
|==============================================================================|
@ -299,18 +299,14 @@ begin
FReply.Clear;
FBuffer := Query.EncodeBuf;
FSock.Connect(FHost, cSnmpProtocol);
FHostIP := '0.0.0.0';
FSock.SendString(FBuffer);
FBuffer := FSock.RecvPacket(FTimeout);
if FSock.LastError = 0 then
begin
FHostIP := FSock.GetRemoteSinIP;
FSock.SendBuffer(PChar(FBuffer), Length(FBuffer));
if FSock.CanRead(FTimeout) then
begin
x := FSock.WaitingData;
if x > 0 then
begin
SetLength(FBuffer, x);
FSock.RecvBuffer(PChar(FBuffer), x);
Result := True;
end;
end;
if Result then
Result := FReply.DecodeBuf(FBuffer);
end;

17
snmptrap.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.002.003 |
| Project : Delphree - Synapse | 002.002.004 |
|==============================================================================|
| Content: SNMP traps |
|==============================================================================|
@ -278,28 +278,19 @@ function TTrapSNMP.Send: Integer;
begin
FTrap.EncodeTrap;
FSock.Connect(SNMPHost, FTrap.TrapPort);
FSock.SendBuffer(PChar(FTrap.FBuffer), Length(FTrap.FBuffer));
FSock.SendString(FTrap.FBuffer);
Result := 1;
end;
function TTrapSNMP.Recv: Integer;
var
x: Integer;
begin
Result := 0;
FSock.Bind('0.0.0.0', FTrap.TrapPort);
if FSock.CanRead(FTimeout) then
begin
x := FSock.WaitingData;
if x > 0 then
begin
SetLength(FTrap.FBuffer, x);
FSock.RecvBuffer(PChar(FTrap.FBuffer), x);
FTrap.FBuffer := FSock.RecvPacket(FTimeout);
if Fsock.Lasterror = 0 then
if FTrap.DecodeTrap then
Result := 1;
end;
end;
end;
function SendTrap(const Dest, Source, Enterprise, Community: string;
Generic, Specific, Seconds: Integer; const MIBName, MIBValue: string;

77
synachar.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 003.002.000 |
| Project : Delphree - Synapse | 004.000.000 |
|==============================================================================|
| Content: Charset conversion support |
|==============================================================================|
@ -621,6 +621,43 @@ const
$00B0, $00A8, $02D9, $0171, $0158, $0159, $25A0, $00A0
);
// nothing fr replace
Replace_None: array[0..0] of Word =
(0);
//remove diakritics from Czech
Replace_Czech: array[0..55] of Word =
(
$00E1, $0061,
$010D, $0063,
$010F, $0064,
$010E, $0044,
$00E9, $0065,
$011B, $0065,
$00ED, $0069,
$00F3, $006F,
$0159, $0072,
$0161, $0073,
$0165, $0074,
$00FA, $0075,
$016F, $0075,
$00FD, $0079,
$017E, $007A,
$00C1, $0041,
$010C, $0043,
$00C9, $0045,
$011A, $0045,
$00CD, $0049,
$00D3, $004F,
$0158, $0052,
$0160, $0053,
$0164, $0053,
$00DA, $0054,
$016E, $0055,
$00DD, $0059,
$017D, $005A
);
{==============================================================================}
function UTF8toUCS4(const Value: string): string;
function UCS4toUTF8(const Value: string): string;
@ -628,6 +665,8 @@ function UTF7toUCS2(const Value: string): string;
function UCS2toUTF7(const Value: string): string;
function CharsetConversion(Value: string; CharFrom: TMimeChar;
CharTo: TMimeChar): string;
function CharsetConversionEx(Value: string; CharFrom: TMimeChar;
CharTo: TMimeChar; const TransformTable: array of Word): string;
function GetCurCP: TMimeChar;
function GetCPFromID(Value: string): TMimeChar;
function GetIDFromCP(Value: TMimeChar): string;
@ -654,7 +693,22 @@ var
SetFour: set of TMimeChar = [UCS_4, UTF_8];
{==============================================================================}
function ReplaceUnicode(Value: Word; const TransformTable: array of Word): Word;
var
n: integer;
begin
if High(TransformTable) <> 0 then
for n := 0 to High(TransformTable) do
if not odd(n) then
if TransformTable[n] = Value then
begin
Value := TransformTable[n+1];
break;
end;
Result := Value;
end;
{==============================================================================}
procedure CopyArray(const SourceTable: array of Word;
var TargetTable: array of Word);
var
@ -665,7 +719,6 @@ begin
end;
{==============================================================================}
procedure GetArray(CharSet: TMimeChar; var Result: array of Word);
begin
case CharSet of
@ -723,7 +776,6 @@ begin
end;
{==============================================================================}
procedure ReadMulti(const Value: string; var Index: Integer; mb: Byte;
var b1, b2, b3, b4: Byte);
var
@ -752,7 +804,6 @@ begin
end;
{==============================================================================}
function WriteMulti(b1, b2, b3, b4: Byte; mb: Byte): string;
var
b: array[0..3] of Byte;
@ -768,7 +819,6 @@ begin
end;
{==============================================================================}
function UTF8toUCS4(const Value: string): string;
var
n, x, ul, m: Integer;
@ -819,7 +869,6 @@ begin
end;
{==============================================================================}
function UCS4toUTF8(const Value: string): string;
var
s, l, k: string;
@ -867,7 +916,6 @@ begin
end;
{==============================================================================}
function UTF7toUCS2(const Value: string): string;
var
n: Integer;
@ -908,7 +956,6 @@ begin
end;
{==============================================================================}
function UCS2toUTF7(const Value: string): string;
var
s: string;
@ -948,9 +995,15 @@ begin
end;
{==============================================================================}
function CharsetConversion(Value: string; CharFrom: TMimeChar;
CharTo: TMimeChar): string;
begin
Result := CharsetConversionEx(Value, CharFrom, CharTo, Replace_None);
end;
{==============================================================================}
function CharsetConversionEx(Value: string; CharFrom: TMimeChar;
CharTo: TMimeChar; const TransformTable: array of Word): string;
var
uni: Word;
n, m: Integer;
@ -986,6 +1039,7 @@ begin
if b1 > 127 then
begin
uni := SourceTable[b1];
uni := ReplaceUnicode(uni, TransformTable);
b1 := Lo(uni);
b2 := Hi(uni);
end;
@ -1025,7 +1079,6 @@ begin
end;
{==============================================================================}
{$IFDEF LINUX}
function GetCurCP: TMimeChar;
@ -1062,7 +1115,6 @@ end;
{$ENDIF}
{==============================================================================}
function GetCPFromID(Value: string): TMimeChar;
begin
Value := UpperCase(Value);
@ -1156,7 +1208,6 @@ begin
end;
{==============================================================================}
function GetIDFromCP(Value: TMimeChar): string;
begin
case Value of
@ -1222,7 +1273,6 @@ begin
end;
{==============================================================================}
function NeedCharsetConversion(const Value: string): Boolean;
var
n: Integer;
@ -1237,7 +1287,6 @@ begin
end;
{==============================================================================}
function IdealCharsetCoding(const Value: string; CharFrom: TMimeChar;
CharTo: TMimeSetChar): TMimeChar;
var

112
synautil.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Delphree - Synapse | 002.001.000 |
| Project : Delphree - Synapse | 002.003.000 |
|==============================================================================|
| Content: support procedures and functions |
|==============================================================================|
@ -41,10 +41,12 @@ uses
function Timezone: string;
function Rfc822DateTime(t: TDateTime): string;
function CDateTime(t: TDateTime): string;
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 IPToID(Host: string): string;
procedure Dump(const Buffer, DumpFile: string);
function SeparateLeft(const Value, Delimiter: string): string;
function SeparateRight(const Value, Delimiter: string): string;
@ -61,7 +63,43 @@ function RPos(const Sub, Value: String): Integer;
function Fetch(var Value: string; const Delimiter: string): string;
implementation
{==============================================================================}
var
SaveDayNames: array[1..7] of string;
SaveMonthNames: array[1..12] of string;
const
MyDayNames: array[1..7] of string =
('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
MyMonthNames: array[1..12] of string =
('Jan', 'Feb', 'Mar', 'Apr',
'May', 'Jun', 'Jul', 'Aug',
'Sep', 'Oct', 'Nov', 'Dec');
procedure SaveNames;
var
I: integer;
begin
for I := Low(ShortDayNames) to High(ShortDayNames) do
begin
SaveDayNames[I] := ShortDayNames[I];
ShortDayNames[I] := MyDayNames[I];
end;
for I := Low(ShortMonthNames) to High(ShortMonthNames) do
begin
SaveMonthNames[I] := ShortMonthNames[I];
ShortMonthNames[I] := MyMonthNames[I];
end;
end;
procedure RestoreNames;
var
I: integer;
begin
for I := Low(ShortDayNames) to High(ShortDayNames) do
ShortDayNames[I] := SaveDayNames[I];
for I := Low(ShortMonthNames) to High(ShortMonthNames) do
ShortMonthNames[I] := SaveMonthNames[I];
end;
{==============================================================================}
function Timezone: string;
@ -107,39 +145,28 @@ end;
{==============================================================================}
function Rfc822DateTime(t: TDateTime): string;
var
I: Integer;
SaveDayNames: array[1..7] of string;
SaveMonthNames: array[1..12] of string;
const
MyDayNames: array[1..7] of string =
('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
MyMonthNames: array[1..12] of string =
('Jan', 'Feb', 'Mar', 'Apr',
'May', 'Jun', 'Jul', 'Aug',
'Sep', 'Oct', 'Nov', 'Dec');
begin
if ShortDayNames[1] = MyDayNames[1] then
Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t)
else
begin
for I := Low(ShortDayNames) to High(ShortDayNames) do
begin
SaveDayNames[I] := ShortDayNames[I];
ShortDayNames[I] := MyDayNames[I];
end;
for I := Low(ShortMonthNames) to High(ShortMonthNames) do
begin
SaveMonthNames[I] := ShortMonthNames[I];
ShortMonthNames[I] := MyMonthNames[I];
end;
SaveNames;
try
Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t);
for I := Low(ShortDayNames) to High(ShortDayNames) do
ShortDayNames[I] := SaveDayNames[I];
for I := Low(ShortMonthNames) to High(ShortMonthNames) do
ShortMonthNames[I] := SaveMonthNames[I];
end;
Result := Result + ' ' + Timezone;
finally
RestoreNames;
end;
end;
{==============================================================================}
function CDateTime(t: TDateTime): string;
begin
SaveNames;
try
Result := FormatDateTime('mmm dd hh:mm:ss', t);
if Result[5] = '0' then
Result[5] := ' ';
finally
RestoreNames;
end;
end;
{==============================================================================}
@ -159,7 +186,7 @@ begin
x := Ord(Value[Index])
else
x := 0;
if Length(Value) > (Index + 1) then
if Length(Value) >= (Index + 1) then
y := Ord(Value[Index + 1])
else
y := 0;
@ -206,6 +233,27 @@ begin
Delete(Result, 1, 1);
end;
{==============================================================================}
//Hernan Sanchez
function IPToID(Host: string): string;
var
s, t: string;
i, x: Integer;
begin
Result := '';
for x := 1 to 3 do
begin
t := '';
s := StrScan(PChar(Host), '.');
t := Copy(Host, 1, (Length(Host) - Length(s)));
Delete(Host, 1, (Length(Host) - Length(s) + 1));
i := StrToIntDef(t, 0);
Result := Result + Chr(i);
end;
i := StrToIntDef(Host, 0);
Result := Result + Chr(i);
end;
{==============================================================================}
procedure Dump(const Buffer, DumpFile: string);