Clipper On Line • Ver Tópico - Bloqueio Online

Bloqueio Online

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

Moderador: Moderadores

 

Bloqueio Online

Mensagempor fladimir » 22 Mar 2010 00:21

Olá nobres colegas, estou com a idéia de desenvolver uma forma de bloqueio online para os clientes inadimplentes... vou explanar a situação atual, a idéia e o q já fiz, para que algum colega possa colaborar com alguma idéia no sentido ou alguma outra solução para minha questão.

Atualmente os clientes utilizam o sistema e o mesmo é locado, pagam a mensalidade via boleto e eu tenho a posição financeira via sistema do banco, q futuramente fornecerá automaticamente via arquivo texto o retorno de quem pagou ou não, atualmente isto é feito manual, entro no sistema do banco e baixo os retornos de quem pagou ou não, ai alimento meu sistema de controle.

O sistema q esta nos clientes tem uma proteção interna por Data e Nr. de Execuções, ou seja, se o cliente ficar voltando a data o sistema irá expirar por execuções se a data fluir normalmente em média de 35 em 35 dias o sistema pede liberação.

Isto esta gerando uma certa perca de tempo, q preciso automatizar para crescer, minha idéia é a seguinte:

No início do sistema após checar a proteção o mesmo verifica se tem acesso a internet, em caso positivo roda uma função para verificar no ftp da empresa se consta um bloqueio (arquivo com nome = cnpj cadastrado no sistema do cliente), caso tenha um bloqueio no FTP o sistema automaticamente muda a proteção para 2 dia, ou seja, na proxima vez q o cliente entrar no sistema ou no outro dia o sistema irá exibir a mensagem de alerta q o mesmo será bloqueado apos X dias em virtude de não constar pagamento.
Em caso de não haver internet o sistema continua trabalhando da forma antiga Data ou nr. de execuções


Td isto já esta implementado (mas não em funcionamento nos clientes - que ainda estão na forma antiga Data ou Nr. Execuções), ou seja, aplicação esta entrando e verificando a internet, verificado se tem o arquivo de bloqueio e retorno para efetuar o bloqueio após 2 dias... agora o crucial....

Caso não tenha o arquivo de bloqueio, pode significar o seguinte:

Não achou o Arquivo devido o CNPJ estar diferente do cliente para o meu sistema de controle por algum motivo, ou,
Não achou o Arquivo devido o Cliente estar EM DIA.


Agora minhas preocupações são caso erre na análise e não fique amarrado, o sistema vai ficar liberando direto e as vezes pode ser uma situação q não prevista, nesse caso, algum colega teria uma idéia para BLOQUEAR SOMENTE UM CLIENTE ONLINE

Aguardo e agradeço Dicas, Idéias, Sugestões, Soluções

Obrigado e Sucesso!!!

:)Pos
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.
Avatar de usuário

fladimir
Colaborador

Colaborador
 
Mensagens: 2434
Data de registro: 15 Nov 2006 19:21
Curtiu: 28 vezes
Mens.Curtidas: 157 vezes

Re: Bloqueio Online

Mensagempor rochinha » 22 Mar 2010 02:19

Amiguinho,

Faça o seguinte:

Salve em um arquivo cujo nome tenha o CNPJ e extensão .LIC a frase Status: S ou Status: N

Eleve este arquivo para a raiz de seu site ou uma pasta em seu site.

Dentro de seu programa use o seguinte código para recuperá-lo após testar se internet esta ativa.
   cCNPJ := "00000000000100" // "00.000.000/0001-00"
   ws:=TdWebService():new()
   cNRevisao := ws:OpenWS("http://www.seusite.com.br/" + cCNPJ + ".lic")
   ws:end()
   //
   cLiberado := substr( cNRevisao, at("Status: ",cNRevisao)+8, 1 )
   //
   if cLiberado = "S"
      ? "Sistema liberado on-line."
   else
      ? "Sistema travado."
   endif


O código de OpenWS:
#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 subst(alltrim(xml),1,len(alltrim(xml))-5)

METHOD End() CLASS TdWebService
   FreeLib32(xDll)
   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


Sinceramente não sei dizer se DLL.CH faz parte do Fivewin ou do Borland, de qualquer forma utilize os métodos do xHarbour para acessar DLLs e boa sorte.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Re: Bloqueio Online

Mensagempor fladimir » 22 Mar 2010 11:39

Salvei os codigos em 2 prgs um chamado teste e o outro chamado OpeWs.prg

só q ao compilar da o erro conforme abaixo:

xHarbour Compiler build 1.2.1 (SimpLex) (Rev. 6646)
Copyright 1999-2009, http://www.xharbour.org http://www.harbour-project.org/
Compiling 'TESTE.PRG'...

Lines 16, Functions/Procedures 1
Generating C source output to 'obj\TESTE.c'...
Done.

Building object module for 'obj\TESTE.c'
using C compiler 'BCC32' as defined in 'C:\xHARBOUR\BIN\harbour.cfg'...
Exec: BCC32  -c -D__EXPORT__ -IC:\xHARBOUR\include  -d -LC:\xHARBOUR\lib -oobj\TESTE.obj obj\TESTE.c
Borland C++ 5.5.1 for Win32 Copyright (c) 1993, 2000 Borland
obj\TESTE.c:
Done.
Deleting: "obj\TESTE.c"
Done.
xHarbour Compiler build 1.2.1 (SimpLex) (Rev. 6646)
Copyright 1999-2009, http://www.xharbour.org http://www.harbour-project.org/
Compiling 'OPENWS.PRG'...

OPENWS.PRG(1) Error E0030  Syntax error: "syntax error at 'INCLUDE'"

OPENWS.PRG(5) Error E0030  Syntax error: "syntax error at 'TDWEBSERVICE'"

OPENWS.PRG(6) Error E0030  Syntax error: "syntax error at 'HOPEN'"

OPENWS.PRG(7) Error E0030  Syntax error: "syntax error at 'SBUFFER'"

OPENWS.PRG(8) Error E0030  Syntax error: "syntax error at 'XDLL'"

OPENWS.PRG(10) Error E0030  Syntax error: "syntax error at 'NEW'"

OPENWS.PRG(12) Error E0030  Syntax error: "syntax error at 'OPENWS'"

OPENWS.PRG(14) Error E0030  Syntax error: "syntax error at 'END'"

OPENWS.PRG(15) Error E0020  Incomplete statement or unbalanced delimiters

OPENWS.PRG(17) Error E0030  Syntax error: "syntax error at 'NEW'"

OPENWS.PRG(18) Error E0030  Syntax error: "syntax error at 'BUFFERSIZE'"

OPENWS.PRG(19) Error E0001  Statement not allowed outside of procedure or function

OPENWS.PRG(20) Error E0001  Statement not allowed outside of procedure or function

OPENWS.PRG(21) Error E0001  Statement not allowed outside of procedure or function

OPENWS.PRG(22) Error E0001  Statement not allowed outside of procedure or function

OPENWS.PRG(24) Error E0030  Syntax error: "syntax error at 'OPENWS'"

OPENWS.PRG(25) Error E0001  Statement not allowed outside of procedure or function

OPENWS.PRG(26) Error E0001  Statement not allowed outside of procedure or function

OPENWS.PRG(27) Error E0001  Statement not allowed outside of procedure or function

OPENWS.PRG(28) Error E0001  Statement not allowed outside of procedure or function

OPENWS.PRG(29) Error E0001  Statement not allowed outside of procedure or function

OPENWS.PRG(31) Error E0030  Syntax error: "syntax error at 'END'"

OPENWS.PRG(32) Error E0001  Statement not allowed outside of procedure or function

OPENWS.PRG(33) Error E0001  Statement not allowed outside of procedure or function

OPENWS.PRG(38) Error E0030  Syntax error: "syntax error at 'FUNCTION'"

OPENWS.PRG(39) Error E0030  Syntax error: "syntax error at 'FUNCTION'"

OPENWS.PRG(40) Error E0030  Syntax error: "syntax error at 'FUNCTION'"

OPENWS.PRG(41) Error E0030  Syntax error: "syntax error at 'FUNCTION'"

28 errors

No code generated


Grato e Sucesso!!!
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.
Avatar de usuário

fladimir
Colaborador

Colaborador
 
Mensagens: 2434
Data de registro: 15 Nov 2006 19:21
Curtiu: 28 vezes
Mens.Curtidas: 157 vezes

Re: Bloqueio Online

Mensagempor rochinha » 22 Mar 2010 14:57

Amiguinho,

Em OpenWS desabilite:
#include "dll.ch"

static xdll


Ainda neste arquivo troque as chamadas DLL FUNCTION pelo método xHarbour de chamadas em DLL, o DllCall(...).

No final de seu arquivo TESTE.PRG acrescente:
#include "OpenWS.prg"


Compile apenas o TESTE.PRG
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Re: Bloqueio Online

Mensagempor fladimir » 22 Mar 2010 22:45

Obrigado Rochinha pelas dicas mas continua dando erro, aparentemente fiz como vc mencionou, vou postar o teste.prg e o openws.prg e o log de erro.

Teste.PRG:

******************
Proc Main

cCNPJ := "01002003000155" // "00.000.000/0001-00"
ws:=TdWebService():new()
cNRevisao := ws:OpenWS("http://www.site.com.br/" + cCNPJ + ".lic")
ws:end()

cLiberado := substr( cNRevisao, at("Status: ",cNRevisao)+8, 1 )

if cLiberado = "S"
   ? "Sistema liberado on-line."
else
   ? "Sistema travado."
endif

#include "OpenWS.prg"

Return


Agora o OpenWS.prg:

//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 subst(alltrim(xml),1,len(alltrim(xml))-5)

METHOD End() CLASS TdWebService
FreeLib32(xDll)
return nil

DllCall(InternetOpen( cApp as LPSTR, n1 AS DWORD, n2 AS LPSTR, n3 AS LPSTR,;
          n4 AS DWORD ) AS LONG PASCAL ;
          FROM "InternetOpenA" LIB xdll)
DllCall(InternetReadFile(hFile As 7, @sBuffer As 8, lNumBytesToRead As 7, @lNumberOfBytesRead As 7) As 7 PASCAL Lib xdll)
DllCall(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)
DllCall(InternetCloseHandle( hSession AS LONG ) AS BOOL PASCAL LIB xdll)


Compilei somente o Teste.prg

Mas gerou erros conforme log abaixo:

xHarbour Compiler build 1.2.1 (SimpLex) (Rev. 6646)
Copyright 1999-2009, http://www.xharbour.org http://www.harbour-project.org/
Compiling 'teste.PRG'...

OpenWS.prg(4) Error E0030  Syntax error: "syntax error at 'TDWEBSERVICE'"

OpenWS.prg(5) Error E0030  Syntax error: "syntax error at 'HOPEN'"

OpenWS.prg(6) Error E0030  Syntax error: "syntax error at 'SBUFFER'"

OpenWS.prg(7) Error E0030  Syntax error: "syntax error at 'XDLL'"

OpenWS.prg(9) Error E0030  Syntax error: "syntax error at 'NEW'"

OpenWS.prg(11) Error E0030  Syntax error: "syntax error at 'OPENWS'"

OpenWS.prg(13) Error E0030  Syntax error: "syntax error at 'END'"

OpenWS.prg(14) Error E0020  Incomplete statement or unbalanced delimiters

OpenWS.prg(16) Error E0030  Syntax error: "syntax error at 'NEW'"

OpenWS.prg(17) Error E0030  Syntax error: "syntax error at 'BUFFERSIZE'"

OpenWS.prg(23) Error E0030  Syntax error: "syntax error at 'OPENWS'"

OpenWS.prg(24) Error E0004  LOCAL declaration follows executable statement

OpenWS.prg(30) Error E0030  Syntax error: "syntax error at 'END'"

OpenWS.prg(37) Error E0030  Syntax error: "syntax error at 'LPSTR'"

OpenWS.prg(38) Error E0030  Syntax error: "syntax error at '7'"

OpenWS.prg(39) Error E0030  Syntax error: "syntax error at '7'"

OpenWS.prg(40) Error E0030  Syntax error: "syntax error at 'LONG'"

17 errors

No code generated


Não sei o q posso estar de errado...?

:%
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.
Avatar de usuário

fladimir
Colaborador

Colaborador
 
Mensagens: 2434
Data de registro: 15 Nov 2006 19:21
Curtiu: 28 vezes
Mens.Curtidas: 157 vezes

Re: Bloqueio Online

Mensagempor sygecom » 22 Mar 2010 22:51

tente colocar no inicio de OpenWS.prg:
#include 'hbclass.ch'
Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
leonardodemachado@hotmail.com

Faça você também sua doação esse fórum é uma lenda viva: http://www.pctoledo.com.br/doacao
Avatar de usuário

sygecom
Usuário Nível 7

Usuário Nível 7
 
Mensagens: 7006
Data de registro: 21 Jul 2006 10:12
Cidade/Estado: Alvorada-RS
Curtiu: 1 vez
Mens.Curtidas: 130 vezes

Re: Bloqueio Online

Mensagempor fladimir » 22 Mar 2010 22:55

É Leonardo, obrigado pela atenção melhorou reduziu os erros para:

xHarbour Compiler build 1.2.1 (SimpLex) (Rev. 6646)
Copyright 1999-2009, http://www.xharbour.org http://www.harbour-project.org/
Compiling 'TESTE.PRG'...

100
100
200
300
400
500
600
700
800
900
1000
1100

OpenWS.prg(18) Error E0030  Syntax error: "syntax error at 'BUFFERSIZE'"
OpenWS.prg(38) Error E0030  Syntax error: "syntax error at 'LPSTR'"
OpenWS.prg(39) Error E0030  Syntax error: "syntax error at '7'"
OpenWS.prg(40) Error E0030  Syntax error: "syntax error at '7'"
OpenWS.prg(41) Error E0030  Syntax error: "syntax error at 'LONG'"
5 errors

No code generated


Mas ainda persiste....

:'(
Editado pela última vez por fladimir em 22 Mar 2010 23:01, num total de 1 vezes
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.
Avatar de usuário

fladimir
Colaborador

Colaborador
 
Mensagens: 2434
Data de registro: 15 Nov 2006 19:21
Curtiu: 28 vezes
Mens.Curtidas: 157 vezes

Re: Bloqueio Online

Mensagempor sygecom » 22 Mar 2010 22:57

Coloque no inicio do .PRG (isso é parte da DLL.CH)
#ifndef _DLL_CH
#define _DLL_CH

#ifndef _C_TYPES
   #define _C_TYPES
   #define VOID     0
   #define BYTE     1
   #define CHAR     2
   #define WORD     3

#ifdef __CLIPPER__
   #define _INT     4         // conflicts with Clipper Int()
#else
   #define _INT     7
#endif

   #define BOOL     5
   #define HDC      6
   #define LONG     7
   #define STRING   8
   #define LPSTR    9
   #define PTR     10
   #define _DOUBLE 11         // conflicts with BORDER DOUBLE
   #define DWORD   12
#endif
Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
leonardodemachado@hotmail.com

Faça você também sua doação esse fórum é uma lenda viva: http://www.pctoledo.com.br/doacao
Avatar de usuário

sygecom
Usuário Nível 7

Usuário Nível 7
 
Mensagens: 7006
Data de registro: 21 Jul 2006 10:12
Cidade/Estado: Alvorada-RS
Curtiu: 1 vez
Mens.Curtidas: 130 vezes

Re: Bloqueio Online

Mensagempor sygecom » 22 Mar 2010 23:00

Na verdade tinha que compilar aqui para ver os erros, não achei o tal buffersize na DLL.CH alias nem no .PRG
Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
leonardodemachado@hotmail.com

Faça você também sua doação esse fórum é uma lenda viva: http://www.pctoledo.com.br/doacao
Avatar de usuário

sygecom
Usuário Nível 7

Usuário Nível 7
 
Mensagens: 7006
Data de registro: 21 Jul 2006 10:12
Cidade/Estado: Alvorada-RS
Curtiu: 1 vez
Mens.Curtidas: 130 vezes

Re: Bloqueio Online

Mensagempor fladimir » 22 Mar 2010 23:01

É Leonardo, TA INDO.... resolveu o LPR, mas continua os outros.....:

xHarbour Compiler build 1.2.1 (SimpLex) (Rev. 6646)
Copyright 1999-2009, http://www.xharbour.org http://www.harbour-project.org/
Compiling 'TESTE.PRG'...

100
100
200
300
400
500
600
700
800
900
1000
1100

OpenWS.prg(46) Error E0030  Syntax error: "syntax error at 'BUFFERSIZE'"
OpenWS.prg(66) Error E0030  Syntax error: "syntax error at '9'"
OpenWS.prg(67) Error E0030  Syntax error: "syntax error at '7'"
OpenWS.prg(68) Error E0030  Syntax error: "syntax error at '7'"
OpenWS.prg(69) Error E0030  Syntax error: "syntax error at '7'"
5 errors

No code generated


Abaixo segue OpenWS.PRG atualizado com a dicas do Rochinha e do Leonardo:

//include "dll.ch"
//static xdll
#include 'hbclass.ch'

#ifndef _DLL_CH
#define _DLL_CH

#ifndef _C_TYPES
   #define _C_TYPES
   #define VOID     0
   #define BYTE     1
   #define CHAR     2
   #define WORD     3

#ifdef __CLIPPER__
   #define _INT     4         // conflicts with Clipper Int()
#else
   #define _INT     7
#endif

   #define BOOL     5
   #define HDC      6
   #define LONG     7
   #define STRING   8
   #define LPSTR    9
   #define PTR     10
   #define _DOUBLE 11         // conflicts with BORDER DOUBLE
   #define DWORD   12
#endif

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 subst(alltrim(xml),1,len(alltrim(xml))-5)

METHOD End() CLASS TdWebService
FreeLib32(xDll)
return nil

DllCall(InternetOpen( cApp as LPSTR, n1 AS DWORD, n2 AS LPSTR, n3 AS LPSTR,;
          n4 AS DWORD ) AS LONG PASCAL ;
          FROM "InternetOpenA" LIB xdll)
DllCall(InternetReadFile(hFile As 7, @sBuffer As 8, lNumBytesToRead As 7, @lNumberOfBytesRead As 7) As 7 PASCAL Lib xdll)
DllCall(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)
DllCall(InternetCloseHandle( hSession AS LONG ) AS BOOL PASCAL LIB xdll)


:%
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.
Avatar de usuário

fladimir
Colaborador

Colaborador
 
Mensagens: 2434
Data de registro: 15 Nov 2006 19:21
Curtiu: 28 vezes
Mens.Curtidas: 157 vezes

Re: Bloqueio Online

Mensagempor fladimir » 22 Mar 2010 23:05

Não entendo de Classes e Métodos das mesmas, mas no Método New esta definido Default Buffersize, não sei se seria a definição do mesmo, mas realmente não esta achando....

O q poderia ser ?
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.
Avatar de usuário

fladimir
Colaborador

Colaborador
 
Mensagens: 2434
Data de registro: 15 Nov 2006 19:21
Curtiu: 28 vezes
Mens.Curtidas: 157 vezes

Re: Bloqueio Online

Mensagempor sygecom » 22 Mar 2010 23:15

Ahhh o problema está no DEFAULT, acho que se deixar assim passa:
#include 'common.ch'
DEFAULT buffersize TO 64000
Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
leonardodemachado@hotmail.com

Faça você também sua doação esse fórum é uma lenda viva: http://www.pctoledo.com.br/doacao
Avatar de usuário

sygecom
Usuário Nível 7

Usuário Nível 7
 
Mensagens: 7006
Data de registro: 21 Jul 2006 10:12
Cidade/Estado: Alvorada-RS
Curtiu: 1 vez
Mens.Curtidas: 130 vezes

Re: Bloqueio Online

Mensagempor sygecom » 22 Mar 2010 23:25

Salve toda a DLL.CH e descomente o #INCLUDE 'DLL.CH' ai pode até remover aquela parte da DLL.CH que colocou no .PRG que compila sem erros

// Copyright FiveTech 1993-07

#ifndef _DLL_CH
#define _DLL_CH

#ifndef _C_TYPES
   #define _C_TYPES
   #define VOID     0
   #define BYTE     1
   #define CHAR     2
   #define WORD     3

#ifdef __CLIPPER__
   #define _INT     4         // conflicts with Clipper Int()
#else
   #define _INT     7
#endif

   #define BOOL     5
   #define HDC      6
   #define LONG     7
   #define STRING   8
   #define LPSTR    9
   #define PTR     10
   #define _DOUBLE 11         // conflicts with BORDER DOUBLE
   #define DWORD   12
#endif

#translate NOREF([@]<x>) => <x>

#ifndef __HARBOUR__
  #ifndef __XPP__
     #ifndef __CLIPPER__
        #ifndef __C3__
           #define __CLIPPER__
        #endif
     #endif
  #endif
#endif

#ifndef __CLIPPER__
   #translate DLL32 => DLL
#endif

//----------------------------------------------------------------------------//

#xcommand DLL [<static:STATIC>] FUNCTION <FuncName>( [ <uParam1> AS <type1> ] ;
                                                     [, <uParamN> AS <typeN> ] ) ;
             AS <return> [<pascal:PASCAL>] [ FROM <SymName> ] LIB <*DllName*> ;
       => ;
          [<static>] function <FuncName>( [NOREF(<uParam1>)] [,NOREF(<uParamN>)] ) ;;
             local hDLL := If( ValType( <DllName> ) == "N", <DllName>, LoadLibrary( <(DllName)> ) ) ;;
             local uResult ;;
             local cFarProc ;;
             if Abs( hDLL ) > 32 ;;
                cFarProc = GetProcAdd( hDLL,;
                If( [ Empty( <SymName> ) == ] .t., <(FuncName)>, <SymName> ),;
                [<.pascal.>], <return> [,<type1>] [,<typeN>] ) ;;
                uResult = CallDLL( cFarProc [,<uParam1>] [,<uParamN>] ) ;;
                If( ValType( <DllName> ) == "N",, FreeLibrary( hDLL ) ) ;;
             else ;;
                MsgInfo( "Error code: " + LTrim( Str( hDLL ) ) + " loading " + ;
                If( ValType( <DllName> ) == "C", <DllName>, Str( <DllName> ) ) ) ;;
             end ;;
          return uResult

//----------------------------------------------------------------------------//

#xcommand DLL32 [<static:STATIC>] FUNCTION <FuncName>( [ <uParam1> AS <type1> ] ;
                                                      [, <uParamN> AS <typeN> ] ) ;
             AS <return> [<pascal:PASCAL>] [ FROM <SymName> ] LIB <*DllName*> ;
       => ;
          [<static>] function <FuncName>( [NOREF(<uParam1>)] [,NOREF(<uParamN>)] ) ;;
             local hDLL := If( ValType( <DllName> ) == "N", <DllName>, LoadLib32( <(DllName)> ) ) ;;
             local uResult ;;
             local cFarProc ;;
             if Abs( hDLL ) <= 32 ;;
                MsgInfo( "Error code: " + LTrim( Str( hDLL ) ) + " loading " + <DllName> ) ;;
             else ;;
                cFarProc = GetProc32( hDLL,;
                If( [ Empty( <SymName> ) == ] .t., <(FuncName)>, <SymName> ),;
                [<.pascal.>], <return> [,<type1>] [,<typeN>] ) ;;
                uResult = CallDLL32( cFarProc [,<uParam1>] [,<uParamN>] ) ;;
                If( ValType( <DllName> ) == "N",, FreeLib32( hDLL ) ) ;;
             end ;;
          return uResult

#endif

//----------------------------------------------------------------------------//
Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
leonardodemachado@hotmail.com

Faça você também sua doação esse fórum é uma lenda viva: http://www.pctoledo.com.br/doacao
Avatar de usuário

sygecom
Usuário Nível 7

Usuário Nível 7
 
Mensagens: 7006
Data de registro: 21 Jul 2006 10:12
Cidade/Estado: Alvorada-RS
Curtiu: 1 vez
Mens.Curtidas: 130 vezes

Re: Bloqueio Online

Mensagempor fladimir » 23 Mar 2010 08:36

O erro ainda persiste, mas parece q deve ser algo ou na Sintaxe das linhas abaixo:

DllCall(InternetOpen(cApp as LPSTR, n1 AS DWORD, n2 AS LPSTR, n3 AS LPSTR, n4 AS DWORD) ;
                     AS LONG PASCAL FROM "InternetOpenA" LIB xdll)
DllCall(InternetReadFile(hFile As 7, @sBuffer As 8, lNumBytesToRead As 7, @lNumberOfBytesRead As 7) ;
                     As 7 PASCAL Lib xdll)
DllCall(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)
DllCall(InternetCloseHandle( hSession AS LONG ) AS BOOL PASCAL LIB xdll)


Teste.PRG:
Proc Main

cCNPJ := "3753896400106" // "00.000.000/0001-00"
ws:=TdWebService():new()
cNRevisao := ws:OpenWS("http://www.seusite.com.br/" + cCNPJ + ".lic")
ws:end()
cLiberado := substr( cNRevisao, at("Status: ",cNRevisao)+8, 1 )
if cLiberado = "S"
   ? "Sistema liberado on-line."
else
   ? "Sistema travado."
endif

#include "OpenWS.prg"

Return


OpenWS.PRG:
#include "dll.ch"
#include 'hbclass.ch'
#include 'common.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 to 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 subst(alltrim(xml),1,len(alltrim(xml))-5)

METHOD End() CLASS TdWebService
FreeLib32(xDll)
return nil

DllCall(InternetOpen(cApp as LPSTR, n1 AS DWORD, n2 AS LPSTR, n3 AS LPSTR, n4 AS DWORD) ;
                     AS LONG PASCAL FROM "InternetOpenA" LIB xdll)
DllCall(InternetReadFile(hFile As 7, @sBuffer As 8, lNumBytesToRead As 7, @lNumberOfBytesRead As 7) ;
                     As 7 PASCAL Lib xdll)
DllCall(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)
DllCall(InternetCloseHandle( hSession AS LONG ) AS BOOL PASCAL LIB xdll)

Dll.CH:
// Copyright FiveTech 1993-07

#ifndef _DLL_CH
#define _DLL_CH

#ifndef _C_TYPES
   #define _C_TYPES
   #define VOID     0
   #define BYTE     1
   #define CHAR     2
   #define WORD     3

#ifdef __CLIPPER__
   #define _INT     4         // conflicts with Clipper Int()
#else
   #define _INT     7
#endif

   #define BOOL     5
   #define HDC      6
   #define LONG     7
   #define STRING   8
   #define LPSTR    9
   #define PTR     10
   #define _DOUBLE 11         // conflicts with BORDER DOUBLE
   #define DWORD   12
#endif

#translate NOREF([@]<x>) => <x>

#ifndef __HARBOUR__
  #ifndef __XPP__
     #ifndef __CLIPPER__
        #ifndef __C3__
           #define __CLIPPER__
        #endif
     #endif
  #endif
#endif

#ifndef __CLIPPER__
   #translate DLL32 => DLL
#endif

//----------------------------------------------------------------------------//

#xcommand DLL [<static:STATIC>] FUNCTION <FuncName>( [ <uParam1> AS <type1> ] ;
                                                     [, <uParamN> AS <typeN> ] ) ;
             AS <return> [<pascal:PASCAL>] [ FROM <SymName> ] LIB <*DllName*> ;
       => ;
          [<static>] function <FuncName>( [NOREF(<uParam1>)] [,NOREF(<uParamN>)] ) ;;
             local hDLL := If( ValType( <DllName> ) == "N", <DllName>, LoadLibrary( <(DllName)> ) ) ;;
             local uResult ;;
             local cFarProc ;;
             if Abs( hDLL ) > 32 ;;
                cFarProc = GetProcAdd( hDLL,;
                If( [ Empty( <SymName> ) == ] .t., <(FuncName)>, <SymName> ),;
                [<.pascal.>], <return> [,<type1>] [,<typeN>] ) ;;
                uResult = CallDLL( cFarProc [,<uParam1>] [,<uParamN>] ) ;;
                If( ValType( <DllName> ) == "N",, FreeLibrary( hDLL ) ) ;;
             else ;;
                MsgInfo( "Error code: " + LTrim( Str( hDLL ) ) + " loading " + ;
                If( ValType( <DllName> ) == "C", <DllName>, Str( <DllName> ) ) ) ;;
             end ;;
          return uResult

//----------------------------------------------------------------------------//

#xcommand DLL32 [<static:STATIC>] FUNCTION <FuncName>( [ <uParam1> AS <type1> ] ;
                                                      [, <uParamN> AS <typeN> ] ) ;
             AS <return> [<pascal:PASCAL>] [ FROM <SymName> ] LIB <*DllName*> ;
       => ;
          [<static>] function <FuncName>( [NOREF(<uParam1>)] [,NOREF(<uParamN>)] ) ;;
             local hDLL := If( ValType( <DllName> ) == "N", <DllName>, LoadLib32( <(DllName)> ) ) ;;
             local uResult ;;
             local cFarProc ;;
             if Abs( hDLL ) <= 32 ;;
                MsgInfo( "Error code: " + LTrim( Str( hDLL ) ) + " loading " + <DllName> ) ;;
             else ;;
                cFarProc = GetProc32( hDLL,;
                If( [ Empty( <SymName> ) == ] .t., <(FuncName)>, <SymName> ),;
                [<.pascal.>], <return> [,<type1>] [,<typeN>] ) ;;
                uResult = CallDLL32( cFarProc [,<uParam1>] [,<uParamN>] ) ;;
                If( ValType( <DllName> ) == "N",, FreeLib32( hDLL ) ) ;;
             end ;;
          return uResult

#endif

//----------------------------------------------------------------------------//


Arquivo de Log com o Erro:
xHarbour Compiler build 1.2.1 (SimpLex) (Rev. 6646)
Copyright 1999-2009, http://www.xharbour.org http://www.harbour-project.org/
Compiling 'TESTE.PRG'...

100
100
200
300
400
500
600
700
800
900
1000
1100
100

OpenWS.prg(40) Error E0030  Syntax error: "syntax error at '9'"
OpenWS.prg(42) Error E0030  Syntax error: "syntax error at '7'"
OpenWS.prg(44) Error E0030  Syntax error: "syntax error at '7'"
OpenWS.prg(45) Error E0030  Syntax error: "syntax error at '7'"
4 errors

No code generated


:'(
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.
Avatar de usuário

fladimir
Colaborador

Colaborador
 
Mensagens: 2434
Data de registro: 15 Nov 2006 19:21
Curtiu: 28 vezes
Mens.Curtidas: 157 vezes

Re: Bloqueio Online

Mensagempor fladimir » 23 Mar 2010 14:35

Somebody ?
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.
Avatar de usuário

fladimir
Colaborador

Colaborador
 
Mensagens: 2434
Data de registro: 15 Nov 2006 19:21
Curtiu: 28 vezes
Mens.Curtidas: 157 vezes

Próximo



Retornar para Harbour

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 12 visitantes


Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Faça uma doação para o forum
cron
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro