UPD: Merge some changes from Synapse SVN trunk; fixes building on Win64, some types changes.

This commit is contained in:
cobines 2011-07-24 11:57:22 +00:00
commit cdc8ca7c5d
10 changed files with 232 additions and 120 deletions

View file

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 009.006.000 |
| Project : Ararat Synapse | 009.008.004 |
|==============================================================================|
| Content: Library base |
|==============================================================================|
| Copyright (c)1999-2008, Lukas Gebauer |
| Copyright (c)1999-2011, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)1999-2008. |
| Portions created by Lukas Gebauer are Copyright (c)1999-2011. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@ -82,6 +82,18 @@ Core with implementation basic socket classes.
{$H+}
{$M+}
//old Delphi does not have MSWINDOWS define.
{$IFDEF WIN32}
{$IFNDEF MSWINDOWS}
{$DEFINE MSWINDOWS}
{$ENDIF}
{$ENDIF}
{$IFDEF UNICODE}
{$WARN IMPLICIT_STRING_CAST OFF}
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
{$ENDIF}
unit blcksock;
interface
@ -672,8 +684,8 @@ type
{:Return value of protocol type for socket creation.}
function GetSocketProtocol: integer; Virtual;
{:WSA structure with information about socket provider. On linux is this
structure simulated!}
{:WSA structure with information about socket provider. On non-windows
platforms this structure is simulated!}
property WSAData: TWSADATA read GetWsaData;
{:Structure describing local socket side.}
@ -1508,7 +1520,7 @@ var
li: TLinger;
x: integer;
buf: TMemory;
{$IFNDEF WIN32}
{$IFNDEF MSWINDOWS}
timeval: TTimeval;
{$ENDIF}
begin
@ -1558,7 +1570,7 @@ begin
synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
buf, SizeOf(Value.Value));
{$ELSE}
{$IFDEF WIN32}
{$IFDEF MSWINDOWS}
buf := @Value.Value;
synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
buf, SizeOf(Value.Value));
@ -1575,7 +1587,7 @@ begin
{$IFDEF CIL}
buf := System.BitConverter.GetBytes(value.Value);
{$ELSE}
{$IFDEF WIN32}
{$IFDEF MSWINDOWS}
buf := @Value.Value;
synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO),
buf, SizeOf(Value.Value));
@ -2014,11 +2026,12 @@ var
{$ENDIF}
begin
b := true;
l := 0;
if WithSize then
begin
l := Stream.Size - Stream.Position;;
if Indy then
l := SwapBytes(l);
if not Indy then
l := synsock.HToNL(l);
end;
repeat
{$IFDEF CIL}
@ -2189,7 +2202,7 @@ begin
end
else
begin
{$IFDEF WIN32}
{$IFDEF MSWINDOWS}
//not drain CPU on large downloads...
Sleep(0);
{$ENDIF}
@ -3145,7 +3158,7 @@ end;
function TSocksBlockSocket.SocksOpen: boolean;
var
Buf: string;
Buf: AnsiString;
n: integer;
begin
Result := False;
@ -3175,8 +3188,8 @@ begin
;
2:
begin
Buf := #1 + char(Length(FSocksUsername)) + FSocksUsername
+ char(Length(FSocksPassword)) + FSocksPassword;
Buf := #1 + AnsiChar(Length(FSocksUsername)) + FSocksUsername
+ AnsiChar(Length(FSocksPassword)) + FSocksPassword;
SendString(Buf);
Buf := RecvBufferStr(2, FSocksTimeout);
if Length(Buf) < 2 then
@ -3199,14 +3212,14 @@ end;
function TSocksBlockSocket.SocksRequest(Cmd: Byte;
const IP, Port: string): Boolean;
var
Buf: string;
Buf: AnsiString;
begin
FBypassFlag := True;
try
if FSocksType <> ST_Socks5 then
Buf := #4 + char(Cmd) + SocksCode(IP, Port)
Buf := #4 + AnsiChar(Cmd) + SocksCode(IP, Port)
else
Buf := #5 + char(Cmd) + #0 + SocksCode(IP, Port);
Buf := #5 + AnsiChar(Cmd) + #0 + SocksCode(IP, Port);
SendString(Buf);
Result := FLastError = 0;
finally
@ -3216,7 +3229,7 @@ end;
function TSocksBlockSocket.SocksResponse: Boolean;
var
Buf, s: string;
Buf, s: AnsiString;
x: integer;
begin
Result := False;
@ -3249,7 +3262,7 @@ begin
x := RecvByte(FSocksTimeout);
if FLastError <> 0 then
Exit;
s := char(x) + RecvBufferStr(x, FSocksTimeout);
s := AnsiChar(x) + RecvBufferStr(x, FSocksTimeout);
end;
4:
s := RecvBufferStr(16, FSocksTimeout);
@ -3304,10 +3317,10 @@ begin
ip6 := StrToIP6(IP);
Result := #4;
for n := 0 to 15 do
Result := Result + char(ip6[n]);
Result := Result + AnsiChar(ip6[n]);
end
else
Result := #3 + char(Length(IP)) + IP;
Result := #3 + AnsiChar(Length(IP)) + IP;
Result := Result + CodeInt(ResolvePort(Port));
end;
end;

View file

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 003.005.001 |
| Project : Ararat Synapse | 004.000.000 |
|==============================================================================|
| Content: FTP client |
|==============================================================================|
| Copyright (c)1999-2008, Lukas Gebauer |
| Copyright (c)1999-2011, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c) 1999-2008. |
| Portions created by Lukas Gebauer are Copyright (c) 1999-2010. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@ -53,6 +53,11 @@ Used RFC: RFC-959, RFC-2228, RFC-2428
{$ENDIF}
{$H+}
{$IFDEF UNICODE}
{$WARN IMPLICIT_STRING_CAST OFF}
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
{$ENDIF}
unit ftpsend;
interface
@ -84,18 +89,17 @@ type
listing of FTP server.}
TFTPListRec = class(TObject)
private
FFileName: string;
FFileName: String;
FDirectory: Boolean;
FReadable: Boolean;
FFileSize: Longint;
FFileSize: int64;
FFileTime: TDateTime;
FOriginalLine: string;
FMask: string;
FPermission: string;
FPermission: String;
public
{: You can assign another TFTPListRec to this object.}
procedure Assign(Value: TFTPListRec); virtual;
published
{:name of file}
property FileName: string read FFileName write FFileName;
{:if name is subdirectory not file.}
@ -103,7 +107,7 @@ type
{:if you have rights to read}
property Readable: Boolean read FReadable write FReadable;
{:size of file in bytes}
property FileSize: Longint read FFileSize write FFileSize;
property FileSize: int64 read FFileSize write FFileSize;
{:date and time of file. Local server timezone is used. Any timezone
conversions was not done!}
property FileTime: TDateTime read FFileTime write FFileTime;
@ -135,16 +139,16 @@ type
YearTime: string;
Year: string;
Hours: string;
HoursModif: string;
HoursModif: Ansistring;
Minutes: string;
Seconds: string;
Size: string;
Permissions: string;
Size: Ansistring;
Permissions: Ansistring;
DirFlag: string;
function GetListItem(Index: integer): TFTPListRec; virtual;
function ParseEPLF(Value: string): Boolean; virtual;
procedure ClearStore; virtual;
function ParseByMask(Value, NextValue, Mask: string): Integer; virtual;
function ParseByMask(Value, NextValue, Mask: ansistring): Integer; virtual;
function CheckValues: Boolean; virtual;
procedure FillRecord(const Value: TFTPListRec); virtual;
public
@ -224,7 +228,7 @@ type
FFullSSL: Boolean;
function Auth(Mode: integer): Boolean; virtual;
function Connect: Boolean; virtual;
function InternalStor(const Command: string; RestoreAt: integer): Boolean; virtual;
function InternalStor(const Command: string; RestoreAt: int64): Boolean; virtual;
function DataSocket: Boolean; virtual;
function AcceptDataSocket: Boolean; virtual;
procedure DoStatus(Response: Boolean; const Value: string); virtual;
@ -304,7 +308,7 @@ type
{:Return size of Filename file on FTP server. If command failed (i.e. not
implemented), return -1.}
function FileSize(const FileName: string): integer; virtual;
function FileSize(const FileName: string): int64; virtual;
{:Send NOOP command to FTP server for preserve of disconnect by inactivity
timeout.}
@ -508,7 +512,7 @@ end;
function TFTPSend.ReadResult: Integer;
var
s, c: string;
s, c: AnsiString;
begin
FFullResult.Clear;
c := '';
@ -818,7 +822,7 @@ end;
procedure TFTPSend.ParseRemoteEPSV(Value: string);
var
n: integer;
s, v: string;
s, v: AnsiString;
begin
s := SeparateRight(Value, '(');
s := Trim(SeparateLeft(s, ')'));
@ -1034,10 +1038,10 @@ begin
end;
end;
function TFTPSend.InternalStor(const Command: string; RestoreAt: integer): Boolean;
function TFTPSend.InternalStor(const Command: string; RestoreAt: int64): Boolean;
var
SendStream: TStream;
StorSize: integer;
StorSize: int64;
begin
Result := False;
if FDirectFile then
@ -1081,7 +1085,7 @@ end;
function TFTPSend.StoreFile(const FileName: string; Restore: Boolean): Boolean;
var
RestoreAt: integer;
RestoreAt: int64;
begin
Result := False;
if FileName = '' then
@ -1128,7 +1132,7 @@ begin
Result := (FTPCommand('DELE ' + FileName) div 100) = 2;
end;
function TFTPSend.FileSize(const FileName: string): integer;
function TFTPSend.FileSize(const FileName: string): int64;
var
s: string;
begin
@ -1137,7 +1141,11 @@ begin
begin
s := Trim(SeparateRight(ResultString, ' '));
s := Trim(SeparateLeft(s, ' '));
{$IFDEF VER100}
Result := StrToIntDef(s, -1);
{$ELSE}
Result := StrToInt64Def(s, -1);
{$ENDIF}
end;
end;
@ -1336,11 +1344,11 @@ begin
DirFlag := '';
end;
function TFTPList.ParseByMask(Value, NextValue, Mask: string): Integer;
function TFTPList.ParseByMask(Value, NextValue, Mask: AnsiString): Integer;
var
Ivalue, IMask: integer;
MaskC, LastMaskC: Char;
c: char;
MaskC, LastMaskC: AnsiChar;
c: AnsiChar;
s: string;
begin
ClearStore;
@ -1670,7 +1678,11 @@ begin
x := StrToIntDef(BlockSize, 1)
else
x := 1;
{$IFDEF VER100}
Value.FileSize := x * StrToIntDef(Size, 0);
{$ELSE}
Value.FileSize := x * StrToInt64Def(Size, 0);
{$ENDIF}
DecodeDate(Date,myear,mmonth,mday);
mhours := 0;
@ -1761,7 +1773,11 @@ begin
'r':
flr.Readable := true;
's':
{$IFDEF VER100}
flr.FileSize := StrToIntDef(Copy(s, 2, Length(s) - 1), 0);
{$ELSE}
flr.FileSize := StrToInt64Def(Copy(s, 2, Length(s) - 1), 0);
{$ENDIF}
'm':
flr.FileTime := (StrToIntDef(Copy(s, 2, Length(s) - 1), 0) / 86400)
+ 25569;

View file

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 001.001.000 |
| Project : Ararat Synapse | 001.001.004 |
|==============================================================================|
| Content: Socket Independent Platform Layer - FreePascal definition include |
|==============================================================================|
| Copyright (c)2006-2009, Lukas Gebauer |
| Copyright (c)2006-2011, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2006-2009. |
| Portions created by Lukas Gebauer are Copyright (c)2006-2011. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@ -113,6 +113,7 @@ const
IPPROTO_UDP = 17; { User Datagram Protocol }
IPPROTO_IPV6 = 41;
IPPROTO_ICMPV6 = 58;
IPPROTO_RM = 113;
IPPROTO_RAW = 255;
IPPROTO_MAX = 256;
@ -249,7 +250,13 @@ const
MSG_OOB = sockets.MSG_OOB; // Process out-of-band data.
MSG_PEEK = sockets.MSG_PEEK; // Peek at incoming messages.
{$ifdef DARWIN}
MSG_NOSIGNAL = $20000; // Do not generate SIGPIPE.
// Works under MAC OS X, but is undocumented,
// So FPC doesn't include it
{$else}
MSG_NOSIGNAL = sockets.MSG_NOSIGNAL; // Do not generate SIGPIPE.
{$endif}
const
WSAEINTR = ESysEINTR;

View file

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 002.000.008 |
| Project : Ararat Synapse | 002.000.009 |
|==============================================================================|
| Content: Socket Independent Platform Layer - Linux definition include |
|==============================================================================|
| Copyright (c)1999-2003, Lukas Gebauer |
| Copyright (c)1999-2010, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2003. |
| Portions created by Lukas Gebauer are Copyright (c)2003-2010. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@ -129,6 +129,7 @@ const
IPPROTO_UDP = 17; { User Datagram Protocol }
IPPROTO_IPV6 = 41;
IPPROTO_ICMPV6 = 58;
IPPROTO_RM = 113;
IPPROTO_RAW = 255;
IPPROTO_MAX = 256;

View file

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 002.002.000 |
| Project : Ararat Synapse | 002.003.000 |
|==============================================================================|
| Content: Socket Independent Platform Layer - Win32 definition include |
| Content: Socket Independent Platform Layer - Win32/64 definition include |
|==============================================================================|
| Copyright (c)1999-2008, Lukas Gebauer |
| Copyright (c)1999-2011, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2003. |
| Portions created by Lukas Gebauer are Copyright (c)2003-2011. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@ -44,8 +44,6 @@
{:@exclude}
{$IFDEF WIN32}
//{$DEFINE WINSOCK1}
{Note about define WINSOCK1:
If you activate this compiler directive, then socket interface level 1.1 is
@ -238,6 +236,14 @@ For IPv6 support you must have new API!
(*$HPPEMIT '#undef PF_INET6' *)
{$ENDIF}
{$IFDEF FPC}
{$IFDEF WIN32}
{$ALIGN OFF}
{$ELSE}
{$PACKRECORDS C}
{$ENDIF}
{$ENDIF}
interface
uses
@ -260,17 +266,29 @@ type
u_long = Longint;
pu_long = ^u_long;
pu_short = ^u_short;
{$IFDEF FPC}
TSocket = ptruint;
{$ELSE}
{$IFDEF WIN64}
TSocket = UINT_PTR;
{$ELSE}
TSocket = u_int;
{$ENDIF}
{$ENDIF}
TAddrFamily = integer;
TMemory = pointer;
const
{$IFDEF WINCE}
DLLStackName = 'ws2.dll';
{$ELSE}
{$IFDEF WINSOCK1}
DLLStackName = 'wsock32.dll';
{$ELSE}
DLLStackName = 'ws2_32.dll';
{$ENDIF}
{$ENDIF}
DLLwship6 = 'wship6.dll';
cLocalhost = '127.0.0.1';
@ -286,7 +304,7 @@ const
FD_SETSIZE = 64;
type
PFDSet = ^TFDSet;
TFDSet = packed record
TFDSet = record
fd_count: u_int;
fd_array: array[0..FD_SETSIZE-1] of TSocket;
end;
@ -298,7 +316,7 @@ const
type
PTimeVal = ^TTimeVal;
TTimeVal = packed record
TTimeVal = record
tv_sec: Longint;
tv_usec: Longint;
end;
@ -311,6 +329,7 @@ const
IPPROTO_UDP = 17; { User Datagram Protocol }
IPPROTO_IPV6 = 41;
IPPROTO_ICMPV6 = 58;
IPPROTO_RM = 113;
IPPROTO_RAW = 255;
IPPROTO_MAX = 256;
@ -318,14 +337,14 @@ const
type
PInAddr = ^TInAddr;
TInAddr = packed record
TInAddr = record
case integer of
0: (S_bytes: packed array [0..3] of byte);
1: (S_addr: u_long);
end;
PSockAddrIn = ^TSockAddrIn;
TSockAddrIn = packed record
TSockAddrIn = record
case Integer of
0: (sin_family: u_short;
sin_port: u_short;
@ -341,7 +360,7 @@ type
end;
PInAddr6 = ^TInAddr6;
TInAddr6 = packed record
TInAddr6 = record
case integer of
0: (S6_addr: packed array [0..15] of byte);
1: (u6_addr8: packed array [0..15] of byte);
@ -350,7 +369,7 @@ type
end;
PSockAddrIn6 = ^TSockAddrIn6;
TSockAddrIn6 = packed record
TSockAddrIn6 = record
sin6_family: u_short; // AF_INET6
sin6_port: u_short; // Transport level port number
sin6_flowinfo: u_long; // IPv6 flow information
@ -366,7 +385,7 @@ type
end;
PHostEnt = ^THostEnt;
THostEnt = packed record
THostEnt = record
h_name: PAnsiChar;
h_aliases: ^PAnsiChar;
h_addrtype: Smallint;
@ -377,7 +396,7 @@ type
end;
PNetEnt = ^TNetEnt;
TNetEnt = packed record
TNetEnt = record
n_name: PAnsiChar;
n_aliases: ^PAnsiChar;
n_addrtype: Smallint;
@ -385,15 +404,20 @@ type
end;
PServEnt = ^TServEnt;
TServEnt = packed record
TServEnt = record
s_name: PAnsiChar;
s_aliases: ^PAnsiChar;
{$ifdef WIN64}
s_proto: PAnsiChar;
s_port: Smallint;
{$else}
s_port: Smallint;
s_proto: PAnsiChar;
{$endif}
end;
PProtoEnt = ^TProtoEnt;
TProtoEnt = packed record
TProtoEnt = record
p_name: PAnsiChar;
p_aliases: ^PAnsichar;
p_proto: Smallint;
@ -526,7 +550,7 @@ type
{ Structure used by kernel to pass protocol information in raw sockets. }
PSockProto = ^TSockProto;
TSockProto = packed record
TSockProto = record
sp_family: u_short;
sp_protocol: u_short;
end;
@ -553,7 +577,7 @@ const
type
{ Structure used for manipulating linger option. }
PLinger = ^TLinger;
TLinger = packed record
TLinger = record
l_onoff: u_short;
l_linger: u_short;
end;
@ -715,14 +739,22 @@ const
WSASYS_STATUS_LEN = 128;
type
PWSAData = ^TWSAData;
TWSAData = packed record
TWSAData = record
wVersion: Word;
wHighVersion: Word;
{$ifdef win64}
iMaxSockets : Word;
iMaxUdpDg : Word;
lpVendorInfo : PAnsiChar;
szDescription : array[0..WSADESCRIPTION_LEN] of AnsiChar;
szSystemStatus : array[0..WSASYS_STATUS_LEN] of AnsiChar;
{$else}
szDescription: array[0..WSADESCRIPTION_LEN] of AnsiChar;
szSystemStatus: array[0..WSASYS_STATUS_LEN] of AnsiChar;
iMaxSockets: Word;
iMaxUdpDg: Word;
lpVendorInfo: PAnsiChar;
{$endif}
end;
function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
@ -1167,10 +1199,10 @@ begin
Sin.sin_family := AF_INET;
ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
ServEnt := nil;
if ProtoEnt <> nil then
if (ProtoEnt <> nil) and (StrToIntDef(string(Port),-1) =-1) then
ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name);
if ServEnt = nil then
Sin.sin_port := synsock.htons(StrToIntDef(Port, 0))
Sin.sin_port := synsock.htons(StrToIntDef(string(Port), 0))
else
Sin.sin_port := ServEnt^.s_port;
if IP = cBroadcast then
@ -1282,7 +1314,7 @@ var
IP: u_long;
PAdrPtr: PaPInAddr;
i: Integer;
s: AnsiString;
s: String;
InAddr: TInAddr;
begin
IPList.Clear;
@ -1312,7 +1344,7 @@ begin
end;
end
else
IPList.Add(Name);
IPList.Add(string(Name));
end
else
begin
@ -1342,7 +1374,7 @@ begin
if r = 0 then
begin
host := PAnsiChar(host);
IPList.Add(host);
IPList.Add(string(host));
end;
end;
AddrNext := AddrNext^.ai_next;
@ -1375,7 +1407,7 @@ begin
if ProtoEnt <> nil then
ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name);
if ServEnt = nil then
Result := StrToIntDef(Port, 0)
Result := StrToIntDef(string(Port), 0)
else
Result := synsock.htons(ServEnt^.s_port);
finally
@ -1580,6 +1612,4 @@ end;
finalization
begin
SynSockCS.Free;
end;
{$ENDIF}
end;

View file

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 002.002.000 |
| Project : Ararat Synapse | 002.002.001 |
|==============================================================================|
| Content: Coding and decoding support |
|==============================================================================|
| Copyright (c)1999-2007, Lukas Gebauer |
| Copyright (c)1999-2010, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2000-2007. |
| Portions created by Lukas Gebauer are Copyright (c)2000-2010. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@ -50,6 +50,12 @@
{$R-}
{$H+}
{$IFDEF UNICODE}
{$WARN IMPLICIT_STRING_CAST OFF}
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
{$WARN SUSPICIOUS_TYPECAST OFF}
{$ENDIF}
unit synacode;
interface
@ -66,7 +72,7 @@ const
['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
'"', '_'];
NonAsciiChar: TSpecials =
[Char(0)..Char(31), Char(127)..Char(255)];
[#0..#31, #127..#255];
URLFullSpecialChar: TSpecials =
[';', '/', '?', ':', '@', '=', '&', '#', '+'];
URLSpecialChar: TSpecials =

View file

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 001.001.001 |
| Project : Ararat Synapse | 001.002.000 |
|==============================================================================|
| Content: Utils for FreePascal compatibility |
|==============================================================================|
| Copyright (c)1999-2007, Lukas Gebauer |
| Copyright (c)1999-2011, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2003-2007. |
| Portions created by Lukas Gebauer are Copyright (c)2003-2011. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@ -48,6 +48,12 @@
{$MODE DELPHI}
{$ENDIF}
{$H+}
//old Delphi does not have MSWINDOWS define.
{$IFDEF WIN32}
{$IFNDEF MSWINDOWS}
{$DEFINE MSWINDOWS}
{$ENDIF}
{$ENDIF}
unit synafpc;
@ -57,7 +63,7 @@ uses
{$IFDEF FPC}
dynlibs, sysutils;
{$ELSE}
{$IFDEF WIN32}
{$IFDEF MSWINDOWS}
Windows;
{$ELSE}
SysUtils;
@ -76,8 +82,12 @@ function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer):
type
{$IFDEF CIL}
TLibHandle = Integer;
PtrInt = Integer;
{$ELSE}
TLibHandle = HModule;
{$IFNDEF WIN64}
PtrInt = Integer;
{$ENDIF}
{$ENDIF}
{$IFDEF VER100}
LongWord = DWord;
@ -116,7 +126,7 @@ end;
procedure Sleep(milliseconds: Cardinal);
begin
{$IFDEF WIN32}
{$IFDEF MSWINDOWS}
{$IFDEF FPC}
sysutils.sleep(milliseconds);
{$ELSE}

View file

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 001.002.000 |
| Project : Ararat Synapse | 001.002.001 |
|==============================================================================|
| Content: IP address support procedures and functions |
|==============================================================================|
| Copyright (c)2006-2009, Lukas Gebauer |
| Copyright (c)2006-2010, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c) 2006-2008. |
| Portions created by Lukas Gebauer are Copyright (c) 2006-2010. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@ -51,6 +51,12 @@
{$R-}
{$H+}
{$IFDEF UNICODE}
{$WARN IMPLICIT_STRING_CAST OFF}
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
{$WARN SUSPICIOUS_TYPECAST OFF}
{$ENDIF}
unit synaip;
interface
@ -112,7 +118,7 @@ var
// i.e. "$80"
if Result then
for n := 1 to length(Value) do
if not (Value[n] in ['0'..'9']) then
if not (AnsiChar(Value[n]) in ['0'..'9']) then
begin
Result := False;
Break;
@ -193,7 +199,7 @@ begin
begin
s := Fetch(Host, '.');
i := StrToIntDef(s, 0);
Result := Result + Chr(i);
Result := Result + AnsiChar(i);
end;
end;

View file

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 004.013.000 |
| Project : Ararat Synapse | 004.014.001 |
|==============================================================================|
| Content: support procedures and functions |
|==============================================================================|
| Copyright (c)1999-2008, Lukas Gebauer |
| Copyright (c)1999-2010, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c) 1999-2008. |
| Portions created by Lukas Gebauer are Copyright (c) 1999-2010. |
| Portions created by Hernan Sanchez are Copyright (c) 2000. |
| All Rights Reserved. |
|==============================================================================|
@ -53,12 +53,25 @@
{$R-}
{$H+}
//old Delphi does not have MSWINDOWS define.
{$IFDEF WIN32}
{$IFNDEF MSWINDOWS}
{$DEFINE MSWINDOWS}
{$ENDIF}
{$ENDIF}
{$IFDEF UNICODE}
{$WARN IMPLICIT_STRING_CAST OFF}
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
{$WARN SUSPICIOUS_TYPECAST OFF}
{$ENDIF}
unit synautil;
interface
uses
{$IFDEF WIN32}
{$IFDEF MSWINDOWS}
Windows,
{$ELSE}
{$IFDEF FPC}
@ -102,7 +115,7 @@ function AnsiCDateTime(t: TDateTime): string;
{:Decode three-letter string with name of month to their month number. If string
not match any month name, then is returned 0. For parsing are used predefined
names for English, French and German and names from system locale too.}
function GetMonthNumber(Value: AnsiString): integer;
function GetMonthNumber(Value: String): integer;
{:Return decoded time from given string. Time must be witch separator ':'. You
can use "hh:mm" or "hh:mm:ss".}
@ -251,7 +264,7 @@ function FetchEx(var Value: string; const Delimiter, Quotation: string): string;
{:If string is binary string (contains non-printable characters), then is
returned true.}
function IsBinaryString(const Value: string): Boolean;
function IsBinaryString(const Value: AnsiString): Boolean;
{:return position of string terminator in string. If terminator found, then is
returned in terminator parameter.
@ -327,7 +340,7 @@ const
MyDayNames: array[1..7] of AnsiString =
('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
var
MyMonthNames: array[0..6, 1..12] of AnsiString =
MyMonthNames: array[0..6, 1..12] of String =
(
('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', //rewrited by system locales
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'),
@ -349,7 +362,7 @@ var
{==============================================================================}
function TimeZoneBias: integer;
{$IFNDEF WIN32}
{$IFNDEF MSWINDOWS}
{$IFNDEF FPC}
var
t: TTime_T;
@ -526,10 +539,10 @@ end;
{==============================================================================}
function GetMonthNumber(Value: AnsiString): integer;
function GetMonthNumber(Value: String): integer;
var
n: integer;
function TestMonth(Value: AnsiString; Index: Integer): Boolean;
function TestMonth(Value: String; Index: Integer): Boolean;
var
n: integer;
begin
@ -700,7 +713,7 @@ end;
{==============================================================================}
function GetUTTime: TDateTime;
{$IFDEF WIN32}
{$IFDEF MSWINDOWS}
{$IFNDEF FPC}
var
st: TSystemTime;
@ -742,7 +755,7 @@ end;
{==============================================================================}
function SetUTTime(Newdt: TDateTime): Boolean;
{$IFDEF WIN32}
{$IFDEF MSWINDOWS}
{$IFNDEF FPC}
var
st: TSystemTime;
@ -795,7 +808,7 @@ end;
{==============================================================================}
{$IFNDEF WIN32}
{$IFNDEF MSWINDOWS}
function GetTick: LongWord;
var
Stamp: TTimeStamp;
@ -1405,7 +1418,7 @@ end;
{==============================================================================}
function IsBinaryString(const Value: string): Boolean;
function IsBinaryString(const Value: AnsiString): Boolean;
var
n: integer;
begin
@ -1413,7 +1426,7 @@ begin
for n := 1 to Length(Value) do
if Value[n] in [#0..#8, #10..#31] then
//ignore null-terminated strings
if not ((n = Length(value)) and (Value[n] = #0)) then
if not ((n = Length(value)) and (Value[n] = AnsiChar(#0))) then
begin
Result := True;
Break;
@ -1720,7 +1733,7 @@ end;
{==============================================================================}
function GetTempFile(const Dir, prefix: AnsiString): AnsiString;
{$IFNDEF FPC}
{$IFDEF WIN32}
{$IFDEF MSWINDOWS}
var
Path: AnsiString;
x: integer;
@ -1730,7 +1743,7 @@ begin
{$IFDEF FPC}
Result := GetTempFileName(Dir, Prefix);
{$ELSE}
{$IFNDEF WIN32}
{$IFNDEF MSWINDOWS}
Result := tempnam(Pointer(Dir), Pointer(prefix));
{$ELSE}
{$IFDEF CIL}
@ -1784,7 +1797,7 @@ begin
for n := 1 to Length(t) do
if t[n] = #9 then
t[n] := ' ';
if not(t[1] in [' ', '"', ':', '=']) then
if not(AnsiChar(t[1]) in [' ', '"', ':', '=']) then
Break
else
begin

View file

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 005.001.000 |
| Project : Ararat Synapse | 005.002.001 |
|==============================================================================|
| Content: Socket Independent Platform Layer |
|==============================================================================|
| Copyright (c)1999-2003, Lukas Gebauer |
| Copyright (c)1999-2011, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2001-2003. |
| Portions created by Lukas Gebauer are Copyright (c)2001-2011. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@ -48,20 +48,30 @@ unit synsock;
{$MINENUMSIZE 4}
{$IFDEF CIL}
{$I ssdotnet.pas}
{$ENDIF}
//old Delphi does not have MSWINDOWS define.
{$IFDEF WIN32}
{$I sswin32.pas}
{$ELSE}
{$IFDEF FPC}
{$I ssfpc.pas}
{$ELSE}
{$I sslinux.pas}
{$IFNDEF MSWINDOWS}
{$DEFINE MSWINDOWS}
{$ENDIF}
{$ENDIF}
{$IFDEF CIL}
{$I ssdotnet.inc}
{$ELSE}
{$IFDEF MSWINDOWS}
{$I sswin32.inc}
{$ELSE}
{$IFDEF WINCE}
{$I sswin32.inc} //not complete yet!
{$ELSE}
{$IFDEF FPC}
{$I ssfpc.inc}
{$ELSE}
{$I sslinux.inc}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
end.