//not seem to have any form of retry code.\r
\r
unit dnsasync;\r
-\r
+{$ifdef fpc}\r
+ {$mode delphi}\r
+{$endif}\r
interface\r
\r
+{$include lcoreconfig.inc}\r
+\r
uses\r
- {$ifdef win32}\r
+ {$ifdef winasyncdns}\r
dnswin,\r
{$endif}\r
lsocket,lcore,\r
classes,binipstuff,dnscore,btime,lcorernd;\r
\r
-{$include lcoreconfig.inc}\r
-\r
const\r
numsock=1{$ifdef ipv6}+1{$endif};\r
\r
\r
dnsserverids : array[0..numsock-1] of integer;\r
startts:double;\r
- {$ifdef win32}\r
+ {$ifdef winasyncdns}\r
dwas : tdnswinasync;\r
{$endif}\r
\r
procedure asyncprocess(socketno:integer);\r
procedure receivehandler(sender:tobject;error:word);\r
function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
- {$ifdef win32}\r
+ {$ifdef winasyncdns}\r
procedure winrequestdone(sender:tobject;error:word);\r
{$endif}\r
\r
onrequestdone:tsocketevent;\r
\r
//addr and port allow the application to specify a dns server specifically\r
- //for this dnsasync object. This is not a reccomended mode of operation\r
+ //for this dnsasync object. This is not a recommended mode of operation\r
//because it limits the app to one dns server but is kept for compatibility\r
//and special uses.\r
- addr,port:string;\r
+ addr,port:ansistring;\r
\r
overrideaf : integer;\r
\r
procedure cancel;//cancel an outstanding dns request\r
- function dnsresult:string; //get result of dnslookup as a string\r
+ function dnsresult:ansistring; //get result of dnslookup as a string\r
procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip\r
property dnsresultlist : tbiniplist read fresultlist;\r
- procedure forwardlookup(const name:string); //start forward lookup,\r
- //preffering ipv4\r
+ procedure forwardlookup(const name:ansistring); //start forward lookup,\r
+ //preferring ipv4\r
procedure reverselookup(const binip:tbinip); //start reverse lookup\r
- procedure customlookup(const name:string;querytype:integer); //start custom type lookup\r
+ procedure customlookup(const name:ansistring;querytype:integer); //start custom type lookup\r
\r
constructor create(aowner:tcomponent); override;\r
destructor destroy; override;\r
setstate_request_init('',states[socketno]);\r
end;\r
end;\r
+\r
+ {$ifdef winasyncdns}\r
+ if assigned(dwas) then begin\r
+ dwas.release;\r
+ dwas := nil;\r
+ end;\r
+ {$endif}\r
+\r
inherited destroy;\r
end;\r
\r
Src : TInetSockAddrV;\r
SrcLen : Integer;\r
fromip:tbinip;\r
- fromport:string;\r
+ fromport:ansistring;\r
begin\r
socketno := tlsocket(sender).tag;\r
//writeln('got a reply on socket number ',socketno);\r
if states[socketno].resultaction <> action_done then begin\r
//we ignore packets that come after we are done\r
if dnsserverids[socketno] >= 0 then begin\r
- reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000000));\r
+ reportlag(dnsserverids[socketno],trunc((wintimefloat-startts)*1000000));\r
dnsserverids[socketno] := -1;\r
end;\r
{ writeln('received reply');}\r
\r
function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
var\r
- destination : string;\r
+ destination : tbinip;\r
inaddr : tinetsockaddrv;\r
trytolisten:integer;\r
begin\r
result := false;\r
if len = 0 then exit; {no packet}\r
if sockets[socketno].state <> wsconnected then begin\r
- startts := unixtimefloat;\r
+ startts := wintimefloat;\r
if port = '' then port := '53';\r
sockets[socketno].Proto := 'udp';\r
sockets[socketno].ondataavailable := receivehandler;\r
end;\r
if addr <> '' then begin\r
dnsserverids[socketno] := -1;\r
- destination := addr\r
+ destination := ipstrtobinf(addr);\r
end else begin\r
- destination := getcurrentsystemnameserver(dnsserverids[socketno]);\r
+ destination := getcurrentsystemnameserverbin(dnsserverids[socketno]);\r
end;\r
- destinations[socketno] := ipstrtobinf(destination);\r
+ destinations[socketno] := destination;\r
\r
- {$ifdef ipv6}{$ifdef win32}\r
+ {$ifdef ipv6}{$ifdef mswindows}\r
if destinations[socketno].family = AF_INET6 then if (requestaf = useaf_default) then requestaf := useaf_preferv6;\r
{$endif}{$endif}\r
\r
exit;\r
end;\r
\r
- if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;\r
-\r
if overrideaf = useaf_default then begin\r
{$ifdef ipv6}\r
- {$ifdef win32}if not (usewindns and (addr = '')) then{$endif}\r
+ {$ifdef winasyncdns}if not (usewindns and (addr = '') and (overridednsserver = '')) then{$endif}\r
initpreferredmode;\r
{$endif}\r
requestaf := useaf;\r
requestaf := overrideaf;\r
end;\r
\r
- {$ifdef win32}\r
- if usewindns and (addr = '') then begin\r
+ {$ifdef winasyncdns}\r
+ if usewindns and (addr = '') and (overridednsserver = '') then begin\r
dwas := tdnswinasync.create;\r
dwas.onrequestdone := winrequestdone;\r
\r
inc(numsockused);\r
end;\r
{$endif}\r
+\r
for i := 0 to numsockused-1 do begin\r
asyncprocess(i);\r
end;\r
-\r
end;\r
\r
procedure tdnsasync.reverselookup;\r
begin\r
- if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;\r
- {$ifdef win32}\r
+ {$ifdef winasyncdns}\r
if usewindns and (addr = '') then begin\r
dwas := tdnswinasync.create;\r
dwas.onrequestdone := winrequestdone;\r
\r
procedure tdnsasync.customlookup;\r
begin\r
- if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;\r
setstate_custom(name,querytype,states[0]);\r
numsockused := 1;\r
asyncprocess(0);\r
var\r
socketno : integer;\r
begin\r
- {$ifdef win32}\r
+ {$ifdef winasyncdns}\r
if assigned(dwas) then begin\r
dwas.release;\r
dwas := nil;\r
onrequestdone(self,0);\r
end;\r
\r
-{$ifdef win32}\r
+{$ifdef winasyncdns}\r
procedure tdnsasync.winrequestdone(sender:tobject;error:word);\r
\r
begin\r