kapiaba Posted April 22, 2015 Report Share Posted April 22, 2015 Boa tarde Rochinha, esta funcção deveria retornar a hora de Brasilia? Compilei com xHarbour e fwh13.06 e não está retornando nada. Origem: http://www.pctoledo.com.br/forum/viewtopic.php?f=4&t=14691&start=30 #include "FiveWin.ch" #include "dll.ch" static xdll // Need to TdWebService Class STATIC oWnd Function Main(_ping_) Pinga( _ping_ ) return nil //------------------------------------- Function Pinga(DestinationAddress) //------------------------------------- local IcmpHandle,Replicas local RequestData:="Testando ping",; RequestSize:=15,; RequestOptions:="",; ReplyBuffer:=space(278),; ReplySize:=278,; Timeout:=500 && Milisegundos de espera default DestinationAddress := "0.0.0.0" DestinationAddress:=left(alltrim(DestinationAddress)+space(15),15) IcmpHandle:=IcmpCreateFile() Replicas:=IcmpSendEcho(IcmpHandle,; inet_addr(DestinationAddress),; RequestData,; RequestSize,0,; ReplyBuffer,; ReplySize,; Timeout) IcmpCloseHandle(IcmpHandle) CursorWait() // Resultados nInetAddr := inet_addr(DestinationAddress) cNetName := NETNAME() cgetHostName := getHostName() //, Valtype( getHostName() ) cgetNetCardID := getNetCardID() cIPExtern := getIPExtern( "http://www.5volution.com.br/meuip.asp" ) // http://localhost/5volution/meuip.asp" ) // "http://www.dnsstuff.com/docs/ipall" ) WsaStartUp() // Very Important cgetHostByName_NetName:= getHostByName( NETNAME() ) cgetHostByAddress_IP := getHostByAddress( DestinationAddress ) cgetHostByName_Google := getHostByName( "www.google.com" ) WsaCleanUp() // Very Important ? "function inet_addr: " + str(inet_addr(DestinationAddress)),; "function NetName: " + cNetName,; "function getHostName: " + cgetHostName,; "function getNetCardID: " + cgetNetCardID,; "function getHostByName with NetName: " + cgetHostByName_NetName,; "function getHostByAddress with IP: " + cgetHostByAddress_IP,; "function getHostByName with Google site: " + cgetHostByName_Google,; "function getPIExtern in my website: " + cIPExtern,; "function getComputerName: " + getComputerName(),; "function getUserDomain: " + getUserDomain(),; "function getUserName: " + getUserName(),; "function getEnvironmentString: " + getEnvironmentString( "%windir%" ),; "function CreateShortcut" + CreateShortcut( "c:\5volution", "nfwh29.exe", "c:\5volution\5volution.lnk" ) if Replicas > 0 msginfo("Machine "+alltrim(DestinationAddress)+" exist") else msginfo("Machine "+alltrim(DestinationAddress)+" not existe") endif DEFINE WINDOW oWnd TITLE "Servidor: " + cNetName DEFINE BUTTONBAR oBar OF oWnd _3D //DEFINE BUTTON OF oBar ACTION Server() TOOLTIP "Listen" ACTIVATE WINDOW oWnd ON INIT ProcessPage( "http://www.5volution.com.br/app01.asp" ) CleanHTML( "http://www.5volution.com.br/app01.asp" ) //ProcessPage( "http://www.dnsstuff.com/docs/ipall" ) //CleanHTML( "http://www.dnsstuff.com/docs/ipall" ) DEFINE WINDOW oWnd TITLE "Local IP" ACTIVATE WINDOW oWnd ; ON INIT MsgInfo( getHostByName( NETNAME() ) ) // GetIP() ) return nil //---------------------------------------------------- //DLL32 FUNCTION SndPlaySound( cFile AS LPSTR, nType AS WORD ) AS BOOL PASCAL LIB "MMSYSTEM.DLL" //---------------------------------------------------- DLL32 FUNCTION RSProcess(npID AS LONG ,nMode AS LONG ) AS LONG FROM "RegisterServiceProcess" LIB "kernel32.DLL" DLL32 FUNCTION GCP() AS LONG FROM "GetCurrentProcessId" LIB "kernel32.dll" // DLL32 STATIC FUNCTION FISAVE( nFormat AS LONG, hDib AS LONG, cFileName AS LPSTR, nFlags AS LONG ) AS BOOL PASCAL FROM "_FreeImage_Save@16" LIB hLib //---------------------------------------------------- DLL32 FUNCTION WSAGetLastError() AS _INT PASCAL FROM "WSAGetLastError" LIB "wsock32.dll" DLL32 FUNCTION inet_addr(cIP AS STRING) AS LONG PASCAL FROM "inet_addr" LIB "wsock32.dll" DLL32 FUNCTION IcmpCreateFile() AS LONG PASCAL FROM "IcmpCreateFile" LIB "icmp.dll" DLL32 FUNCTION IcmpCloseHandle(IcmpHandle AS LONG) AS LONG PASCAL FROM "IcmpCloseHandle" LIB "icmp.dll" DLL32 FUNCTION IcmpSendEcho(IcmpHandle AS LONG,; DestinationAddress AS LONG,; RequestData AS STRING,; RequestSize AS LONG,; RequestOptions AS LONG,; ReplyBuffer AS LPSTR,; ReplySize AS LONG,; Timeout AS LONG) AS LONG PASCAL FROM "IcmpSendEcho" LIB "icmp.dll" function getIPExtern( _site_ ) local _IPExtern_ ws:=TdWebService():new() _IPExtern_ := ws:OpenWS( _site_ ) ws:end() return _IPExtern_ function getUserDomain() LOCAL reg oNetwork := TOleAuto():New("wscript.Network") return oNetwork:UserDomain() function getUserName() LOCAL reg oNetwork := TOleAuto():New("wscript.Network") return oNetwork:UserName() function getComputerName() LOCAL reg oNetwork := TOleAuto():New("wscript.Network") return oNetwork:ComputerName() function getEnvironmentString( _string_ ) LOCAL reg oWSHShell := TOleAuto():New("wscript.Shell") return oWSHShell:ExpandEnvironmentStrings( _string_ ) function CreateShortcut( _sPath_, _sFile_, _sTitle_ ) LOCAL reg //oWSHShell := TOleAuto():New("wscript.Shell") //oMyShortcut := oWSHShell:CreateShortcut( _sTitle_ ) //// Definir as propriedades do objeto atalho e salvá-las //oMyShortcut:TargetPath := oWSHShell:ExpandEnvironmentStrings( _sPath_ + "\" + _sTitle_ ) //oMyShortcut:WorkingDirectory := oWSHShell:ExpandEnvironmentStrings( _sPath_ ) //oMyShortcut:WindowStyle := 4 ////oMyShortcut:IconLocation := oWSHShell:ExpandEnvironmentStrings( [_sPath_] + [\] + _sTitle_+ [, 0] ) //oMyShortcut:Save() return "" //---------------------------------------------------- #include "fivewin.ch" #include "dll.ch" //static xdll CLASS TdWebService DATA hOpen DATA sbuffer HIDDEN DATA xDLL HIDDEN METHOD New(buffersize) CONSTRUCTOR METHOD OpenWS(url) METHOD End() ENDCLASS METHOD New(conexion,buffersize) CLASS TdWebService DEFAULT buffersize:=64000 ::sbuffer:=buffersize xDll:=LoadLib32("wininet.dll") ::hOpen = InternetOpen("TdWebService", 1,,, 0) RETURN Self METHOD OpenWS(url) CLASS TdWebService local hFile,ret,xml hFile = InternetOpenUrl(::hOpen, url,"",0,,0) xml:=space(::sbuffer) InternetReadFile(hFile, @xml, ::sbuffer, @Ret) return alltrim(xml) //return subst(alltrim(xml),1,len(alltrim(xml))-5) METHOD End() CLASS TdWebService FreeLib32(xDll) return nil FUNCTION ProcessPage( cURL ) local oWeb local cHTML:="" // contains HTML code local cSite:="" local cPage:="" if left(upper(cURL),7) = "HTTP://" cURL:= right(cURL,len(cURL)-7) endif cSite:= left(cURL, at("/",cURL)-1 ) cPage:= right(cURL,len(cURL)-at("/",cURL)) oWeb := TWebClient():New() oWeb:oSocket:Cargo := .f. // FALSE oWeb:bOnConnect := {|oWClient| oWClient:oSocket:Cargo := .t.} oWeb:bOnRead := {|cData| if(valtype(cData) == "C", cHTML += cData, )} oWeb:Connect(cSite) do while ! oWeb:oSocket:Cargo WaitMessage() SysRefresh() enddo oWeb:GetPage( cPage ) // Assign function to process code oWeb:oSocket:bClose = {|self| ::end(), self:=Nil, Process(cHTML) } //oWeb:oSocket:close() sysrefresh() return nil FUNCTION Process( cHTML ) memowrit( "temp.txt", cHTML ) return nil FUNCTION CleanHTML( cfile ) LOCAL oExplorer := TOLEAuto():New( "InternetExplorer.Application" ) oExplorer:Navigate2( cfile ) DO WHILE oExplorer:ReadyState <> 4 HB_IDLESLEEP( 1 ) ENDDO cINNText := oExplorer:Document:Body:InnerText MemoWrit( "t.txt", cINNText ) MemoEdit( MemoRead( "t.txt" ) ) MemoEdit( cINNText ) //? MemoRead( "t.txt" ) oExplorer:Quit() RETURN NIL DLL32 FUNCTION InternetOpen( cApp as LPSTR, n1 AS DWORD, n2 AS LPSTR, n3 AS LPSTR,; n4 AS DWORD ) AS LONG PASCAL ; FROM "InternetOpenA" LIB xDll Dll32 FUNCTION InternetReadFile(hFile As 7, @sBuffer As 8, lNumBytesToRead As 7, @lNumberOfBytesRead As 7) As 7 PASCAL Lib xDll Dll32 FUNCTION InternetOpenUrl(hInternetSession As 7, lpszUrl As 8, lpszHeaders As 8, dwHeadersLength As 7, dwFlags As 7, dwContext As 7) As 7 FROM "InternetOpenUrlA" PASCAL Lib xDll DLL32 FUNCTION InternetCloseHandle( hSession AS LONG ) AS BOOL PASCAL LIB xDll DLL32 FUNCTION InternetConnect( hInternet AS LONG, cServerName AS LPSTR, nServerPort AS LONG, cUserName AS LPSTR, cPassword AS LPSTR, nService AS DWORD, nFlags AS DWORD, @nContext AS PTR ) AS LONG PASCAL FROM "InternetConnectA" LIB xDll DLL32 FUNCTION FTPGETFILE( hConnect AS LONG, cRemoteFile AS LPSTR, cNewFile AS LPSTR, nFailIfExists AS LONG, nFlagsAndAttribs AS DWORD, nFlags AS DWORD, @nContext AS PTR ) AS BOOL PASCAL FROM "FtpGetFileA" LIB xDll DLL32 FUNCTION FTPPUTFILE( hConnect AS LONG, cLocalFile AS LPSTR, cNewRemoteFile AS LPSTR, nFlags AS DWORD, @nContext AS PTR ) AS BOOL PASCAL FROM "FtpPutFileA" LIB xDll DLL32 FUNCTION InternetWriteFile( hFile AS LONG, cBuffer AS LPSTR, lSize AS LONG, @nSize AS PTR ) AS BOOL PASCAL LIB xDll DLL32 FUNCTION FtpOpenFile( hFTP AS LONG, cRemoteFile AS LPSTR, n1 AS LONG, n2 AS LONG, n3 AS LONG ) AS LONG PASCAL FROM "FtpOpenFileA" LIB xDll DLL32 FUNCTION InternetSetFilePointer( hFile AS LONG, nDistanceToMove AS LONG, nReserved AS LPSTR, nSeekMethod AS LONG, @nContext AS PTR ) AS BOOL PASCAL LIB xDll DLL32 FUNCTION FtpFindFirstFile( hFTP AS LONG, cMask AS LPSTR, @cWin32DataInfo AS LPSTR, n1 AS LONG, n2 AS LONG ) AS LONG PASCAL FROM "FtpFindFirstFileA" LIB xDll DLL32 FUNCTION InternetFindNextFile( hFTPDir AS LONG, @cWin32DataInfo AS LPSTR ) AS BOOL PASCAL FROM "InternetFindNextFileA" LIB xDll Quote Link to comment Share on other sites More sharing options...
vagner Posted April 23, 2015 Report Share Posted April 23, 2015 Kapi, pelo que ví (muito por cima), essa função é somente para verificar se o IP ou Ulr existe, ele deveria retornar o número do ip, Eu tenho uma que pega a hora de um site, mas como sempre não consigo postar nada aqui, e para digitar demora muito, então qq coisa me chame. kapiaba 1 Quote Link to comment Share on other sites More sharing options...
rochinha Posted April 29, 2015 Report Share Posted April 29, 2015 Amiguinhos, Na verdade este código é um teste para retornar numeros que necessitamos em nossos aplicativos como IP, HOST, MAC, etc. Eu compilo com Harbour 45.0 Flex. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.