X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/40b538b4671a190ea35502207562edabfcea539b..ac385c745f6e299bea549eb2006b803e3885c916:/dnswin.pas?ds=inline diff --git a/dnswin.pas b/dnswin.pas old mode 100755 new mode 100644 index 573c888..5e85f70 --- 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; @@ -40,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 @@ -53,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; @@ -81,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; @@ -107,15 +110,15 @@ begin getmem(output,sizeof(taddrinfo)); if assigned(prev) then prev.ai_next := output; - getmem(output.ai_addr,sizeof(tinetsockaddr)); + getmem(output.ai_addr,sizeof(tlinetsockaddr4)); if servname <> nil then output.ai_addr.InAddr.port := htons(strtoint(servname)) else output.ai_addr.InAddr.port := 0; output.ai_addr.InAddr.addr := longint(addrlist^^); - inc(integer(addrlist),4); + inc(taddrint(addrlist),4); output.ai_flags := 0; output.ai_family := af_inet; output.ai_socktype := 0; output.ai_protocol := 0; - output.ai_addrlen := sizeof(tinetsockaddr); + output.ai_addrlen := sizeof(tlinetsockaddr4); output.ai_canonname := nil; output.ai_next := nil; prev := output; @@ -132,7 +135,7 @@ begin if a 0 then begin error := getnameinforesult; result := ''; @@ -263,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 @@ -270,7 +274,7 @@ begin end; end; -procedure tdnswinasync.forwardlookup(name:string); +procedure tdnswinasync.forwardlookup(name:thostname); begin self.name := name; freverse := false; @@ -328,6 +332,7 @@ var hbrBackground : 0; lpszMenuName : nil; lpszClassName : 'dnswinClass'); +procedure init; begin if Windows.RegisterClass(MyWindowClass) = 0 then halt; @@ -344,4 +349,7 @@ begin nil); { CreateParam } //writeln('dnswin hwnd is ',hwnddnswin); //writeln('last error is ',GetLastError); +end; + + end.