Jump to content
Fivewin Brasil

Helio_hbinfo

Membros
  • Posts

    261
  • Joined

  • Last visited

Everything posted by Helio_hbinfo

  1. Pessoal bom dia. Muito obrigado a todos. Aparentemente esta OK agora. So mais uma duvida. Desde que montaram este novo FORUM os meus caracteres de acentuacao estao desconfigurados. Alguem pode me indicar a fonte para resolver isso? Mais uma vez grato a todos.
  2. Boa noite Eu usei esta rotina para capturar dados da balanca TOLEDO, espero que ajude //-----------------------------------------------// // Modulo : TOLEDO.PRG // // Comentário : Acesso a balanca toledo // // Data : 24/08/2004 - Sandro // // Atualização : // // Comentário : os Parametros Peso e // // Tara devem ser fornecidos por referencia // // Exemplo : // // Peso := 0 // // Tara := 0 // // Erro := Toledo("9091","COM1",@Peso, @tara) // // Msginfo( "Peso: "+str(Peso) ) // //-----------------------------------------------// //#include "fivewin.ch" //------------------------------------------ FUNCTION Toledo( Modelo, Porta, Peso, Tara ) //------------------------------------------ STATIC TamPacote := 100 LOCAL Com, baudRate, databits, parity, stopbit, TamBuff, Bytes, buffer, x, erro LOCAL l_Erro := .F., time_out:=0 LOCAL c_Peso, c_Tara, c_liq, l_tara, l_check, c_check LOCAL swa, swa_bit0, swa_bit1, swa_bit2, swa_bit3, swa_bit4, swa_bit5, swa_bit6, swa_bit7 LOCAL swb, swb_bit0, swb_bit1, swb_bit2, swb_bit3, swb_bit4, swb_bit5, swb_bit6, swb_bit7 //----- Se Nao especificar modelo, encerra comunicação IF ValType( Modelo ) <> "C" //IF isWorking() // UnInt_Port() // ENDIF Peso := NIL RETURN( 0 ) ENDIF IF ! Upper( Modelo ) $ '9091,9094,8132,8510,8530,ID1,2090' Peso := NIL RETURN( - 1 ) ENDIF IF ! Upper( Porta ) $ 'COM1,COM2,COM3,COM4' Peso := NIL RETURN( - 2 ) ENDIF Com := Porta //"COM1" baudRate := 4800 databits := 7 parity := 2 stopbit := 2 TamBuff := 8000 DADOS :="" // NHANDLE:=Init_Port( Porta, baudRate , databits , parity , stopbit , TamBuff ) IF EMPTY(NHANDLE) Peso := NIL UnInt_Port(nhandle) RETURN( - 16 ) ? 'ERRO DE LEITURA NA BALANÇA' ENDIF // OutBufClr(NHANDLE) // Limpa o Buffer de Saida l_Erro := .T. time_out := 0 DO WHILE l_ErrO=.T. Buffer := "" DO WHILE time_out < 100000 //IF(NETNAME()='DAF',60000,40000) // Bytes := InbufSize(NHANDLE) IF Bytes >= TamPacote // Buffer := InChr( NHANDLE, Bytes, @DADOS) IF Len( DADOS) - Len( StrTran( DADOS, Chr( 13 ), "" ) ) >= 2 EXIT ENDIF ENDIF time_out:= time_out+1 ENDDO IF time_out >= 100000 //IF(NETNAME()='DAF',60000,40000) IF TamPacote = 100 Peso := NIL UnInt_Port(nhandle) RETURN( - 30 ) ELSE TamPacote := 100 LOOP ENDIF ENDIF l_Erro := .F. DADOS := SubStr( DADOS, At( Chr( 13 ), DADOS) + 1 ) TamBuff := At( Chr( 13 ), DADOS) IF Upper( Modelo ) $ '9091,8132,8510,2090' DO WHILE .T. IF SubStr( DADOS, 1, 1 ) <> Chr( 2 ) .and. SubStr( DADOS, 2, 1 ) <> Chr( 2 ) Peso := NIL UnInt_Port(nhandle) RETURN( - 34 ) ENDIF IF SubStr( DADOS, 2, 1 ) = Chr( 2 ) DADOS:= SubStr( DADOS, 2 ) l_check := .T. ELSE l_check := .F. ENDIF Bytes := At( Chr( 13 ), DADOS) IF Bytes = 0 Peso := NIL UnInt_Port(nhandle) RETURN( - 34 ) ENDIF IF l_check c_check := SubStr( DADOS, Bytes + 1, 1 ) IF c_check <> checksum( SubStr( DADOS, 1, Bytes ) ) Peso := NIL UnInt_Port(nhandle) RETURN( - 35 ) ENDIF ENDIF DADOS := SubStr( DADOS, 1, Bytes - 1 ) swa := AscBin( Asc( SubStr( DADOS, 2, 1 ) ) ) swb := AscBin( Asc( SubStr( DADOS, 3, 1 ) ) ) swa_bit7 := SubStr( swa, 1, 1 ) swa_bit6 := SubStr( swa, 2, 1 ) swa_bit5 := SubStr( swa, 3, 1 ) swa_bit4 := SubStr( swa, 4, 1 ) swa_bit3 := SubStr( swa, 5, 1 ) swa_bit2 := SubStr( swa, 6, 1 ) swa_bit1 := SubStr( swa, 7, 1 ) swa_bit0 := SubStr( swa, 8, 1 ) swb_bit7 := SubStr( swb, 1, 1 ) swb_bit6 := SubStr( swb, 2, 1 ) swb_bit5 := SubStr( swb, 3, 1 ) swb_bit4 := SubStr( swb, 4, 1 ) swb_bit3 := SubStr( swb, 5, 1 ) swb_bit2 := SubStr( swb, 6, 1 ) swb_bit1 := SubStr( swb, 7, 1 ) swb_bit0 := SubStr( swb, 8, 1 ) IF Upper( Modelo ) = '2090' IF swa_bit6 <> '0' .or. swa_bit5 <> '1' Peso := NIL UnInt_Port(nhandle) RETURN( - 34 ) ENDIF ELSE IF swa_bit6 <> '0' .or. swa_bit5 <> '1' .or. swb_bit4 <> '1' .or. swb_bit5 <> '1' Peso := NIL UnInt_Port(nhandle) RETURN( - 34 ) ENDIF ENDIF IF swb_bit2 = '1' Peso := NIL UnInt_Port(nhandle) RETURN( - 32 ) ENDIF c_Peso := SubStr( DADOS, 5, 6 ) IF swb_bit0 = '1' c_Tara := SubStr( DADOS, 11, 6 ) IF Empty( c_Tara ) c_Tara := '000000' ENDIF l_tara := .T. ELSE c_Tara := '000000' l_tara := .F. ENDIF IF swa_bit2 = '0' .and. swa_bit1 = '0' .and. swa_bit0 = '1' c_Peso := SubStr( c_Peso, 1, 6 ) c_Tara := SubStr( c_Tara, 1, 6 ) ELSEIF swa_bit2 = '0' .and. swa_bit1 = '1' .and. swa_bit0 = '0' c_Peso := SubStr( c_Peso, 1, 6 ) c_Tara := SubStr( c_Tara, 1, 6 ) ELSEIF swa_bit2 = '0' .and. swa_bit1 = '1' .and. swa_bit0 = '1' c_Peso := SubStr( c_Peso, 1, 5 ) + '.' + SubStr( c_Peso, 6, 1 ) c_Tara := SubStr( c_Tara, 1, 5 ) + '.' + SubStr( c_Tara, 6, 1 ) ELSEIF swa_bit2 = '1' .and. swa_bit1 = '0' .and. swa_bit0 = '0' c_Peso := SubStr( c_Peso, 1, 4 ) + '.' + SubStr( c_Peso, 5, 2 ) c_Tara := SubStr( c_Tara, 1, 4 ) + '.' + SubStr( c_Tara, 5, 2 ) ELSEIF swa_bit2 = '1' .and. swa_bit1 = '0' .and. swa_bit0 = '1' c_Peso := SubStr( c_Peso, 1, 3 ) + '.' + SubStr( c_Peso, 4, 3 ) c_Tara := SubStr( c_Tara, 1, 3 ) + '.' + SubStr( c_Tara, 4, 3 ) ELSEIF swa_bit2 = '1' .and. swa_bit1 = '1' .and. swa_bit0 = '0' c_Peso := SubStr( c_Peso, 1, 2 ) + '.' + SubStr( c_Peso, 3, 4 ) c_Tara := SubStr( c_Tara, 1, 2 ) + '.' + SubStr( c_Tara, 3, 4 ) ELSE l_Erro := .T. EXIT ENDIF IF swb_bit1 = '1' c_Peso := '-' + AllTrim( c_Peso ) ENDIF IF swb_bit0 = '1' c_liq := c_Peso c_Peso := "" ELSE c_liq := "" ENDIF EXIT ENDDO IF ! l_Erro c_Peso := AllTrim( c_Peso ) c_liq := AllTrim( c_liq ) c_Tara := AllTrim( c_Tara ) IF ! Empty( c_Peso ) FOR x = 1 TO Len( c_Peso ) IF ! SubStr( c_Peso, x, 1 ) $ '0123456789.-' l_Erro := .T. Erro := - 31 EXIT ENDIF NEXT ELSE IF ! Empty( c_liq ) FOR x = 1 TO Len( c_liq ) IF ! SubStr( c_liq, x, 1 ) $ '0123456789.-' l_Erro := .T. Erro := - 31 EXIT ENDIF NEXT ELSE l_Erro := .T. ENDIF ENDIF IF l_tara .and. ! l_Erro FOR x = 1 TO Len( c_Tara ) IF ! SubStr( c_Tara, x, 1 ) $ '0123456789.-' l_Erro := .T. Erro := - 31 EXIT ENDIF NEXT ENDIF IF ! Empty( c_liq ) .and. Empty( c_Peso ) .and. ! l_Erro IF ! Empty( c_Tara ) c_Peso := AllTrim( Str( Val( c_liq ) + Val( c_Tara ) ) ) ELSE c_Peso := c_liq ENDIF ENDIF ENDIF ELSEIF Upper( Modelo ) $ '9096,8530' DO WHILE .T. IF SubStr( DADOS, 1, 1 ) <> Chr( 2 ) .and. SubStr( DADOS, 2, 1 ) <> Chr( 2 ) Peso := NIL UnInt_Port(nhandle) RETURN( - 34 ) ENDIF IF SubStr( DADOS, 2, 1 ) = Chr( 2 ) DADOS:= SubStr( DADOS, 2 ) l_check := .T. ELSE l_check := .F. ENDIF Bytes := At( Chr( 13 ), DADOS) IF Bytes = 0 Peso := NIL UnInt_Port(nhandle) RETURN( - 34 ) ENDIF IF l_check c_check := SubStr( DADOS, Bytes + 1, 1 ) IF c_check <> checksum( SubStr( DADOS, 1, Bytes ) ) Peso := NIL UnInt_Port(nhandle) RETURN( - 35 ) ENDIF ENDIF DADOS := SubStr( DADOS, 1, Bytes - 1 ) swa := AscBin( Asc( SubStr( DADOS, 2, 1 ) ) ) swb := AscBin( Asc( SubStr( DADOS, 3, 1 ) ) ) swa_bit7 := SubStr( swa, 1, 1 ) swa_bit6 := SubStr( swa, 2, 1 ) swa_bit5 := SubStr( swa, 3, 1 ) swa_bit4 := SubStr( swa, 4, 1 ) swa_bit3 := SubStr( swa, 5, 1 ) swa_bit2 := SubStr( swa, 6, 1 ) swa_bit1 := SubStr( swa, 7, 1 ) swa_bit0 := SubStr( swa, 8, 1 ) swb_bit7 := SubStr( swb, 1, 1 ) swb_bit6 := SubStr( swb, 2, 1 ) swb_bit5 := SubStr( swb, 3, 1 ) swb_bit4 := SubStr( swb, 4, 1 ) swb_bit3 := SubStr( swb, 5, 1 ) swb_bit2 := SubStr( swb, 6, 1 ) swb_bit1 := SubStr( swb, 7, 1 ) swb_bit0 := SubStr( swb, 8, 1 ) IF swa_bit6 <> '1' .or. swa_bit5 <> '1' .or. swb_bit5 <> '1' UnInt_Port(nhandle) RETURN(-33) ENDIF IF swb_bit2 = '1' UnInt_Port(nhandle) RETURN(-32) ENDIF c_Peso := SubStr( DADOS, 6, 5 ) IF swb_bit0 = '1' c_Tara := SubStr( DADOS, 11, 5 ) IF Empty( c_Tara ) c_Tara := '00000' ENDIF l_tara := .T. ELSE c_Tara := '00000' l_tara := .F. ENDIF IF swa_bit2 = '0' .and. swa_bit1 = '0' .and. swa_bit0 = '0' c_Peso := c_Peso + "0" c_Tara := c_Tara + "0" ELSEIF swa_bit2 = '0' .and. swa_bit1 = '0' .and. swa_bit0 = '1' c_Peso := SubStr( c_Peso, 1, 5 ) c_Tara := SubStr( c_Tara, 1, 5 ) ELSEIF swa_bit2 = '0' .and. swa_bit1 = '1' .and. swa_bit0 = '0' c_Peso := SubStr( c_Peso, 1, 4 ) + '.' + SubStr( c_Peso, 5, 1 ) c_Tara := SubStr( c_Tara, 1, 4 ) + '.' + SubStr( c_Tara, 5, 1 ) ELSEIF swa_bit2 = '0' .and. swa_bit1 = '1' .and. swa_bit0 = '1' c_Peso := SubStr( c_Peso, 1, 3 ) + '.' + SubStr( c_Peso, 4, 2 ) c_Tara := SubStr( c_Tara, 1, 3 ) + '.' + SubStr( c_Tara, 4, 2 ) ELSEIF swa_bit2 = '1' .and. swa_bit1 = '0' .and. swa_bit0 = '0' c_Peso := SubStr( c_Peso, 1, 2 ) + '.' + SubStr( c_Peso, 3, 3 ) c_Tara := SubStr( c_Tara, 1, 2 ) + '.' + SubStr( c_Tara, 3, 3 ) ELSE l_Erro := .T. EXIT ENDIF IF swb_bit1 = '1' c_Peso := '-' + AllTrim( c_Peso ) ENDIF IF swb_bit0 = '1' c_liq := c_Peso c_Peso := "" ELSE c_liq := "" ENDIF EXIT ENDDO IF ! l_Erro c_Peso := AllTrim( c_Peso ) c_liq := AllTrim( c_liq ) c_Tara := AllTrim( c_Tara ) IF ! Empty( c_Peso ) FOR x = 1 TO Len( c_Peso ) IF ! SubStr( c_Peso, x, 1 ) $ '0123456789.-' l_Erro := .T. Erro := - 31 EXIT ENDIF NEXT ELSE IF ! Empty( c_liq ) FOR x = 1 TO Len( c_liq ) IF ! SubStr( c_liq, x, 1 ) $ '0123456789.-' l_Erro := .T. Erro := - 31 EXIT ENDIF NEXT ELSE l_Erro := .T. ENDIF ENDIF IF l_tara .and. ! l_Erro FOR x = 1 TO Len( c_Tara ) IF ! SubStr( c_Tara, x, 1 ) $ '0123456789.-' l_Erro := .T. Erro := - 31 EXIT ENDIF NEXT ENDIF IF ! Empty( c_liq ) .and. Empty( c_Peso ) .and. ! l_Erro IF ! Empty( c_Tara ) c_Peso := AllTrim( Str( Val( c_liq ) + Val( c_Tara ) ) ) ELSE c_Peso := c_liq ENDIF ENDIF ENDIF ELSE Peso := NIL UnInt_Port(nhandle) RETURN( - 1 ) ENDIF ENDDO Peso := Val( c_Peso ) Tara := Val( c_Tara ) UnInt_Port(nhandle) msgalert(peso,tara) TamPacote := TamBuff * 2 RETURN ( 0 ) //---------------------------- FUNCTION Toledo_erro( Erro ) //---------------------------- LOCAL mens := "" IF Erro = - 1 mens := 'Erro de parametros (Toledo)' ELSEIF Erro = - 2 mens := 'Canal de comunicacao invalido (Toledo)' ELSEIF Erro = - 3 mens := 'Numero de interrupcao invalido (Toledo)' ELSEIF Erro = - 4 mens := 'Numero de Bits invalido (Toledo)' ELSEIF Erro = - 5 mens := 'Taxa de comunicacao invalida (Toledo)' ELSEIF Erro = - 6 mens := 'Numero de stop Bits invalido (Toledo)' ELSEIF Erro = - 7 mens := 'Paridade invalida (Toledo)' ELSEIF Erro = - 8 mens := 'Tamanho de buffer invalido (Toledo)' ELSEIF Erro = - 9 mens := 'Tipo de controle de fluxo invalido (Toledo)' ELSEIF Erro = - 10 mens := 'Canal de comunicacao ja está aberto (Toledo)' ELSEIF Erro = - 11 mens := 'Canal de comunicacao nao esta aberto (Toledo)' ELSEIF Erro = - 12 mens := 'Memoria insuficiente para a operacao (Toledo)' ELSEIF Erro = - 13 mens := 'Buffer de Transmissao cheio (Toledo)' ELSEIF Erro = - 14 mens := 'Buffer de recepcao vazio (Toledo)' ELSEIF Erro = - 15 mens := 'Estado de sinal invalido (Toledo)' ELSEIF Erro = - 16 mens := 'Porta invalida ou erro de hardware (Toledo)' ELSEIF Erro = - 17 mens := 'Codigo de configuracao invalido (Toledo)' ELSEIF Erro = - 18 mens := 'Erro de recepcao (Toledo)' ELSEIF Erro = - 19 mens := 'Erro no Fechamento do canal (Toledo)' ELSEIF Erro = - 20 mens := 'Erro na transmissao (Toledo)' ELSEIF Erro = - 30 mens := 'Erro de Time-out Balanca (Toledo)' ELSEIF Erro = - 31 mens := 'Erro de Comunicacao na Balanca. Dados nao numericos (Toledo)' ELSEIF Erro = - 32 mens := 'Balanca excedeu a faixa de peso suportada. (Toledo)' ELSEIF Erro = - 33 mens := 'Erro de Comunicacao na Balanca (Toledo)' ELSEIF Erro = - 34 mens := 'Protocolo de balança inválido (Toledo)' ELSEIF Erro = - 35 mens := 'Erro de consistência de CheckSum (Toledo)' ELSE mens := 'Erro desconhecido (Toledo)' ENDIF mens := '(' + AllTrim( Str( Erro ) ) + ')' + ' -> ' + mens RETURN( mens ) //---------------------------------- STATIC FUNCTION Checksum( Pacote ) //---------------------------------- LOCAL f_tam := 0, f_asc := 0, f_bin := "", f_co2 := "" , f_pos f_tam := Len( Pacote ) FOR f_pos = 1 TO f_tam f_asc := f_asc + Asc( SubStr( Pacote, f_pos, 1 ) ) NEXT f_bin := AscBin( f_asc ) f_co2 := f_bin f_co2 := StrTran( f_co2, '1', '2' ) f_co2 := StrTran( f_co2, '0', '1' ) f_co2 := StrTran( f_co2, '2', '0' ) f_co2 := AscBin( BinAsc( f_co2 ) + 1 ) f_co2 := '0' + SubStr( f_co2, ( Len( f_co2 ) - 7 ) + 1, 7 ) RETURN( Chr( BinAsc( f_co2 ) ) ) //------------------------------- STATIC FUNCTION ascbin( f_asc ) //------------------------------- priv f_bin, f_tam IF ValType( f_asc ) # "N" msgstop( "erro de parametros. Funcção AscBin" ) quit ENDIF IF f_asc < 0 msgstop( "erro de parametros. Funcção AscBin" ) quit ENDIF f_bin = "" DO WHILE f_asc >= 2 f_bin = Str( ( f_asc % 2 ), 1 ) + f_bin f_asc = Int( f_asc / 2 ) ENDDO f_bin = Str( f_asc, 1 ) + f_bin IF ( Len( f_bin ) % 8 ) <> 0 f_tam := ( Int( Len( f_bin ) / 8 ) + 1 ) * 8 f_bin = repl( "0", f_tam - Len( f_bin ) ) + f_bin ENDIF RETURN( ( f_bin ) ) //------------------------------- STATIC FUNCTION binasc( f_bin ) //------------------------------- PRIVATE f_asc, f_tam, f_pot, p IF ValType( f_bin ) # "C" msgstop( "erro de parametros. Função BinAsc" ) quit ENDIF f_asc := 0 f_pot := 0 FOR p = Len( f_bin ) TO 1 STEP - 1 IF subst( f_bin, p, 1 ) = "1" f_asc := f_asc + ( 2 ** f_pot ) ELSEIF subst( f_bin, p, 1 ) <> "0" msgstop( "erro de parametros. Função BinAsc" ) quit ENDIF f_pot := f_pot + 1 NEXT RETURN f_asc //--------------------------- Final da rotina -----------------------------------
  3. Muito obrigado pela atencao, mas continua do mesmo jeito. fiz o exeplo que vc me indicou e outro prueba.prg, mas acontece o erro (LME288) Warning error detected (LME288) ERROR : Unable to perform link * Linking errors * Pesquisei na internet e fiz o procedimento para : Lo primero que hice fue limpiar temps y registro con la Herramienta de BitdefenderLuego ejecutar bcdedit / set IncreaseUserVa 3072reinicie... recompilé y... nada!, errorEntonces utilicé CCleanerLuego ejecutar bcdedit / set IncreaseUserVa 3072reinicie... recompilé y... nada!, Horror!!Entonces ejecuté un buscador de Malware, bajado desde InfoSpyware, JRT (Junkware Removal Tool)Luego ejecutar bcdedit / set IncreaseUserVa 3072Y... voilá!!! recompilo!! e nao deu certo Sera que pode me ajudar?
  4. eu coloquei todas que acompanham o arquivo zip da fivewin (gilmer) enviou Grato
  5. Bom tarde a todos, a um mes eu fiz a aquisicao de um upgrade da versao 12.03 para a versao 17.04 fiz as instalacoes, mas quando vou compilar os meus programas ocorre este erro. Ja fiz um monte de pesquisar e alteracoes mas nao tive exito. Sera que alguem pode me ajudar? Eu ainda nao consegui utilizar a versao adquirida. Esta ocorrendo este erro e ja fiz varia tentativas e sem sucesso. Helio Tsuyama tentando usar 17.04 - xDEV 0.7 - workshop 4.5
  6. Bom dia João Podem contar comigo. Infelizmente nos últimos 3 anos tive problemas de doença na família. Qualquer dia de Novembro. Acredito que este ano da. Abraços Helio Tsuyama Santo André - SP
  7. 1 - João Santos - Email: joao@pleno.com.br 2 - Luiz Fernando - Email: empresoft@globo.com 3 - Alexandre Serafini - alexandre@polirep.com.br 4 - Nárlem - narlem@nagas.com.br 5 - Gilmer - gilmer@fivewin.com.br 6 - Alexandre Pereira - alexandre@declatecnologia.com.br 7 - Evandro G. de Paula - imortal@skillnet.com.br 8 - Vailton Renato - contato@vailton.com.br 9 - Rubens Martins - rumarti@gmail.com 10 - Cleber Conde - cleber@krcsistemas.com.br 11 - Decker - Carlos E. Decker 12 - Vagner Wirts - vwirts@ig.com.br 13 - Antenor Trufelli Filho - trufelli@uol.com.br 14 - José Carlos R Leoner - Guaruhos - SP - josecarlos@vimatec.com.br 15 - Luis Antonio da Paixao - Sao Sebastiao do Paraiso - Minas Gerais - luispaixao13@hotmail.com 16 - Valdir - Jundiaí - valdir@fivesolution.com.br 17 - Luiz Antonio de Oliveira - Santa fe do Sul - SP luizantoniooliveira@hotmail.com - LUIZ53 18 - Giovanny Vecchi - Santa Fé do Sul - SP - 19 - Claudio de Oliveira - claliveira@ig.com.br 20 - Ailton - Syspel 21 - José Maria da Silva - saa50@bol.com.br 22 - Helio Tsuyama - hbinfo.br@gmail.com Estaremos la este ano
  8. 1 - João Santos - Email: joao@pleno.com.br 2 - Luiz Fernando - Email: empresoft@globo.com 3 - Alexandre Serafini - alexandre@polirep.com.br 4 - Nárlem - narlem@nagas.com.br 5 - Gilmer - gilmer@fivewin.com.br 6 - Alexandre Pereira - alexandre@declatecnologia.com.br 7 - Evandro G. de Paula - imortal@skillnet.com.br 8 - Vailton Renato - contato@vailton.com.br 9 - Rubens Martins - rumarti@gmail.com 10 - Cleber Conde - cleber@krcsistemas.com.br 11 - Decker - Carlos E. Decker 12 - Vagner Wirts - vwirts@ig.com.br 13 - Antenor Trufelli Filho - trufelli@uol.com.br 14 - José Carlos R Leoner - Guaruhos - SP - josecarlos@vimatec.com.br 15 - Luis Antonio da Paixao - Sao Sebastiao do Paraiso - Minas Gerais - luispaixao13@hotmail.com 16 - Valdir - Jundiaí - valdir@fivesolution.com.br 17 - Luiz Antonio de Oliveira - Santa fe do Sul - SP luizantoniooliveira@hotmail.com - LUIZ53 18 - Giovanny Vecchi - Santa Fé do Sul - SP - 19 - Claudio de Oliveira - claliveira@ig.com.br 20 - Ailton - Syspel 21 - José Maria da Silva - saa50@bol.com.br 22 - Helio Tsuyama - hbinfo.br@gmail.com Vamos este ano
  9. Guilmer, ficou muito legal. Passei um email para a cheila, eu fiz a atualizacao para a versao 12.01 em 27/02/2012 e nao recebi o numero de serie, coloque o da versao anterior para poder me cadastrar. Sao detalhes que acertaremos. Abracos Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.com
  10. Erro de logica, o Rikko estava certo. cpdf_file := wFilePdf + STRZERO(cessao->documento,6,0) + ".PDF" DO WHILE .NOT.EOF() wtotal := 0.00 wdocumento := cessao->documento wdata := DTOC(data) wrazao := razao wtotal := wtotal +( qdade10*valor10 ) Relat43() cpdf_file := wFilePdf + STRZERO(cessao->documento,6,0) + ".PDF" SKIP ENDDO Relat43() CLOSE Cessao Muito Obrigado a todos. O Bullzip eh muito facil de usar. Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.com
  11. Bom dia Rikko O conteudo do wdocumento esta correto, tanto que ele gera o relatorio com o numero correto, mas ele coloca o nome do arquivo com o documento seguinte. Eh como ele gerasse o nome do arquivo somente depois de ler o registro seguinte. Em que momento eh gerado o arquivo? Grato pela atencao Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.com
  12. Boa Tarde a todos Estou tentando usar o BULLZIP, e esta ocorrendo o seguinte erro. Tenho que imprimir um DBF com numero pedido, cliente e itens. O programa gera conteudo do relatorio correto, porem o nome do arquivo PDF eh gerado com o numero do segundo pedido. O nome do arquivo PDF eh deslocado de 1 registro. Alguem pode me ajudar? Grato Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.com ///////////////////////////////////// FUNCTION Relat43() && Imprime Recibo LOCAL oPrn, oFont, oFont1, oFont2, oFont3, oFont8, oFont9, oFont10, oFont11, oFont12 LOCAL oPrinter, oReport LOCAL oBrush, oPen1, oPen2 LOCAL nlines, wlinha, i, cline LOCAL wln, winc LOCAL wFileWmf := "cessao.WMF" //"STD_INJ.EMF" cPDF := "C:\TEMP\TESTEBULZIP.PDF" nArea := Select() cpdf_File := "C:\TEMP\TESTEBULZIP.PDF" cpdf_file := wFilePdf + STRZERO(wdocumento,6,0) + ".PDF" // initialize Bullzip PDF settings ************************************************************ oPdf := TOleAuto():New( "Bullzip.PDFPrinterSettings" ) oPdf:SetValue("Output",cpdf_File) oPdf:SetValue("ConfirmOverwrite", "no") oPdf:SetValue("ShowSaveAS", "never") oPdf:SetValue("ShowSettings", "never") oPdf:SetValue("ShowPDF", "no") oPdf:SetValue("RememberLastFileName", "no") oPdf:SetValue("RememberLastFolderName", "no") oPdf:WriteSettings := .T. PRINTER oPrn NAME "Gerandopdf" ; to "Bullzip PDF Printer" //modal DEFINE FONT oFont8 NAME "Arial" SIZE 0, -8 OF oPrn DEFINE FONT oFont NAME "Arial" BOLD SIZE 0, -8 OF oPrn DEFINE FONT oFont1 NAME "Arial" BOLD ITALIC SIZE 0,-20 OF oPrn DEFINE FONT oFont2 NAME "Arial" BOLD ITALIC UNDERLINE SIZE 0, -8 OF oPrn DEFINE FONT oFont3 NAME "Arial" BOLD SIZE 0,-11 OF oPrn oPrn:StartPage() oPrn:ImportWMF( wFileWmf ) wln := 3.3 winc := .404 oPrn:CmSay( wln, 19.0, TRANSFORM(wdocumento, "@E 999,999"), oFont3,,,2,1) oPrn:CmSay( wln+(winc* 0.0), 12.0, wdata, oFont3) wln := 4.23 oPrn:CmSay( wln+(winc* 1.0), 3.5, wrazao, oFont3) wln := 7.50 IF !EMPTY(wfilme1) oPrn:CmSay( wln+(winc* 1.0), 1.0, wfilme1, oFont3) oPrn:CmSay( wln+(winc* 1.0), 13.5, TRANSFORM(wqdade1, "@E 999,999"), oFont3,,,2,1) oPrn:CmSay( wln+(winc* 1.0), 16.5, TRANSFORM(wvalor1, "@E 999,999.99"), oFont3,,,2,1) oPrn:CmSay( wln+(winc* 1.0), 20.0, TRANSFORM((wqdade1*wvalor1), "@E 999,999.99"), oFont3,,,2,1) ENDIF oPrn:CmSay( 23.40, 20.0, TRANSFORM(wTotal, "@E 999,999.99"), oFont3,,,2,1) oPrn:EndPage() SysWait(.5) oFont8:end() oFont:end() oFont1:end() oFont2:end() oFont3:end() ENDPRINTER oPdf := NIL RELEASE oPdf RETURN(NIL) Editado por - hinfo on 23/07/2012 18:49:42 Editado por - hinfo on 24/07/2012 09:42:56
  13. Boa Tarde a todos Estou tentando usar o BULLZIP, e esta ocorrendo o seguinte erro. Tenho que imprimir um DBF com numero pedido, cliente e itens. O programa gera conteudo do relatorio correto, porem o nome do arquivo PDF eh gerado com o numero do segundo pedido. O nome do arquivo PDF eh deslocado de 1 registro. Alguem pode me ajudar? Grato Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.com ///////////////////////////////////// FUNCTION Relat43() && Imprime Recibo LOCAL oPrn, oFont, oFont1, oFont2, oFont3, oFont8, oFont9, oFont10, oFont11, oFont12 LOCAL oPrinter, oReport LOCAL oBrush, oPen1, oPen2 LOCAL nlines, wlinha, i, cline LOCAL wln, winc LOCAL wFileWmf := "cessao.WMF" //"STD_INJ.EMF" cPDF := "C:\TEMP\TESTEBULZIP.PDF" nArea := Select() cpdf_File := "C:\TEMP\TESTEBULZIP.PDF" cpdf_file := wFilePdf + STRZERO(wdocumento,6,0) + ".PDF" // initialize Bullzip PDF settings ************************************************************ oPdf := TOleAuto():New( "Bullzip.PDFPrinterSettings" ) oPdf:SetValue("Output",cpdf_File) oPdf:SetValue("ConfirmOverwrite", "no") oPdf:SetValue("ShowSaveAS", "never") oPdf:SetValue("ShowSettings", "never") oPdf:SetValue("ShowPDF", "no") oPdf:SetValue("RememberLastFileName", "no") oPdf:SetValue("RememberLastFolderName", "no") oPdf:WriteSettings := .T. PRINTER oPrn NAME "Gerandopdf" ; to "Bullzip PDF Printer" //modal DEFINE FONT oFont8 NAME "Arial" SIZE 0, -8 OF oPrn DEFINE FONT oFont NAME "Arial" BOLD SIZE 0, -8 OF oPrn DEFINE FONT oFont1 NAME "Arial" BOLD ITALIC SIZE 0,-20 OF oPrn DEFINE FONT oFont2 NAME "Arial" BOLD ITALIC UNDERLINE SIZE 0, -8 OF oPrn DEFINE FONT oFont3 NAME "Arial" BOLD SIZE 0,-11 OF oPrn oPrn:StartPage() oPrn:ImportWMF( wFileWmf ) wln := 3.3 winc := .404 oPrn:CmSay( wln, 19.0, TRANSFORM(wdocumento, "@E 999,999"), oFont3,,,2,1) oPrn:CmSay( wln+(winc* 0.0), 12.0, wdata, oFont3) wln := 4.23 oPrn:CmSay( wln+(winc* 1.0), 3.5, wrazao, oFont3) wln := 7.50 IF !EMPTY(wfilme1) oPrn:CmSay( wln+(winc* 1.0), 1.0, wfilme1, oFont3) oPrn:CmSay( wln+(winc* 1.0), 13.5, TRANSFORM(wqdade1, "@E 999,999"), oFont3,,,2,1) oPrn:CmSay( wln+(winc* 1.0), 16.5, TRANSFORM(wvalor1, "@E 999,999.99"), oFont3,,,2,1) oPrn:CmSay( wln+(winc* 1.0), 20.0, TRANSFORM((wqdade1*wvalor1), "@E 999,999.99"), oFont3,,,2,1) ENDIF oPrn:CmSay( 23.40, 20.0, TRANSFORM(wTotal, "@E 999,999.99"), oFont3,,,2,1) oPrn:EndPage() SysWait(.5) oFont8:end() oFont:end() oFont1:end() oFont2:end() oFont3:end() ENDPRINTER oPdf := NIL RELEASE oPdf RETURN(NIL) Editado por - hinfo on 23/07/2012 18:49:42 Editado por - hinfo on 24/07/2012 09:42:56
  14. Boa noite a todos Eu estou interessado em participar da coop Tenham uma boa semana Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.com
  15. To nessa Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.co
  16. Boa noite pessoal. Eu acho que o pessoal usuarios do fivewin, acabou transformando e viabilizando a profissao de nos programadores. Acredito que a criacao de uma cooperativa pode ser a solucao para encontrarmos saidas para o SPED e outros... Contem comigo. Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.co
  17. Wagner eu encontrei isso, nao sei se ajuda. abracos Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.com //-----------------------------------------------// // Modulo : TOLEDO.PRG // // Comentário : Acesso a balanca toledo // // Data : 24/08/2004 - Sandro // // Atualização : // // Comentário : os Parametros Peso e // // Tara devem ser fornecidos por referencia // // Exemplo : // // Peso := 0 // // Tara := 0 // // Erro := Toledo("9091","COM1",@Peso, @tara) // // Msginfo( "Peso: "+str(Peso) ) // //-----------------------------------------------// #INCLUDE "c:\fwh\include\FiveWin.ch" //------------------------------------------ FUNCTION Toledo( Modelo, Porta, Peso, Tara ) //------------------------------------------ STATIC TamPacote := 100 LOCAL Com, baudRate, databits, parity, stopbit, TamBuff, Bytes LOCAL l_Erro := .F., timeout := 0 LOCAL c_Peso, c_Tara, c_liq, l_tara, l_check, c_check LOCAL swa, swa_bit0, swa_bit1, swa_bit2, swa_bit3, swa_bit4, swa_bit5, swa_bit6, swa_bit7 LOCAL swb, swb_bit0, swb_bit1, swb_bit2, swb_bit3, swb_bit4, swb_bit5, swb_bit6, swb_bit7 //----- Se Nao especificar modelo, encerra comunicação IF ValType( Modelo ) <> "C" IF isWorking() UnInt_Port() ENDIF Peso := NIL RETURN( 0 ) ENDIF //msgalert(modelo,"cheguei") IF ! Upper( Modelo ) $ '9091,9094,8132,8510,8530,ID1,2090' Peso := NIL RETURN( - 1 ) ENDIF IF ! Upper( Porta ) $ 'COM1,COM2,COM3,COM4' Peso := NIL RETURN( - 2 ) ENDIF IF ! isWorking() Com := Porta //"COM1" baudRate := 4800 databits := 7 parity := 2 stopbit := 2 TamBuff := 8000 IF ! Init_Port( Porta, baudRate , databits , parity , stopbit , TamBuff ) Peso := NIL RETURN( - 16 ) ENDIF OutBufClr() // Limpa o Buffer de Saida ENDIF l_Erro := .T. timeout := 0 DO WHILE l_Erro Buffer := "" DO WHILE timeout < 200000 Bytes := InbufSize() IF Bytes >= TamPacote Buffer := InChr( Bytes ) IF Len( Buffer ) - Len( StrTran( Buffer, Chr( 13 ), "" ) ) >= 2 EXIT ENDIF ENDIF timeout := timeout + 1 ENDDO IF timeout >= 200000 IF TamPacote = 100 Peso := NIL RETURN( - 30 ) ELSE TamPacote := 100 LOOP ENDIF ENDIF l_Erro := .F. Buffer := SubStr( Buffer, At( Chr( 13 ), Buffer ) + 1 ) TamBuff := At( Chr( 13 ), Buffer ) IF Upper( Modelo ) $ '9091,8132,8510,2090' DO WHILE .T. IF SubStr( Buffer, 1, 1 ) <> Chr( 2 ) .and. SubStr( Buffer, 2, 1 ) <> Chr( 2 ) Peso := NIL RETURN( - 34 ) ENDIF IF SubStr( Buffer, 2, 1 ) = Chr( 2 ) Buffer := SubStr( Buffer, 2 ) l_check := .T. ELSE l_check := .F. ENDIF Bytes := At( Chr( 13 ), Buffer ) IF Bytes = 0 Peso := NIL RETURN( - 34 ) ENDIF IF l_check c_check := SubStr( Buffer, Bytes + 1, 1 ) IF c_check <> checksum( SubStr( Buffer, 1, Bytes ) ) Peso := NIL RETURN( - 35 ) ENDIF ENDIF Buffer := SubStr( Buffer, 1, Bytes - 1 ) swa := AscBin( Asc( SubStr( Buffer, 2, 1 ) ) ) swb := AscBin( Asc( SubStr( buffer, 3, 1 ) ) ) swa_bit7 := SubStr( swa, 1, 1 ) swa_bit6 := SubStr( swa, 2, 1 ) swa_bit5 := SubStr( swa, 3, 1 ) swa_bit4 := SubStr( swa, 4, 1 ) swa_bit3 := SubStr( swa, 5, 1 ) swa_bit2 := SubStr( swa, 6, 1 ) swa_bit1 := SubStr( swa, 7, 1 ) swa_bit0 := SubStr( swa, 8, 1 ) swb_bit7 := SubStr( swb, 1, 1 ) swb_bit6 := SubStr( swb, 2, 1 ) swb_bit5 := SubStr( swb, 3, 1 ) swb_bit4 := SubStr( swb, 4, 1 ) swb_bit3 := SubStr( swb, 5, 1 ) swb_bit2 := SubStr( swb, 6, 1 ) swb_bit1 := SubStr( swb, 7, 1 ) swb_bit0 := SubStr( swb, 8, 1 ) IF Upper( Modelo ) = '2090' IF swa_bit6 <> '0' .or. swa_bit5 <> '1' Peso := NIL RETURN( - 34 ) ENDIF ELSE IF swa_bit6 <> '0' .or. swa_bit5 <> '1' .or. swb_bit4 <> '1' .or. swb_bit5 <> '1' Peso := NIL RETURN( - 34 ) ENDIF ENDIF IF swb_bit2 = '1' Peso := NIL RETURN( - 32 ) ENDIF c_Peso := SubStr( Buffer, 5, 6 ) IF swb_bit0 = '1' c_Tara := SubStr( Buffer, 11, 6 ) IF Empty( c_Tara ) c_Tara := '000000' ENDIF l_tara := .T. ELSE c_Tara := '000000' l_tara := .F. ENDIF IF swa_bit2 = '0' .and. swa_bit1 = '0' .and. swa_bit0 = '1' c_Peso := SubStr( c_Peso, 1, 6 ) c_Tara := SubStr( c_Tara, 1, 6 ) ELSEIF swa_bit2 = '0' .and. swa_bit1 = '1' .and. swa_bit0 = '0' c_Peso := SubStr( c_Peso, 1, 6 ) c_Tara := SubStr( c_Tara, 1, 6 ) ELSEIF swa_bit2 = '0' .and. swa_bit1 = '1' .and. swa_bit0 = '1' c_Peso := SubStr( c_Peso, 1, 5 ) + '.' + SubStr( c_Peso, 6, 1 ) c_Tara := SubStr( c_Tara, 1, 5 ) + '.' + SubStr( c_Tara, 6, 1 ) ELSEIF swa_bit2 = '1' .and. swa_bit1 = '0' .and. swa_bit0 = '0' c_Peso := SubStr( c_Peso, 1, 4 ) + '.' + SubStr( c_Peso, 5, 2 ) c_Tara := SubStr( c_Tara, 1, 4 ) + '.' + SubStr( c_Tara, 5, 2 ) ELSEIF swa_bit2 = '1' .and. swa_bit1 = '0' .and. swa_bit0 = '1' c_Peso := SubStr( c_Peso, 1, 3 ) + '.' + SubStr( c_Peso, 4, 3 ) c_Tara := SubStr( c_Tara, 1, 3 ) + '.' + SubStr( c_Tara, 4, 3 ) ELSEIF swa_bit2 = '1' .and. swa_bit1 = '1' .and. swa_bit0 = '0' c_Peso := SubStr( c_Peso, 1, 2 ) + '.' + SubStr( c_Peso, 3, 4 ) c_Tara := SubStr( c_Tara, 1, 2 ) + '.' + SubStr( c_Tara, 3, 4 ) ELSE l_Erro := .T. EXIT ENDIF IF swb_bit1 = '1' c_Peso := '-' + AllTrim( c_Peso ) ENDIF IF swb_bit0 = '1' c_liq := c_Peso c_Peso := "" ELSE c_liq := "" ENDIF EXIT ENDDO IF ! l_Erro c_Peso := AllTrim( c_Peso ) c_liq := AllTrim( c_liq ) c_Tara := AllTrim( c_Tara ) IF ! Empty( c_Peso ) FOR x = 1 TO Len( c_Peso ) IF ! SubStr( c_Peso, x, 1 ) $ '0123456789.-' l_Erro := .T. Erro := - 31 EXIT ENDIF NEXT ELSE IF ! Empty( c_liq ) FOR x = 1 TO Len( c_liq ) IF ! SubStr( c_liq, x, 1 ) $ '0123456789.-' l_Erro := .T. Erro := - 31 EXIT ENDIF NEXT ELSE l_Erro := .T. ENDIF ENDIF IF l_tara .and. ! l_Erro FOR x = 1 TO Len( c_Tara ) IF ! SubStr( c_Tara, x, 1 ) $ '0123456789.-' l_Erro := .T. Erro := - 31 EXIT ENDIF NEXT ENDIF IF ! Empty( c_liq ) .and. Empty( c_Peso ) .and. ! l_Erro IF ! Empty( c_Tara ) c_Peso := AllTrim( Str( Val( c_liq ) + Val( c_Tara ) ) ) ELSE c_Peso := c_liq ENDIF ENDIF ENDIF ELSEIF Upper( Modelo ) $ '9096,8530' DO WHILE .T. IF SubStr( Buffer, 1, 1 ) <> Chr( 2 ) .and. SubStr( Buffer, 2, 1 ) <> Chr( 2 ) Peso := NIL RETURN( - 34 ) ENDIF IF SubStr( Buffer, 2, 1 ) = Chr( 2 ) Buffer := SubStr( Buffer, 2 ) l_check := .T. ELSE l_check := .F. ENDIF Bytes := At( Chr( 13 ), Buffer ) IF Bytes = 0 Peso := NIL RETURN( - 34 ) ENDIF IF l_check c_check := SubStr( Buffer, Bytes + 1, 1 ) IF c_check <> checksum( SubStr( Buffer, 1, Bytes ) ) Peso := NIL RETURN( - 35 ) ENDIF ENDIF Buffer := SubStr( Buffer, 1, Bytes - 1 ) swa := AscBin( Asc( SubStr( Buffer, 2, 1 ) ) ) swb := AscBin( Asc( SubStr( buffer, 3, 1 ) ) ) swa_bit7 := SubStr( swa, 1, 1 ) swa_bit6 := SubStr( swa, 2, 1 ) swa_bit5 := SubStr( swa, 3, 1 ) swa_bit4 := SubStr( swa, 4, 1 ) swa_bit3 := SubStr( swa, 5, 1 ) swa_bit2 := SubStr( swa, 6, 1 ) swa_bit1 := SubStr( swa, 7, 1 ) swa_bit0 := SubStr( swa, 8, 1 ) swb_bit7 := SubStr( swb, 1, 1 ) swb_bit6 := SubStr( swb, 2, 1 ) swb_bit5 := SubStr( swb, 3, 1 ) swb_bit4 := SubStr( swb, 4, 1 ) swb_bit3 := SubStr( swb, 5, 1 ) swb_bit2 := SubStr( swb, 6, 1 ) swb_bit1 := SubStr( swb, 7, 1 ) swb_bit0 := SubStr( swb, 8, 1 ) IF swa_bit6 <> '1' .or. swa_bit5 <> '1' .or. swb_bit5 <> '1' RETURN(-33) ENDIF IF swb_bit2 = '1' RETURN(-32) ENDIF c_Peso := SubStr( Buffer, 6, 5 ) IF swb_bit0 = '1' c_Tara := SubStr( Buffer, 11, 5 ) IF Empty( c_Tara ) c_Tara := '00000' ENDIF l_tara := .T. ELSE c_Tara := '00000' l_tara := .F. ENDIF IF swa_bit2 = '0' .and. swa_bit1 = '0' .and. swa_bit0 = '0' c_Peso := c_Peso + "0" c_Tara := c_Tara + "0" ELSEIF swa_bit2 = '0' .and. swa_bit1 = '0' .and. swa_bit0 = '1' c_Peso := SubStr( c_Peso, 1, 5 ) c_Tara := SubStr( c_Tara, 1, 5 ) ELSEIF swa_bit2 = '0' .and. swa_bit1 = '1' .and. swa_bit0 = '0' c_Peso := SubStr( c_Peso, 1, 4 ) + '.' + SubStr( c_Peso, 5, 1 ) c_Tara := SubStr( c_Tara, 1, 4 ) + '.' + SubStr( c_Tara, 5, 1 ) ELSEIF swa_bit2 = '0' .and. swa_bit1 = '1' .and. swa_bit0 = '1' c_Peso := SubStr( c_Peso, 1, 3 ) + '.' + SubStr( c_Peso, 4, 2 ) c_Tara := SubStr( c_Tara, 1, 3 ) + '.' + SubStr( c_Tara, 4, 2 ) ELSEIF swa_bit2 = '1' .and. swa_bit1 = '0' .and. swa_bit0 = '0' c_Peso := SubStr( c_Peso, 1, 2 ) + '.' + SubStr( c_Peso, 3, 3 ) c_Tara := SubStr( c_Tara, 1, 2 ) + '.' + SubStr( c_Tara, 3, 3 ) ELSE l_Erro := .T. EXIT ENDIF IF swb_bit1 = '1' c_Peso := '-' + AllTrim( c_Peso ) ENDIF IF swb_bit0 = '1' c_liq := c_Peso c_Peso := "" ELSE c_liq := "" ENDIF EXIT ENDDO IF ! l_Erro c_Peso := AllTrim( c_Peso ) c_liq := AllTrim( c_liq ) c_Tara := AllTrim( c_Tara ) IF ! Empty( c_Peso ) FOR x = 1 TO Len( c_Peso ) IF ! SubStr( c_Peso, x, 1 ) $ '0123456789.-' l_Erro := .T. Erro := - 31 EXIT ENDIF NEXT ELSE IF ! Empty( c_liq ) FOR x = 1 TO Len( c_liq ) IF ! SubStr( c_liq, x, 1 ) $ '0123456789.-' l_Erro := .T. Erro := - 31 EXIT ENDIF NEXT ELSE l_Erro := .T. ENDIF ENDIF IF l_tara .and. ! l_Erro FOR x = 1 TO Len( c_Tara ) IF ! SubStr( c_Tara, x, 1 ) $ '0123456789.-' l_Erro := .T. Erro := - 31 EXIT ENDIF NEXT ENDIF IF ! Empty( c_liq ) .and. Empty( c_Peso ) .and. ! l_Erro IF ! Empty( c_Tara ) c_Peso := AllTrim( Str( Val( c_liq ) + Val( c_Tara ) ) ) ELSE c_Peso := c_liq ENDIF ENDIF ENDIF ELSE Peso := NIL RETURN( - 1 ) ENDIF ENDDO Peso := Val( c_Peso ) Tara := Val( c_Tara ) //if isWorking() // UnInt_Port() //endif TamPacote := TamBuff * 2 Tamp := TamPacote RETURN ( 0 ) //---------------------------- FUNCTION Toledo_erro( Erro ) //---------------------------- LOCAL mens := "" IF Erro = - 1 mens := 'Erro de parametros (Toledo)' ELSEIF Erro = - 2 mens := 'Canal de comunicacao invalido (Toledo)' ELSEIF Erro = - 3 mens := 'Numero de interrupcao invalido (Toledo)' ELSEIF Erro = - 4 mens := 'Numero de Bits invalido (Toledo)' ELSEIF Erro = - 5 mens := 'Taxa de comunicacao invalida (Toledo)' ELSEIF Erro = - 6 mens := 'Numero de stop Bits invalido (Toledo)' ELSEIF Erro = - 7 mens := 'Paridade invalida (Toledo)' ELSEIF Erro = - 8 mens := 'Tamanho de buffer invalido (Toledo)' ELSEIF Erro = - 9 mens := 'Tipo de controle de fluxo invalido (Toledo)' ELSEIF Erro = - 10 mens := 'Canal de comunicacao ja está aberto (Toledo)' ELSEIF Erro = - 11 mens := 'Canal de comunicacao nao esta aberto (Toledo)' ELSEIF Erro = - 12 mens := 'Memoria insuficiente para a operacao (Toledo)' ELSEIF Erro = - 13 mens := 'Buffer de Transmissao cheio (Toledo)' ELSEIF Erro = - 14 mens := 'Buffer de recepcao vazio (Toledo)' ELSEIF Erro = - 15 mens := 'Estado de sinal invalido (Toledo)' ELSEIF Erro = - 16 mens := 'Porta invalida ou erro de hardware (Toledo)' ELSEIF Erro = - 17 mens := 'Codigo de configuracao invalido (Toledo)' ELSEIF Erro = - 18 mens := 'Erro de recepcao (Toledo)' ELSEIF Erro = - 19 mens := 'Erro no Fechamento do canal (Toledo)' ELSEIF Erro = - 20 mens := 'Erro na transmissao (Toledo)' ELSEIF Erro = - 30 mens := 'Erro de Time-out Balanca (Toledo)' ELSEIF Erro = - 31 mens := 'Erro de Comunicacao na Balanca. Dados nao numericos (Toledo)' ELSEIF Erro = - 32 mens := 'Balanca excedeu a faixa de peso suportada. (Toledo)' ELSEIF Erro = - 33 mens := 'Erro de Comunicacao na Balanca (Toledo)' ELSEIF Erro = - 34 mens := 'Protocolo de balança inválido (Toledo)' ELSEIF Erro = - 35 mens := 'Erro de consistência de CheckSum (Toledo)' ELSE mens := 'Erro desconhecido (Toledo)' ENDIF mens := '(' + AllTrim( Str( Erro ) ) + ')' + ' -> ' + mens RETURN( mens ) //---------------------------------- STATIC FUNCTION Checksum( Pacote ) //---------------------------------- LOCAL f_tam := 0, f_asc := 0, f_bin := "", f_co2 := "" f_tam := Len( Pacote ) FOR f_pos = 1 TO f_tam f_asc := f_asc + Asc( SubStr( Pacote, f_pos, 1 ) ) NEXT f_bin := AscBin( f_asc ) f_co2 := f_bin f_co2 := StrTran( f_co2, '1', '2' ) f_co2 := StrTran( f_co2, '0', '1' ) f_co2 := StrTran( f_co2, '2', '0' ) f_co2 := AscBin( BinAsc( f_co2 ) + 1 ) f_co2 := '0' + SubStr( f_co2, ( Len( f_co2 ) - 7 ) + 1, 7 ) RETURN( Chr( BinAsc( f_co2 ) ) ) //------------------------------- STATIC FUNCTION ascbin( f_asc ) //------------------------------- priv f_bin, f_tam IF ValType( f_asc ) # "N" msgstop( "erro de parametros. Funcção AscBin" ) quit ENDIF IF f_asc < 0 msgstop( "erro de parametros. Funcção AscBin" ) quit ENDIF f_bin = "" DO WHILE f_asc >= 2 f_bin = Str( ( f_asc % 2 ), 1 ) + f_bin f_asc = Int( f_asc / 2 ) ENDDO f_bin = Str( f_asc, 1 ) + f_bin IF ( Len( f_bin ) % 8 ) <> 0 f_tam := ( Int( Len( f_bin ) / 8 ) + 1 ) * 8 f_bin = repl( "0", f_tam - Len( f_bin ) ) + f_bin ENDIF RETURN( ( f_bin ) ) //------------------------------- STATIC FUNCTION binasc( f_bin ) //------------------------------- PRIVATE f_asc, f_tam, f_pot IF ValType( f_bin ) # "C" msgstop( "erro de parametros. Função BinAsc" ) quit ENDIF f_asc := 0 f_pot := 0 FOR p = Len( f_bin ) TO 1 STEP - 1 IF subst( f_bin, p, 1 ) = "1" f_asc := f_asc + ( 2 ** f_pot ) ELSEIF subst( f_bin, p, 1 ) <> "0" msgstop( "erro de parametros. Função BinAsc" ) quit ENDIF f_pot := f_pot + 1 NEXT RETURN f_asc //--------------------------- Final da rotina -----------------------------------
  18. Com a ajuda do Sr.Antonio Linares, deu certo. Eu nao criei a LIB, estou compilando todos os PRG e Funcoes Muito obrigado a tods pela atencao. Nao consegui ainda o xharbour com o xdev (texto)
  19. Boa tarde Eu utilizei as mesmas pastas, porem os arquivos foram colocados e atualizados todos os caminhos Grato Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.com
  20. Pessoal, bom dia No dia 21/02/2012 fiz uma atualizacao no fivewin de 2.5 para 12.01 - xharbour 1.2.1 - xdev0.6 para 0.7 - bcc55 p/ bcc582 Tive alguns problemas para o fivewin mas parace que agora esta ok, o meu problema esta no xharbour com o xdev, tenho um sistema que nao da erro na compilacao mas aparece uma tela preta quando peco para executar o aplicativo. Fiz um teste com poucas linhas e acontece a mesma coisa. estou anexando abaixo. Eu nao sei mais aonde mexer. Poderiam me ajudar? Muito obrigado pela atencao PS. Antes estes programas rodavam bem. Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.com Programa : //-------------------------------------------------- FUNCTION Main() LOCAL cOldColor := SetColor() LOCAL cNewColor := PadR( "W+/N,W+/B", 40 ) CLS ? "Current color :", cOldColor ? SetColor( cNewColor ) @ Row(), Col() SAY "Enter new color:" GET cNewColor READ cNewColor := Trim( cNewColor ) SetColor( cNewColor ) ? "New color is :", cNewColor SetColor( cOldColor ) ? "Back to original" Return nil //////////////////////////////////////////////////// compile="Sim"> compile="Sim"> compile="Sim"> compile="Sim" /////////////////////////////////////////////////////// /* Opçoes do compilador */ /* * Os arquivos que poderemos processar ... */ /* *.PRG */ /* *.C */ /* *.CPP */ /* *.RC */ //////////////////////////////////////////////////////// /* * São Paulo , 16/06/2006 @ 06:36 * Revisado em 23/8/2006 17:00:02 * ----------------------------- * Harbour.xCompiler.prg * * Arquivo contendo os comandos de Script para processamento de um projeto * Harbour modo CONSOLE com Borland BCC ou MinGW. */ #define CRLF Chr(13)+Chr(10) function Prepare type := Project( 'TargetType' ) if FileExists( 'harbour.exe', m_PreSetPath ) .or. ; FileExists( 'hb.exe', m_PreSetPath ) /* alert(1) elseif ; FileExists( 'hb.exe', m_PreSetPath )*/ * else MsgError( 'O arquivo principal do compilador não existe!' ) return .f. end if !FileExists( 'bcc32.exe', m_PreSetPath ) MsgError( 'O arquivo requerido BCC32.EXE não foi localizado no sistema!' ) return .f. end if !FileExists( 'ilink32.exe', m_PreSetPath ) MsgError( 'O arquivo requerido ILINK32.EXE não foi localizado no sistema!' ) return .f. end /* * 30/9/2006 21:02:35 * Aqui neste ponto setamos a variavel abaixo como SIM, indicando * que desejamos recompilar todo o projeto. Caso o valor dela seja .F. * a xDev irá compilar e linkar usando o padrao solicitado pelo * programador que estiver usando a xDev. */ m_bCompileAll := SameText( fForceCompileAll, 'sim' ) return .t. function UnPrepare return .t. /* * Esta função é executada, sempre que a xDev precisar compilar um arquivo .PRG */ function OnFilePRG * Preparamos a linha de comando cmd := 'harbour.exe' cmd += ' "' + m_sFileName + '"' cmd += ' /q /o"' + m_sOutPut + '"' cmd += ' ' + fFlagA + ' ' + fFlagL + ' ' + fFlagM + ' ' + ; ' ' + fFlagN + ' ' + fFlagZ + ' ' + fFlagP * * Verificarmos se ele nao quer desativar o DEBUG para este módulo em específico! * para isto usamos a funcao SameText() que compara os 2 argumentos ignorando * letras maiúsculas / minúsculas. * if !SameText( PRG_DisableDebug, 'sim' ) cmd += ' ' + fFlagB end * Verificamos as diretrivas #DEFINEs e adicionamos ela na linha de comando! aDefs := Alltrim(CustomDefines) + ',' + ; // Diretrivas gerais do projeto Alltrim(PRG_Defines) + ',' + ; // Diretrivas específicas deste arquivo Alltrim(m_PreSetDefines) // Estas sao as diretrivas do PROJETO e do PRESET atual aDefs := StrTran(aDefs, ';', ',' ) aDefs := StrTran(aDefs, ' ', '' ) aDefs := ListAsArray( aDefs, ',') cmd := alltrim( cmd ) for i := 0 to len( aDefs ) if !Empty(aDefs) cmd += ' /D' + aDefs end next * Isto inclui os #DEFINEs de cada versao do xHb e do HB específicas if !Empty(m_PresetConstants) cmd += m_PresetConstants end * Colocamos os outros parametros (se houver) cmd := alltrim( cmd ) cmd += " " + fMiscOption1 * Executamos o comando específico para compilar runBat(cmd) bOk := (ErrorLevel() == 0) return bOk /* * Esta função é executada, sempre que a xDev precisar compilar um arquivo .C/.CPP */ function OnFileC * Preparamos a linha de comando aLines := {} * Verificamos as diretrivas #DEFINEs e adicionamos ela na linha de comando! aDefs := Alltrim(CustomDefines) + ',' + ; // Diretrivas gerais do projeto Alltrim(PRG_Defines) + ',' + ; // Diretrivas específicas deste arquivo Alltrim(m_PreSetDefines) // Estas sao as diretrivas do PROJETO e do PRESET atual aDefs := StrTran(aDefs, ';', ',' ) aDefs := StrTran(aDefs, ' ', '' ) aDefs := ListAsArray( aDefs, ',') cmd := alltrim( cmd ) for i := 0 to len( aDefs ) if !Empty(aDefs) AAdd( aLines, '-D' + aDefs) end next * Isto inclui os #DEFINEs de cada versao do xHb e do HB específicas if !Empty(m_PresetConstants) AAdd( aLines, m_PresetConstants) end * Ajustamos os outros parametros AAdd( aLines, '-I"' + m_PreSetInclude +'"') AAdd( aLines, '-L"' + m_PreSetLib + ';' +m_PreSetObj + '"') AAdd( aLines, '-o"' + m_sOutPut + '"') AAdd( aLines, '"' + m_sFileName + '"') * Salvamos e executamos o comando específico para compilar MemoWrite( 'b32.bc', aLines ) runBat('BCC32 -M -c @B32.BC') bOk := (ErrorLevel() == 0) return bOk /* * Esta função é executada, sempre que a xDev precisar compilar um arquivo .RC */ function OnFileRC cmd := FindFile( 'brc32.exe', m_PreSetPath ) if Empty(cmd) cmd := FindFile( 'porc.exe', m_PreSetPath ) end if Empty(cmd) MsgError( 'Erro ao localizar o aplicativo necessário para compilar o módulo "'+m_sFileName+'"!' ) return .f. end * Preparamos a linha de comando cmd += ' -r -fo"' + m_sOutPut + '" -i"' + m_PreSetInclude +'"' * Verificamos as diretrivas #DEFINEs e adicionamos ela na linha de comando! aDefs := Alltrim(CustomDefines) + ',' + ; // Diretrivas gerais do projeto Alltrim(PRG_Defines) + ',' + ; // Diretrivas específicas deste arquivo Alltrim(m_PreSetDefines) // Estas sao as diretrivas do PROJETO e do PRESET atual aDefs := StrTran(aDefs, ';', ',' ) aDefs := StrTran(aDefs, ' ', '' ) aDefs := ListAsArray( aDefs, ',') cmd := alltrim( cmd ) for i := 0 to len( aDefs ) if !Empty(aDefs) cmd += ' -D' + aDefs end next * Isto inclui os #DEFINEs de cada versao do xHb e do HB específicas if !Empty(m_PresetConstants) cmd += m_PresetConstants end * Ajustamos os outros parametros cmd += ' "' + m_sFileName + '"' * Executamos o comando específico para compilar run (cmd) bOk := (ErrorLevel() == 0) return bOk function OnBuild if SameText( type, 'LIB' ) return BuildLib() end if SameText( type, 'DLL' ) return BuildDLL() end return BuildExe() function BuildExe() * Preparamos a linha de comando aLines := {} AAdd( aLines, '-I"' + m_PreSetInclude +'" +') AAdd( aLines, '-L"' + m_PreSetLib + ';' +m_PreSetObj + '" +') * Usamos sempre a função SAMETEXT() pq ela compara removendo os espaços e * ignorando maiúsculas e minúsculas if SameText( fForceCON, 'Sim' ) * ele quer q abra a janela dos no fundo. else * Testamos abaixo se ele usa uma lib grafica em modo console * se for .T. a comparacao abaixo devemos esconder a janela DOS. if SameText( Left( fGUILib,2 ), 'gt') AADD( aLines, '-aa +' ) end end if !Empty(fMiscOption4) AADD( aLines, fMiscOption4 +' +' ) end AADD( aLines, '-Gn -M -m -Tpe -s +' ) AADD( aLines, 'c0w32.obj + ' ) /* * Incluimos os arquivos .OBJ do projeto */ aFiles := Project( "*.OBJ" ) t := Len( aFiles ) FOR i := 1 TO t IF i == t AADD( aLines, '"'+aFiles+'", + ' ) ELSE AADD( aLines, '"'+aFiles+'" + ' ) End End AADD( aLines, '"'+m_sOutPut + '", + ' ) AADD( aLines, '"'+ChangeFileExt( m_sOutPut, '.map')+'", + ' ) /* * Chamamos a função que pega o nome das libs corretas */ DefaultLibs() AADD( aLines, 'cw32.lib + ' ) AADD( aLines, 'import32.lib + ' ) if SameText( RDD4, 'sim' ) AADD( aLines, 'odbc32.lib +') end if FileExists('rasapi32.lib', m_PreSetLib ) AADD( aLines, 'rasapi32.lib +' ) end if FileExists('nddeapi.lib', m_PreSetLib ) AADD( aLines, 'nddeapi.lib +' ) end if FileExists('iphlpapi.lib', m_PreSetLib ) AADD( aLines, 'iphlpapi.lib +' ) end AADD( aLines, ',' ) /* * Põe os RCs project files */ aFiles := Project( "*.RES" ) FOR i := 1 TO Len( aFiles ) IF i == t AADD( aLines, '"'+aFiles+'" ' ) else AADD( aLines, '"'+aFiles+'" + ' ) End End MemoWrite( 'b32.bc', aLines ) runBat('ILINK32 @B32.BC') bOk := (ErrorLevel() == 0) /* * Testamos se ele quer compactar o aplicativo gerado usando UPX * 22/01/2008 - 10:35:49 */ if bOk .and. SameText( fUseUPX, 'Sim' ) cmd := FindFile( 'upx.exe', m_PreSetPath ) if Empty(cmd) MsgError( 'Erro ao localizar o arquivo UPX.EXE necessário para compactar seu aplicativo!' ) return .f. end aLines := {} AADD( aLines, 'ECHO xDev TITLE UPX' ) AADD( aLines, 'ECHO xDev FILE '+ m_sOutPut +'' ) AADD( aLines, 'UPX.EXE "'+m_sOutPut + '"' ) cmd := ListAsText( aLines ) runBat( cmd ) bOk := (ErrorLevel() == 0) end return bOk function BuildDLL() * Preparamos a linha de comando aLines := {} AAdd( aLines, '-I"' + m_PreSetInclude +'" +') AAdd( aLines, '-L"' + m_PreSetLib + ';' +m_PreSetObj + '" +') * Usamos sempre a função SAMETEXT() pq ela compara removendo os espaços e * ignorando maiúsculas e minúsculas if SameText( fForceCON, 'Sim' ) AADD( aLines, '-aa +' ) end AADD( aLines, '-Gn -M -m -Tpd -s + ' ) AADD( aLines, '-Gpr -ap + ' ) AADD( aLines, 'c0d32.obj + ' ) /* * Incluimos os arquivos .OBJ do projeto */ aFiles := Project( "*.OBJ" ) t := Len( aFiles ) FOR i := 1 TO t IF i == t AADD( aLines, '"'+aFiles+'", + ' ) ELSE AADD( aLines, '"'+aFiles+'" + ' ) End End AADD( aLines, '"'+m_sOutPut + '", + ' ) AADD( aLines, '"'+ChangeFileExt( m_sOutPut, '.map')+'", + ' ) /* * Chamamos a função que pega o nome das libs corretas */ DefaultLibs() AADD( aLines, 'cw32.lib + ' ) AADD( aLines, 'import32.lib, ' ) /* * Põe os RCs project files */ aFiles := Project( "*.RES" ) FOR i := 1 TO Len( aFiles ) IF i == t AADD( aLines, '"'+aFiles+'" ' ) else AADD( aLines, '"'+aFiles+'" + ' ) End End MemoWrite( 'b32.bc', aLines ) runBat('ILINK32 @B32.BC') bOk := (ErrorLevel() == 0) /* * Testamos se ele quer compactar o aplicativo gerado usando UPX * 22/01/2008 - 10:35:49 */ if bOk .and. SameText( fUseUPX, 'Sim' ) cmd := FindFile( 'upx.exe', m_PreSetPath ) if Empty(cmd) MsgError( 'Erro ao localizar o arquivo UPX.EXE necessário para compactar seu aplicativo!' ) return .f. end aLines := {} AADD( aLines, 'ECHO xDev TITLE UPX' ) AADD( aLines, 'ECHO xDev FILE '+ m_sOutPut +'' ) AADD( aLines, 'UPX.EXE "'+m_sOutPut + '"' ) cmd := ListAsText( aLines ) runBat( cmd ) bOk := (ErrorLevel() == 0) end return bOk function BuildLib() * Preparamos a linha de comando aLines := {} * Veja bem, se ele quer criar uma .LIB, então temos que pegar todos os arquivos * .OBJ e jogar dentro da LIB aFiles := Project( "*.OBJ" ) t := Len( aFiles ) FOR i := 1 TO t AADD( aLines, 'ECHO xDev TITLE Linkando' ) AADD( aLines, 'ECHO xDev FILE '+ ExtractFileName( aFiles ) +'' ) AADD( aLines, 'TLIB "'+m_sOutPut+'" +- "'+aFiles+'"' ) End * Existe algo pra compilar? IF Empty( aLines ) return .T. End cmd := ListAsText( aLines ) runBat( cmd ) bOk := (ErrorLevel() == 0) * * 29/9/2006 16:49:59 * Se deu tudo certo na compilação e for para copiar para a pasta LIB do nosso * compilador, fazemos isto agora! * if (bOk) .and. SameText( fInstallLIB, 'sim' ) Dest := getLibFolder() + extractfilename( m_sOutPut ) bOk := CopyFile( m_sOutPut, Dest ) end return bOk function DefaultLibs() Libs := .T. if SameText( CustomLIBs, 'Sim') /* * Se ele tem a lista de LIBs personalizadas não preenchemos isto... */ else /* * Testamos se ele quer usar a HARBOUR.DLL se for, isto reduz o numero de LIBs * linkadas no projeto. */ if SameText( fUseHBDLL, 'sim' ) AADD( aLines, 'harbour.lib + ' ) if SameText( RDD3, 'sim' ) AADD( aLines, 'rddads.lib +') AADD( aLines, 'ace32.lib +') end if FileExists( 'bcc640.lib', m_PreSetLib ) AADD( aLines, 'bcc640.lib + ' ) end Libs := .F. else AADD( aLines, 'lang.lib + ' ) AADD( aLines, 'vm.lib + ' ) AADD( aLines, 'rtl.lib + ' ) AADD( aLines, 'rdd.lib + ' ) AADD( aLines, 'macro.lib + ' ) AADD( aLines, 'pp.lib + ' ) AADD( aLines, 'dbfntx.lib + ' ) if SameText( RDD2, 'sim' ) AADD( aLines, 'dbfcdx.lib + ' ) end if SameText( RDD3, 'sim' ) AADD( aLines, 'rddads.lib +') AADD( aLines, 'ace32.lib +') end if FileExists( 'bcc640.lib', m_PreSetLib ) AADD( aLines, 'bcc640.lib + ' ) end if FileExists('dbfdbt.lib', m_PreSetLib ) AADD( aLines, 'dbfdbt.lib + ' ) end if FileExists('dbffpt.lib', m_PreSetLib ) AADD( aLines, 'dbffpt.lib + ' ) end end if SameText( RDD1, 'sim' ) AADD( aLines, ApplyMacros( 'sqllib_($hV).lib + ') ) AADD( aLines, 'libmysql.lib +') end end /* * Incluimos os arquivos .LIB no projeto. O segundo parametro .T. indica que * queremos TODOS os arquivos ATÉ MESMO AQUELES MARCADOS com a opção * compile=FALSE, por isto usamos um parametro .T. * * Quando omitimos o segundo parametro, ele puxará apenas os arquivos * marcados como COMPILE=TRUE e desde modo, irá ignorar os arquivos .LIB */ aFiles := Project( "*.LIB" ) FOR i := 1 TO Len( aFiles ) AADD( aLines, '"'+aFiles+'" + ' ) End if SameText( CustomLIBs, 'Sim') /* * Se ele tem a lista de LIBs personalizada, caimos fora! */ else if SameText( fFlagB, '/B' ) AADD( aLines, 'debug.lib + ' ) end if SameText( fUseHBDLL, 'sim' ) *** elseif !Libs *** else AADD( aLines, 'common.lib + ' ) if SameText( fGUILib, 'Gtwvt' ) * AADD( aLines, 'gtwvt.lib +' ) * if FileExists('wvtgui.lib', m_PreSetLib ) AADD( aLines, 'wvtgui.lib +' ) end * elseif SameText( fGUILib, 'Gtwvw' ) * AADD( aLines, 'gtwvw.lib +' ) * elseif SameText( fGUILib, 'CGI/Web' ) * AADD( aLines, 'gtcgi.lib + ' ) * else if FileExists('gtwin.lib', m_PreSetLib ) AADD( aLines, 'gtwin.lib + ' ) else AADD( aLines, 'gtgui.lib + ' ) end end end /* * Testa se o arquivo bcc640.lib existe no * PATH passado no segundo arqumento, neste caso m_PreSetLib */ if FileExists( 'codepage.lib', m_PreSetLib ) AADD( aLines, 'codepage.lib + ' ) end if FileExists('ct.lib', m_PreSetLib ) AADD( aLines, 'ct.lib + ' ) end if FileExists('tip.lib', m_PreSetLib ) AADD( aLines, 'tip.lib + ' ) end if FileExists('hsx.lib', m_PreSetLib ) AADD( aLines, 'hsx.lib + ' ) end if FileExists('pcrepos.lib', m_PreSetLib ) AADD( aLines, 'pcrepos.lib + ' ) end if FileExists('hbsix.lib', m_PreSetLib ) AADD( aLines, 'hbsix.lib + ' ) end end return
  21. Pessoal, bom dia No dia 21/02/2012 fiz uma atualizacao no fivewin de 2.5 para 12.01 - xharbour 1.2.1 - xdev0.6 para 0.7 - bcc55 p/ bcc582 Tive alguns problemas para o fivewin mas parace que agora esta ok, o meu problema esta no xharbour com o xdev, tenho um sistema que nao da erro na compilacao mas aparece uma tela preta quando peco para executar o aplicativo. Fiz um teste com poucas linhas e acontece a mesma coisa. estou anexando abaixo. Eu nao sei mais aonde mexer. Poderiam me ajudar? Muito obrigado pela atencao PS. Antes estes programas rodavam bem. Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.com Programa : //-------------------------------------------------- FUNCTION Main() LOCAL cOldColor := SetColor() LOCAL cNewColor := PadR( "W+/N,W+/B", 40 ) CLS ? "Current color :", cOldColor ? SetColor( cNewColor ) @ Row(), Col() SAY "Enter new color:" GET cNewColor READ cNewColor := Trim( cNewColor ) SetColor( cNewColor ) ? "New color is :", cNewColor SetColor( cOldColor ) ? "Back to original" Return nil //////////////////////////////////////////////////// compile="Sim"> compile="Sim"> compile="Sim"> compile="Sim" /////////////////////////////////////////////////////// /* Opçoes do compilador */ /* * Os arquivos que poderemos processar ... */ /* *.PRG */ /* *.C */ /* *.CPP */ /* *.RC */ //////////////////////////////////////////////////////// /* * São Paulo , 16/06/2006 @ 06:36 * Revisado em 23/8/2006 17:00:02 * ----------------------------- * Harbour.xCompiler.prg * * Arquivo contendo os comandos de Script para processamento de um projeto * Harbour modo CONSOLE com Borland BCC ou MinGW. */ #define CRLF Chr(13)+Chr(10) function Prepare type := Project( 'TargetType' ) if FileExists( 'harbour.exe', m_PreSetPath ) .or. ; FileExists( 'hb.exe', m_PreSetPath ) /* alert(1) elseif ; FileExists( 'hb.exe', m_PreSetPath )*/ * else MsgError( 'O arquivo principal do compilador não existe!' ) return .f. end if !FileExists( 'bcc32.exe', m_PreSetPath ) MsgError( 'O arquivo requerido BCC32.EXE não foi localizado no sistema!' ) return .f. end if !FileExists( 'ilink32.exe', m_PreSetPath ) MsgError( 'O arquivo requerido ILINK32.EXE não foi localizado no sistema!' ) return .f. end /* * 30/9/2006 21:02:35 * Aqui neste ponto setamos a variavel abaixo como SIM, indicando * que desejamos recompilar todo o projeto. Caso o valor dela seja .F. * a xDev irá compilar e linkar usando o padrao solicitado pelo * programador que estiver usando a xDev. */ m_bCompileAll := SameText( fForceCompileAll, 'sim' ) return .t. function UnPrepare return .t. /* * Esta função é executada, sempre que a xDev precisar compilar um arquivo .PRG */ function OnFilePRG * Preparamos a linha de comando cmd := 'harbour.exe' cmd += ' "' + m_sFileName + '"' cmd += ' /q /o"' + m_sOutPut + '"' cmd += ' ' + fFlagA + ' ' + fFlagL + ' ' + fFlagM + ' ' + ; ' ' + fFlagN + ' ' + fFlagZ + ' ' + fFlagP * * Verificarmos se ele nao quer desativar o DEBUG para este módulo em específico! * para isto usamos a funcao SameText() que compara os 2 argumentos ignorando * letras maiúsculas / minúsculas. * if !SameText( PRG_DisableDebug, 'sim' ) cmd += ' ' + fFlagB end * Verificamos as diretrivas #DEFINEs e adicionamos ela na linha de comando! aDefs := Alltrim(CustomDefines) + ',' + ; // Diretrivas gerais do projeto Alltrim(PRG_Defines) + ',' + ; // Diretrivas específicas deste arquivo Alltrim(m_PreSetDefines) // Estas sao as diretrivas do PROJETO e do PRESET atual aDefs := StrTran(aDefs, ';', ',' ) aDefs := StrTran(aDefs, ' ', '' ) aDefs := ListAsArray( aDefs, ',') cmd := alltrim( cmd ) for i := 0 to len( aDefs ) if !Empty(aDefs) cmd += ' /D' + aDefs end next * Isto inclui os #DEFINEs de cada versao do xHb e do HB específicas if !Empty(m_PresetConstants) cmd += m_PresetConstants end * Colocamos os outros parametros (se houver) cmd := alltrim( cmd ) cmd += " " + fMiscOption1 * Executamos o comando específico para compilar runBat(cmd) bOk := (ErrorLevel() == 0) return bOk /* * Esta função é executada, sempre que a xDev precisar compilar um arquivo .C/.CPP */ function OnFileC * Preparamos a linha de comando aLines := {} * Verificamos as diretrivas #DEFINEs e adicionamos ela na linha de comando! aDefs := Alltrim(CustomDefines) + ',' + ; // Diretrivas gerais do projeto Alltrim(PRG_Defines) + ',' + ; // Diretrivas específicas deste arquivo Alltrim(m_PreSetDefines) // Estas sao as diretrivas do PROJETO e do PRESET atual aDefs := StrTran(aDefs, ';', ',' ) aDefs := StrTran(aDefs, ' ', '' ) aDefs := ListAsArray( aDefs, ',') cmd := alltrim( cmd ) for i := 0 to len( aDefs ) if !Empty(aDefs) AAdd( aLines, '-D' + aDefs) end next * Isto inclui os #DEFINEs de cada versao do xHb e do HB específicas if !Empty(m_PresetConstants) AAdd( aLines, m_PresetConstants) end * Ajustamos os outros parametros AAdd( aLines, '-I"' + m_PreSetInclude +'"') AAdd( aLines, '-L"' + m_PreSetLib + ';' +m_PreSetObj + '"') AAdd( aLines, '-o"' + m_sOutPut + '"') AAdd( aLines, '"' + m_sFileName + '"') * Salvamos e executamos o comando específico para compilar MemoWrite( 'b32.bc', aLines ) runBat('BCC32 -M -c @B32.BC') bOk := (ErrorLevel() == 0) return bOk /* * Esta função é executada, sempre que a xDev precisar compilar um arquivo .RC */ function OnFileRC cmd := FindFile( 'brc32.exe', m_PreSetPath ) if Empty(cmd) cmd := FindFile( 'porc.exe', m_PreSetPath ) end if Empty(cmd) MsgError( 'Erro ao localizar o aplicativo necessário para compilar o módulo "'+m_sFileName+'"!' ) return .f. end * Preparamos a linha de comando cmd += ' -r -fo"' + m_sOutPut + '" -i"' + m_PreSetInclude +'"' * Verificamos as diretrivas #DEFINEs e adicionamos ela na linha de comando! aDefs := Alltrim(CustomDefines) + ',' + ; // Diretrivas gerais do projeto Alltrim(PRG_Defines) + ',' + ; // Diretrivas específicas deste arquivo Alltrim(m_PreSetDefines) // Estas sao as diretrivas do PROJETO e do PRESET atual aDefs := StrTran(aDefs, ';', ',' ) aDefs := StrTran(aDefs, ' ', '' ) aDefs := ListAsArray( aDefs, ',') cmd := alltrim( cmd ) for i := 0 to len( aDefs ) if !Empty(aDefs) cmd += ' -D' + aDefs end next * Isto inclui os #DEFINEs de cada versao do xHb e do HB específicas if !Empty(m_PresetConstants) cmd += m_PresetConstants end * Ajustamos os outros parametros cmd += ' "' + m_sFileName + '"' * Executamos o comando específico para compilar run (cmd) bOk := (ErrorLevel() == 0) return bOk function OnBuild if SameText( type, 'LIB' ) return BuildLib() end if SameText( type, 'DLL' ) return BuildDLL() end return BuildExe() function BuildExe() * Preparamos a linha de comando aLines := {} AAdd( aLines, '-I"' + m_PreSetInclude +'" +') AAdd( aLines, '-L"' + m_PreSetLib + ';' +m_PreSetObj + '" +') * Usamos sempre a função SAMETEXT() pq ela compara removendo os espaços e * ignorando maiúsculas e minúsculas if SameText( fForceCON, 'Sim' ) * ele quer q abra a janela dos no fundo. else * Testamos abaixo se ele usa uma lib grafica em modo console * se for .T. a comparacao abaixo devemos esconder a janela DOS. if SameText( Left( fGUILib,2 ), 'gt') AADD( aLines, '-aa +' ) end end if !Empty(fMiscOption4) AADD( aLines, fMiscOption4 +' +' ) end AADD( aLines, '-Gn -M -m -Tpe -s +' ) AADD( aLines, 'c0w32.obj + ' ) /* * Incluimos os arquivos .OBJ do projeto */ aFiles := Project( "*.OBJ" ) t := Len( aFiles ) FOR i := 1 TO t IF i == t AADD( aLines, '"'+aFiles+'", + ' ) ELSE AADD( aLines, '"'+aFiles+'" + ' ) End End AADD( aLines, '"'+m_sOutPut + '", + ' ) AADD( aLines, '"'+ChangeFileExt( m_sOutPut, '.map')+'", + ' ) /* * Chamamos a função que pega o nome das libs corretas */ DefaultLibs() AADD( aLines, 'cw32.lib + ' ) AADD( aLines, 'import32.lib + ' ) if SameText( RDD4, 'sim' ) AADD( aLines, 'odbc32.lib +') end if FileExists('rasapi32.lib', m_PreSetLib ) AADD( aLines, 'rasapi32.lib +' ) end if FileExists('nddeapi.lib', m_PreSetLib ) AADD( aLines, 'nddeapi.lib +' ) end if FileExists('iphlpapi.lib', m_PreSetLib ) AADD( aLines, 'iphlpapi.lib +' ) end AADD( aLines, ',' ) /* * Põe os RCs project files */ aFiles := Project( "*.RES" ) FOR i := 1 TO Len( aFiles ) IF i == t AADD( aLines, '"'+aFiles+'" ' ) else AADD( aLines, '"'+aFiles+'" + ' ) End End MemoWrite( 'b32.bc', aLines ) runBat('ILINK32 @B32.BC') bOk := (ErrorLevel() == 0) /* * Testamos se ele quer compactar o aplicativo gerado usando UPX * 22/01/2008 - 10:35:49 */ if bOk .and. SameText( fUseUPX, 'Sim' ) cmd := FindFile( 'upx.exe', m_PreSetPath ) if Empty(cmd) MsgError( 'Erro ao localizar o arquivo UPX.EXE necessário para compactar seu aplicativo!' ) return .f. end aLines := {} AADD( aLines, 'ECHO xDev TITLE UPX' ) AADD( aLines, 'ECHO xDev FILE '+ m_sOutPut +'' ) AADD( aLines, 'UPX.EXE "'+m_sOutPut + '"' ) cmd := ListAsText( aLines ) runBat( cmd ) bOk := (ErrorLevel() == 0) end return bOk function BuildDLL() * Preparamos a linha de comando aLines := {} AAdd( aLines, '-I"' + m_PreSetInclude +'" +') AAdd( aLines, '-L"' + m_PreSetLib + ';' +m_PreSetObj + '" +') * Usamos sempre a função SAMETEXT() pq ela compara removendo os espaços e * ignorando maiúsculas e minúsculas if SameText( fForceCON, 'Sim' ) AADD( aLines, '-aa +' ) end AADD( aLines, '-Gn -M -m -Tpd -s + ' ) AADD( aLines, '-Gpr -ap + ' ) AADD( aLines, 'c0d32.obj + ' ) /* * Incluimos os arquivos .OBJ do projeto */ aFiles := Project( "*.OBJ" ) t := Len( aFiles ) FOR i := 1 TO t IF i == t AADD( aLines, '"'+aFiles+'", + ' ) ELSE AADD( aLines, '"'+aFiles+'" + ' ) End End AADD( aLines, '"'+m_sOutPut + '", + ' ) AADD( aLines, '"'+ChangeFileExt( m_sOutPut, '.map')+'", + ' ) /* * Chamamos a função que pega o nome das libs corretas */ DefaultLibs() AADD( aLines, 'cw32.lib + ' ) AADD( aLines, 'import32.lib, ' ) /* * Põe os RCs project files */ aFiles := Project( "*.RES" ) FOR i := 1 TO Len( aFiles ) IF i == t AADD( aLines, '"'+aFiles+'" ' ) else AADD( aLines, '"'+aFiles+'" + ' ) End End MemoWrite( 'b32.bc', aLines ) runBat('ILINK32 @B32.BC') bOk := (ErrorLevel() == 0) /* * Testamos se ele quer compactar o aplicativo gerado usando UPX * 22/01/2008 - 10:35:49 */ if bOk .and. SameText( fUseUPX, 'Sim' ) cmd := FindFile( 'upx.exe', m_PreSetPath ) if Empty(cmd) MsgError( 'Erro ao localizar o arquivo UPX.EXE necessário para compactar seu aplicativo!' ) return .f. end aLines := {} AADD( aLines, 'ECHO xDev TITLE UPX' ) AADD( aLines, 'ECHO xDev FILE '+ m_sOutPut +'' ) AADD( aLines, 'UPX.EXE "'+m_sOutPut + '"' ) cmd := ListAsText( aLines ) runBat( cmd ) bOk := (ErrorLevel() == 0) end return bOk function BuildLib() * Preparamos a linha de comando aLines := {} * Veja bem, se ele quer criar uma .LIB, então temos que pegar todos os arquivos * .OBJ e jogar dentro da LIB aFiles := Project( "*.OBJ" ) t := Len( aFiles ) FOR i := 1 TO t AADD( aLines, 'ECHO xDev TITLE Linkando' ) AADD( aLines, 'ECHO xDev FILE '+ ExtractFileName( aFiles ) +'' ) AADD( aLines, 'TLIB "'+m_sOutPut+'" +- "'+aFiles+'"' ) End * Existe algo pra compilar? IF Empty( aLines ) return .T. End cmd := ListAsText( aLines ) runBat( cmd ) bOk := (ErrorLevel() == 0) * * 29/9/2006 16:49:59 * Se deu tudo certo na compilação e for para copiar para a pasta LIB do nosso * compilador, fazemos isto agora! * if (bOk) .and. SameText( fInstallLIB, 'sim' ) Dest := getLibFolder() + extractfilename( m_sOutPut ) bOk := CopyFile( m_sOutPut, Dest ) end return bOk function DefaultLibs() Libs := .T. if SameText( CustomLIBs, 'Sim') /* * Se ele tem a lista de LIBs personalizadas não preenchemos isto... */ else /* * Testamos se ele quer usar a HARBOUR.DLL se for, isto reduz o numero de LIBs * linkadas no projeto. */ if SameText( fUseHBDLL, 'sim' ) AADD( aLines, 'harbour.lib + ' ) if SameText( RDD3, 'sim' ) AADD( aLines, 'rddads.lib +') AADD( aLines, 'ace32.lib +') end if FileExists( 'bcc640.lib', m_PreSetLib ) AADD( aLines, 'bcc640.lib + ' ) end Libs := .F. else AADD( aLines, 'lang.lib + ' ) AADD( aLines, 'vm.lib + ' ) AADD( aLines, 'rtl.lib + ' ) AADD( aLines, 'rdd.lib + ' ) AADD( aLines, 'macro.lib + ' ) AADD( aLines, 'pp.lib + ' ) AADD( aLines, 'dbfntx.lib + ' ) if SameText( RDD2, 'sim' ) AADD( aLines, 'dbfcdx.lib + ' ) end if SameText( RDD3, 'sim' ) AADD( aLines, 'rddads.lib +') AADD( aLines, 'ace32.lib +') end if FileExists( 'bcc640.lib', m_PreSetLib ) AADD( aLines, 'bcc640.lib + ' ) end if FileExists('dbfdbt.lib', m_PreSetLib ) AADD( aLines, 'dbfdbt.lib + ' ) end if FileExists('dbffpt.lib', m_PreSetLib ) AADD( aLines, 'dbffpt.lib + ' ) end end if SameText( RDD1, 'sim' ) AADD( aLines, ApplyMacros( 'sqllib_($hV).lib + ') ) AADD( aLines, 'libmysql.lib +') end end /* * Incluimos os arquivos .LIB no projeto. O segundo parametro .T. indica que * queremos TODOS os arquivos ATÉ MESMO AQUELES MARCADOS com a opção * compile=FALSE, por isto usamos um parametro .T. * * Quando omitimos o segundo parametro, ele puxará apenas os arquivos * marcados como COMPILE=TRUE e desde modo, irá ignorar os arquivos .LIB */ aFiles := Project( "*.LIB" ) FOR i := 1 TO Len( aFiles ) AADD( aLines, '"'+aFiles+'" + ' ) End if SameText( CustomLIBs, 'Sim') /* * Se ele tem a lista de LIBs personalizada, caimos fora! */ else if SameText( fFlagB, '/B' ) AADD( aLines, 'debug.lib + ' ) end if SameText( fUseHBDLL, 'sim' ) *** elseif !Libs *** else AADD( aLines, 'common.lib + ' ) if SameText( fGUILib, 'Gtwvt' ) * AADD( aLines, 'gtwvt.lib +' ) * if FileExists('wvtgui.lib', m_PreSetLib ) AADD( aLines, 'wvtgui.lib +' ) end * elseif SameText( fGUILib, 'Gtwvw' ) * AADD( aLines, 'gtwvw.lib +' ) * elseif SameText( fGUILib, 'CGI/Web' ) * AADD( aLines, 'gtcgi.lib + ' ) * else if FileExists('gtwin.lib', m_PreSetLib ) AADD( aLines, 'gtwin.lib + ' ) else AADD( aLines, 'gtgui.lib + ' ) end end end /* * Testa se o arquivo bcc640.lib existe no * PATH passado no segundo arqumento, neste caso m_PreSetLib */ if FileExists( 'codepage.lib', m_PreSetLib ) AADD( aLines, 'codepage.lib + ' ) end if FileExists('ct.lib', m_PreSetLib ) AADD( aLines, 'ct.lib + ' ) end if FileExists('tip.lib', m_PreSetLib ) AADD( aLines, 'tip.lib + ' ) end if FileExists('hsx.lib', m_PreSetLib ) AADD( aLines, 'hsx.lib + ' ) end if FileExists('pcrepos.lib', m_PreSetLib ) AADD( aLines, 'pcrepos.lib + ' ) end if FileExists('hbsix.lib', m_PreSetLib ) AADD( aLines, 'hbsix.lib + ' ) end end return
  22. Boa noite pessoal. A 10 dias fiz um upgrade do fivewin e ate agora nao consegui criar, so da erro. E me parece que so falta esta lib para rodar os programas. Alguem pode me ajudar? Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.com Editado por - hinfo on 20/03/2012 11:46:15
  23. Boa noite pessoal. A 10 dias fiz um upgrade do fivewin e ate agora nao consegui criar, so da erro. E me parece que so falta esta lib para rodar os programas. Alguem pode me ajudar? Helio Tsuyama Santo Andre - SP fw12.01-xhb1.2.1-xDev0.7 - bcc 5.82 hbinfo.br@gmail.com Editado por - hinfo on 20/03/2012 11:46:15
  24. Ola Eu uso o achat em alguns clientes, msg interno por ip Funciona legal Helio Tsuyama Santo Andre - SP FWH25Fev - WS - xHb .99-3 - xDev Studio v0.62 hbinfo.br@gmail.com
×
×
  • Create New...