Initial work on porting lcore to delphi 2010

git-svn-id: file:///svnroot/lcore/branches/delphi2010@67 b1de8a11-f9be-4011-bde0-cc7ace90066a

diff --git a/dnswin.pas b/dnswin.pas
index e9c2a16d1b30552806351797720adb8b75500756..02539e901d963ed2cc04af9640a2e313d0bddeda 100644 (file)
--- 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\r
 //set to a windows error code (error will be left untouched under non error\r
 //conditions).\r
 //on failure a null string or zeroed out binip will be retuned and error will be\r
 //set to a windows error code (error will be left untouched under non error\r
 //conditions).\r

-function winforwardlookuplist(name : string;familyhint:integer;var error : integer) : tbiniplist;\r
-function winreverselookup(ip:tbinip;var error:integer):string;\r
+function winforwardlookuplist(name : thostname;familyhint:integer;var error : integer) : tbiniplist;\r
+function winreverselookup(ip:tbinip;var error:integer):thostname;\r

 \r
 \r
 type\r
 \r
 \r
 type\r


@@ -28,10 +28,10 @@ type
     procedure execute; override;\r
   public\r
     onrequestdone:tsocketevent;\r
     procedure execute; override;\r
   public\r
     onrequestdone:tsocketevent;\r

-    name : string;\r
+    name : thostname;\r

     iplist : tbiniplist;\r
 \r
     iplist : tbiniplist;\r
 \r

-    procedure forwardlookup(name:string);\r
+    procedure forwardlookup(name:thostname);\r

     procedure reverselookup(ip:tbinip);\r
     destructor destroy; override;\r
     procedure release;\r
     procedure reverselookup(ip:tbinip);\r
     destructor destroy; override;\r
     procedure release;\r


@@ -53,14 +53,14 @@ type
     ai_socktype : longint;\r
     ai_protocol : longint;\r
     ai_addrlen : taddrint;\r
     ai_socktype : longint;\r
     ai_protocol : longint;\r
     ai_addrlen : taddrint;\r

-    ai_canonname : pchar;\r
+    ai_canonname : pansichar;\r

     ai_addr : pinetsockaddrv;\r
     ai_next : paddrinfo;\r
   end;\r
   ppaddrinfo = ^paddrinfo;\r
     ai_addr : pinetsockaddrv;\r
     ai_next : paddrinfo;\r
   end;\r
   ppaddrinfo = ^paddrinfo;\r

-  tgetaddrinfo = function(nodename : pchar; servname : pchar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;\r
+  tgetaddrinfo = function(nodename : pansichar; servname : pansichar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;\r

   tfreeaddrinfo = procedure(ai : paddrinfo); stdcall;\r
   tfreeaddrinfo = procedure(ai : paddrinfo); stdcall;\r

-  tgetnameinfo = function(sa:Pinetsockaddrv;salen : longint; host:pchar;hostlen : longint;serv:pchar;servlen:longint;flags:longint) : longint;stdcall;\r
+  tgetnameinfo = function(sa:Pinetsockaddrv;salen : longint; host:pansichar;hostlen : longint;serv:pansichar;servlen:longint;flags:longint) : longint;stdcall;\r

 var\r
   getaddrinfo : tgetaddrinfo;\r
   freeaddrinfo : tfreeaddrinfo;\r
 var\r
   getaddrinfo : tgetaddrinfo;\r
   freeaddrinfo : tfreeaddrinfo;\r


@@ -81,7 +81,7 @@ type
   plongint = ^longint;\r
   pplongint = ^plongint;\r
 \r
   plongint = ^longint;\r
   pplongint = ^plongint;\r
 \r

-function v4onlygetaddrinfo(nodename : pchar; servname : pchar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;\r
+function v4onlygetaddrinfo(nodename : pansichar; servname : pansichar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;\r

 var\r
   output,prev,first : paddrinfo;\r
   hostent : phostent;\r
 var\r
   output,prev,first : paddrinfo;\r
   hostent : phostent;\r


@@ -132,7 +132,7 @@ begin
   if a<b then result := a else result := b;\r
 end;\r
 \r
   if a<b then result := a else result := b;\r
 end;\r
 \r

-function v4onlygetnameinfo(sa:Pinetsockaddrv;salen : longint; host:pchar;hostlen : longint;serv:pchar;servlen:longint;flags:longint) : longint;stdcall;\r
+function v4onlygetnameinfo(sa:Pinetsockaddrv;salen : longint; host:pansichar;hostlen : longint;serv:pansichar;servlen:longint;flags:longint) : longint;stdcall;\r

 var\r
   hostent : phostent;\r
   bytestocopy : integer;\r
 var\r
   hostent : phostent;\r
   bytestocopy : integer;\r


@@ -158,13 +158,13 @@ procedure populateprocvars;
 var\r
   libraryhandle : hmodule;\r
   i : integer;\r
 var\r
   libraryhandle : hmodule;\r
   i : integer;\r

-  dllname : string;\r
+  dllname : ansistring;\r

 \r
 begin\r
   if assigned(getaddrinfo) then exit; //procvars already populated\r
   for i := 0 to 1 do begin\r
     if i=0 then dllname := 'Ws2_32.dll' else dllname := 'Wship6.dll';\r
 \r
 begin\r
   if assigned(getaddrinfo) then exit; //procvars already populated\r
   for i := 0 to 1 do begin\r
     if i=0 then dllname := 'Ws2_32.dll' else dllname := 'Wship6.dll';\r

-    libraryhandle := LoadLibrary(pchar(dllname));\r
+    libraryhandle := LoadLibraryA(pansichar(dllname));\r

     getaddrinfo := getprocaddress(libraryhandle,'getaddrinfo');\r
     freeaddrinfo := getprocaddress(libraryhandle,'freeaddrinfo');\r
     getnameinfo := getprocaddress(libraryhandle,'getnameinfo');\r
     getaddrinfo := getprocaddress(libraryhandle,'getaddrinfo');\r
     freeaddrinfo := getprocaddress(libraryhandle,'freeaddrinfo');\r
     getnameinfo := getprocaddress(libraryhandle,'getnameinfo');\r


@@ -181,7 +181,7 @@ begin
 end;\r
 \r
 \r
 end;\r
 \r
 \r

-function winforwardlookuplist(name : string;familyhint:integer;var error : integer) : tbiniplist;\r
+function winforwardlookuplist(name : thostname;familyhint:integer;var error : integer) : tbiniplist;\r

 var\r
   hints: taddrinfo;\r
   res0,res : paddrinfo;\r
 var\r
   hints: taddrinfo;\r
   res0,res : paddrinfo;\r


@@ -198,7 +198,7 @@ begin
   hints.ai_canonname := nil;\r
   hints.ai_addr := nil;\r
   hints.ai_next := nil;\r
   hints.ai_canonname := nil;\r
   hints.ai_addr := nil;\r
   hints.ai_next := nil;\r

-  getaddrinforesult := getaddrinfo(pchar(name),'1',@hints,@res);\r
+  getaddrinforesult := getaddrinfo(pansichar(name),'1',@hints,@res);\r

   res0 := res;\r
   result := biniplist_new;\r
   if getaddrinforesult = 0 then begin\r
   res0 := res;\r
   result := biniplist_new;\r
   if getaddrinforesult = 0 then begin\r


@@ -227,7 +227,7 @@ begin
   end;\r
 end;\r
 \r
   end;\r
 end;\r
 \r

-function winreverselookup(ip:tbinip;var error : integer):string;\r
+function winreverselookup(ip:tbinip;var error : integer):thostname;\r

 var\r
   sa : tinetsockaddrv;\r
   getnameinforesult : integer;\r
 var\r
   sa : tinetsockaddrv;\r
   getnameinforesult : integer;\r


@@ -236,7 +236,7 @@ begin
   makeinaddrv(ip,'1',sa);\r
   populateprocvars;\r
   setlength(result,1025);\r
   makeinaddrv(ip,'1',sa);\r
   populateprocvars;\r
   setlength(result,1025);\r

-  getnameinforesult := getnameinfo(@sa,sizeof(tinetsockaddrv),pchar(result),length(result),nil,0,0);\r
+  getnameinforesult := getnameinfo(@sa,sizeof(tinetsockaddrv),pansichar(result),length(result),nil,0,0);\r

   if getnameinforesult <> 0 then begin\r
     error := getnameinforesult;\r
     result := '';\r
   if getnameinforesult <> 0 then begin\r
     error := getnameinforesult;\r
     result := '';\r


@@ -270,7 +270,7 @@ begin
   end;\r
 end;\r
 \r
   end;\r
 end;\r
 \r

-procedure tdnswinasync.forwardlookup(name:string);\r
+procedure tdnswinasync.forwardlookup(name:thostname);\r

 begin\r
   self.name := name;\r
   freverse := false;\r
 begin\r
   self.name := name;\r
   freverse := false;\r

diff --git a/lcore.pas b/lcore.pas
index bb9eb8d606537ee4a8caf0fbd300105515e363c8..d0fc5686a88848574676f7d36972a598b734e57b 100755 (executable)
--- a/lcore.pas
+++ b/lcore.pas
@@ -48,6 +48,19 @@ interface
     absoloutemaxs:integer=0;\r
 \r
   type\r
     absoloutemaxs:integer=0;\r
 \r
   type\r

+    {$IF CompilerVersion >= 20.0}\r
+      { Delphi 2009/2010 widestring is the default string type }\r
+      thostname = ansistring;\r
+      tbufferstring = ansistring;\r
+      tipstring = ansistring;\r
+    {$else}\r
+      { Old pre-unicode delphi, todo: need to check if ansistring is available\r
+        in all older versions of delphi }\r
+      thostname = string;\r
+      tbufferstring = string;\r
+      tipstring = string;\r
+    {$ifend}\r
+\r

     {$ifdef ver1_0}\r
       sigset= array[0..31] of longint;\r
     {$endif}\r
     {$ifdef ver1_0}\r
       sigset= array[0..31] of longint;\r
     {$endif}\r


@@ -106,7 +119,7 @@ interface
       lasterror:integer;\r
       destroying:boolean;\r
       recvbufsize:integer;\r
       lasterror:integer;\r
       destroying:boolean;\r
       recvbufsize:integer;\r

-      function receivestr:string; virtual;\r
+      function receivestr:tbufferstring; virtual;\r

       procedure close;\r
       procedure abort;\r
       procedure internalclose(error:word); virtual;\r
       procedure close;\r
       procedure abort;\r
       procedure internalclose(error:word); virtual;\r


@@ -119,8 +132,8 @@ interface
       procedure dup(invalue:longint);\r
 \r
       function sendflush : integer;\r
       procedure dup(invalue:longint);\r
 \r
       function sendflush : integer;\r

-      procedure sendstr(const str : string);virtual;\r
-      procedure putstringinsendbuffer(const newstring : string);\r
+      procedure sendstr(const str : tbufferstring);virtual;\r
+      procedure putstringinsendbuffer(const newstring : tbufferstring);\r

       function send(data:pointer;len:integer):integer;virtual;\r
       procedure putdatainsendbuffer(data:pointer;len:integer); virtual;\r
       procedure deletebuffereddata;\r
       function send(data:pointer;len:integer):integer;virtual;\r
       procedure putdatainsendbuffer(data:pointer;len:integer); virtual;\r
       procedure deletebuffereddata;\r


@@ -442,13 +455,13 @@ begin
   end;\r
 end;\r
 \r
   end;\r
 end;\r
 \r

-procedure tlasio.sendstr(const str : string);\r
+procedure tlasio.sendstr(const str : tbufferstring);\r

 begin\r
   putstringinsendbuffer(str);\r
   sendflush;\r
 end;\r
 \r
 begin\r
   putstringinsendbuffer(str);\r
   sendflush;\r
 end;\r
 \r

-procedure tlasio.putstringinsendbuffer(const newstring : string);\r
+procedure tlasio.putstringinsendbuffer(const newstring : tbufferstring);\r

 begin\r
   if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));\r
 end;\r
 begin\r
   if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));\r
 end;\r

diff --git a/lsocket.pas b/lsocket.pas
index f7d40e39679925f4c9f13493bd57eb5121e435c1..7dc3eb93abd992746c9e1137739599594ffdfa14 100755 (executable)
--- a/lsocket.pas
+++ b/lsocket.pas
@@ -94,11 +94,11 @@ type
       //host               : THostentry      ;\r
 \r
       //mainthread         : boolean         ; //for debuggin only\r
       //host               : THostentry      ;\r
 \r
       //mainthread         : boolean         ; //for debuggin only\r

-      addr:string;\r
-      port:string;\r
-      localaddr:string;\r
-      localport:string;\r
-      proto:string;\r
+      addr:thostname;\r
+      port:ansistring;\r
+      localaddr:thostname;\r
+      localport:ansistring;\r
+      proto:ansistring;\r

       udp,dgram:boolean;\r
       listenqueue:integer;\r
       {$ifdef secondlistener}\r
       udp,dgram:boolean;\r
       listenqueue:integer;\r
       {$ifdef secondlistener}\r


@@ -118,15 +118,15 @@ type
 \r
       procedure handlefdtrigger(readtrigger,writetrigger:boolean); override;\r
       function send(data:pointer;len:integer):integer;override;\r
 \r
       procedure handlefdtrigger(readtrigger,writetrigger:boolean); override;\r
       function send(data:pointer;len:integer):integer;override;\r

-      procedure sendstr(const str : string);override;\r
+      procedure sendstr(const str : tbufferstring);override;\r

       function Receive(Buf:Pointer;BufSize:integer):integer; override;\r
       function getpeername(var addr:tsockaddrin;addrlen:integer):integer; virtual;\r
       procedure getXaddrbin(var binip:tbinip); virtual;\r
       procedure getpeeraddrbin(var binip:tbinip); virtual;\r
       function Receive(Buf:Pointer;BufSize:integer):integer; override;\r
       function getpeername(var addr:tsockaddrin;addrlen:integer):integer; virtual;\r
       procedure getXaddrbin(var binip:tbinip); virtual;\r
       procedure getpeeraddrbin(var binip:tbinip); virtual;\r

-      function getXaddr:string; virtual;\r
-      function getpeeraddr:string; virtual;\r
-      function getXport:string; virtual;\r
-      function getpeerport:string; virtual;\r
+      function getXaddr:thostname; virtual;\r
+      function getpeeraddr:thostname; virtual;\r
+      function getXport:ansistring; virtual;\r
+      function getpeerport:ansistring; virtual;\r

       constructor Create(AOwner: TComponent); override;\r
 \r
       //this one has to be kept public for now because lcorewsaasyncselect calls it\r
       constructor Create(AOwner: TComponent); override;\r
 \r
       //this one has to be kept public for now because lcorewsaasyncselect calls it\r


@@ -296,7 +296,7 @@ begin
   realconnect;\r
 end;\r
 \r
   realconnect;\r
 end;\r
 \r

-procedure tlsocket.sendstr(const str : string);\r
+procedure tlsocket.sendstr(const str : tbufferstring);\r

 begin\r
   if dgram then begin\r
     send(@str[1],length(str))\r
 begin\r
   if dgram then begin\r
     send(@str[1],length(str))\r


@@ -372,7 +372,7 @@ var
   yes:longint;\r
   socktype:integer;\r
   biniptemp:tbinip;\r
   yes:longint;\r
   socktype:integer;\r
   biniptemp:tbinip;\r

-  origaddr:string;\r
+  origaddr:thostname;\r

 begin\r
   if state <> wsclosed then close;\r
   udp := uppercase(proto) = 'UDP';\r
 begin\r
   if state <> wsclosed then close;\r
   udp := uppercase(proto) = 'UDP';\r


@@ -709,7 +709,7 @@ begin
   converttov4(binip);\r
 end;\r
 \r
   converttov4(binip);\r
 end;\r
 \r

-function tlsocket.getXaddr:string;\r
+function tlsocket.getXaddr:thostname;\r

 var\r
   biniptemp:tbinip;\r
 begin\r
 var\r
   biniptemp:tbinip;\r
 begin\r


@@ -718,7 +718,7 @@ begin
   if result = '' then result := 'error';\r
 end;\r
 \r
   if result = '' then result := 'error';\r
 end;\r
 \r

-function tlsocket.getpeeraddr:string;\r
+function tlsocket.getpeeraddr:thostname;\r

 var\r
   biniptemp:tbinip;\r
 begin\r
 var\r
   biniptemp:tbinip;\r
 begin\r


@@ -727,7 +727,7 @@ begin
   if result = '' then result := 'error';\r
 end;\r
 \r
   if result = '' then result := 'error';\r
 end;\r
 \r

-function tlsocket.getXport:string;\r
+function tlsocket.getXport:ansistring;\r

 var\r
   addr:tinetsockaddrv;\r
   i:integer;\r
 var\r
   addr:tinetsockaddrv;\r
   i:integer;\r


@@ -743,7 +743,7 @@ begin
   result := inttostr(htons(addr.InAddr.port));\r
 end;\r
 \r
   result := inttostr(htons(addr.InAddr.port));\r
 end;\r
 \r

-function tlsocket.getpeerport:string;\r
+function tlsocket.getpeerport:ansistring;\r

 var\r
   addr:tinetsockaddrv;\r
   i:integer;\r
 var\r
   addr:tinetsockaddrv;\r
   i:integer;\r