From 8e7497020dcd3c9f6b1b035aea011edeb76e6f8c Mon Sep 17 00:00:00 2001
From: zipplet <zipplet@zipplet.co.uk>
Date: Tue, 9 Feb 2010 19:52:15 +0000
Subject: [PATCH] Initial work on porting lcore to delphi 2010

git-svn-id: file:///svnroot/lcore/branches/delphi2010@67 b1de8a11-f9be-4011-bde0-cc7ace90066a
---
 dnswin.pas  | 32 ++++++++++++++++----------------
 lcore.pas   | 23 ++++++++++++++++++-----
 lsocket.pas | 32 ++++++++++++++++----------------
 3 files changed, 50 insertions(+), 37 deletions(-)

diff --git a/dnswin.pas b/dnswin.pas
index e9c2a16..02539e9 100644
--- a/dnswin.pas
+++ b/dnswin.pas
@@ -9,8 +9,8 @@ uses binipstuff,classes,lcore;
 //on failure a null string or zeroed out binip will be retuned and error will be
 //set to a windows error code (error will be left untouched under non error
 //conditions).
-function winforwardlookuplist(name : string;familyhint:integer;var error : integer) : tbiniplist;
-function winreverselookup(ip:tbinip;var error:integer):string;
+function winforwardlookuplist(name : thostname;familyhint:integer;var error : integer) : tbiniplist;
+function winreverselookup(ip:tbinip;var error:integer):thostname;
 
 
 type
@@ -28,10 +28,10 @@ type
     procedure execute; override;
   public
     onrequestdone:tsocketevent;
-    name : string;
+    name : thostname;
     iplist : tbiniplist;
 
-    procedure forwardlookup(name:string);
+    procedure forwardlookup(name:thostname);
     procedure reverselookup(ip:tbinip);
     destructor destroy; override;
     procedure release;
@@ -53,14 +53,14 @@ type
     ai_socktype : longint;
     ai_protocol : longint;
     ai_addrlen : taddrint;
-    ai_canonname : pchar;
+    ai_canonname : pansichar;
     ai_addr : pinetsockaddrv;
     ai_next : paddrinfo;
   end;
   ppaddrinfo = ^paddrinfo;
-  tgetaddrinfo = function(nodename : pchar; servname : pchar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;
+  tgetaddrinfo = function(nodename : pansichar; servname : pansichar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;
   tfreeaddrinfo = procedure(ai : paddrinfo); stdcall;
-  tgetnameinfo = function(sa:Pinetsockaddrv;salen : longint; host:pchar;hostlen : longint;serv:pchar;servlen:longint;flags:longint) : longint;stdcall;
+  tgetnameinfo = function(sa:Pinetsockaddrv;salen : longint; host:pansichar;hostlen : longint;serv:pansichar;servlen:longint;flags:longint) : longint;stdcall;
 var
   getaddrinfo : tgetaddrinfo;
   freeaddrinfo : tfreeaddrinfo;
@@ -81,7 +81,7 @@ type
   plongint = ^longint;
   pplongint = ^plongint;
 
-function v4onlygetaddrinfo(nodename : pchar; servname : pchar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;
+function v4onlygetaddrinfo(nodename : pansichar; servname : pansichar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;
 var
   output,prev,first : paddrinfo;
   hostent : phostent;
@@ -132,7 +132,7 @@ begin
   if a<b then result := a else result := b;
 end;
 
-function v4onlygetnameinfo(sa:Pinetsockaddrv;salen : longint; host:pchar;hostlen : longint;serv:pchar;servlen:longint;flags:longint) : longint;stdcall;
+function v4onlygetnameinfo(sa:Pinetsockaddrv;salen : longint; host:pansichar;hostlen : longint;serv:pansichar;servlen:longint;flags:longint) : longint;stdcall;
 var
   hostent : phostent;
   bytestocopy : integer;
@@ -158,13 +158,13 @@ procedure populateprocvars;
 var
   libraryhandle : hmodule;
   i : integer;
-  dllname : string;
+  dllname : ansistring;
 
 begin
   if assigned(getaddrinfo) then exit; //procvars already populated
   for i := 0 to 1 do begin
     if i=0 then dllname := 'Ws2_32.dll' else dllname := 'Wship6.dll';
-    libraryhandle := LoadLibrary(pchar(dllname));
+    libraryhandle := LoadLibraryA(pansichar(dllname));
     getaddrinfo := getprocaddress(libraryhandle,'getaddrinfo');
     freeaddrinfo := getprocaddress(libraryhandle,'freeaddrinfo');
     getnameinfo := getprocaddress(libraryhandle,'getnameinfo');
@@ -181,7 +181,7 @@ begin
 end;
 
 
-function winforwardlookuplist(name : string;familyhint:integer;var error : integer) : tbiniplist;
+function winforwardlookuplist(name : thostname;familyhint:integer;var error : integer) : tbiniplist;
 var
   hints: taddrinfo;
   res0,res : paddrinfo;
@@ -198,7 +198,7 @@ begin
   hints.ai_canonname := nil;
   hints.ai_addr := nil;
   hints.ai_next := nil;
-  getaddrinforesult := getaddrinfo(pchar(name),'1',@hints,@res);
+  getaddrinforesult := getaddrinfo(pansichar(name),'1',@hints,@res);
   res0 := res;
   result := biniplist_new;
   if getaddrinforesult = 0 then begin
@@ -227,7 +227,7 @@ begin
   end;
 end;
 
-function winreverselookup(ip:tbinip;var error : integer):string;
+function winreverselookup(ip:tbinip;var error : integer):thostname;
 var
   sa : tinetsockaddrv;
   getnameinforesult : integer;
@@ -236,7 +236,7 @@ begin
   makeinaddrv(ip,'1',sa);
   populateprocvars;
   setlength(result,1025);
-  getnameinforesult := getnameinfo(@sa,sizeof(tinetsockaddrv),pchar(result),length(result),nil,0,0);
+  getnameinforesult := getnameinfo(@sa,sizeof(tinetsockaddrv),pansichar(result),length(result),nil,0,0);
   if getnameinforesult <> 0 then begin
     error := getnameinforesult;
     result := '';
@@ -270,7 +270,7 @@ begin
   end;
 end;
 
-procedure tdnswinasync.forwardlookup(name:string);
+procedure tdnswinasync.forwardlookup(name:thostname);
 begin
   self.name := name;
   freverse := false;
diff --git a/lcore.pas b/lcore.pas
index bb9eb8d..d0fc568 100755
--- a/lcore.pas
+++ b/lcore.pas
@@ -48,6 +48,19 @@ interface
     absoloutemaxs:integer=0;
 
   type
+    {$IF CompilerVersion >= 20.0}
+      { Delphi 2009/2010 widestring is the default string type }
+      thostname = ansistring;
+      tbufferstring = ansistring;
+      tipstring = ansistring;
+    {$else}
+      { Old pre-unicode delphi, todo: need to check if ansistring is available
+        in all older versions of delphi }
+      thostname = string;
+      tbufferstring = string;
+      tipstring = string;
+    {$ifend}
+
     {$ifdef ver1_0}
       sigset= array[0..31] of longint;
     {$endif}
@@ -106,7 +119,7 @@ interface
       lasterror:integer;
       destroying:boolean;
       recvbufsize:integer;
-      function receivestr:string; virtual;
+      function receivestr:tbufferstring; virtual;
       procedure close;
       procedure abort;
       procedure internalclose(error:word); virtual;
@@ -119,8 +132,8 @@ interface
       procedure dup(invalue:longint);
 
       function sendflush : integer;
-      procedure sendstr(const str : string);virtual;
-      procedure putstringinsendbuffer(const newstring : string);
+      procedure sendstr(const str : tbufferstring);virtual;
+      procedure putstringinsendbuffer(const newstring : tbufferstring);
       function send(data:pointer;len:integer):integer;virtual;
       procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
       procedure deletebuffereddata;
@@ -442,13 +455,13 @@ begin
   end;
 end;
 
-procedure tlasio.sendstr(const str : string);
+procedure tlasio.sendstr(const str : tbufferstring);
 begin
   putstringinsendbuffer(str);
   sendflush;
 end;
 
-procedure tlasio.putstringinsendbuffer(const newstring : string);
+procedure tlasio.putstringinsendbuffer(const newstring : tbufferstring);
 begin
   if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
 end;
diff --git a/lsocket.pas b/lsocket.pas
index f7d40e3..7dc3eb9 100755
--- a/lsocket.pas
+++ b/lsocket.pas
@@ -94,11 +94,11 @@ type
       //host               : THostentry      ;
 
       //mainthread         : boolean         ; //for debuggin only
-      addr:string;
-      port:string;
-      localaddr:string;
-      localport:string;
-      proto:string;
+      addr:thostname;
+      port:ansistring;
+      localaddr:thostname;
+      localport:ansistring;
+      proto:ansistring;
       udp,dgram:boolean;
       listenqueue:integer;
       {$ifdef secondlistener}
@@ -118,15 +118,15 @@ type
 
       procedure handlefdtrigger(readtrigger,writetrigger:boolean); override;
       function send(data:pointer;len:integer):integer;override;
-      procedure sendstr(const str : string);override;
+      procedure sendstr(const str : tbufferstring);override;
       function Receive(Buf:Pointer;BufSize:integer):integer; override;
       function getpeername(var addr:tsockaddrin;addrlen:integer):integer; virtual;
       procedure getXaddrbin(var binip:tbinip); virtual;
       procedure getpeeraddrbin(var binip:tbinip); virtual;
-      function getXaddr:string; virtual;
-      function getpeeraddr:string; virtual;
-      function getXport:string; virtual;
-      function getpeerport:string; virtual;
+      function getXaddr:thostname; virtual;
+      function getpeeraddr:thostname; virtual;
+      function getXport:ansistring; virtual;
+      function getpeerport:ansistring; virtual;
       constructor Create(AOwner: TComponent); override;
 
       //this one has to be kept public for now because lcorewsaasyncselect calls it
@@ -296,7 +296,7 @@ begin
   realconnect;
 end;
 
-procedure tlsocket.sendstr(const str : string);
+procedure tlsocket.sendstr(const str : tbufferstring);
 begin
   if dgram then begin
     send(@str[1],length(str))
@@ -372,7 +372,7 @@ var
   yes:longint;
   socktype:integer;
   biniptemp:tbinip;
-  origaddr:string;
+  origaddr:thostname;
 begin
   if state <> wsclosed then close;
   udp := uppercase(proto) = 'UDP';
@@ -709,7 +709,7 @@ begin
   converttov4(binip);
 end;
 
-function tlsocket.getXaddr:string;
+function tlsocket.getXaddr:thostname;
 var
   biniptemp:tbinip;
 begin
@@ -718,7 +718,7 @@ begin
   if result = '' then result := 'error';
 end;
 
-function tlsocket.getpeeraddr:string;
+function tlsocket.getpeeraddr:thostname;
 var
   biniptemp:tbinip;
 begin
@@ -727,7 +727,7 @@ begin
   if result = '' then result := 'error';
 end;
 
-function tlsocket.getXport:string;
+function tlsocket.getXport:ansistring;
 var
   addr:tinetsockaddrv;
   i:integer;
@@ -743,7 +743,7 @@ begin
   result := inttostr(htons(addr.InAddr.port));
 end;
 
-function tlsocket.getpeerport:string;
+function tlsocket.getpeerport:ansistring;
 var
   addr:tinetsockaddrv;
   i:integer;
-- 
2.30.2