//Xbuild -mt TestServer

*******************************************************************************
PROCEDURE Main
*******************************************************************************
   LOCAL pServer, pClient
   Public cData, pSocket

   CLS

   Use Produto Alias Produto
   Index on PrCodi To Prod01
   Index on CodBarra To Prod02
   Index on PrDesc to Prod03
   Use Produto Index Prod01, Prod02, Prod03

   INetInit()
   pServer := INetServer( 8000 )
   // stop listening after .5 seconds
   INetSetTimeout( pServer, 500 )
   
   ? "Servidor executando", pServer
   ? "Pression <Esc> para fechar Ver 0.0.1"
   ? "Aguardando "
   _x := 1
   DO WHILE Inkey(.1) <> 27
      // wait for incoming connection requests
      pClient := INetAccept( pServer )
      IF INetErrorCode( pServer ) == 0
         // process client request in separate thread
         StartThread( @ServeClient(), pClient )
      ELSE
         // display some kind of "I am still alive" message
         if     _x == 1 ; @ 03,13 say "\" ; _x++
         elseif _x == 2 ; @ 03,13 say "|" ; _x++
         elseif _x == 3 ; @ 03,13 say "/" ; _x++
         elseif _x == 4 ; @ 03,13 say "-" ; _x:=1
         endif
      ENDIF
   ENDDO

   // make sure second thread has ended
   WaitForThreads()

   // close socket and cleanup memory
   INetClose( pServer )
   INetCleanup()
RETURN

*******************************************************************************
PROCEDURE ServeClient( pSocket )
*******************************************************************************
   LOCAL cBuffer, nBytes, cData := ""
   @ 04,02 say 'Dados da Ultima Consulta'
   // display IP address of client
   @ 06,02 say "IP Cliente.: "+INetAddress( pSocket )
   @ 06,col()+10 say Time()
   cData := INetRecvLine( pSocket, @nBytes )
   @ 06,col()+10 say cData
   if cdata = nil .or. cdata=''
      alert('Retornando Nulo')
      Return
   Endif
   if left(cData,2) = 'SP'
      INetSend( pSocket, SeekProd(right(cData,len(cData)-2)) )
   elseif left(cData,2) = 'RL'
      INetSend( pSocket, Createrel(right(cData,len(cData)-2)) )
   else
      INetSend( pSocket, 'Problema na Solicitacao.: '+cData )
   endif
RETURN
*******************************************************************************

Function SeekProd(cData)
   @ 08,02 say "Produto Solicitado.: "+cData
   Select Produto
   DbSetOrder(1)
   DbGotop()
   dbseek( Cdata )
   if Found()
      INetSend( pSocket, Produto->PrCodi+'|'+Produto->PrDesc+'|'+Str(PrCons) )
      @ 10,02 say 'Retorno.: '+Produto->PrCodi+'|'+Produto->PrDesc+'|'+Str(PrCons)
   Else
      DbSetOrder(2)
      DbGotop()
      dbseek( Cdata )
      if Found()
         @ 10,02 say 'Retorno.: '+Produto->PrCodi+'|'+Produto->PrDesc+'|'+Str(PrCons)
         Return(Produto->PrCodi+'|'+Produto->PrDesc+'|'+Str(PrCons))
      else
         @ 10,02 say 'Retorno.: Produto não encontrado...'
         Return('PRODUTO NÃO ENCONTRATO')
      Endif
   Endif
return(.t.)

Func CreateRel(cData)
Local XParam := 0
Private Lin := 0
Private Param, Letra1, letra2 := Space(1)
Private VRel
  @ 08,02 say "Gerando Relatorio.: "+left(cData,at("|",cData)-1)
  Param := Right(cData,len(cData)-at('|',cData)-1) 
  XParam := 0
  do while at('|',cData)>0
     XParam ++
     if Xparam = 1
        Letra1 := left(cData, at('|',cData)-1 ) 
     Else
        Letra2 := left(cData, at('|',cData)-1 ) 
     Endif
     cData := right(cData, len(cData)-at('|',cData)) 
  enddo
  @ 10,02 Say 'Parametros.: Letras '+chr(34)+letra1+chr(34)+' até '+Chr(34)+letra2+chr(34)
  Select Produto
  DbSetOrder(3)
  DbGotop()
  dbseek( Letra1 )
  Lin := 64
  VRel := ''
  do whil !eof() .and. left(Produto->PrDesc,1)<=Letra2
     if Lin > 60
        Lin := 6
        cabecalho()
     endif
     VRel := VRel+Transform(Produto->PrCodi,'999999')+' '+trim(Produto->PrDesc)+Spac(41-len(trim(Produto->PrDesc)))+transform(Produto->PrCons,"@E 999,999.99")+INetCRLF()
     Lin ++
     dbskip()
     if Lin > 60 .or. eof() .or. left(Produto->PrDesc,1)>Letra2
        for Vlin := Lin to 60
          VRel := Vrel + '' + INetCRLF()
        next
        VRel := VRel + Replicate('-',80)+INetCRLF()
        VRel := VRel + '      DataRey Informática'+INetCRLF()
        Lin := 64
     endif
  enddo
  @ 10,02 say 'Retorno.: retornado o relatorio'
  _arq := fcreate( 'RelProd.Txt' )
  fwrite( _arq, VRel )
  fclose( _arq )
Return(VRel)

Function Cabecalho
   VRel := VRel + 'Relatorio de Produto'+INetCRLF()
   VRel := VRel + '           de '+chr(34)+letra1+chr(34)+' até '+Chr(34)+letra2+chr(34)+INetCRLF()
   VRel := VRel + replicate('-',80)+INetCRLF()
   VRel := VRel + 'Código Descricao                                 Pr.Venda'+INetCRLF()
   Lin  := 6
return(.t.)