Coloquei este exemplo aqui para ilustrar a forma de se obter informações do sistema operacional com o uso de recursos externos, como Activex.
No exemplo que se segue faço uso do Activex DNSLookup, facilmente encontrável na internet pelo Google.
Codigo exemplo:
/*
*
*
*/
#include "FiveWin.ch"
function Main(DomainName,IPAddr)
local oWnd, oActiveX
RegisterServer( "qDNS.ocx" )
oqDNS := TOleAuto():New("qdns.DNSLookup")
DomainName := "www.pctoledo.com.br"
IPAddr := "127.0.0.1"
? IPLookup := oqDNS:IPLookup(DomainName)
? NameLookup := oqDNS:ReverseLookup(IPAddr)
oqDNS:End()
return nil
#pragma BEGINDUMP
#include <hbapi.h>
#include <windows.h>
typedef LONG ( * PDLLREGISTERSERVER ) ( void );
HB_FUNC( REGISTERSERVER )
{
HMODULE hDll = LoadLibrary( hb_parc( 1 ) );
LONG lReturn = 0;
if( hDll )
{
FARPROC pRegisterServer = GetProcAddress( hDll, "DllRegisterServer" );
if( pRegisterServer )
lReturn = ( ( PDLLREGISTERSERVER ) pRegisterServer )();
FreeLibrary( hDll );
}
hb_retnl( lReturn );
}
#pragma ENDDUMP
Neste exemplo podemos obter a mesma informação que o PING do DOS com a sutileza de não ser necessário obter arquivos de saida em texto, recuperá-los e capturar os valores dentro do conteúdo.
O código exemplo em Visual Basic Script e ASP que acompanha o Activex está aqui, foi minha fonte de inspiração:
<%
Option Explicit
'=================================================================================
'=== You may use and distribute this code, but you may not charge
'=== for it or present it as your own work. This notice should be retained.
'=== This source code is provided WITHOUT WARRANTY either expressed or implied.
'=== If you find any bugs in this code, please notify the author.
'=== This code is provided "As-Is" - if it doesn't work, we accept
'=== no responsibility, nor do we support it.
'===
'=== Purpose: Perform DNS Lookup and Reverse Name Lookup
'=== Author: Michael Meelis (michael@meelix.com)
'=== Updated: 12Apr01
'=================================================================================
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title>DNS Lookup</title>
</head>
<body>
<%
Dim DNSObj
Dim DomainName
Dim IPLookup
Dim IPAddr
Dim NameLookup
DomainName = Request.Form("DomainName").Item
IPLookup = ""
IPAddr = Request.Form("IPAddr").Item
NameLookup = ""
On Error Resume Next
'=== Work around for checking if DNS is actually working ===
Set DNSObj = Server.CreateObject("qdns.DNSLookup")
If Err.Number = -2147221005 Then
'=== QDNS.dll is not properly installed ================
Response.Write "<font color=red>Object not installed! Please copy QDNS.dll to your permanent Directory and run ""regsvr32 QDNS.dll""</font><BR>"
Else
'=== Lets check if we can reach the DNS server and if it is responsive ===
If Not DNSObj.IsDnsResponsive() then
'=== DNS is NOT working from this location so exit ===
Response.Write "<font color=red>DNS Server not responsive.</font>"
Else
'=== Now lets do some DNS work =======================
If Not IsEmpty(DomainName) And Len(DomainName) > 0 Then IPLookup = DNSObj.IPLookup(DomainName)
If Not IsEmpty(IPAddr) And Len(IPAddr) > 0 Then NameLookup = DNSObj.ReverseLookup(IPAddr)
End if
End if
'=== Clean up ===
Set DNSObj = Nothing
%>
<form method='POST'>
DNS Name: <input type="text" name="DomainName" size="37" value="<%=DomainName%>"> has IP Address: <B><%=IPLookup%></B>
<BR>
IP Address: <input type="text" name="IPAddr" size="37" value="<%=IPAddr%>"> has DNS Name: <B><%=NameLookup%></B>
<BR><BR>
<input type='submit' value='Perform Lookup'>
</form>
</body>
</html>
Usei Fivewin para obter as respostas, mas o código pode ser usado em qualquer Harbour/xHarbour com uso de OLE.
Podem baixar de http://wareseeker.com/Network-Tools/dns ... zip/335238