X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/40b538b4671a190ea35502207562edabfcea539b..9eaeac69829469108bce954ccce0710bbdb27fb3:/dnswin.pas diff --git a/dnswin.pas b/dnswin.pas old mode 100755 new mode 100644 index 573c888..567ea68 --- 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 @@ -21,17 +21,16 @@ type tdnswinasync=class(tthread) private freverse : boolean; - error : integer; freewhendone : boolean; hadevent : boolean; protected 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; @@ -42,7 +41,8 @@ type 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 @@ -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,12 +81,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; @@ -132,7 +133,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 +159,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 +182,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 +199,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,16 +228,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 - makeinaddrv(sa,ip); + 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 := ''; @@ -263,6 +264,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 @@ -270,7 +272,7 @@ begin end; end; -procedure tdnswinasync.forwardlookup(name:string); +procedure tdnswinasync.forwardlookup(name:thostname); begin self.name := name; freverse := false;