Servidor NTP para harbour 3.0
Moderador: Moderadores
Servidor NTP para harbour 3.0
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")
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)
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)
- Itamar M. Lins Jr.
- Administrador

- Mensagens: 7929
- Registrado em: 30 Mai 2007 11:31
- Localização: Ilheus Bahia
- Curtiu: 1 vez
Servidor NTP para harbour 3.0
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
Aqui deu certinho.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
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.
Itamar M. Lins Jr.
Servidor NTP para harbour 3.0
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)
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

- Mensagens: 939
- Registrado em: 06 Jul 2004 11:53
- Localização: Gurupi-TO
- Nascimento
- Usuário Nível 4

- Mensagens: 763
- Registrado em: 19 Jul 2008 12:11
- Localização: OLINDA-PE
Servidor NTP para harbour 3.0
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
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
- Nascimento
- Usuário Nível 4

- Mensagens: 763
- Registrado em: 19 Jul 2008 12:11
- Localização: OLINDA-PE
Servidor NTP para harbour 3.0
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
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
Servidor NTP para harbour 3.0
Para testar:
if Internet("www.google.com.br")
//internet ok.
endif
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)
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)
- Nascimento
- Usuário Nível 4

- Mensagens: 763
- Registrado em: 19 Jul 2008 12:11
- Localização: OLINDA-PE
Servidor NTP para harbour 3.0
Muito obrigado Em especial asimoes,Toledo e os demais
e Que seja eterno esse forum que é um dos melhores da internet :{
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
- Nascimento
- Usuário Nível 4

- Mensagens: 763
- Registrado em: 19 Jul 2008 12:11
- Localização: OLINDA-PE
Servidor NTP para harbour 3.0
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
- Nascimento
- Usuário Nível 4

- Mensagens: 763
- Registrado em: 19 Jul 2008 12:11
- Localização: OLINDA-PE
Servidor NTP para harbour 3.0
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
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
- Nascimento
- Usuário Nível 4

- Mensagens: 763
- Registrado em: 19 Jul 2008 12:11
- Localização: OLINDA-PE
Servidor NTP para harbour 3.0
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
o endereço da pagina caso alguem queira ver
http://forums.fivetechsupport.com/viewt ... 12&t=18634
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
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
Servidor NTP para harbour 3.0
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:

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

Será que eu estou fazendo algo errado?
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:

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

Será que eu estou fazendo algo errado?
Inacio de Carvalho Neto
Servidor NTP para harbour 3.0
Esta faltando a minha função CRIA_OLE()
Segue abaixo:
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_OLESun 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.
“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.
Servidor NTP para harbour 3.0
Incluí a tua função cria_ole, mas agora está dando erros nela:


Inacio de Carvalho Neto
- rochinha
- Administrador

- Mensagens: 4664
- Registrado em: 18 Ago 2003 20:43
- Localização: São Paulo - Brasil
- Contato:
Servidor NTP para harbour 3.0
Amiguinhos,
Tentem esta:
Compilem e dem o nome de PINGA.EXE. Este utilitario executa vários testezinhos.
Algumas bibliotecas que usei:
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
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.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.

