X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/055fa6bf18e0733d1bf2f97075d6bb33c76e72b5..1c8b91ca0f6891a397357c7cf7d77af18c15937d:/dnsasync.pas diff --git a/dnsasync.pas b/dnsasync.pas index fab858d..5e72cc0 100644 --- a/dnsasync.pas +++ b/dnsasync.pas @@ -7,18 +7,20 @@ //not seem to have any form of retry code. unit dnsasync; - +{$ifdef fpc} + {$mode delphi} +{$endif} interface +{$include lcoreconfig.inc} + uses - {$ifdef win32} + {$ifdef winasyncdns} dnswin, {$endif} lsocket,lcore, classes,binipstuff,dnscore,btime,lcorernd; -{$include lcoreconfig.inc} - const numsock=1{$ifdef ipv6}+1{$endif}; @@ -39,7 +41,7 @@ type dnsserverids : array[0..numsock-1] of integer; startts:double; - {$ifdef win32} + {$ifdef winasyncdns} dwas : tdnswinasync; {$endif} @@ -49,7 +51,7 @@ type procedure asyncprocess(socketno:integer); procedure receivehandler(sender:tobject;error:word); function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean; - {$ifdef win32} + {$ifdef winasyncdns} procedure winrequestdone(sender:tobject;error:word); {$endif} @@ -57,21 +59,21 @@ type onrequestdone:tsocketevent; //addr and port allow the application to specify a dns server specifically - //for this dnsasync object. This is not a reccomended mode of operation + //for this dnsasync object. This is not a recommended mode of operation //because it limits the app to one dns server but is kept for compatibility //and special uses. - addr,port:string; + addr,port:ansistring; overrideaf : integer; procedure cancel;//cancel an outstanding dns request - function dnsresult:string; //get result of dnslookup as a string + function dnsresult:ansistring; //get result of dnslookup as a string procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip property dnsresultlist : tbiniplist read fresultlist; - procedure forwardlookup(const name:string); //start forward lookup, - //preffering ipv4 + procedure forwardlookup(const name:ansistring); //start forward lookup, + //preferring ipv4 procedure reverselookup(const binip:tbinip); //start reverse lookup - procedure customlookup(const name:string;querytype:integer); //start custom type lookup + procedure customlookup(const name:ansistring;querytype:integer); //start custom type lookup constructor create(aowner:tcomponent); override; destructor destroy; override; @@ -109,6 +111,14 @@ begin setstate_request_init('',states[socketno]); end; end; + + {$ifdef winasyncdns} + if assigned(dwas) then begin + dwas.release; + dwas := nil; + end; + {$endif} + inherited destroy; end; @@ -118,7 +128,7 @@ var Src : TInetSockAddrV; SrcLen : Integer; fromip:tbinip; - fromport:string; + fromport:ansistring; begin socketno := tlsocket(sender).tag; //writeln('got a reply on socket number ',socketno); @@ -139,7 +149,7 @@ begin if states[socketno].resultaction <> action_done then begin //we ignore packets that come after we are done if dnsserverids[socketno] >= 0 then begin - reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000000)); + reportlag(dnsserverids[socketno],trunc((wintimefloat-startts)*1000000)); dnsserverids[socketno] := -1; end; { writeln('received reply');} @@ -153,7 +163,7 @@ end; function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean; var - destination : string; + destination : tbinip; inaddr : tinetsockaddrv; trytolisten:integer; begin @@ -162,7 +172,7 @@ begin result := false; if len = 0 then exit; {no packet} if sockets[socketno].state <> wsconnected then begin - startts := unixtimefloat; + startts := wintimefloat; if port = '' then port := '53'; sockets[socketno].Proto := 'udp'; sockets[socketno].ondataavailable := receivehandler; @@ -185,13 +195,13 @@ begin end; if addr <> '' then begin dnsserverids[socketno] := -1; - destination := addr + destination := ipstrtobinf(addr); end else begin - destination := getcurrentsystemnameserver(dnsserverids[socketno]); + destination := getcurrentsystemnameserverbin(dnsserverids[socketno]); end; - destinations[socketno] := ipstrtobinf(destination); + destinations[socketno] := destination; - {$ifdef ipv6}{$ifdef win32} + {$ifdef ipv6}{$ifdef mswindows} if destinations[socketno].family = AF_INET6 then if (requestaf = useaf_default) then requestaf := useaf_preferv6; {$endif}{$endif} @@ -255,11 +265,9 @@ begin exit; end; - if (overridednsserver <> '') and (addr = '') then addr := overridednsserver; - if overrideaf = useaf_default then begin {$ifdef ipv6} - {$ifdef win32}if not (usewindns and (addr = '')) then{$endif} + {$ifdef winasyncdns}if not (usewindns and (addr = '') and (overridednsserver = '')) then{$endif} initpreferredmode; {$endif} requestaf := useaf; @@ -267,8 +275,8 @@ begin requestaf := overrideaf; end; - {$ifdef win32} - if usewindns and (addr = '') then begin + {$ifdef winasyncdns} + if usewindns and (addr = '') and (overridednsserver = '') then begin dwas := tdnswinasync.create; dwas.onrequestdone := winrequestdone; @@ -291,16 +299,15 @@ begin inc(numsockused); end; {$endif} + for i := 0 to numsockused-1 do begin asyncprocess(i); end; - end; procedure tdnsasync.reverselookup; begin - if (overridednsserver <> '') and (addr = '') then addr := overridednsserver; - {$ifdef win32} + {$ifdef winasyncdns} if usewindns and (addr = '') then begin dwas := tdnswinasync.create; dwas.onrequestdone := winrequestdone; @@ -316,7 +323,6 @@ end; procedure tdnsasync.customlookup; begin - if (overridednsserver <> '') and (addr = '') then addr := overridednsserver; setstate_custom(name,querytype,states[0]); numsockused := 1; asyncprocess(0); @@ -338,7 +344,7 @@ procedure tdnsasync.cancel; var socketno : integer; begin - {$ifdef win32} + {$ifdef winasyncdns} if assigned(dwas) then begin dwas.release; dwas := nil; @@ -361,7 +367,7 @@ begin onrequestdone(self,0); end; -{$ifdef win32} +{$ifdef winasyncdns} procedure tdnsasync.winrequestdone(sender:tobject;error:word); begin