Bloqueio Online

[fladimir]

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

[rochinha]

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.

Código: Selecionar todos

   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:

Código: Selecionar todos

#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.

[fladimir]

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

só q ao compilar da o erro conforme abaixo:

Código: Selecionar todos

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!!!

[rochinha]

Amiguinho,

Em OpenWS desabilite:

Código: Selecionar todos

#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:

Código: Selecionar todos

#include "OpenWS.prg"

Compile apenas o TESTE.PRG

[fladimir]

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:

Código: Selecionar todos

******************
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:

Código: Selecionar todos

//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:

Código: Selecionar todos

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...?

:%

[sygecom]

tente colocar no inicio de OpenWS.prg:
#include 'hbclass.ch'

[fladimir]

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

Código: Selecionar todos

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....

:'(

[sygecom]

Coloque no inicio do .PRG (isso é parte da DLL.CH)

Código: Selecionar todos

#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

[sygecom]

Na verdade tinha que compilar aqui para ver os erros, não achei o tal buffersize na DLL.CH alias nem no .PRG

[fladimir]

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

Código: Selecionar todos

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:

Código: Selecionar todos

//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)

:%

[fladimir]

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 ?

[sygecom]

Ahhh o problema está no DEFAULT, acho que se deixar assim passa:
#include 'common.ch'
DEFAULT buffersize TO 64000

[sygecom]

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

Código: Selecionar todos

// 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

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

[fladimir]

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

Código: Selecionar todos

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:

Código: Selecionar todos

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:

Código: Selecionar todos

#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:

Código: Selecionar todos

// 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:

Código: Selecionar todos

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

:'(

[fladimir]

Somebody ?