X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/40b538b4671a190ea35502207562edabfcea539b..7b8a26e75924ecff47d3e347eb4e2685656c728e:/dnswin.pas?ds=inline
diff --git a/dnswin.pas b/dnswin.pas
old mode 100755
new mode 100644
index 573c888..1f6263d
--- 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,7 +110,7 @@ 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);
@@ -115,7 +118,7 @@ begin
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<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 +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');
@@ -181,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;
@@ -198,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
@@ -227,16 +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
- 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 +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.