PC Toledo

Código: Selecionar todos

//inicio do modelo de um arquivo
Campos:={{"CODIGO"   ,"C", 4,0},;
         {"MOTORISTA","C",40,0},;
         {"OPER"     ,"C",10,0}}
NewOpenFile(cDir,"CDOC0700",{{"CDOC0700","CODIGO"},{"CDOC0701","MOTORISTA"}},Campos,,aPack,.F.)
//fim 


Funções abaixo: chamadas pela NewOpenFile

Procedure NewOpenFile(nDir,cArquivo,aIndice,aCampos,cUser,cPack,lShared)
Local i:=0
Private lExecuta:=.T.,pStruct:=pIndex:=.F.
lShared:=If(lShared=Nil,.T.,lShared)
If !File(nDir+cArquivo+".DBF")
   DbCreate(nDir+cArquivo,aCampos)
   pIndex:=.T. //aindex
   If cUser#Nil .And. cUser=.T. //se for o aruqivo de cadastro de usuarios
      DbUseArea(.T.,,nDir+cArquivo,,lShared,.F.)
      DbAppend()
      //bla bla bla nos campos
      DbCommitAll()
   EndIf
   DbCloseAll()
EndIf
DbUseArea(.T.,,nDir+cArquivo,,lShared,.F.)
lExecuta:=If(Neterr(),.F.,.T.)
If(lExecuta=.T.,DbStructFile(nDir,cArquivo,aIndice,cPack,aCampos),.T.) //ESTRUTURAR, COMPACTAR, VERIFICAR, DbCloseAll()
Return .T.
//*
Procedure DbStructFile(nDir,cArquivo,aIndice,cPack,aCampos) 
Local i:=h:=0,aFieldNew:=.T.,aStrucNew:=.F.,PLinha:=Row(),PColuna:=Col(),aFileSt:=DbStruct(),aArquivo:="DB"+Right(cArquivo,6),a_RA:=a_RF:=0,a_VI:=w_VI
If aIndice#Nil
   For i = 1 To Len(aIndice) //verifica se falta indices
       w_VI:=If(!File(nDir+aIndice[i,1]+"."+wRDD),.T.,w_VI)
   Next
EndIf
If w_VI=.T.
   ShowWait(01,,"Verificando Arquivo "+cArquivo+".DBF...")
   aFieldNew:=.F. //não há estrtuturações
   For i:=1 To Len(aCampos) //VERIFICAR SO OS ERRADOS e NAO ENCONTRADOS NOVA
      For h:=1 To Len(aFileSt)
         ShowWaitProc()
         If Trim(aCampos[i,1])==Trim(aFileSt[h,1])
            aStrucNew:=If(aCampos[i,2]#aFileSt[h,2].Or.;
                          aCampos[i,3]#aFileSt[h,3].Or.;
                          aCampos[i,4]#aFileSt[h,4],.T.,aStrucNew)
            If(aStrucNew=.T.,{|| Exit},.T.)
         EndIf
      Next
      If(aStrucNew=.T.,{|| Exit},.T.)
   Next
   For i:=1 To Len(aFileSt) 
      For h:=1 To Len(aCampos)
         ShowWaitProc()
         If Trim(aFileSt[i,1])==Trim(aCampos[h,1])
            aStrucNew:=If(aFileSt[i,2]#aCampos[h,2].Or.aFileSt[i,3]#aCampos[h,3].Or.aFileSt[i,4]#aCampos[h,4],.T.,aStrucNew)
            If(aStrucNew=.T.,{|| Exit},.T.)
         EndIf
      Next
      If(aStrucNew=.T.,{|| Exit},.T.)
   Next
   CloseWindow()
   w_VI:=a_VI
EndIf
If aStrucNew=.T. //se estruturar apagar indices compactar e recriar
   Keyin:=NewAnsWer({"A Estrutura Nova Do "+cArquivo+".DBF Foi Atualizada,","Sua Atual Estrutura Esta Desatualizada,","Para Estruturar Neste Momento, A C¢pia De Seguran‡a","Dever  Estar Atualizada. Informe a Op‡Æo Desejada?"},"Aten‡Æo",01,{"&Cancelar","&Estruturar"},,1,1)
   If Keyin=2
      DbEraseIndex(nDir,lExecuta,.T.,aIndice,cPack) //APAGAR INDICES
      DbCompacFile(cArquivo,.T.,.T.) //COMPACTAR ARQUIVO
      ShowWait(,,"Estruturando Arquivo "+cArquivo+".DBF...")
      a_RA:=LastRec()
      DbCloseArea()
      FRename(nDir+cArquivo+".DBF",nDir+aArquivo+".DBF") //renomear
      DbCreate(nDir+cArquivo,aCampos)  //recriar
      DbUseArea(.T.,,nDir+cArquivo,,.F.,.F.)
      wwArquivo:=nDir+aArquivo
      Append From &wwArquivo.    //copiar 
      a_RF:=LastRec()
      pStruct:=If(Neterr().Or.a_RA#a_RF,.F.,.T.)
      CloseWindow()
   ElseIf Keyin=1
      ShowMessage(,,{"O Sistema Ser  Encerrado.","Efetue C¢pia De Seguran‡a e","Reordene Os Arquivos"+If(Keyin=2,",Utilizando a Op‡Æo COMPACTA.",".")},0)
      DbCloseAll()
      ConfigSaida()
      Break
   EndIf
   If pStruct=.T.  //se deu certo apaga
      FErase(nDir+"DB"+Right(cArquivo,6)+".DBF")
   ElseIf pStruct=.F. //se deu erro cancela
      ShowWait(,,"Cancelando Processo...")
      DbCloseAll()
      FErase(nDir+cArquivo+".DBF")
      FRename(nDir+"DB"+Right(cArquivo,6)+".DBF",nDir+cArquivo+".DBF")
      CloseWindow()
      ShowMessage(,,{"Erro Ao Efetuar Atualiza‡Æo do Arquivo",""+cArquivo+".DBF, Favor Contactar O Gerente De C.P.D.,","E Informe Este Erro. O Sistema Ser  Encerrado!"},0)
      ConfigSaida()
      Break
   EndIf
Else
   DbEraseIndex(nDir,lExecuta,aIndex,aIndice,cPack) //APAGAR INDICES
   DbCompacFile(cArquivo,cPack,aIndex) //COMPACTAR ARQUIVO
EndIf
If aIndice#Nil
   For i:=1 To Len(aIndice)
     If(!File(nDir+aIndice[i,1]+"."+wRDD),IndexFile(aIndice[i,2],nDir+aIndice[i,1]),.T.)
     aColor:=SetColor()
     SetColor("B+/N")
     ?? Chr(169)  //"ú"
     SetColor(aColor)
   Next
EndIf
Return .T.
//*
Procedure DbEraseIndex(nDir,lExecuta,aIndex,aIndice,cPack) //USAR PARA APAGAR INDICES
If lExecuta=.T..And.aIndice#Nil
   For i:=1 To Len(aIndice) //verifica se falta indices
      pIndex:=If(!File(nDir+aIndice[i,1]+"."+wRDD),.T.,pIndex)
      If(pIndex=.T.,{|| Exit},.T.)
   Next
   If aIndex=.T..And.aIndice#Nil.Or.(pIndex=.T..And.cPack=.T.)  //apaga indices PINDEX APAGA TUDO
      For i:=1 To Len(aIndice)
        If(File(nDir+aIndice[i,1]+"."+wRDD),FErase(nDir+aIndice[i,1]+"."+wRDD),.T.)
      Next
   EndIf
EndIf
Return .T.
//*
Procedure DbCompacFile(cArquivo,cPack,aIndex) //USAR
Local i:=0
If aIndex=.T..And.cPack=.T..And.LExecuta=.T..Or.(pIndex=.T..And.cPack=.T.)
   ShowWait(,,"Compactando Arquivo "+cArquivo+".DBF...")
   Pack
   CloseWindow()
EndIf
Return .T.
//*
Procedure IndexFile(Chave,Arquivo,aOd)
Local NomeArq:=Right(Arquivo,8),aRow:=Row(),aCol:=Col(),Linha:=7,Coluna:=(WPosWin[WIndWin,2]+(((WPosWin[WIndWin,4]-WPosWin[WIndWin,2])/2)-20))
Public cKey:=&Chave.
ShowWait(1,,{""},"Reordenando Arquivo "+NomeArq)
If aOd=="D"
   OrdCondSet(,,,,{|| ContaReg(Linha,Coluna)},LastRec()/100,RecNo())
   OrdCreate(Arquivo,,Chave,&("{||"+Chave+"}"))
   Index On &Chave. To (Arquivo)+"."+wRdd Eval ContaReg(Linha,Coluna) Every LastRec()/100 DESCENDING
Else
   Index On &Chave. To (Arquivo)+"."+wRdd Eval ContaReg(Linha,Coluna) Every LastRec()/100
EndIf
CloseWindow()
@ aRow,aCol Say ""
Return .T.