16 Out 2018 09:06
17 Out 2018 14:30
17 Out 2018 15:10
/*
HMG Grid PostgreSql Demo
(c) 2010 Roberto Lopez
*/
#include "hmg.ch"
#command USE <(db)> [VIA <rdd>] [ALIAS <a>] [<nw: NEW>] ;
[<ex: EXCLUSIVE>] [<sh: SHARED>] [<ro: READONLY>] ;
[CODEPAGE <cp>] [CONNECTION <nConn>] [INDEX <(index1)> [, <(indexN)>]] => ;
dbUseArea( <.nw.>, <rdd>, <(db)>, <(a)>, ;
if(<.sh.> .or. <.ex.>, !<.ex.>, NIL), <.ro.>, [<cp>], [<nConn>] ) ;
[; dbSetIndex( <(index1)> )] ;
[; dbSetIndex( <(indexN)> )]
REQUEST PGRDD
Function Main
Local cServer := '127.0.0.1'
Local cDataBase := 'data1'
Local cUser := 'postgres'
Local cPassWord := '1234'
Local nConnectionHandle := 0
nConnectionHandle := dbPGConnection( cServer + ";" + cDataBase + ";" + cUser + ";" + cPassWord )
CreateTable( cServer , cDataBase , cUser , cPassWord )
USE "SELECT * FROM test ;" ALIAS Test NEW VIA "pgrdd" CONNECTION nConnectionHandle
DEFINE WINDOW Form_1 ;
AT 0,0 ;
WIDTH 800 ;
HEIGHT 510 ;
TITLE 'Hello World!' ;
MAIN
DEFINE MAIN MENU
POPUP 'File'
ITEM 'Append (Alt+A)' ACTION Form_1.Grid_1.Append
ITEM 'Save Last Appended Record (Alt+S)' ACTION Form_1.Grid_1.Save
ITEM 'Set RecNo' ACTION Form_1.Grid_1.RecNo := val(InputBox('',''))
ITEM 'Get RecNo' ACTION MsgInfo( Str(Form_1.Grid_1.RecNo) )
ITEM 'Delete' ACTION Form_1.Grid_1.Delete
ITEM 'Recall' ACTION Form_1.Grid_1.Recall
END POPUP
END MENU
@ 10,10 GRID Grid_1 ;
WIDTH 770 ;
HEIGHT 440 ;
HEADERS { 'Code' , 'Name' , 'Salary' , 'Creation' , 'Description' } ;
WIDTHS { 100 , 120 , 120 , 120 , 120 } ;
VALUE { 1 , 1 } ;
COLUMNCONTROLS { aCtrl_1 , aCtrl_2 } ;
ROWSOURCE "Test"
END WINDOW
CENTER WINDOW Form_1
ACTIVATE WINDOW Form_1
Return
Function CreateTable ( cServer , cDataBase , cUser , cPassWord )
Local oServer, oQuery, oRow, i
Local cQuery
oServer := TPQServer():New( cServer , cDataBase , cUser , cPassWord )
if oServer:NetErr()
MsgStop ( oServer:Error() )
Exit Program
endif
if oServer:TableExists('TEST')
oQuery := oServer:Execute('DROP TABLE Test')
oQuery:Destroy()
endif
cQuery := 'CREATE TABLE test('
cQuery += ' Code integer not null primary key, '
cQuery += ' Name Varchar(40), '
cQuery += ' Salary Double Precision, '
cQuery += ' Creation Date, '
cQuery += ' Description text ) '
oQuery := oServer:Query(cQuery)
if oQuery:neterr()
MsgStop ( oQuery:Error() )
endif
oQuery:Destroy()
For i := 1 To 10
cQuery := "INSERT INTO test ( code , name , salary , creation , description ) VALUES ( " + str(i) + " , 'Name " + str(i) + " ' , " + str(i*1000) + " , '2010-01-01' , 'Some Text...' );"
oQuery := oServer:Query(cQuery)
if oQuery:neterr()
MsgStop ( 'error' )
Exit
endif
next i
oQuery:destroy()
oServer:Commit()
oServer:Destroy()
Return nil
17 Out 2018 20:08
# include "postgres.ch"
# include "inkey.ch"
# include "setcurs.ch"
PROCEDURE main ()
LOCAL conn, res, aTemp, x, y, pFile
LOCAL CDatabase: = "MANAGEMENT"
LOCAL CUser: = "postgres"
LOCAL cPass: = "Resipol01"
LOCAL CHOST: = "localhost"
LOCAL oServer
CLEAR SCREEN
nTop: = 1
nLeft: = 1
nBottom: = MAXROW ()
nRight: = MAXCOL ()
oServer: = TPQServer (): New (CHOST, CDatabase, CUser, cPass)
IF oServer: NetErr ()
? oServer: ErrorMsg ()
QUIT
ENDIF
oQuery: = oServer: Query ("SELECT * FROM proveedo WHERE cierre = '2004-02-29')
/ * this works
do whil! oQuery: Eof ()
? oQuery: recno (),;
oQuery: FIELDGET (oQuery: fieldpos ("Proveedor"));
oQuery: FIELDGET (oQuery: fieldpos ("nombre"))
oQuery: skip ()
end whil
* /
oRow: = oQuery: Blank ()
oB: = TBrowseNew (nTop + 2 + 1 nLeft, nBottom - 1, nRight - 1)
oB: skipBlock: = {| i | oQuery: Skip (i)}
for n: = 1 to oRow: FCOUNT ()
oB: addColumn (TBColumnNew (oRow: FieldName (n), {| | oRow: FieldName (n)}))
next
b: refreshAll ()
while. t.
while! ob: stabilize ()
end
while! ob: stabilize ()
end
b: applykey (key: = INKEY (0))
if key == K_ENTER. orig. K_RIGHT key ==
if oQuery: Eof ()
exit
else
if ob: COLPOS <b: colCount. and. K_ENTER key ==
b: right ()
key: = 0
else
if key! = K_RIGHT
b: down ()
end if
endif
endif
elseif key == K_ESC
inkey ()
exit
elseif key == K_CTRL_ENTER
exit
endif
end
oQuery: Destroy ()
oServer: Destroy ()
? "Closing ..."
RETURN
01 Nov 2018 17:23
//-----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 )
03 Nov 2018 16:53