Fragmentos de códigos usados aqui por mim.
Com esses exemplos podemos indexar, importar, modificar as estruturas em tempo de execução, inclusive em rede.
Itamar M. Lins Jr.
Código: Selecionar todos
#include "ord.ch"
#include "hwgui.ch"
#include "rddleto.ch"
REQUEST HB_GT_GUI_DEFAULT
REQUEST HB_GT_WIN
REQUEST DBFCDX,DBFFPT,DBFDBT,LETO
REQUEST HB_LANG_PT,HB_CODEPAGE_PTISO,HB_CODEPAGE_PT850
*---------------------------------------------------------------------------------------
Function Main
*---------------------------------------------------------------------------------------
RDDSetDefault("DBFCDX")
set autopen on
set optimize on
Chk_DBF()
Check_indices()
**********************
Function check_indices
**********************
*
*
ordena_grupos()
****************
Function chk_dbf
****************
*
*
Private DRIVER := iif(lRddLeto,'LETO','DBFCDX')
CriaStruGrupos()
***********************
Function CriaStruGrupos // Grupos
***********************
*
*
aStru := EstruturaGrupos()
If lRddLeto
Else
If !file(dDados+'grupos.dbf')
rodape(oDlg,1,'Criando Estrutura grupos.dbf')
dbcreate(dDados+'grupos.dbf',astru,DRIVER)
Else
ChecaEstrutura("grupos.dbf",astru)
EndIf
EndIf
************************
Function EstruturaGrupos
************************
*
*
Return {{'cod_grupo','c',06,0},;
{'grupo' ,'c',25,0},;
{'tipo' ,'c',01,0},;
{'diamod' ,'d',08,0},;
{'digital' ,'c',01,0},;
{"enviado" ,"l",01,0}}
**********************
Function ordena_grupos
**********************
*
If !file(dDados+"grupos.cdx")
AbreDb('grupos.dbf','gr',.f.)
nIni:=1; tReg:=gr->(RecCount())
@ 10,10 say "Criando Indices dos Grupos -- Total: "+transf(treg,'999,999,999') of oDlg size 400,30
index on cod_grupo tag gr01 to grupos.cdx eval {||oBar:Set(,Recno()),.t.}
index on grupo tag gr02 to grupos.cdx eval {||oBar:Set(,Recno()),.t.}
close gr
EndIf
*****************************
Function AbreDb(db,Apel,lMod)
*****************************
*
*
lRet := .t.
if select(apel) > 0
FechaDb(apel)
endif
if lMod
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
If lRddLeto
If Leto_File(dServidor+Db)
DbUseArea(.t.,"LETO",dServidor+DB,apel,.T.,.F.,'PTISO')
Else
MsgStop('Arquivo Não Foi Localizado: '+dServidor+Db)
lRet := .f.
EndIf
Else
DbUseArea(.t.,'DBFCDX',dDados+db,apel,.T.,.F.,'PTISO')
EndIf
//use ( dDados+Db ) New Alias apel SHARED
Recover
msginfo('Erro, abrindo Arquivo: '+dDados+Db+' Compartilhado')
lRet := .f.
End Sequence
if Neterr()
MsgInfo('Usado de Forma Exclusiva, Em Outro Lugar.')
lRet := .f.
endif
else
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
If lRddLeto
If Leto_File(dServidor+Db)
DbUseArea(.t.,"LETO",dServidor+DB,apel,.F.,.F.,'PTISO')
Else
MsgStop('Arquivo Não Foi Localizado: '+dServidor+Db)
lRet := .f.
EndIf
Else
DbUseArea(.t.,'DBFCDX',dDados+db,apel,.F.,.F.,'PTISO')
EndIf
Recover
msginfo('Erro, abrindo Arquivo: '+dDados+Db,'Exclusivo')
lRet := .f.
End Sequence
if Neterr()
MsgInfo('Arquivo Aberto, Em Outro Lugar.')
lRet := .f.
endif
EndIf
If lRet
If lRddLeto
cFileCDX := dServidor+strtran(db,"dbf","cdx")
//cFIleCDX := strtran(db,"\","/")
If Leto_file(cFileCDX)
OrdSetFocus(1) //Set Index to &cFileCDX
Else
// Msginfo('Sem Indice: '+cFileCDX)
EndIf
Else
ind := dDados+substr(db,1,at('.',db))+'cdx'
if file(ind)
set index to &ind
endif
EndIf
EndIf
Return lRet
*********************************************
Function ChecaEstrutura(cDbf,aStruAtual,dAno)
*********************************************
*
*
local lMudou := .f., barra := iif (lLinux,"/","\")
dbt := substr(cDbf,1,at(".",cDbf))+'dbt'
if dAno == Nil
else
cDbf := dAno+barra+cDbf
endif
While !AbreDb(cDbf,"dbchk",.T.) ; Enddo
aStruAnt := dbStruct()
if Len(aStruAnt) != Len(aStruAtual)
lMudou := .t.
else
for nCont := 1 to Len(aStruAtual) // Compara cada campo
for nCont2 := 1 to 4 // Compara nome, tipo, tamanho e decimais
if nCont2 <= 2
aStruAtual[nCont,nCont2] := upper(aStruAtual[nCont,nCont2])
endif
If aStruAtual[nCont,nCont2] == aStruAnt[nCont,nCont2]
Else
//MsgInfo('mudou: '+cDbf+" -- "+aStruAtual[nCont,nCont2]+" <> "+aStruAnt[nCont,nCont2])
lMudou := .t.
exit
endif
next
if lMudou // Achou diferença já encerra
exit
endif
next
endif
DbChk->(DbCloseArea())
if lMudou
cdx := substr(cDbf,1,at(".",cDbf))+'cdx'
arq := substr(cDbf,rat("\",cDbf)+1,len(cDbf) ) // )+'dbf'
//msginfo(arq)
nDir := substr(cDbf,1,rat("\",cDbf))
If lRddLeto
if len(nDir) > 0
nDir := dServidor+nDir
else
nDir := dServidor
endif
Else
if len(nDir) > 0
nDir := dDados+nDir
else
nDir := dDados
endif
EndIf
//msginfo('ndir:'+nDir)
If lRddLeto
If Leto_File(nDir+cdx)
If Leto_fErase(nDir+cdx) > 0
MsgInfo('Erro ao Apagar o Arquivo: '+nDir+CDX)
close all
cancel
EndIf
EndIf
Else
if file(nDir+cdx)
if ferase(nDir+cdx) > 0
MsgInfo('Erro ao Apagar o Arquivo cdx')
close all
cancel
endif
endif
EndIF
// rodape(oDlg,1,"Importando "+cDbf)
If lRddLeto
/*
If Leto_File(nDir+"arqvelho")
Else
MsgInfo('Pasta: '+nDir+"arqvelho não existe.")
Return .f.
EndIf
*/
Else
If hb_DirExists(nDir+"arqvelho")
Else
If (makedir(nDir+"arqvelho")==0)
Else
MsgInfo('Sem Permissão de Criar a Pasta.')
close all
cancel
Endif
EndIf
EndIf
dbCreate(nDir+"temp.dbf",aStruAtual, iif(lRddLeto,"LETO","DBFCDX") )
nTemp := nDir+"temp.dbf"
Begin Sequence
DbUseArea(.t., iif(lRddLeto,"LETO","DBFCDX") , nTemp , "dbc" ,.f.,.f.,'PTISO')
// use (nTemp) new alias dbc exclusive via iif(lRddLeto,"LETO","DBFCDX")
recover
MsgInfo('Não Abriu o Arquivo: '+nTemp)
close all
cancel
End Sequence
If lRddLeto
string := dServidor+cDbf
Else
string := dDados+cDbf
EndIf
Append from &string via iif(lRddLeto,"LETO","DBFCDX")
/*
if file(dbt)
append from &string //via 'DBFDBT'
else
append from &string //via 'DBFCDX'
endif
*/
dbc->(DbCloseArea())
//rodape(oDlg,1,barra+curdir()+barra+cDBF+","+barra+curdir()+barra+"arqvelho"+barra+cDBF,0)
If lRddLeto
if Leto_ferase(nDir+"arqvelho\"+Arq) > 0
MsgInfo('Não Apagou o Arquivo')
close all
cancel
endif
Else
if ferase(nDir+"arqvelho\"+Arq) > 0
MsgInfo('Não Apagou o Arquivo')
close all
cancel
endif
EndIf
cLocal := nDir+Arq
cNome := nDir+strtran(Arq,'dbf','old')
msginfo(cLocal+" "+cNome)
If lRddLeto
erro := Leto_fRename(cLocal,cNome)
Else
erro := FileMove(cLocal,nDir+"arqvelho"+barra+Arq)
EndIf
if erro = 0
else
msgstop("Não moveu o arquivo, erro: "+str(erro)+CrLf+"O Sistema Será Cancelado.")
close all
PostQuitMessage( 0 )
endif
if fRename(nDir+"temp.dbf",dDados+cDbf)>0
MsgInfo('Erro ao Renomear o Arquivo: '+cdbf)
close all
cancel
endif
if file(nDir+"temp.fpt")
cDbf := substr(cDbf,1,at('.',cDbf))+'fpt'
if fRename(nDir+"temp.fpt",nDir+cDbf) > 0
MsgInfo('Erro ao renomear o Arquivo: '+cdbf)
close all
cancel
endif
endif
//rodape(oDlg,1,'')
endif
//dbchk->(DbCloseArea())
return lMudou
