Como usar o WILBOR GRADUAL via SOCKET
Enviado: 24 Abr 2008 16:26
Usei como base o exemplo que peguei no site da gradual e adaptei para uso no xharbour.
Espero que possa ajudar alguem.
Frazato@ibest.com.br
Espero que possa ajudar alguem.
Frazato@ibest.com.br
Código: Selecionar todos
Static pSocket
Function Main()
REQUEST DBFCDX
RDDSETDEFAULT("dbfcdx")
DBSETDRIVER("dbfcdx")
dbsetdriver("DBFCDX")
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
Set background Tasks On
SET WRAP ON
Parameters nPorta
nPorta := val(nPorta)
if nPorta <= 0
nPorta := 1800
Endif
Close All
Sele 1
Use Produto Alias Prod
Set index to Produto
Sele 2
USE Mesa005 ALIAS CFG
Go top
xMaxMesa := CFG->Qtd_mesa
wID_Servidor := Alltrim(CFG->LoctxtPDV)
cTerm_grad := Term_grad
cTituloDisplay := Cfg->Cabeca1
Sele 3
USE Mesa002 ALIAS WORK2
SET INDEX TO Mesa002
SELE 4
USE Mesa001 ALIAS WORK
SET INDEX TO Mesa001
waitkbd := array(32) // flag de aguardando entrada de teclado
teclado := array(32) // buffer de teclado
pikture := array(32) // picture de teclado
pospic := array(32) // posicao na picture de teclado
posicao := array(32) // posicao na execucao do programa
pprinter := array(32) // array para armazenamento de impressao paralela
sprinter := array(32) // array para armazenamento de impressao serial
pinpos := array(32) // posicao de entrada no array impressao paralela
sinpos := array(32) // posicao de entrada no array impressao serial
poutpos := array(32) // posicao de saida no array impressao paralela
soutpos := array(32) // posicao de saida no array impressao serial
//
//
// Defines para os acessos indexados as variaveis gerenciais da rede
//
//
#define POS posicao[terminal+1] // posicao do programa
#define KPIC pikture[terminal+1] // picture de teclado
#define KBD teclado[terminal+1] // variavel com input de teclado
#define WAITT waitkbd[terminal+1] // flag de aguardo de entrada de dados
#define PPIC pospic[terminal+1] // posicao a receber na picture de teclado
#define PPRN pprinter[terminal+1]
#define SPRN sprinter[terminal+1]
#define PINP pinpos[terminal+1]
#define PINS sinpos[terminal+1]
#define POUTP poutpos[terminal+1]
#define POUTS soutpos[terminal+1]
#define ESC 27
#define BKSP 8
novahora:=""
novoseg:=""
velhoseg:=""
vseg := array( 32 )
#define VELHOSEG vseg[terminal+1]
delaic := array(32)
#define DELAI delaic[terminal+1]
nParada := 0
cComanda := ''
nQuantVenda := 0
lProdPesado := .f.
//
// Rotinas de inicializacao da estrutura de controle da rede de terminais
//
terminal := 0 // Variavel que indica o terminal que esta sendo
// tratado a cada instante. Se for usada como
// variavel para indexacao dos vetores, permitira
// que a programacao fique mais simples e que
// nao haja mistura dos dados entre os terminais
helpstr := "" // Variavel de apoio para a funcao GFLUSHPRN
SetColor('ww+/bb+')
@ 02,02 Clear to 05,70
@ 02,02 to 05,70
@ 02,03 say '[ JAF Desenv. (14) 3324-2427 (Joao Frazato) **Micro Terminal** ]'
@ 05,03 say '[ xHarbour 99.70 Usando TCP/IP ( Socket ) ]'
@ 05,35 say "Porta("+Str(nPorta,5)+")"
Conecta()
IniciaTeclados()
do while .T.
@ 03,50 say pSocket Color('rr+/bb+')
@ 04,03 say Substr("Monitorando Porta....."+Space(100),1,40)
IF INetErrorCode( pSocket ) <> 0
@ 04,03 say Substr("Reestabelecendo Conec‡Æo!"+Space(100),1,40)
INetClose( pSocket )
INetCleanUp()
Conecta()
IniciaTeclados()
Endif
termprog1( 0 ) // chama a rotina termprog1 para o terminal 0
calcula_delay()
If Lastkey()==27
Exit
Endif
enddo
INetCleanUp()
Close All
Return Nil
//
// Funcoes de controle da rede de terminais
//
//
// GPOSCUR : posciona o cursor no display do terminal
// valores validos: linha 0,1
// coluna 00 a 39
Function Gposcur( linha, coluna )
cCmdLimpa:=Chr(27)+'['+Alltrim(Str(Linha,2))+';'+Alltrim(Str(coluna,2))
nBytes := Len(cCmdLimpa)
nBytes := INetSendall( pSocket, cCmdLimpa,nBytes )
return .T.
//
// GDISPLAY : envia uma string ao display do terminal
//
//
Function Gdisplay( mensagem )
cCmdLimpa:=mensagem
nBytes := Len(cCmdLimpa)
nBytes := INetSendall( pSocket, cCmdLimpa,nBytes )
return .T.
//
// GECHO : envia um caracter para o display do terminal
//
//
Function Gecho( dado )
cCmdLimpa:= Dado
nBytes := Len(cCmdLimpa)
nBytes := INetSendall( pSocket, cCmdLimpa,nBytes )
return .T.
//
// GCLEAR : apaga o display do terminal
//
//
Function Gclear
cCmdLimpa:= Chr(27)+'[H'+Chr(27)+'[J'
nBytes := Len(cCmdLimpa)
nBytes := INetSendall( pSocket, cCmdLimpa,nBytes )
return .T.
//
// GPRINTP : envia uma string para a porta de saida paralela do terminal
// assinalado em numterm( 00 a 31 ).
// O aplicativo devera ter o tratamento para que o array de saida
// daquele terminal nao seja estourado (65535 caracteres).
//
Function Gprintp( string, numterm )
pinpos[numterm+1] := pinpos[numterm+1] + len( string )
pprinter[numterm+1] := pprinter[numterm+1] + string
return .T.
//
// GPRINTS : envia uma string para a porta de saida serial do terminal
// assinalado em numterm( 00 a 31 ).
// O aplicativo devera ter o tratamento para que o array de saida
// daquele terminal nao seja estourado (65535 caracteres).
//
Function Gprints( string, numterm )
sinpos[numterm+1] := sinpos[numterm+1] + len( string )
sprinter[numterm+1] := sprinter[numterm+1] + string
Gdisplay(string)
return .T.
//
// GFLUSHPRN : faz a tentativa de envio das informacoes contidas no buffer
// de impressao de paralela e serial dos terminais.
// Deve ser chamada com uma frequencia alta, pois a nao
// colocacao no buffer do schedule, implica na nao impressao dos
// dados.
// O buffer do schedule e limitado a 200 posicoes que serao assim
// preenchidas a cada chamada do GFLUSHPRN, e descarregadas a
// cada chamada do schedule.
// Uma chamada do schedule nao significa que o buffer de
// saida sera descarregado completamente. Porem sempre que houver
// espaco para passar dados para este buffer a funcao enviara
// alguma informacao.
//
Function Gflushprn
helpstr:=chr(1)
do while substr( helpstr, 1, 1 )==chr(1)
if PINS<>POUTS
*helpstr:=chr(254)+padl( ltrim( str(terminal,2,0) ), 2, "0" )+"R"+substr(SPRN,POUTS,1)
cCmdLimpa:= chr(27)+"R"+substr(SPRN,POUTS,1)
nBytes := Len(cCmdLimpa)
nBytes := INetSendall( pSocket, cCmdLimpa,nBytes )
nBytes := INetRecv( pSocket, @helpstr )
*fwrite( handle, helpstr, len(helpstr) )
*fread( handle, @helpstr, 2 )
if substr( helpstr, 1, 1 )=chr(1)
POUTS := POUTS + 1
endif
else
SPRN:=""
PINS:=1
POUTS:=1
helpstr:=chr(0)
endif
enddo
helpstr:=chr(1)
do while substr( helpstr, 1, 1 )==chr(1)
if PINP<>POUTP
helpstr:=chr(254)+strzero(terminal,2)+"I"+substr(PPRN,POUTP,1)
*fwrite( handle, helpstr, len(helpstr) )
*fread( handle, @helpstr, 2 )
cCmdLimpa:= chr(27)+"R"+substr(SPRN,POUTS,1)
nBytes := Len(cCmdLimpa)
nBytes := INetSendall( pSocket, cCmdLimpa,nBytes )
nBytes := INetRecv( pSocket, @helpstr )
if substr( helpstr, 1, 1 )=chr(1)
POUTP := POUTP + 1
endif
else
PPRN:=""
PINP:=1
POUTP:=1
helpstr:=chr(0)
endif
enddo
return
//
// GGET : prepara todas as estruturas para o recebimento de uma picture do
// teclado.
//
Function Gget( formato )
retorno:=.T.
if WAITT==0
KPIC:=formato // guarda o formato
PPIC:=1 // posiciona o ponteiro na 1a. posicao
KBD:="" // limpa o buffer de entrada
WAITT:=1 // liga o flag de espera de picture
retorno:=.T.
else
retorno:=.F.
endif
return retorno
procedure ajusta_ponto
pponto:=0
slen:=len(KBD)
posponto:=1
do while substr(KPIC, posponto, 1 )<>"."
posponto:=posponto+1
if posponto==len(KPIC)
exit
endif
enddo
if posponto==len(KPIC)
return
endif
strdisp := REPLICATE(" ",posponto-1-LEN(ALLTRIM(KBD))) + ALLTRIM(KBD)
sppic := PPIC
do while SPPIC>1
Gecho(chr(BKSP))
sppic := sppic - 1
enddo
PPIC := posponto
Gdisplay( strdisp )
KBD:=strdisp
return
//
//
// Rotinas de tratamento dos Microterminais
//
//
//---------------------------------------------------------------------------
Function termprog1( numterm )
terminal := numterm
Gflushprn()
if POS == 1
nParada:=0
Gclear() // 1234567890123456789012345678901234567890
*Gdisplay( "SISTEMA JAF **** MICRO TERMINAL ****" )
cMsg := Substr(Substr(cTituloDisplay,1,20)+Space(5)+"JAF Desenv"+space(40),1,40)
Gdisplay( cMsg )
Gdisplay( "NR COMANDA: " )
Gget( "999@" )
POS:=2
elseif POS == 2
if Gtrtecla()
Gclear()
cComanda := Val(KBD)
If cComanda== 0 .or. cComanda > xMaxMesa
Gdisplay('COMANDA NAO DISPONIVEL .'+Str(cComanda,3) )
nParada := 1000
POS := 1
Else
Gdisplay('ATENDENDO COMANDA NR.'+Str(cComanda,3) )
nParada := 100
POS:=3
Endif
If KBD==CHR(ESC)
close arq1
fclose( handle )
quit
endif
*POS:=3
endif
elseif POS == 3 // Consulta
nParada:=0
Gclear()
Gdisplay( "Codigo do Produto: " )
Gget( "99999@" )
POS:=9
elseif POS == 9
if Gtrtecla()
If KBD==CHR(ESC)
POS:= 1
endif
Sele Prod
go top
cCodItem := StrZero(Val(substr(KBD,1,5)),5)
Seek cCodItem
if found()
Gclear()
Gdisplay( Substr(Prod->Descricao+Space(40),1,40) )
Gdisplay( "PRECO :"+Transf(Prod->Venda,'@EZ 999.99') )
If Prod->PRODPESADO=="S"
lProdPesado:=.t.
Endif
POS:= 10
else
Gclear()
Gdisplay( "Produto sem Cadastro"+cCodItem)
nParada:=1000
POS:= 1
Endif
Endif
elseif POS == 10
nParada:=0
*Gclear()
If lProdPesado== .t.
Gdisplay( " Peso:" )
Gget( "999.999@" )
Else
Gdisplay( " Quantidade:" )
Gget( "999999@" )
Endif
POS:=11
elseif POS == 11
If lProdPesado== .t.
Balanca()
*servidor.Socket.connections[IndConexao].SendText(Chr(27) + '[?24h' + Chr(27) + '[5i' + Chr(5) + Chr(27) + '[4i');//Serial 1 para MT WT2
Endif
if Gtrtecla()
If KBD==CHR(ESC)
POS:= 1
endif
nQuantVenda := val(KBD)
If nQuantVenda > 0
POS := 12
Else
POS := 3
Endif
Endif
elseif POS == 12
nParada:=0
Gclear()
cDadosPedido := Substr(Prod->Descricao,1,24)+" QTD :"+str(nQuantVenda,10,3)
Gdisplay(cDadosPedido+'Conf(S/N)')
Gget( "X@" )
POS:=13
elseif POS == 13
if Gtrtecla()
If KBD==CHR(ESC)
POS:= 1
Endif
AbreMesa(cComanda)
If UPPER(KBD)=='S'
cSocket := pSocket
If cTerm_grad$"DA"
Sele Work2
Append Blank
Repla Work2->Id_Mesa With StrZero(cComanda,3)
Repla Work2->CodProd With Prod->Codigo
Repla Work2->DesProd With Prod->descricao
Repla Work2->Quantid With nQuantVenda
Repla Work2->Preco With Prod->Venda
Repla Work2->Custo With Prod->Custo
Commit
Unlock
Endif
If cTerm_grad$"TA"
wObserv := ''
Grava_Txt('PRODUTO',cComanda,;
Prod->Codigo,;
nQuantVenda,;
wObserv)
Endif
Gclear()
Gdisplay( "Pedido Feito")
nParada:=500
Endif
POS:= 1
Endif
endif
return
//------------------------------------------------------------------------------
// Uso do Socket
Function Conecta()
Local retorno := .t.
LOCAL cBuffer, nBytes, cRequest, cResponse
// initialize sockets system and connect to server
INetInit()
pSocket := INetServer(nPorta)
pSocket := INetAccept(pSocket)
IF INetErrorCode( pSocket ) <> 0
*? "Socket error:", INetErrorDesc( pSocket )
INetCleanUp()
QUIT
ENDIF
RETURN retorno
//Rotinas de Teste
Function Gtrtecla
Local retorno:=.F.
Local gtecla:=""
Local gpict:=" "
cCmdLimpa:=chr(254)+strzero(terminal,2)+"K"
* fwrite( handle, helpstr, len(helpstr) )
* nBytes := Len(cCmdLimpa)
* nBytes := INetSendall( pSocket, cCmdLimpa,nBytes )
*fread( handle, @helpstr, 2 )
nBytes := INetRecv( pSocket, @helpstr )
gtecla:=substr( helpstr, 1, 1 )
*Gdisplay(helpstr)
if WAITT==0 // se o flag de espera por picture nao
return .F. // estiver ligado retorna erro.
endif
if gtecla<>Chr(0) // se a existe tecla para tratar
if gtecla==Chr(127)
if PPIC==1
KBD := Chr(ESC)
WAITT := 0
return .T.
else
do while PPIC>1
Gecho(CHR(BKSP))
PPIC:=PPIC-1
enddo
KBD:=""
endif
elseif gtecla==Chr(BKSP)
if PPIC>1
gpict := substr( KPIC, PPIC-1, 1 )
if gpict=="/" .or. gpict=="."
Gecho( gtecla )
PPIC = PPIC-1
endif
PPIC = PPIC-1
KBD := substr( KBD, 1, PPIC-1 )
Gecho( gtecla )
endif
elseif gtecla==Chr(13)
@ 04,50 say KBD Color('GB+/BB+')
WAITT:=0
retorno:=.T.
else
gpict=substr( KPIC, PPIC, 1 )
if gpict=="X"
KBD = KBD + gtecla
PPIC = PPIC + 1
Gecho( gtecla )
elseif gpict=="9"
if gtecla>="0" .and. gtecla<="9" .or. gtecla=="."
if gtecla=="."
ajusta_ponto()
else
KBD = KBD + gtecla
PPIC = PPIC + 1
Gecho( gtecla )
endif
endif
elseif gpict=="A"
if gtecla>="A" .and. gtecla<="Z" .or. gtecla==" "
KBD = KBD + gtecla
PPIC = PPIC + 1
Gecho( gtecla )
endif
endif
gpict=substr( KPIC, PPIC, 1 )
if gpict=="@"
@ 04,50 say KBD Color('GB+/BB+')
WAITT:=0
retorno:=.T.
elseif gpict=="/"
PPIC = PPIC + 1
Gecho("/")
elseif gpict=="."
Gecho(".")
KBD := KBD + "."
PPIC = PPIC + 1
else
retorno:=.F.
endif
endif
endif
return retorno
//----------------------------------------------------------------
Function calcula_delay()
*do while Seconds() < TFIM
millisec(nParada)
*enddo
return NIL
//v---------------------------------------------------------------
Function IniciaTeclados()
terminal:=0
do while terminal<32
POS:=1 // define a posicao inicial de entrada no programa
WAITT:=0 // inicializa o flag de teclado
PINP:=0 // inicializa entrada de impressao paralela
SINP:=0 // inicializa entrada de impressao serial
POUTP:=0 // inicializa saida de impressao paralela
SOUTP:=0 // inicializa saida de impressao serial
PPRN := "" // inicializa o vetor de paralela
SPRN := "" // inicializa o vetor de serial
Gclear() // Envia dois apagamentos de display para que o
Gclear() // terminal possa ficar sincronizado com o PC
terminal=terminal+1
enddo
return nil
Function Balanca()
lProdPesado := .f.
* servidor.Socket.connections[IndConexao].SendText(Chr(27) + '[?24h' + Chr(27) + '[5i' + Chr(5) + Chr(27) + '[4i');//Serial 1 para MT WT2
cCmdLimpa := Chr(27) + '[?24h' + Chr(27) + '[5i' + Chr(5) + Chr(27) + '[4i'
nBytes := Len(cCmdLimpa)
nBytes := INetSendall( pSocket, cCmdLimpa,nBytes )
* millisec(200)
nBytes := INetRecv( pSocket, @helpstr )
* ? helpstr
Return nil
Function Imprimir_Item()
Local cQuebra := chr(10)+chr(13)
Local cCmdLimpa := 'teste de impressao!'
nBytes := Len(cCmdLimpa)
nBytes := INetSendall( pSocket, cCmdLimpa,nBytes )
Return nil
//--------------------------------------------
Static Function Grava_Txt(Rotina,nMesa,cProduto,nQuant,cObserv)
Local QuebraLinha := Chr(13)+Chr(10)
If Empty(cProduto)
Return Nil
Endif
wID_Garcon := StrZero(nMesa,3)
mLocServ := wID_Servidor//'\\Servidor\Jaf\Pocket\'
Arquivo := mLocServ+'Ent_'+wID_Garcon+'.txt'
If File(mLocServ+'\Sai_'+wID_Garcon+'.txt')
Delete File (mLocServ+'\Sai_'+wID_Garcon+'.txt')
Endif
Handle := FCreate(Arquivo)
If Ferror() # 0
Return Nil
Endif
mString:= Rotina+"|"+;
StrZero(nMesa,3)+"|"+;
cProduto+"|"+;
StrZero(nQuant*100,11)+"|"+;
cObserv+"|"+;
wID_Garcon // Dados do Garcon
Fwrite(Handle,mString+QuebraLinha)
FCLOSE(HANDLE)
Return Nil
//------------------------------------------
Static Function AbreMesa(nMesa)
Sele WORK
OrdSetFocus("Mesa0102")
Go top
Seek StrZero(nMesa,3)
If ! Found()
Append Blank
Repla Work->Id_Contr With StrZero(Recno(),5)
Repla Work->Id_Mesa With StrZero(nMesa,3)
Repla Work->Data With Date()
Repla Work->Horaini With Time()
Repla Work->Situacao With "A"
Commit
Unlock
Endif
Return nil