Estou tendo vários problemas com uma aplicação que utilizo de terceiro no mercado para consulta de preço neste tipo de terminal, fica dando erros de DLL, e para não ter a rotina de ficar importando arquivo resolvi fazer uma para atender as minhas necessidades, acho de da para melhorar para mais de 3 terminais, hj tenho 2 e está funcionado bem!
Espero que sirva para alguém!!
Frazato
Código: Selecionar todos
#INCLUDE "FILEIO.CH"
#include "inkey.ch"
#include "set.ch"
#include "wingdi.ch"
#include "winuser.ch"
#include "common.ch"
#include "setcurs.ch"
#include "getexit.ch"
Static gSocket
#define CR chr(13)
#define LF chr(10)
static MutexCount
static wListaTerminal := {}
static nPorta
Static cLocalServ
Static wItensLidos := {}
//------------------------------
FUNCTION MAIN()
nPorta := Val(INI_PEGA_DADOS("PORTA"))
cLocaServ := INI_PEGA_DADOS('SERVIDORJAF')
ConectaBDF() // atender a multherd
Set Color to 'w+/b+'
Clear
@ 00,00 say Padc('### JAF DESENV. TERMINAL BUSCA PRECO GERTEC |SEM DLL ### ',90) Color('R+/GB+')
@ 01,00 say Padc('Versao Beta ==>'+ Version(),90) Color('NN+/GB+')
@ 02,00 say Padc('Servidor JAF:'+cLocaServ,80)
@ 03,02 say Padc("Porta ("+Str(nPorta,5)+") Iniciado em..."+dtoc(Date())+' '+time(),80)
@ 04,00 to 04,90
DispOutAt( maxrow()-2, 0, Repli('-',90), "W+/N" )
DispOutAt( maxrow()-1, 0, padc( "JAF Desenvolvimentos - Joao Frazato",90 ), "W+/N" )
INetInit()
gSocket := INetServer(nPorta)
nReconecoes := 1
*g_nUserCount := 0
*g_nTotalCount := 0
MutexCount := HB_MutexCreate()
wListaTerminal:= {}
do while .T.
InetSetTimeout( gSocket, 100000 ) // Timeout de Recepção 3 seg //
pSocket := INetAccept(gSocket) //gSocket
@ 05,00 say Time()
@ 05,31 say 'Coneccao:'+Time()+' Tentativas...'+str(nReconecoes,5)
IF INetErrorCode( gSocket ) <> 0
nReconecoes++
Inkey(0.1)
If Lastkey()==27
Exit
Endif
Loop
Endif
cIp_Pdv_solicitante := INetAddress(pSocket)
If nOk:= Ascan(wListaTerminal,{|x|x[1]==cIp_Pdv_solicitante} ) = 0
Aadd(wListaTerminal,{cIp_Pdv_solicitante,pSocket})
Endif
hb_ThreadStart( @PapoTerminal(),pSocket,cIp_Pdv_solicitante)
*PegandoMensagemPDV(pSocket,cIp_Pdv_solicitante)
Inkey(0.1)
If Lastkey()==27
Exit
Endif
@ 6,60 say ' Terminais '
@ 7,60 say '-------------------------'
For i:= 1 to len(wListaTerminal)
@ i+8,60 say wListaTerminal[i,1]
@ i+8,78 say wListaTerminal[i,2]
Next
@ 7,05 say '### ULTIMOS ITENS LIDOS ###'
CorOld :=SetColor()
Set color to 'r*/nn'
@ 08,1 Clear to 20,56
For x:= 1 to Len(wItensLidos)
@ x+7,1 say wItensLidos[x]
If x >= 10
hb_mutexLock( MutexCount )
wItensLidos := {}
hb_mutexUnlock( MutexCount )
Exit
Endif
NExt
SetColor(CorOld)
Enddo
INetClose( gSocket )
INetCleanUp()
Close All
Return Nil
//------------------------------------------
Function PapoTerminal(sconc,cIpterminal)
Local pSocket := sconc
Local ntimesaida := 5 * 1000000
Local cMsg, cLidos,Bloco,nErro
Local cPesqEan
InetSetTimeout( pSocket ,nTimeSaida) // Timeout de Recepção 3 seg //
// --- envia msg pro temrinal
cMsg := '#ok'
INetSendall( pSocket,cMsg)
DispOutAt( maxrow()-3, 0,'Terminal Conectado...'+cIpterminal , "'ww+/b+'" )
Do while .t.
cLidos := ''
nErro := hb_InetErrorCode( pSocket )
Bloco := Space(255)
bytes := hb_inetRecv(pSocket,@BLOCO)
cLidos := Left(Bloco,Bytes)
If hb_inetstatus(pSocket)== -1 // erro coneccao
Exit
Endif
If Len(cLidos) >= 14
ConectaBDF() // Abre
cPesq2 := cLidos
cPesqEan := sonumeros(cLidos)
cPesqEan := StrZero(Val(cPesqEan),16)
cMsg := '#nfound'
Sele Sku
OrdSetFocus("Skus01")
Go top
SEEK cPesqEan
If Found()
Sele Prod
OrdSetFocus("Prod01")
Go Top
Seek Sku->Cod_Prod
If Found()
nVenda := Prod->venda
xOferta := Iif( ( Date() >= Prod->Ofer_Inici) .And. ( Date() <= Prod->Ofer_Termi) .And. ( Prod->Ofer_Valor > 0 ) ,"*Oferta*" ,"" )
If xOferta#''
nVenda := Prod->Ofer_Valor
Endif
cMsg := '#R$ '+Alltrim(transf(nVenda,'@EZ 99999.99'))+'*JAF*'+xOferta+;
+'|'+Alltrim(Prod->descricao)
GravaLogRetorno(cLidos+' '+cMsg+' Terminal..'+cIpterminal+' Hora..:'+time())
Aadd(wItensLidos,Prod->Codigo+'.'+Prod->Descricao+' '+time()) // mostra lista itens
Else
GravaLogRetorno(cLidos+' Produto erro codigo barras '+time())
Endif
Else
GravaLogRetorno(cLidos+' Codigo ean invalido '+time())
Endif
INetSendall( pSocket,cMsg)
inkey(0.1)
Else
*@ 22,20 say 'Aguardando..'+Time()
Endif
If nErro # 0
Exit
Endif
If LastKey()==27
Exit
Endif
Enddo
INetClose( pSocket )
Return .t. //
//---------------------------------------------------------
sTatic function sonumeros(e)
Local n := '0123456789'
Local i
Local c:= ''
For i:= 1 to Len(e)
If Substr(e,i,1)$n
c+= Substr(e,i,1)
Endif
Next
Return c
******************
FUNCTION Iniciar()
******************
set confirm on
set deleted on
set bell off
set scoreboard off
set date british
set epoch to 1950
Set date format to "DD/MM/YYYY"
Set exclusive off
Setmode(25,90)
lRet := .t.
RETURN lRet
//--------------------------------------------
Static Function GravaLogRetorno(cMsg)
Local cFileName := "Busca_Preco.txt"
Local hFile, cLine := "", n
Local cFieldAnt
Local CRLF := Chr(13)+Chr(10)
Local i
cLine := cMsg+CRLF
hb_mutexLock( MutexCount )
If ! File( cFileName ) // Caso nao tenha cria o arquivo
FClose( FCreate( cFileName ) )
Endif
Do Whil .T.
If ( ( hFile := FOpen( cFileName, 1+16 ) ) # -1 )
FSeek( hFile, 0, 2 )
FWrite( hFile, cLine, Len( cLine ) )
FClose( hFile )
Exit
Else
Exit
Endif
Enddo
hb_mutexUnlock( MutexCount )
Retu(.T.)
//---------------------------------------------------------
Static Function Cria_configuracao()
Local WARQ := "buscapreco.JAF"
Local HANDLE
If ! File(WARQ)
HANDLE := fcreate(WARQ, FC_NORMAL )
If HANDLE > 0
*fwrite(HANDLE, "IPLETODB=200.192.243.252#" + chr(13) + chr(10) )
*fwrite(HANDLE, "PORTALETODB=2812#" + chr(13) + chr(10) )
fwrite(HANDLE, "SERVIDORJAF=G:\JAF\BBA\#" + chr(13) + chr(10) )
fwrite(HANDLE, "PORTA=4548#" + chr(13) + chr(10) )
*fwrite(HANDLE, "TIMEOUT=3000#" + chr(13) + chr(10) )
RET := (ferror() = 0)
fclose(HANDLE)
Endif
Endif
Return nil
*>------------------------------------------------------------------------
Static Function INI_PEGA_DADOS(PARAM) //
LOCAL BUSCA , ARQUIVO ,BSUCA,INIPARMA , FIMPARAM , SIZESTRING
IF ! FILE("buscapreco.JAF")
CLOSE ALL
Alert("Criado o arquivo de Configura‡Æo de (buscapreco.JAF)")
Cria_configuracao()
quit
ELSE
ARQUIVO := "buscapreco.JAF"
ENDIF
LINHA := Memoread(Arquivo)
BUSCA := AT(PARAM,LINHA)
LINHA := SUBSTR(LINHA,BUSCA,80)
INIPARAM := AT("=" ,LINHA)
FIMPARAM := AT("#" ,LINHA)
SIZESTRING:= ( FIMPARAM - INIPARAM )
VINIPARAM := ALLTRIM(SUBSTR(LINHA,INIPARAM+1,SIZESTRING-1))
RETURN VINIPARAM
//---------------------------------------------------------------
Function ConectaBDF()
nPorta := Val(INI_PEGA_DADOS("PORTA"))
cLocaServ := INI_PEGA_DADOS('SERVIDORJAF')
Set Defa to ( cLocaServ )
REQUEST DBFCDX
RDDSETDEFAULT("dbfcdx")
DBSETDRIVER("dbfcdx")
Iniciar()
Close all
Sele 1
Use CadSkus Alias Sku
Set index to CadSkus
Sele 2
use Produto alias Prod
Set index to Produto
Return nil
