X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/6cb6b7ede2d178e03fa817bc28474c175f5a93b9..7839389a75b803b3f9e3c88a8f269c178497cdb2:/dnswin.pas?ds=sidebyside

diff --git a/dnswin.pas b/dnswin.pas
old mode 100755
new mode 100644
index ffe472b..17a8a97
--- a/dnswin.pas
+++ b/dnswin.pas
@@ -2,15 +2,15 @@ unit dnswin;
 
 interface
 
-uses binipstuff,classes,lcore;
+uses binipstuff,classes,lcore,pgtypes;
 
 {$include lcoreconfig.inc}
 
 //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
@@ -20,19 +20,17 @@ type
   //release should only be called from the main thread
   tdnswinasync=class(tthread)
   private
-    ipv6preffered : boolean;
     freverse : boolean;
-    error : integer;
     freewhendone : boolean;
     hadevent : boolean;
   protected
     procedure execute; override;
   public
     onrequestdone:tsocketevent;
-    name : string;
-    ip : tbinip;
+    name : thostname;
+    iplist : tbiniplist;
 
-    procedure forwardlookup(name:string;ipv6preffered:boolean);
+    procedure forwardlookup(name:thostname);
     procedure reverselookup(ip:tbinip);
     destructor destroy; override;
     procedure release;
@@ -41,9 +39,12 @@ type
 
   end;
 
+procedure init;
+
 implementation
 uses
-  lsocket,pgtypes,sysutils,winsock,windows,messages;
+  { zipplet: moved pgtypes to interface because it's needed for the string definitions }
+  lsocket,sysutils,winsock,windows,messages;
 
 type
   //taddrinfo = record; //forward declaration
@@ -54,14 +55,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;
@@ -82,12 +83,13 @@ 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;
   addrlist:^pointer;
 begin
+  output := nil;
   if hints.ai_family <> af_inet6 then begin
     result := 0;
 
@@ -133,7 +135,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;
@@ -159,13 +161,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');
@@ -182,7 +184,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;
@@ -199,7 +201,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
@@ -228,26 +230,16 @@ begin
   end;
 end;
 
-function winreverselookup(ip:tbinip;var error : integer):string;
+function winreverselookup(ip:tbinip;var error : integer):thostname;
 var
   sa : tinetsockaddrv;
   getnameinforesult : integer;
 begin
 
-  if ip.family = AF_INET then begin
-    sa.InAddr.family := AF_INET;
-    sa.InAddr.port := 1;
-    sa.InAddr.addr := ip.ip;
-  end else {$ifdef ipv6}if ip.family = AF_INET6 then begin
-    sa.InAddr6.sin6_family  := AF_INET6;
-    sa.InAddr6.sin6_port := 1;
-    sa.InAddr6.sin6_addr := ip.ip6;
-  end else{$endif} begin
-    raise exception.create('unrecognised address family');
-  end;
+  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 := '';
@@ -274,6 +266,7 @@ begin
     if assigned (dwas.onrequestdone) then dwas.onrequestdone(dwas,awparam);
     dwas.hadevent := true;
     if dwas.freewhendone then dwas.free;
+    result := 0; {added returning 0 when handling --beware}
   end else begin
     //not passing unknown messages on to defwindowproc will cause window
     //creation to fail! --plugwash
@@ -281,16 +274,16 @@ begin
   end;
 end;
 
-procedure tdnswinasync.forwardlookup(name:string;ipv6preffered:boolean);
+procedure tdnswinasync.forwardlookup(name:thostname);
 begin
   self.name := name;
-  self.ipv6preffered := ipv6preffered;
   freverse := false;
   resume;
 end;
 procedure tdnswinasync.reverselookup(ip:tbinip);
 begin
-  self.ip := ip;
+  iplist := biniplist_new;
+  biniplist_add(iplist,ip);
   freverse := true;
   resume;
 end;
@@ -298,14 +291,14 @@ end;
 procedure tdnswinasync.execute;
 var
   error : integer;
-  l:tbiniplist;
+
 begin
   error := 0;
   if reverse then begin
-    name := winreverselookup(ip,error);
+    name := winreverselookup(biniplist_get(iplist,0),error);
   end else begin
-    l := winforwardlookuplist(name,0,error);
-    ip := biniplist_get(l,0);
+    iplist := winforwardlookuplist(name,0,error);
+
   end;
   postmessage(hwnddnswin,wm_user,error,taddrint(self));
 end;
@@ -339,6 +332,7 @@ var
                                  hbrBackground : 0;
                                  lpszMenuName  : nil;
                                  lpszClassName : 'dnswinClass');
+procedure init;
 begin
 
     if Windows.RegisterClass(MyWindowClass) = 0 then halt;
@@ -355,4 +349,7 @@ begin
                                nil);      { CreateParam   }
   //writeln('dnswin hwnd is ',hwnddnswin);
   //writeln('last error is ',GetLastError);
+end;
+
+
 end.