Servidor NTP para harbour 3.0

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

Avatar do usuário
asimoes
Colaborador
Colaborador
Mensagens: 4919
Registrado em: 26 Abr 2007 16:48
Localização: RIO DE JANEIRO-RJ

Servidor NTP para harbour 3.0

Mensagem por asimoes »

Itamar,

Compilou com essa versão do mingw: TDM-GCC

Fiz um teste usando a função ntp a função retorna data e hora, mas com uma diferença de +2 horas da hora atual, passei os ips:

? hb_ntp_GetTimeUTC( "200.160.7.186")
? hb_ntp_GetTimeUTC( "200.186.125.195")
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar do usuário
Itamar M. Lins Jr.
Administrador
Administrador
Mensagens: 7929
Registrado em: 30 Mai 2007 11:31
Localização: Ilheus Bahia
Curtiu: 1 vez

Servidor NTP para harbour 3.0

Mensagem por Itamar M. Lins Jr. »

Código: Selecionar todos

/* Copyright 2013 Viktor Szakats (vszakats.net/harbour) */

#require "hbmisc"

PROCEDURE Main()

   LOCAL tTime

   Set( _SET_DATEFORMAT, "yyyy-mm-dd" )

   ?? "UTC    time:", tTime := hb_ntp_GetTimeUTC( "0.europe.pool.ntp.org" )
   ?
   ?? "Local  time:", tTime + hb_UTCOffset() / 86400
   ?
   ?? "System time:", hb_DateTime()
   ?

   RETURN
C:\Users\Itamar\Documents\GitHub\harbour-core\contrib\hbmisc\tests>ntp
UTC time: 2013-12-26 22:23:05.223
Local time: 2013-12-26 19:23:05.224
System time: 2013-12-26 19:23:00.539
Aqui deu certinho.

Tem que ter essa linha aqui p/ ajuste! -> tTime + hb_UTCOffset() / 86400
A função hb_UTCOffset()...

Saudações,
Itamar M. Lins Jr.
Saudações,
Itamar M. Lins Jr.
Avatar do usuário
asimoes
Colaborador
Colaborador
Mensagens: 4919
Registrado em: 26 Abr 2007 16:48
Localização: RIO DE JANEIRO-RJ

Servidor NTP para harbour 3.0

Mensagem por asimoes »

Beleza, Funcionou!
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
marcos.gurupi
Usuário Nível 4
Usuário Nível 4
Mensagens: 939
Registrado em: 06 Jul 2004 11:53
Localização: Gurupi-TO

Servidor NTP para harbour 3.0

Mensagem por marcos.gurupi »

Com xhb nada feito ?
Marcos Roberto
NetService Software
Avatar do usuário
Nascimento
Usuário Nível 4
Usuário Nível 4
Mensagens: 763
Registrado em: 19 Jul 2008 12:11
Localização: OLINDA-PE

Servidor NTP para harbour 3.0

Mensagem por Nascimento »

marcos compilei com o harbour 3.0 e foi de boa
dei uma pequena modificada no fonte mais so o setdate da hbct pra ajustar a data pelo ntp
A arte de programar é simplesmente fazer seus pensamentos serem interpretados por uma maquina :) clipper 5.3 /harbour/minigui
Avatar do usuário
Nascimento
Usuário Nível 4
Usuário Nível 4
Mensagens: 763
Registrado em: 19 Jul 2008 12:11
Localização: OLINDA-PE

Servidor NTP para harbour 3.0

Mensagem por Nascimento »

Amigos Depois a funçao esta funcionando 100% me surgiu uma pequena necessidade

por exemplo como fazer a funçao verificar se o computador esta conectado a internet

se caso estiver ai ele execultar a funçao ntp caso nao esteja usa a funçao date()

por exemplo:

if conectado a internet
today:=(funçao NTP)
else
today:= date()
endif

agradeço desde ja a atenção disponibilizada a mim

att: Josivan Nascimento
A arte de programar é simplesmente fazer seus pensamentos serem interpretados por uma maquina :) clipper 5.3 /harbour/minigui
Avatar do usuário
asimoes
Colaborador
Colaborador
Mensagens: 4919
Registrado em: 26 Abr 2007 16:48
Localização: RIO DE JANEIRO-RJ

Servidor NTP para harbour 3.0

Mensagem por asimoes »

Para testar:

if Internet("www.google.com.br")
//internet ok.
endif

Código: Selecionar todos

FUNCTION Internet( cAddress )
LOCAL aHosts, cName
   HB_InetInit()
   IF cAddress == Nil
      cAddress := "www.google.com.br"
   ENDIF
   aHosts := HB_InetGetHosts( cAddress )
   IF aHosts == Nil .OR. Len(aHosts)=0
      HB_InetCleanup()
      RETURN .F.
   ENDIF
   HB_InetCleanup()
RETURN .T.
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar do usuário
Nascimento
Usuário Nível 4
Usuário Nível 4
Mensagens: 763
Registrado em: 19 Jul 2008 12:11
Localização: OLINDA-PE

Servidor NTP para harbour 3.0

Mensagem por Nascimento »

Muito obrigado Em especial asimoes,Toledo e os demais
e Que seja eterno esse forum que é um dos melhores da internet :{
A arte de programar é simplesmente fazer seus pensamentos serem interpretados por uma maquina :) clipper 5.3 /harbour/minigui
Avatar do usuário
Nascimento
Usuário Nível 4
Usuário Nível 4
Mensagens: 763
Registrado em: 19 Jul 2008 12:11
Localização: OLINDA-PE

Servidor NTP para harbour 3.0

Mensagem por Nascimento »

teste efetuado com sucesso

Código: Selecionar todos

[func main()

if internet('www.globo.com') 
   ?'SIM TEM INTERNET'
else
   ?'Nao conectado a internet'
   endif



FUNCTION Internet( cAddress )
LOCAL aHosts, cName
   HB_InetInit()
   IF cAddress == Nil
      cAddress := "www.google.com.br"
   ENDIF
   aHosts := HB_InetGetHosts( cAddress )
   IF aHosts == Nil .OR. Len(aHosts)=0
      HB_InetCleanup()
      RETURN .f.
   ENDIF
   HB_InetCleanup()
RETURN .T.
A arte de programar é simplesmente fazer seus pensamentos serem interpretados por uma maquina :) clipper 5.3 /harbour/minigui
Avatar do usuário
Nascimento
Usuário Nível 4
Usuário Nível 4
Mensagens: 763
Registrado em: 19 Jul 2008 12:11
Localização: OLINDA-PE

Servidor NTP para harbour 3.0

Mensagem por Nascimento »

Segundo teste Nao satisfatorio :%

fiz o seguinte desconectei a internet do AP (acess pointer) deixando so ele conectado ao micro via cabo de rede

quando rodei o execultavel deu a mensagem dizendo que tem internet

quando na verdade so esta conectado ao ap sem acesso a internet

é como se a funçao nao estivesse pingando o host para ver se realmente é verdadeira a existencia da conexão a internet
A arte de programar é simplesmente fazer seus pensamentos serem interpretados por uma maquina :) clipper 5.3 /harbour/minigui
Avatar do usuário
Nascimento
Usuário Nível 4
Usuário Nível 4
Mensagens: 763
Registrado em: 19 Jul 2008 12:11
Localização: OLINDA-PE

Servidor NTP para harbour 3.0

Mensagem por Nascimento »

achei essa funçao no site da fivewin tem como passar pra windows e que so retorne a .T. ou .F. eu acho que mais ou menos isso que preciso

Código: Selecionar todos

    #include "FiveLinux.ch"

    function Main()

       MsgInfo( Ping( "192.168.0.22" ) )
       
    return nil

    #pragma BEGINDUMP  

    #include <stdio.h>
    #include <stdlib.h>
    #include <sys/types.h>
    #include <sys/socket.h>
    #include <netinet/in.h>
    #include <arpa/inet.h>
    #include <netdb.h>
    #include <linux/ip.h>
    #include <linux/icmp.h>
    #include <string.h>
    #include <unistd.h>

    char dst_addr[20];
    char src_addr[20];

    static unsigned short in_cksum(unsigned short *, int);
    static void parse_argvs(char**, char*, char* );
    static void usage();
    static char* getip();
    static char* toip(char*);

    HB_FUNC( PING )
    {
       struct iphdr* ip;
       struct iphdr* ip_reply;
       struct icmphdr* icmp;
       struct sockaddr_in connection;
       char* packet;
       char* buffer;
       int sockfd;
       int optval;
       int addrlen;
       int siz;

       /*
       if (getuid() != 0)
       {
           fprintf(stderr, "%s: root privelidges needed\n", *(argv + 0));
           exit(EXIT_FAILURE);
       }
       */

       // parse_argvs(argv, dst_addr, src_addr);
       strncpy( dst_addr, toip( ( char * ) hb_parc( 1 ) ), 20 );
       strncpy( src_addr, toip( getip() ), 20 );
       // printf("Source address: %s\n", src_addr);
       // printf("Destination address: %s\n", dst_addr);

       /*
        * allocate all necessary memory
       */
       packet = malloc(sizeof(struct iphdr) + sizeof(struct icmphdr));
       buffer = malloc(sizeof(struct iphdr) + sizeof(struct icmphdr));
       /****************************************************************/

       ip = (struct iphdr*) packet;
       icmp = (struct icmphdr*) (packet + sizeof(struct iphdr));

       /*
        *  here the ip packet is set up
        */
       ip->ihl                     = 5;
       ip->version                 = 4;
       ip->tos                     = 0;
       ip->tot_len                 = sizeof(struct iphdr) + sizeof(struct icmphdr);
       ip->id                      = htons(0);
       ip->frag_off                = 0;
       ip->ttl                     = 64;
       ip->protocol                = IPPROTO_ICMP;
       ip->saddr                   = inet_addr(src_addr);
       ip->daddr                   = inet_addr(dst_addr);
       ip->check                   = in_cksum((unsigned short *)ip, sizeof(struct iphdr));

       if ((sockfd = socket(AF_INET, SOCK_RAW, IPPROTO_ICMP)) == -1)
       {
           hb_retl( FALSE );
           return;
           // perror("socket");
           // exit(EXIT_FAILURE);
       }

       /*
        *  IP_HDRINCL must be set on the socket so that
        *  the kernel does not attempt to automatically add
        *  a default ip header to the packet
        */

       setsockopt(sockfd, IPPROTO_IP, IP_HDRINCL, &optval, sizeof(int));

       /*
        *  here the icmp packet is created
        *  also the ip checksum is generated
        */
       icmp->type                  = ICMP_ECHO;
       icmp->code                  = 0;
       icmp->un.echo.id            = random();
       icmp->un.echo.sequence      = 0;
       icmp-> checksum             = in_cksum((unsigned short *)icmp, sizeof(struct icmphdr));


       connection.sin_family = AF_INET;
       connection.sin_addr.s_addr = inet_addr(dst_addr);

       /*
        *  now the packet is sent
        */

       sendto(sockfd, packet, ip->tot_len, 0, (struct sockaddr*)&connection, sizeof(struct sockaddr));
       // printf("Sent %d byte packet to %s\n", ip->tot_len, dst_addr);

       /*
        *  now we listen for responses
        */
       addrlen = sizeof(connection);
       if (( siz = recvfrom(sockfd, buffer, sizeof(struct iphdr) + sizeof(struct icmphdr), 0, (struct sockaddr *)&connection, &addrlen)) == -1)
       {
           hb_retl( FALSE );
           // perror("recv");
       }
       else
       {
           hb_retl( TRUE );
           // printf("Received %d byte reply from %s:\n", siz , dst_addr);
           // ip_reply = (struct iphdr*) buffer;
           // printf("ID: %d\n", ntohs(ip_reply->id));
           // printf("TTL: %d\n", ip_reply->ttl);
       }

       free(packet);
       free(buffer);
       close(sockfd);
       // return 0;
    }

    static void parse_argvs(char** argv, char* dst, char* src)
    {
       int i;
       if(!(*(argv + 1)))
       {
           /* there are no options on the command line */
           usage();
           exit(EXIT_FAILURE);
       }
       if (*(argv + 1) && (!(*(argv + 2))))
       {
           /*
            *   only one argument provided
            *   assume it is the destination server
            *   source address is local host
            */
           strncpy(dst, *(argv + 1), 15);
           strncpy(src, getip(), 15);
           return;
       }
       else if ((*(argv + 1) && (*(argv + 2))))
       {
           /*
            *    both the destination and source address are defined
            *    for now only implemented is a source address and
            *    destination address
            */
           strncpy(dst, *(argv + 1), 15);
           i = 2;
           while(*(argv + i + 1))
           {
               if (strncmp(*(argv + i), "-s", 2) == 0)
               {
                   strncpy(src, *(argv + i + 1), 15);
                   break;
               }
               i++;
           }
       }

    }

    static void usage()
    {
       fprintf(stderr, "\nUsage: pinger [destination] <-s [source]>\n");
       fprintf(stderr, "Destination must be provided\n");
       fprintf(stderr, "Source is optional\n\n");
    }

    static char* getip()
    {
       char buffer[256];
       struct hostent* h;

       gethostname(buffer, 256);
       h = gethostbyname(buffer);

       return inet_ntoa(*(struct in_addr *)h->h_addr);

    }

    /*
     * return the ip address if host provided by DNS name
     */
    static char* toip(char* address)
    {
       struct hostent* h;
       h = gethostbyname(address);
       return inet_ntoa(*(struct in_addr *)h->h_addr);
    }

    /*
     * in_cksum --
     * Checksum routine for Internet Protocol
     * family headers (C Version)
     */
    static unsigned short in_cksum(unsigned short *addr, int len)
    {
       register int sum = 0;
       u_short answer = 0;
       register u_short *w = addr;
       register int nleft = len;
       /*
        * Our algorithm is simple, using a 32 bit accumulator (sum), we add
        * sequential 16 bit words to it, and at the end, fold back all the
        * carry bits from the top 16 bits into the lower 16 bits.
        */
       while (nleft > 1)
       {
             sum += *w++;
             nleft -= 2;
       }
       /* mop up an odd byte, if necessary */
       if (nleft == 1)
       {
             *(u_char *) (&answer) = *(u_char *) w;
             sum += answer;
       }
       /* add back carry outs from top 16 bits to low 16 bits */
       sum = (sum >> 16) + (sum & 0xffff);         /* add hi 16 to low 16 */
       sum += (sum >> 16);                         /* add carry */
       answer = ~sum;                              /* truncate to 16 bits */
       return (answer);
    }

    #pragma ENDDUMP
     
o endereço da pagina caso alguem queira ver
http://forums.fivetechsupport.com/viewt ... 12&t=18634
A arte de programar é simplesmente fazer seus pensamentos serem interpretados por uma maquina :) clipper 5.3 /harbour/minigui
cjp
Usuário Nível 6
Usuário Nível 6
Mensagens: 1563
Registrado em: 19 Nov 2010 22:29
Localização: paraná
Contato:

Servidor NTP para harbour 3.0

Mensagem por cjp »

Meus caros,

Achei interessante esta função e estou tentando usá-la, mas está dando erro.

No exemplo do Toledo, deu o seguinte erro na compilação:

Imagem


No exemplo do Fladimir, está dando o seguinte erro na compilação:

Imagem

Será que eu estou fazendo algo errado?
Inacio de Carvalho Neto
Avatar do usuário
fladimir
Colaborador
Colaborador
Mensagens: 2445
Registrado em: 15 Nov 2006 20:21

Servidor NTP para harbour 3.0

Mensagem por fladimir »

Esta faltando a minha função CRIA_OLE()

Segue abaixo:

Código: Selecionar todos

//------------------------------------------------------------------------------
FUNCTION Cria_OLE(cObj_OLE, cMsg, lGetActiveObj)
/* Cria objeto Ole */
	LOCAL oObj_OLE := NIL

	DEFAULT cMsg TO 'Erro ao tentar carregar objeto;;Tente novamente'
	DEFAULT lGetActiveObj TO .F.

	IF lGetActiveObj
	   TRY
	      oObj_OLE := GetActiveObject( cObj_OLE )
	   CATCH
			TRY
				oObj_OLE := CREATEOBJECT(cObj_OLE)
			CATCH
		   	Alert(cMsg)
		   	RETURN oObj_OLE
			END
		END
	ELSE
		TRY
			oObj_OLE := CREATEOBJECT(cObj_OLE)
		CATCH
	   	Alert(cMsg)
	   	RETURN oObj_OLE
		END
	ENDIF	
RETURN oObj_OLE
Sun Tzu há mais de três mil anos cita nas epígrafes de seu livro “A Arte da Guerra“:

“Concentre-se nos pontos fortes, reconheça as fraquezas, agarre as oportunidades e proteja-se contra as ameaças”.
“Se não é vantajoso, nunca envie suas tropas; se não lhe rende ganhos, nunca utilize seus homens; se não é uma situação perigosa, nunca lute uma batalha precipitada”
.


Até 2017    Desktop Console [ Legado ] Harbour | MinGW | DBF | CDX | FastReport | MySQL


Novos Projetos:

   Desktop Visual           Windev Desktop
   Celular Android/iOS   Windev Mobile
   WEB                            Windev Web


Sejamos gratos a Deus.
cjp
Usuário Nível 6
Usuário Nível 6
Mensagens: 1563
Registrado em: 19 Nov 2010 22:29
Localização: paraná
Contato:

Servidor NTP para harbour 3.0

Mensagem por cjp »

Incluí a tua função cria_ole, mas agora está dando erros nela:

Imagem
Inacio de Carvalho Neto
Avatar do usuário
rochinha
Administrador
Administrador
Mensagens: 4664
Registrado em: 18 Ago 2003 20:43
Localização: São Paulo - Brasil
Contato:

Servidor NTP para harbour 3.0

Mensagem por rochinha »

Amiguinhos,

Tentem esta:

Código: Selecionar todos

#include "FiveWin.ch" 
#include "dll.ch" 

static xdll // Need to TdWebService Class

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
Compilem e dem o nome de PINGA.EXE. Este utilitario executa vários testezinhos.

Algumas bibliotecas que usei:

Código: Selecionar todos

...
echo %HBDIR%\lib\uuid.lib     + >> b32.bc
echo %HBDIR%\lib\rtl.lib      + >> b32.bc
echo %HBDIR%\lib\vm.lib       + >> b32.bc
echo %HBDIR%\lib\gtwin.lib    + >> b32.bc
echo %HBDIR%\lib\lang.lib     + >> b32.bc
echo %HBDIR%\lib\macro.lib    + >> b32.bc
echo %HBDIR%\lib\rdd.lib      + >> b32.bc
echo %HBDIR%\lib\dbfcdx.lib   + >> b32.bc
echo %HBDIR%\lib\dbfntx.lib   + >> b32.bc
echo %HBDIR%\lib\dbfdbt.lib   + >> b32.bc
echo %HBDIR%\lib\dbffpt.lib   + >> b32.bc
echo %HBDIR%\lib\hbsix.lib    + >> b32.bc
echo %HBDIR%\lib\debug.lib    + >> b32.bc
echo %HBDIR%\lib\common.lib   + >> b32.bc
echo %HBDIR%\lib\pp.lib       + >> b32.bc
echo %HBDIR%\lib\codepage.lib + >> b32.bc
echo %HBDIR%\lib\ct.lib       + >> b32.bc

echo %BCDIR%\lib\pcrepos.lib       + >> %1.bc
echo %BCDIR%\lib\cw32.lib          + >> %1.bc
echo %BCDIR%\lib\import32.lib      + >> %1.bc
echo %BCDIR%\lib\psdk\ole32.lib    + >> b32.bc

echo %BCDIR%\lib\psdk\odbc32.lib   + >> b32.bc
echo %BCDIR%\lib\psdk\nddeapi.lib  + >> b32.bc
echo %BCDIR%\lib\psdk\iphlpapi.lib + >> b32.bc
echo %BCDIR%\lib\psdk\msimg32.lib  + >> b32.bc
echo %BCDIR%\lib\psdk\rasapi32.lib + >> b32.bc

if EXIST win32lib.lib echo win32lib.lib   + >> b32.bc
...
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Responder