diff --git a/asn1util.pas b/asn1util.pas index ba713a0..277d453 100644 --- a/asn1util.pas +++ b/asn1util.pas @@ -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. diff --git a/blcksock.pas b/blcksock.pas index 71b3a76..e658132 100644 --- a/blcksock.pas +++ b/blcksock.pas @@ -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 - SockCheck(synsock.Listen(FSocket, SOMAXCONN)); - GetSins; + 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; @@ -981,13 +1379,81 @@ function TTCPBlockSocket.Accept: TSocket; var Len: Integer; begin - Len := SizeOf(FRemoteSin); - Result := synsock.Accept(FSocket, @FRemoteSin, @Len); - SockCheck(Result); + 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! diff --git a/dnssend.pas b/dnssend.pas index dbe488a..c1055e9 100644 --- a/dnssend.pas +++ b/dnssend.pas @@ -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 diff --git a/ftpsend.pas b/ftpsend.pas index b683c8a..54cd279 100644 --- a/ftpsend.pas +++ b/ftpsend.pas @@ -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 @@ -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,7 +437,8 @@ begin if FDSock.CanRead(FTimeout) then begin x := FDSock.Accept; - FDSock.CloseSocket; + if not FDSock.UsingSocks then + FDSock.CloseSocket; FDSock.Socket := x; Result := True; end; @@ -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 diff --git a/httpsend.pas b/httpsend.pas index 02e6495..113c3e4 100644 --- a/httpsend.pas +++ b/httpsend.pas @@ -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,7 +311,8 @@ begin if Pos('CONTENT-LENGTH:', su) = 1 then begin Size := StrToIntDef(SeparateRight(s, ' '), -1); - FTransferEncoding := TE_IDENTITY; + if Size <> -1 then + FTransferEncoding := TE_IDENTITY; end; if Pos('CONTENT-TYPE:', su) = 1 then FMimeType := SeparateRight(s, ' '); @@ -351,9 +355,9 @@ var s: string; begin repeat - s := FSock.RecvString(FTimeout); - s := s + CRLF; - FDocument.Write(Pointer(s)^, Length(s)); + s := FSock.RecvPacket(FTimeout); + if FSock.LastError = 0 then + FDocument.Write(Pointer(s)^, Length(s)); until FSock.LastError <> 0; Result := True; end; diff --git a/mimepart.pas b/mimepart.pas index a49580e..014820f 100644 --- a/mimepart.pas +++ b/mimepart.pas @@ -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: - Charset := UpperCase(GetParameter(s, 'charset=')); + 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 diff --git a/pingsend.pas b/pingsend.pas index 02ec9a2..614adc5 100644 --- a/pingsend.pas +++ b/pingsend.pas @@ -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; diff --git a/slogsend.pas b/slogsend.pas new file mode 100644 index 0000000..84f6ac3 --- /dev/null +++ b/slogsend.pas @@ -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. diff --git a/snmpsend.pas b/snmpsend.pas index 0eb14f3..59c3989 100644 --- a/snmpsend.pas +++ b/snmpsend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.003.003 | +| Project : Delphree - Synapse | 002.003.005 | |==============================================================================| | Content: SNMP client | |==============================================================================| @@ -299,17 +299,13 @@ begin FReply.Clear; FBuffer := Query.EncodeBuf; FSock.Connect(FHost, cSnmpProtocol); - FHostIP := FSock.GetRemoteSinIP; - FSock.SendBuffer(PChar(FBuffer), Length(FBuffer)); - if FSock.CanRead(FTimeout) then + FHostIP := '0.0.0.0'; + FSock.SendString(FBuffer); + FBuffer := FSock.RecvPacket(FTimeout); + if FSock.LastError = 0 then begin - x := FSock.WaitingData; - if x > 0 then - begin - SetLength(FBuffer, x); - FSock.RecvBuffer(PChar(FBuffer), x); - Result := True; - end; + FHostIP := FSock.GetRemoteSinIP; + Result := True; end; if Result then Result := FReply.DecodeBuf(FBuffer); diff --git a/snmptrap.pas b/snmptrap.pas index 72292f9..5cc87e9 100644 --- a/snmptrap.pas +++ b/snmptrap.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.002.003 | +| Project : Delphree - Synapse | 002.002.004 | |==============================================================================| | Content: SNMP traps | |==============================================================================| @@ -278,27 +278,18 @@ 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); - if FTrap.DecodeTrap then - Result := 1; - end; - end; + FTrap.FBuffer := FSock.RecvPacket(FTimeout); + if Fsock.Lasterror = 0 then + if FTrap.DecodeTrap then + Result := 1; end; function SendTrap(const Dest, Source, Enterprise, Community: string; diff --git a/synachar.pas b/synachar.pas index 72d9a9f..bf72382 100644 --- a/synachar.pas +++ b/synachar.pas @@ -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 diff --git a/synautil.pas b/synautil.pas index 086a646..c637998 100644 --- a/synautil.pas +++ b/synautil.pas @@ -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]; + 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; - Result := Result + ' ' + Timezone; 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);