O programa é bem simples mas está funcional.
um abraço a todos.
Código: Selecionar todos
********************************************************************************
* ID : TesteMySQL.prg *
* OBJETIVO : Programa para testes de acesso ao MySQL com Harbour *
* POR : Boris A. Magaievski *
* EM : 22/03/2012 09:30 *
* *
* NOTAS : (1) Baseado na contrib do harbour e modificado para um exemplo mais *
* real *
* (2) Testado para diversos servidores com portas diferentes da 3306 *
* (3) Compilado com Harbour 3.0 na plataforma windows com BCC32 V 5.5 *
* (4) Compilar com hbmysql.lib na pasta \hb30\lib\win\bcc *
* (5) Utilizada a classe TMySQL para acesso ao servidor *
* (6) informações sobre a classe TMySQL podem ser obtidas aqui: *
* http://culikr.sites.uol.com.br/howmysql.htm *
* *
********************************************************************************
#include "dbstruct.ch"
#include "inkey.ch"
STATIC oServer
STATIC oTable
procedure Main( cArg )
LOCAL oQuery2, oRow, aStru
LOCAL oQuery
*****************************************************************************
* Inclua os dados de acesso ao servidor *
* Nota : o endereço da porta é numérico *
*****************************************************************************
LOCAL cServer := '<nome ou IP do servidor>'
LOCAL cUsuario := '<usuario>'
LOCAL cSenha := '<senha>'
LOCAl cBaseDados := '<base de dados>'
LOCAL cTabela := '<nome da tabela>'
LOCAL nPorta := 3400
LOCAL aTabelas := {}
SET CENTURY ON
SET EPOCH TO 1960
*****************************************************************************
* Configurar p gina de c¢digo apropriada para cada sistema operacional *
* Nota : As requisições de codepage possibilitam trabalhar com vários SOs *
* e charsets pt_br ou seja, corrigem a acentua‡Æo. *
* Para p ginas de c¢digo usar PT850 ou PTISO conforme o config do SO *
*****************************************************************************
REQUEST HB_CODEPAGE_PTISO
REQUEST HB_CODEPAGE_PT850
Hb_LangSelect("PT")
Hb_CdpSelect("PT850")
*****************************************************************************
* Configura‡Æo do ambiente do sistema *
*****************************************************************************
SetMode(25,80)
*******************************************************************
* Estabelece a conexÆo com o servidor *
*******************************************************************
oServer := TMySQLServer():New( cServer, cUsuario, cSenha, nPorta )
if oServer:NetErr()
Alert( oServer:Error() )
oServer:Destroy()
return
endif
*******************************************************************
* Seleciona o banco de dados *
*******************************************************************
oServer:SelectDB( cBaseDados )
if oServer:NetErr()
Alert( oServer:Error() )
oServer:Destroy()
return
endif
*******************************************************************
* Testando se a tabela existe na base de dados *
*******************************************************************
if ! Ascan(oServer:ListTables(), cTabela) > 0
Alert( 'A tabela '+cTabela+' nÆo existe nesta base de dados' )
oServer:Destroy()
return
endif
*******************************************************************
* Selecionando dados da tabela *
* Nota : Altere a query conforme a sua base de dados *
*******************************************************************
oTable := oServer:Query('SELECT CD_REPTE, NM_REPTE, DDD_1, FONE_1, '+;
'E_MAIL, DT_PROCESSAMENTO FROM representantes ')
if oTable:NetErr()
Alert( oTable:Error() )
oServer:Destroy()
QUIT
endif
*******************************************************************
* Navegando pelos dados da tabela *
*******************************************************************
? 'NAVEGANDO'
oB := TBrowseSQL():New( 03, 01, 20, 79, oServer, oTable )
oB:SetKey( K_CTRL_V, { | oB, nkey | DefProc( oB, nKey, cTabela ) } )
do While .t.
oB:ForceStable()
if ( oB:ApplyKey( Inkey( 0 ) ) == - 1 )
exit
endif
enddo
*******************************************************************
* Fechando a conexÆo *
*******************************************************************
oTable:Destroy()
oServer:Destroy()
return
function DefProc( ob, k, ctable )
LOCAL op := ' '
LOCAL orecord
LOCAL aFDatas := Array( 6 )
LOCAL cScreen := SaveScreen()
LOCAL n
cls
SetColor( 'W/B,W/B+,W/R,B/W' )
Dispbox( 00, 00, MaxRow(), MaxCol() )
oRecord := oB:oQuery:GetBlankRow()
for n := 1 to 6
? oRecord:FieldType(n)
if oRecord:FieldType(n) = 'N'
Afill( afDatas,0,n,1 )
elseif oRecord:FieldType(n) = 'C'
Afill( afDatas,Space(oRecord:FieldLen(n)),n,1 )
elseif oRecord:FieldType(n) = 'U'
Afill( afDatas,CtoD('//'),n,1 )
endif
next
inkey(0)
@ 02,02 SAY 'CODIGO' GET afdatas[ 1 ]
@ 03,02 SAY 'NOME' GET afdatas[ 2 ]
@ 04,02 SAY 'DDD' GET afdatas[ 3 ]
@ 05,02 SAY 'TELEFONE' GET afdatas[ 4 ]
@ 06,02 SAY 'E_MAIL' GET afdatas[ 5 ]
@ 07,02 SAY 'DATA' GET afdatas[ 6 ]
READ
@ 23,02 SAY 'Salva (S/N)?' GET op PICT "!"
READ
if op == "S"
// oRecord := oB:oQuery:GetBlankRow()
for n := 1 to 5
oRecord:FieldPut( n, afdatas[ n ] )
next
oRecord:FieldPut( 6, Date() )
oTable:Append( oRecord )
if oTable:NetErr()
Alert( oTable:Error() )
endif
endif
RestScreen( ,,,, cScreen )
oTable:Refresh()
ob:RefresHall()
return( nil )
* Fim do programa