boa tarde :D
depois de algum tempo tentando, enfim consegui terminar.
o fonte que irei postar faz as seguintes tarefas
-cadastra
-lista
-exclue
tanto no bdf como no sql :))
como ja disse uma vez, eu uso o xharbour -:]
ainda tem um pequeno bug no auto incremento do codigo do cliente :'(
mas hj ainda termino de resolver isso...
//-----programa cadastra e exclui arquivos de uma tabela dbf ou sql
//*****************************************************************
#include "sqlrdd.ch"
#include "pgs.ch"
#include "hbclass.ch"
#include "inkey.ch"
#define ultimaLinha 21
REQUEST DBFCDX
REQUEST HB_CODEPAGE_UTF8EX
REQUEST SR_PGS
REQUEST SQLRDD
REQUEST SR_ODBC
//-----inicio do programa
procedure main()
escolha()
RETURN
//-----escolha do banco
procedure escolha()
LOCAL c_opc
@ 00, 00 to 03, maxcol () DOUBLE
@ 01, 02 say "SISTEMA DE CADASTRO PARA PESSOAS FISICAS"
@ 01, maxcol () -15 say "Data:"+Dtoc(date())
@ 02, maxcol () -15 SAY "Hora:"+Time()
@ 02, 02 say "cadastro de clientes"
@ 04, 00 to ultimaLinha, maxcol()
@ 22 ,0 TO 24 , maxcol()
@ 22 ,0 TO 24 , maxcol()
DO WHILE .t.
@ 10, 27 TO 14, 53 DOUBLE
@ 11, 29 PROMPT " cadastrar usando DBF! "
@ 12, 29 PROMPT " cadastrar usando SQL! "
@ 13, 29 PROMPT " sair "
MENU to c_opc
DO CASE
CASE LastKey() == K_ESC; EXIT
CASE c_opc == 1; escdbf()
CASE c_opc == 2; conSql()
CASE c_opc == 3
EXIT
ENDCASE
ENDDO
RETURN
//-----connect postgresql
PROCEDURE conSql()
public vcn
public ncnn
public connect := "SQLRDD"
public server := "192.168.56.30"
public user := "danilo"
public bank := "my_db"
public pass := "senha"
dbclosearea()
ncnn := "pgs="+server+";uid="+user+";dtb="+bank+";pwd="+pass
vcn := SR_AddConnection( CONNECT_POSTGRES, ncnn )
sel := "select cod, name, contact, dat_nas from cliente"
use (sel) alias qwerty new via connect
SR_BeginTransaction()
if vcn < 1
? "erro na conexao"
else
alert("conectado")
endif
cls
escsql()
RETURN NIL
//-----inicio do programa usando sql
procedure escsql()
LOCAL oClasse := cadastro():New()
CLS
config()
oClasse:ExecutSQL()
RETURN
//-----inicio do programa usando o dbf
procedure escdbf()
LOCAL oClasse := Cadastro():New()
CLS
config()
oClasse:Execut()
RETURN
//-----configura��es de inicializa��o
FUNCTION config()
hb_cdpSelect ( " UTF8EX " )
SET DELETE ON // EXCLUIR
SET ESCAPE ON // TECLE ESC PARA SAIR
SET DATE BRITISH // EXIBE O FORMATO DE DATA ATUAL
SET CENTURY ON // EXIBE DATA
SET delimiters on // ATIVA OS DELIMITADORES
SET delimiters to "::" // INFORMA OS DELIMITADORES
SET wrap on // ROLAGEM DO PROMPT
SET MESSAGE to ultimaLinha - 1 center // EXIBE MENSAGEM NA ULTIMA LINHA
use cadastro alias registros
index on codigo to registros
set index to registros
RETURN
//-----cria��o das classes para DBF E SQL
CREATE CLASS cadastro
VAR nOpc INIT 1
METHOD Tela()
METHOD Menu()
METHOD Inclui()
METHOD Exclui()
METHOD listar()
METHOD Execut()
METHOD incluiSQL()
METHOD listarSQL()
METHOD excluiSQL()
METHOD ExecutSQL()
ENDCLASS
//-----menu op��es
METHOD Execut() CLASS cadastro
::tela()
DO WHILE .T.
::menu()
DO CASE
CASE LastKey() == K_ESC; EXIT
CASE ::nOpc == 1; ::Inclui()
CASE ::nOpc == 2; ::listar()
CASE ::nOpc == 3; ::Exclui()
CASE ::nOpc == 4
EXIT
ENDCASE
@ 06, 30 clear to ultimaLinha -4, maxcol () -3
ENDDO
RETURN NIL
//-----tela de apresenta��o
METHOD Tela() CLASS cadastro
@ 00, 00 to 03, maxcol () DOUBLE
@ 01, 02 say "SISTEMA DE CADASTRO PARA PESSOAS FISICAS"
@ 01, maxcol () -15 say "Data:"+Dtoc(date())
@ 02, maxcol () -15 SAY "Hora:"+Time()
@ 02, 02 say "cadastro de clientes"
@ 04, 00 to ultimaLinha, maxcol ()
@ 05, 29 to ultimaLinha -3, maxcol () -1
@ 09, 02 to 18, 27 DOUBLE
@ 09, 04 say ".:CADASTRAR CLIENTES:."
@ 11, 03 prompt " Efetuar cadastro " message "preencher formulario para cadastro"
@ 13, 03 prompt " cadastros feitos " message "ver tabela com os cadastros existentes"
@ 15, 03 prompt " excluir cadastro " message "apagar clientes da tabela"
@ 17, 03 prompt " sair " message "fechar programa"
RETURN NIL
//-----op��es do menu
METHOD menu() CLASS cadastro
::tela()
@ 09, 02 to 18, 27 DOUBLE
@ 09, 04 say ".:CADASTRAR CLIENTES:."
@ 11, 03 prompt " Efetuar cadastro " message "preencher formulario para cadastro"
@ 13, 03 prompt " cadastros feitos " message "ver tabela com os cadastros existentes"
@ 15, 03 prompt " excluir cadastro " message "apagar clientes da tabela"
@ 17, 03 prompt " sair " message "fechar programa"
@ 22 ,0 TO 24 , maxcol()
Menu to ::nOpc
RETURN NIL
//-----incluindo um cliente na tabela dbf
METHOD Inclui() CLASS cadastro
local cNome := space(40)
local nTele := 0
local dDate := ctod( "//" )
local cod := 0
CLS
DbGoBottom()
cod := codigo
cod++
read
::tela()
//----formul�rio para preencher dbf
@ -1, -1 to -1, -1
@ 07, 30 SAY "Nome.......:" get cNome PICT " @S20"
@ 09 ,30 SAY "Telefone...:" get nTele PICT " @R (999) 99999-9999"
@ 11 ,30 SAY "Nascimento.:" get dDate
@ 22 ,0 TO 24 , maxcol()
read
@ -1, -1 to -1, -1
//----salvando na tabela dbf
append blank
REPLACE NOME WITH cNome, ;
CONTATO WITH nTele, ;
DATE WITH dDate, ;
CODIGO WITH cod
CLS
RETURN NIL
//-----listando os cadastros dbf
METHOD listar() class cadastro
cls
DbGoTop()
@ 00, 00 to 02, maxcol () DOUBLE
@ 01, 02 say " CADASTROS DE CLIENTES ATIVOS "
?
? "*******************************************************************************"
? "*| COD | NOME | CONTATO | DATA |*"
Do while ! eof()
? "*|",codigo,'|',nome,Contato, date, "|*"
DbSkip()
enddo
wait " "
cls
Return self
//-----excluindo arquivo da tabela dbf
METHOD Exclui() CLASS cadastro
public codCli := 0
CLS
@ -1, -1 to -1, -1
::tela()
@ 07, 30 say "digite o codigo do cliente:" get codCli
@ 22 ,0 TO 24 , maxcol()
read
if DbSeek( codCli )
DELETE
pack
alert("Registro apagado com sucesso")
else
alert("ESSE REGISTRO NAO EXISTE !" )
endif
@ -1, -1 to -1, -1
CLS
RETURN NIL
//-----menu do SQL
METHOD ExecutSQL() CLASS cadastro
::tela()
DO WHILE .T.
::menu()
DO CASE
CASE LastKey() == K_ESC; EXIT
CASE ::nOpc == 1; ::incluiSQL()
CASE ::nOpc == 2; ::listarSQL()
CASE ::nOpc == 3; ::excluiSQL()
CASE ::nOpc == 4; cls; EXIT
ENDCASE
@ 06, 30 clear to ultimaLinha -4, maxcol () -3
ENDDO
RETURN NIL
//-----cadastro usando sql
METHOD incluiSQL() class cadastro
local names := space(35)
local fonet := 0
local datef := ctod("//")
local codig := 0
::tela()
//----formul�rio para preencher sql
@ -1, -1 to -1, -1
@ 07, 30 SAY "Nome......:"get names PICT "@S20"
@ 09, 30 SAY "Telefone..:"get fonet PICT " @R (999) 99999-9999"
@ 11, 30 SAY "Nascimento:"get datef
read
@ -1, -1 to -1, -1
DbGoBottom()
codig := cod
codig := val( codig )
codig := codig++
codig := strzero( codig, 4 )
ncnn := SR_GetConnection( 1 )
SR_BeginTransaction( vcn )
pron := "insert into cliente ( cod, name, contact, dat_nas ) values" + SqlExp ( { codig, names, fonet, datef } )
ncnn:Exec( pron )
SR_CommitTransaction()
cls
RETURN
//-----listando os cadastros SQL
METHOD listarSQL() class cadastro
cls
DbGoTop()
@ 00, 00 to 02, maxcol () DOUBLE
@ 01, 02 say " CADASTROS DE CLIENTES ATIVOS "
?
? "*******************************************************************************"
? "*| COD | NOME | CONTATO | DATA |*"
Do while ! eof()
? "*|",cod,"|",name,"|",Contact,"|",dat_nas,"|*"
DbSkip()
enddo
wait " "
cls
RETURN NIL
//-----apagar cadastro SQL
METHOD excluiSQL() class cadastro
local codin
cls
::tela()
qwerty->( dbclosearea() )
ncnn := SR_GetConnection( 1 )
@ 07, 30 say "Codigo do cadastro:" get codin
read
pron := "delete from cliente where cod =" + sqlExp( codin )
ncnn:Exec( pron )
browse()
SR_CommitTransaction()
cls
RETURN
//-----função sql
FUNCTION sqlExp( xCampo )
Local cTexto
If ValType( xCampo ) == "A"
AEval( xCampo , { |X,I| xCampo[I] := If( ValType(X)=="D" .and. Empty(X), Nil , X ) } )
cTexto := "(" + SR_SqlQuotedString( xCampo , SYSTEMID_POSTGR , .T. ) + ")"
Else
cTexto := SR_SqlQuotedString( xCampo , SYSTEMID_POSTGR , .T. )
Endif
Return ( cTexto )
espero de coração poder ter ajudado
até a proxima galera fera -:]