*****************************************************************
* SISTEMA....: INTEGRADO                                        *
* PROGRAMA...: RDBASE - ACESSO DIRETO A DBFS                    *
* CRIACAO....: 13.02.99 - JOSE                                  *
*****************************************************************

* ...
* 10.02.12 - Corrigido para mais ordens no disp stat
* 02.07.12 - Alias temporario quando nome com mais de 8 letras
* 02.07.02 - Ajuste ref funcionar goto alem de go
*----------------------------------------------------------------

* #include "jpa.ch"

Static nTempAlias := 1

Procedure RDBASE
Private CfgSetExclusive := .f.
Private CfgHistoTxt[16]
Private CfgHistNum := 50
Private CfgOdometer := 100

msginfo( "Proibido para inexperientes! Ninguem pode estar usando! Se alterar algo, reindexe! Para retornar QUIT")
*For nCont = 1 to MaxRow()
*   msginfo()
*Next
clear
*msginfo("Digite o comando seguido de ENTER, ou QUIT para sair")

@ 05,02 say [EX:  Use \caminho\arquivo     Automaticamente ele fica Preso]
@ 07,02 say [     REPLACE ALL qt_estoque WITH 0]
@ 08,02 say [     REPLACE ALL qt_estoque WITH 0    FOR qt_estoque > 90000]
@ 09,02 say [     REPLACE ALL ALIQUOTA   WITH "FF" FOR aliquota = [01]]

@ 11,02 say [     DELETE  ALL                      FOR ....    CUIDADO]
@ 12,02 say [     DELETE  ALL                            MAIS  CUIDADO]

@ 14,02 say [     LIST    STRU ou STRUC ou STRUCT                     ]
@ 15,02 say [     LIST    ALL  campo, campo, ...   FOR ....           ]

@ 17,02 say [                                                         ]

@ 19,02 say [     QUIT para Sair.  Re-Indexar as Bases...             ]

Set Exclusive off

CfgOdometer = 100
CfgHistNum = 16
Afill( CfgHistoTxt, "" )

mTexto     := ""
mTexto_ant := ""
mPulaLinha := .f.
      mTexto     := ""
Do While .t.
   if mPulaLinha
     *msginfo()
      mPulaLinha := .f.
     *mTexto     := ""
   Endif
   mTexto := mTexto_ant
   mTexto := Pad(mTexto,200)
   @ MaxRow()-3,0 Get mTexto Picture "@S"+Ltrim(Str(MaxCol()-1))
   Read

   mTexto_ant = mTexto

   mInkey := LastKey()
   Do Case
   case LastKey() == 27
      Loop
   case mInkey = 5
      if CfgHistNum > 1
         CfgHistNum = CfgHistNum - 1
         if len( trim( CfgHistoTxt[ CfgHistNum ] ) ) = 0
            CfgHistNum = CfgHistNum + 1
            ?? chr(7)
         Else
            mTexto := CfgHistoTxt[ CfgHistNum ]
         Endif
      Endif
      loop

   case mInkey = 24
      if CfgHistNum < len( CfgHistoTxt )
         CfgHistNum = CfgHistNum + 1
         mTexto := CfgHistoTxt[ CfgHistNum ]
      Endif
      loop
   case Empty(mTexto)
      loop
   EndCase
   mPulaLinha := .t.
   mTexto := Trim(mTexto)
   adel( CfgHistoTxt, 1 )
   CfgHistNum = len(CfgHistoTxt) - 1
   CfgHistoTxt[CfgHistNum] = alltrim(mTexto)
   CfgHistNum = len(CfgHistoTxt)
   CfgHistoTxt[CfgHistNum] = ""

   mTexto   := AllTrim("&mTexto")
   if file("jplogsi.dbf") .And. .Not. Empty(mTexto)
      * GravaLog("(*)"+mTexto)
   Endif

   mComando := Lower(Trim(Left(PegaParam(@mTexto," "),4)))
   if mComando+"," $ "disp,list,appe,brow,cont,copy,dele,edit,inde,loca,"+;
      "pack,reca,rein,repl,seek,sum,unlo,zap," ;
      .or. mComando = "modi" .And. "stru" $ Lower(mTexto)
      if .Not. Used()
         msginfo("Nao tem arquivo em uso!")
         loop
      Endif
   Endif
   if mComando+"," $ "pack,rein,reind,reinde,reindex,zap,"
      // if .Not. fLock()
      //    msginfo("Nao executado, arquivo nao pode ser bloqueado")
      //    loop
      // Endif
      if .Not. CfgSetExclusive
         msginfo("Nao executado, arquivo nao exclusivo")
         Loop
      Endif
   Endif
   Do Case
   case mComando == "quit"
      Exit
   case mComando == "!" .or. mComando == "run"
      tela:=SAVESCREEN(0,0,24,79)
      * DosRun(mTexto)
      ?
      @ MaxRow(), 0 Say "Tecle ESC para prosseguir"
      Do While Inkey(0) != 27
      Enddo
      RESTSCREEN(0,0,24,79,tela)
   case mComando == "?"
      RotinaPrint()
   case mComando == "go" .or. mComando == "goto" ;
      .or. (Type(mComando)=="N" .And. Empty(mTexto))
      if Lower(mTexto) == "top"
         GoTo top
      Elseif Lower(Left(mTexto,4)) == "bott"
         GoTo bottom
      Elseif Type(mTexto) != "N"
         msginfo("Parametros aceitos TOP, BOTT ou numero")
      Elseif &mTexto > LastRec() .or. &mTexto < 1
         msginfo("Registro invalido")
      Else
         GoTo &mTexto
      Endif
   case mComando == "disp" .or. mComando == "list"
      RotinaList()
   case mComando == "appe"
      RotinaAppend()
   case mComando == "brow"
      tela:=SAVESCREEN(0,0,24,79)
      mRow := Row()
      mCol := Col()
      msginfo("Selecione e tecle ENTER para alterar o campo, ESC abandona")
      Browse(2,0,MaxRow()-3,MaxCol())
      RESTSCREEN(0,0,24,79,tela)
      @ mRow, mCol Say ""
   case mComando == "clea"
      Scroll(2,0,MaxRow()-3,MaxCol(),0)
   case mComando == "clos"
      close databases
   case mComando == "cont"
      continue
      if LastKey() == 27
         msginfo("Interrompido")
      Elseif Eof()
         msginfo("Fim de arquivo")
      Endif
   case mComando == "copy"
      RotinaCopy()
   case mComando == "crea"
      RotinaCreate()
   case mComando == "dele"
      RotinaDelete()
   case mComando == "dir"
      RotinaDir(mTexto)
   case mComando == "edit"
      RotinaEdit()
   case mComando == "ejec"
      eject
   case mComando == "inde"
      if Lower(PegaParam(@mTexto," ")) != "on"
         msginfo("Erro de sintaxe")
         loop
      Endif
      mChave := AllTrim(Substr(mTexto,1,At(" to ",Lower(mTexto))-1))
      if .Not. Type(mChave) $ "NCD"
         msginfo("Chave invalida")
         loop
      Endif
      mArquivo := AllTrim(Substr(mTexto,At(" to ",Lower(mTexto))+4))
      if Len(mArquivo) == 0
         msginfo("Arquivo invalido")
         loop
      Endif
      index on &mChave tag jpa to &mArquivo
      msginfo(Str(LastRec()) + " registro(s) indexado(s)")
   case mComando == "loca"
      RotinaLocate()
   case mComando == "modi"
      RotinaModify()
   case mComando == "pack"
      pack
      msginfo(Str(LastRec()) + " registro(s) copiado(s)")
   case mComando == "reca"
      RotinaRecall(mTexto)
   case mComando == "rein"
      reindex
      msginfo(Str(LastRec()) + " registro(s) reindexado(s)")
   case mComando == "repl"
      RotinaReplace()
   case mComando == "seek"
      if Len(Trim(OrdKey())) == 0
         msginfo("Arquivo nao indexado")
      Elseif Type(mTexto) != Type(OrdKey())
         msginfo("Ordem do arquivo nao combina com chave digitada")
      Else
         seek &mTexto
         if Eof()
            msginfo("Nao encontrado")
         Endif
      Endif
   case mComando == "sele"
      if Select(mTexto) == 0
         msginfo("Area nao existe")
      Else
         select (Select(mTexto))
      Endif
   case mComando == "set"
      RotinaSet(mTexto)
   case mComando == "skip"
      if Empty(mTexto)
         skip
      Elseif Type(mTexto) != "N"
         msginfo("Nao foi informado numero")
      Elseif &mTexto < 0 .And. Bof()
         msginfo("Ja' esta' no inicio do arquivo")
      Elseif &mTexto > 0 .And. Eof()
         msginfo("Ja' esta' no fim do arquivo")
      Else
         skip &mTexto
      Endif
   case mComando == "sum"
      RotinaSum()
   case mComando == "unlo"
      if mTexto == "all"
         unlock all
      Else
         unlock
      Endif
   case mComando == "use"
      RotinaUse()
   case mComando == "zap"
      zap
      msginfo("Arquivo foi limpo")
   case mComando == "stor"
      RotinaStore()
   case Left(mTexto,1) == "="
      mTexto := Substr(mTexto,2) + " to " + mComando
      RotinaStore()
   otherwise
      msginfo("Comando invalido")
   EndCase
   dbCommitAll()
Enddo
close databases
set unique    off
set Exclusive off
set deleted   on
set confirm   on
msginfo( "Se voce alterou algo, e' obrigatoria a reindexacao!")
Return
*----------------------------------------------------------------

// Separa parametros do comando

function PegaParam(mTexto,mTipo,mLista)

private mParametro, mTemp, mContini, mContfim

mTexto = AllTrim(mTexto)

Do Case
case mTipo == " "  .or. mTipo == ","
   mParametro = substr( mTexto, 1, at( mTipo, mTexto + mTipo ) - 1 )
   mTexto = substr( mTexto, at( mTipo, mTexto + mTipo ) + 1 )
   mParametro = AllTrim(mParametro)
   mTexto = AllTrim(mTexto)
   Return mParametro

case mTipo == "alias"
   mTexto = " " + mTexto + " "
   mContini = at( " alias ", mTexto )
   if mContini = 0
      Return ""
   Endif
   mContfim = mContini + 7
   Do While substr( mTexto, mContfim, 1 ) == " " ;
      .And. mContfim < len( mTexto )
      mContfim = mContfim + 1
   Enddo
   mParametro = AllTrim(PegaParam(substr(mTexto,mContfim)," "))
   mTexto = substr( mTexto, 1, mContini ) + ;
             substr( mTexto, mContfim + len( mParametro ) + 1 )
   mTexto = AllTrim(mTexto)
   Return mParametro

case mTipo == "set"
   mParametro = ""
   if Lower( mTexto ) == "on"
      mParametro = .t.
   Elseif Lower( mTexto ) == "off"
      mParametro = .f.
   Elseif Type( mTexto ) == "L"
      mParametro = &mTexto
   Endif
   Return mParametro

case mTipo == "par,"
   mParametro = 0
   Do While len( mTexto ) > 0
      mTemp = ""
      Do While len( mTexto ) > 0
         mContini = at( ",", mTexto + "," )
         mTemp    = mTemp + substr( mTexto, 1, mContini - 1 )
         mTexto   = substr( mTexto, mContini + 1 )
         if Type(mTemp) $ "NCDLM"
            Exit
         Endif
         mTemp = mTemp + ","
      Enddo
      mParametro = mParametro + 1
      mLista[ mParametro ] = mTemp
   Enddo
   Return mParametro

case mTipo == "escopo"

// localiza posicao de escopos e condicoes

   for mCont = 1 to 5
      Do Case
      case mCont = 1
         mTipo = "all"
      case mCont = 2
         mTipo = "next"
      case mCont = 3
         mTipo = "record"
      case mCont = 4
         mTipo = "for"
      case mCont = 5
         mTipo = "while"
      EndCase
      mTexto = " " + mTexto + " "
      Declare m_Posi[ 6 ]
      mContfor  = at( " for ", Lower( mTexto ) )
      mContwhil = at( " while ", Lower( mTexto ) )
      if mContwhil = 0
         mContwhil = at( " whil ", Lower( mTexto ) )
      Endif
      mContall  = at( " all ",  Lower( mTexto ) )
      mContnext = at( " next ", Lower( mTexto ) )
      mContReco = at( " record ", Lower( mTexto ) )
      if mContReco = 0
         mContReco = at( " recor ", Lower( mTexto ) )
         if mContReco = 0
            mContReco = at( " reco ", Lower( mTexto ) )
         Endif
      Endif
      m_Posi[ 1 ] = mContall
      m_Posi[ 2 ] = mContnext
      m_Posi[ 3 ] = mContReco
      m_Posi[ 4 ] = len( mTexto )
      m_Posi[ 5 ] = mContfor
      m_Posi[ 6 ] = mContwhil
      asort( m_Posi )

// retira parametro all

      Do Case
      case mTipo = "all" .And. mContall != 0
         m_all    = .t.
         m_Inicio = ascan( m_Posi, mContall )
         m_Final  = m_Posi[ m_Inicio + 1 ]
         mTexto  = stuff( mTexto, mContall, 4, "" )

// retira e valida parametro next

      case mTipo == "next" .And. mContnext != 0
         m_Inicio = ascan( m_Posi, mContnext )
         m_Final  = m_Posi[ m_Inicio + 1 ]
         m_Next   = substr( mTexto, mContnext+1, m_Final - mContnext )
         mTexto  = stuff( mTexto, mContnext, m_Final - mContnext, "" )
         m_Next   = substr( m_Next, at( " ", m_Next ) )
         m_all    = .f.
         if Type( m_Next ) != "N"
            msginfo("NEXT invalido")
            Return .f.
         Endif
         if &m_Next < 0
            msginfo("NEXT invalido")
            Return .f.
         Endif
         m_Next = &m_Next

// retira e valida parametro record

      case mTipo=="record" .And. mContReco != 0
         m_Inicio = ascan( m_Posi, mContReco )
         m_Final  = m_Posi[ m_Inicio + 1 ]
         m_Record = substr( mTexto, mContReco+1, m_Final - mContReco )
         mTexto  = stuff( mTexto, mContReco, m_Final - mContReco, "" )
         m_Record = substr( m_Record, at( " ", m_Record ) )
         if Type( m_Record ) != "N"
            msginfo("RECORD invalido")
            Return .f.
         Endif
         m_Record = &m_Record
         if m_Record < 1 .or. m_Record > lastrec()
            msginfo("Registro indicado nao existe")
            Return .f.
         Endif

// retira e valida parametro for

      case mTipo=="for" .And. mContfor != 0
         m_Inicio = ascan( m_Posi, mContfor )
         m_Final  = m_Posi[ m_Inicio + 1 ]
         m_For    = substr( mTexto, mContfor+1, m_Final - mContfor )
         mTexto  = stuff( mTexto, mContfor, m_Final - mContfor, "" )
         m_For    = substr( m_For, at( " ", m_For ) )
         m_all    = .t.
         if Type( m_For ) != "L"
            msginfo("FOR invalido")
            Return .f.
         Endif

// retira e valida parametro while

      case mTipo=="while" .And. mContwhil != 0
         m_Inicio = ascan( m_Posi, mContwhil )
         m_Final  = m_Posi[ m_Inicio + 1 ]
         m_while  = substr( mTexto, mContwhil+1, m_Final - mContwhil )
         mTexto  = stuff( mTexto, mContwhil, m_Final - mContwhil, "" )
         m_while  = substr( m_while, at( " ", m_while ) )
         m_all    = .f.
         if Type( m_while ) != "L"
            msginfo("WHILE invalido")
            Return .f.
         Endif
      EndCase
      mTexto = alltrim( mTexto )
   next
   mParametro = .t.

case mTipo == "to"
   mTexto = " " + mTexto + " "
   mParametro = ""
   if " to " $ Lower( mTexto )
      mParametro = AllTrim(Lower( substr( mTexto, at( " to ", Lower( mTexto ) ) + 4 ) ))
      if mParametro == "prin"
         mParametro = "print"
      Endif
      mTexto = AllTrim(substr( mTexto, 1, at( " to ", Lower( mTexto ) ) - 1 ))
   Endif

case mTipo == "structure" .or. mTipo == "status" ;
     .or. mTipo == "Exclusive" .or. mTipo == "index" ;
     .or. mTipo == "sdf" .or. mTipo == "extended"

   mTexto = " " + mTexto + " "
   mParametro = .f.
   for mCont = 4 to 9
      m_procu = " " + substr( mTipo, 1, mCont ) + " "
      if m_procu $ Lower( mTexto )
         mParametro = .t.
         mTexto = stuff( mTexto, at( m_procu, ;
                   Lower( mTexto ) ), len( m_procu ) - 1, "" )
      Endif
   next
   mTexto = alltrim( mTexto )

otherwise
   clear
   msginfo("Erro de sintaxe")
   cancel
EndCase
mTexto := AllTrim(mTexto)
Return mParametro
*----------------------------------------------------------------

// Valida parametro conforme o uso

Static Function Param_ok
Parameters mTexto, mTipo
Local nCont

Do Case
case mTipo == "alias"
   if len( mTexto ) = 1  .or. val( mTexto ) # 0
      Return .f.
   Endif
   For nCont = 1 To Len( mTexto )
      if .Not. Lower( Substr( mTexto, nCont, 1 ) ) $ ;
               "abcdefghijklmnopqrstuvwxyz_0123456789"
         Return .f.
      Endif
   Next
   Return .t.

EndCase
Return .f.
*----------------------------------------------------------------

Static Function RotinaDelete()

m_all    = .f.
m_Record = 0
m_Next   = 0
m_For    = ".t."
m_while  = ".t."
if .Not. PegaParam( @mTexto, "escopo" )
   Return
Endif

if len( mTexto ) != 0
   msginfo("Invalido " + mTexto)
   Return
Endif

if m_Record=0 .And. m_Next=0 .And. m_For == ".t." ;
              .And. m_while == ".t." .And. .Not. m_all
   m_Record = recno()
Endif

// executa comando

Do Case
case m_all
   GoTo top
case m_Record != 0
   GoTo m_Record
EndCase

m_Contreg = 0
m_Contdel = 0
mInkey   = 0
*msginfo("Delete")
Do While mInkey != 27 .And. .Not. Eof()
   mInkey = Inkey()
   if .Not. &m_while
      Exit
   Endif
   m_Contreg = m_Contreg + 1
   if &m_For
      * exclui(.t.)
               *msginfo("COLOCAR PARA EXCLUIR")
      m_Contdel = m_Contdel + 1
      if mod( m_Contdel, CfgOdometer ) = 0
         @ MaxRow()-3, 0 Say str(m_Contdel) + " registro(s) deletado(s)"
      Endif
   Endif
   if m_Record != 0
      Exit
   Endif
   skip
   if m_Contreg = m_Next
      Exit
   Endif
Enddo
@ MaxRow()-3, 0 Say str(m_Contdel)+ " registro(s) deletado(s)"
if LastKey() = 27
   msginfo("Interrompido")
Endif
Return NIL
*----------------------------------------------------------------

Static Function RotinaEdit()

if len( mTexto ) != 0
   if Type( mTexto ) != "N"
      msginfo("So' pode ser numero")
      Return
   Endif
   if &mTexto < 1 .or. &mTexto > LastRec()
      msginfo("Numero de registro invalido")
      Return
   Endif
   GoTo &mTexto
Endif

// edita registro

m_inclui = Eof()
m_fCount = fCount()
mPageRec := MaxRow()-6
m_QtTela = int( ( m_fCount + mPageRec - 1 ) / mPageRec)
Declare m_Name[ m_fCount ], m_Type[ m_fcount ], ;
        m_Len[  m_fCount ], m_Dec[  m_fcount ], ;
        m_Pic[  m_fCount ], m_Read[ m_fcount ]

afields( m_name, m_type, m_len, m_dec )

Do While .t.
   if .Not. m_inclui
      if .Not. rLock()
         msginfo("Nao foi possivel travar o registro")
         Return
      Endif
   Endif
   for m_Cont = 1 to m_fcount
       m_Conteudo       = m_name[ m_Cont ]
       m_read[ m_Cont ] = &m_Conteudo
       m_pic[ m_Cont ]  = ""
       if Type( m_Conteudo ) = "C"
          m_pic[ m_Cont ] = iif( len( &m_Conteudo ) > (MaxCol()-25), "@S"+Ltrim(Str(MaxCol()-25)), "@X" )
       Endif
   next
   m_grava = .f.
   m_tela  = 1
   Do While .t.
      Scroll(2,0,MaxRow()-3,MaxCol(),0)
      m_ini = m_tela * mPageRec - mPageRec + 1
      m_fim = iif( m_tela = m_qttela, m_fcount, m_ini + mPageRec - 1 )
      @ 2,1 Say iif( m_inclui .or. Eof(), "INCLUSAO ", "ALTERACAO" ) + ;
                " - Registro.: " + STR( RecNo() ) + ;
                "   " + iif( deleted(),"(EXCLUIDO)","")
      For m_Cont = m_ini To m_fim
          @ m_Cont + 3 - m_ini, 1 Say Pad( m_name[ m_Cont ],18,".") + ": " ;
                   Get m_read[ m_Cont ] Picture ( m_pic[ m_Cont ] )
      Next
      Read
      m_grava = iif( updated(), .t., m_grava )
      Do Case
      case LastKey() = 27
         Exit
      case LastKey() = 18 // .or. (LastKey()==5 .And. Pad(ReadVar(),10) == Pad(GetList[1,2],10))
         m_tela = m_tela - 1
      case LastKey() = 23
         m_grava = .t.
         Exit
      otherwise
         m_tela = m_tela + 1
      EndCase
      if m_tela < 1 .or. m_tela > m_qttela
         Exit
      Endif
   Enddo
   if LastKey() != 27 .And. m_grava
      if m_inclui .or. Eof()
         append blank
         Do While NetErr()
            Inkey(.2)
            append blank
         Enddo
      Endif
      for m_Cont = 1 to m_fcount
         m_campo = m_name[ m_Cont ]
         replace &m_campo with m_read[ m_Cont ]
      next
   Endif
   Do Case
   case LastKey()=27 .or. LastKey()=23
      Exit
   case LastKey()=18
      if .Not. bof()
         skip -1
      Endif
      if bof()
         Exit
      Endif
      if m_inclui
         m_inclui = .f.
      Endif
   otherwise
      if .Not. Eof()
         skip
      Endif
      if Eof() .And. .Not. m_inclui
         m_inclui = .t.
      Endif
   EndCase
Enddo
Return NIL
*----------------------------------------------------------------

Static Function RotinaList()
parameters m_All

m_toname  = PegaParam( @mTexto, "to" )
m_status  = PegaParam( @mTexto, "status" )
m_struct  = PegaParam( @mTexto, "structure" )

m_Cont = 0 + iif( m_status, 1, 0 ) + iif( m_struct, 1, 0 ) + ;
             iif( len( mTexto )=0, 0, 1 )

if m_Cont > 1
   msginfo("Parametros invalidos")
   Return NIL
Endif

Do Case
case m_status
   RotinaListStatus()
case m_struct
   RotinaListStructure()
otherwise
   RotinaListData()
EndCase

if LastKey() = 27
   msginfo("Interrompido")
Endif
Return NIL
*----------------------------------------------------------------

Static Function RotinaListStatus()

m_select = select()
for m_Cont = 1 to 255
   if len( trim( alias( m_Cont ) ) ) != 0
      select ( m_Cont )
      msginfo("Lists Stru Inicio")
      msginfo("Area " + Str(m_Cont,2) + " -> " + Alias() + ;
         iif( m_Cont == m_Select, "  ==> Area Atual", "" ))
      For m_Cont2 = 1 To 100
         if len( trim( OrdKey(m_Cont2 ) ) ) == 0
            Exit
         Endif
         msginfo("   Tag "+OrdName(m_Cont2)+ " -> " + OrdKey(m_Cont2))
      Next
      if len( trim( dbfilter() ) ) != 0
         msginfo("          Filtro: ", dbfilter())
      Endif
      if len( trim( dbrelation() ) ) != 0
         msginfo("          Relacao: " + dbRelation() + ;
            " Area: " + Alias(dbRSelect()) )
      Endif
   Endif
next
select ( m_select )
* msginfo("Diretorio atual -> " + DirPath() )
msginfo("Diretorio atual -> " + curdir() )
msginfo("Lists Stru Final")
Return NIL
*----------------------------------------------------------------

Static Function RotinaListStructure()

m_fcount = fcount()
declare m_nome[ m_fcount ], m_tipo[ m_fcount ], ;
        m_tam[ m_fcount ], m_dec[ m_fcount ]

afields( m_nome, m_tipo, m_tam, m_dec )


  a = ppath + [\] +alltrim(pusuario) + '.txt'
  set device to printer
  set printer to &a

*msginfo("Nome do arquivo.: " + Alias())
 @ prow()+2,01   say "Nome do arquivo.: " + Alias()

*msginfo("Qtde. Registros.: " + lTrim(Str(LastRec())))
 @ prow()+2,01   say "Qtde. Registros.: " + lTrim(Str(LastRec()))

*msginfo()
*msginfo("Seq  ---Nome---  Tipo  Tamanho  Decimais")
 @ prow()+2,01   say "Seq  ---Nome---  Tipo  Tamanho  Decimais"
*msginfo()
m_lin = 5
for m_Cont = 1 to m_fcount
  *msginfo( Str(m_Cont,3) + "  " + pad( m_nome[ m_Cont ], 14 ) + ;
  *  m_tipo[ m_Cont ] + "      " + str( m_tam[ m_Cont ], 3 ) + ;
  *  "      " + str( m_dec[ m_Cont ], 3 ) )

  @ prow()+1,01   say Str(m_Cont,3) + "  " + pad( m_nome[ m_Cont ], 14 ) + m_tipo[ m_Cont ] + "      " + str( m_tam[ m_Cont ], 3 ) + "      " + str( m_dec[ m_Cont ], 3 )

   m_lin = m_lin + 1
   if m_lin > (MaxRow()-8) .And. Len(Trim(m_toname)) == 0
     *msginfo("Tecle algo para prosseguir")
     *Inkey(0)
      if LastKey() == 27
         Exit
      Endif
      m_lin = 0
   Endif
next
if LastKey() != 27
  *msginfo()
  *msginfo("Tamanho total do registro.: " + str( recsize() ) + " bytes")
   @ prow()+2,01   say "Tamanho total do registro.: " + str( recsize() ) + " bytes"
  *msginfo()
Endif


  set device to screen
  do ugaprt


Return NIL
*----------------------------------------------------------------

Static Function RotinaListData()

m_all    = .f.
m_Record = 0
m_Next   = 0
m_For    = ".t."
m_while  = ".t."

mTexto = " " + mTexto + " "

if " all " $ Lower( mTexto )
   mTexto = stuff( mTexto, at( " all ", mTexto ), 4, "" )
   m_all   = .t.
Endif

if mComando == "list"
   m_all = .t.
Endif

if .Not. PegaParam( @mTexto, "escopo" )
   Return
Endif

if m_Record=0 .And. m_Next=0 .And. m_For == ".t." ;
              .And. m_while == ".t."
   if .Not. m_all
      m_Record = recno()
   Else
      m_all    = .t.
   Endif
Endif

// prepara lista dos dados

mTexto = alltrim( mTexto )
declare m_lista[ 100 ]
if len( mTexto ) = 0
   afields( m_lista )
   m_qtparam = fcount()
Else
   m_qtparam = PegaParam( mTexto, "par,", @m_lista )
Endif

// lista do indicado

Do Case
case m_all
   GoTo top
case m_Record != 0
   GoTo m_Record
EndCase

m_Contreg = 0
m_Contdis = 0
mInkey   = 0

  a = ppath + [\] +alltrim(pusuario) + '.txt'
  set device to printer
  set printer to &a

Do While mInkey != 27 .And. .Not. Eof()
   mInkey = Inkey()
   if .Not. &m_while
      Exit
   Endif
   m_Contreg = m_Contreg + 1
   mTexto := ""
   if &m_For
      mTexto := mTexto + Str(RecNo(),6) + " " + ;
         iif( Deleted(), "del", "   ") + " "
      for m_Cont = 1 to m_qtparam
         m_item = m_lista[ m_Cont ]
         if .Not. Type( m_item ) $ "NCLDM"
            if right( m_item, 1 ) == ","
               m_item = substr( m_item, 1, len( m_item ) - 1 )
            Endif
            msginfo("Variavel nao encontrada")
            Return
         Endif
         Do Case
         case Type( m_item ) $ "CLDN"
            mTexto += Transform(&m_Item,"")
         case Type( m_item ) = "M"
            mTexto += "memo"
         EndCase
         if m_Cont != m_qtparam
            mTexto += " "
         Endif
      next
      mTexto := Trim(mTexto)
      Do While Len(mTexto) != 0
        *msginfo("aqui "+Left(mTexto,MaxCol()+1))
         @ prow()+1,01   say Left(mTexto,MaxCol()+1)
         mTexto := Substr(mTexto,MaxCol()+2)
      Enddo
      m_Contdis = m_Contdis + 1
   Endif
   if m_Record != 0
      Exit
   Endif
   skip
   if m_Contreg = m_Next
      Exit
   Endif
Enddo

  set device to screen
  do ugaprt

Return NIL
*----------------------------------------------------------------

Static Function RotinaModify()

m_tipo   = Lower( PegaParam( @mTexto, " " ) )

Do Case
case empty( m_tipo )
   msginfo("Faltou parametros")

case len( m_tipo ) < 4
   msginfo("parametro invalido")

case Lower( m_tipo ) == substr( "structure", 1, len( m_tipo ) )
   do RotinaModifyStructure with mTexto

case Lower( m_tipo ) == substr( "command", 1, len( m_tipo ) )
   do RotinaModifyCommand with mTexto

otherwise
   msginfo("parametro invalido")

EndCase
Return NIL
*----------------------------------------------------------------

Static Function RotinaModifyCommand(cFileName)

if len( trim( cFileName) ) = 0
   msginfo("faltou o nome do programa")
   Return
Endif

if .Not. "." $ cFileName
   cFileName = cFileName + ".pro"
Endif

tela:=SAVESCREEN(0,0,24,79)
RotinaEditAFile(cFileName)
RESTSCREEN(0,0,24,79,tela)
msginfo("ModifyCommand")
Return NIL
*----------------------------------------------------------------

Static Function RotinaEditAFile(cFileName)

if Type( "cFileName" ) != "C"
   cFileName = "none"
Endif

store .f. to altered
store 0   to ret_val
cTexto := memoread(cFileName)

clear
@ 1, 0 to MaxRow()-1, MaxCol()

@ MaxRow(), 0 Say Pad(Lower(cFileName),54)

cTexto = memoedit(cTexto,2,1,MaxRow()-2,MaxCol()-1,.t.,"mfunc",132,3)

if .Not. cFileName=="none" .And. .Not. Empty(cTexto) .And. ret_val==23
   altered = .F.

   * DosRun( "copy " + cFileName + " *.bak > nul" )

   memowrit( cFileName, cTexto)

Endif

Return NIL
*----------------------------------------------------------------

****
*       mfunc()
*
*       memoedit user function
****
function mfunc

parameters mode, line, col
private keypress

ret_val = 0

Do Case

case mode = 3

case mode = 0
   * idle
   @ MaxRow(), MaxCol()-20 Say "line: " + pad( ltrim( str( line ) ), 4 )
   @ MaxRow(), MaxCol()-8 Say "col: "  + pad( ltrim( str( col ) ), 3 )

otherwise
   * keystroke exception
   keypress = LastKey()

   * save values to possibly resume edit
   line_num = line
   col_num  = col
   rel_row  = row() - 2
   rel_col  = col() - 1

   if mode = 2
      altered = .t.

   Endif

   Do Case

   case keypress = 23
      * ctr-w..write file
      if .Not. altered
         * no changes to write
         @ MaxRow(), 0 Say pad( "nenhuma alteracao a gravar.", 54 )

      Else
         * write and resume
         @ MaxRow(), 0 Say space( 54 )
         @ MaxRow(), 0 Say "gravando " + Lower( memofile ) + "..."
         ret_val = 23

      Endif

   case keypress = 27
      * esc..Exit
      if .Not. altered
         * no change
         ret_val = 27

      Else
         * changes have been made to memo
         Response := msginfo("Abandona?",{"S","N","G"})
         Do Case
         case response = 1
            * abort
            ret_val = 27

         case response = 2
            * ignore
            ret_val = 32

         case response = 3
            * save and Exit
            msginfo("gravando " + Lower( memofile ) + "...")
            ret_val = 23

         EndCase
      Endif

   EndCase
EndCase
Return ret_val
*----------------------------------------------------------------

Function RotinaCreate()

if Empty(mTexto)
   msginfo("Parametros invalidos")
   Return NIL
Endif

if " from " $ Lower( " " + mTexto + " " )
   m_Posi  = at( " from ", Lower( " " + mTexto + " " ) )
   m_from  = substr( mTexto, m_Posi + 5 )
   mTexto = substr( mTexto, 1, m_Posi - 1 )
   if mTexto == ""
      msginfo("Faltou o nome do arquivo")
      Return
   Endif
   if .Not. "." $ m_from
      m_from = m_from + ".dbf"
   Endif
   if .Not. file( m_from )
      msginfo("Arquivo de origem nao existe")
      Return
   Endif
   if .Not. "." $ mTexto
      mTexto = mTexto + ".dbf"
   Endif
   if file( mTexto )
      if .Not. msginfo("Arquivo ja existe, sobrepor?",{"Sim","Nao"})=1
         Return
      Endif
   Endif
   create ( mTexto ) from ( m_from )
   Return NIL
Endif

if .Not. "." $ mTexto
   mTexto = mTexto + ".dbf"
Endif

if file( mTexto + ".dbf" )
   if .Not. msginfo("Arquivo ja existe, sobrepor?",{"Sim","Nao"})=1
      Return NIL
   Endif
Endif

RotinaModifyStructure(mTexto)
Return NIL
*----------------------------------------------------------------

Static Function RotinaSum()

// valida parametros

m_to     = PegaParam( @mTexto, "to" )
m_all    = .f.
m_Record = 0
m_Next   = 0
m_For    = ".t."
m_while  = ".t."

if .Not. PegaParam( @mTexto, "escopo" )
   Return NIL
Endif

if m_Record=0 .And. m_Next=0 .And. m_For == ".t." ;
              .And. m_while == ".t." .And. .Not. m_all
   m_Record = recno()
Endif

declare m_lista[ 100 ], m_soma[ 100 ], m_vari[ 100 ]
afill( m_soma, 0  )

m_qtparam = PegaParam( @mTexto, "par,", @m_lista )
m_qtvar   = PegaParam( @m_to,    "par,", @m_vari  )

if m_qtvar != 0 .And. m_qtvar != m_qtparam .or. len( mTexto ) != 0
   msginfo("Parametros invalidos")
   Return NIL
Endif

for m_Cont = 1 to m_qtparam
   m_item = m_lista[ m_Cont ]
   if Type( m_item ) != "N"
      msginfo("Campo nao numerico")
      Return NIL
   Endif
next

// executa comando

Do Case
case m_all
   GoTo top
case m_Record != 0
   GoTo m_Record
EndCase

m_Contreg = 0
m_Contsum = 0
mInkey   = 0
msginfo("Sum")
Do While mInkey != 27 .And. .Not. Eof()
   mInkey = Inkey()
   if .Not. &m_while
      Exit
   Endif
   m_Contreg = m_Contreg + 1
   if &m_For
      for m_Cont = 1 to m_qtparam
         m_item = m_lista[ m_Cont ]
         m_soma[ m_Cont ] = m_soma[ m_Cont ] + &m_item
      next
      m_Contsum = m_Contsum + 1
         if mod( m_Contsum, CfgOdometer ) = 0
            @ MaxRow()-3, 0 Say str(m_Contsum) + " registro(s) somado(s)"
         Endif
   Endif
   if m_Record != 0
      Exit
   Endif
   skip
   if m_Contreg = m_Next
      Exit
   Endif
Enddo
@ MaxRow()-3, 0 Say str(m_Contsum)+" registro(s) somado(s)"
mTexto := ""
for m_Cont = 1 to m_qtparam
   mTexto += Str( m_soma[m_Cont] ) + " "
next
msginfo(mTexto)
if LastKey() = 27
   msginfo("Interrompido")
Endif
Return NIL
*----------------------------------------------------------------

Static Function RotinaSetRelation(cComando)
Local lAdditive := .f., cTrecho := "", cRelationTo := "", cRelationInto := "", nSelect := 0
Local nCont := 0, nQtRelation := 0
Local cOrdKeyFromType := cOrdKeyToType := ""

cTrecho := PegaParam(cComando," ")
if Lower(cTrecho) == substr( "additive", 1, Max( Len( cTrecho ), 4 ) )
   lAdditive = .t.
   cTrecho := PegaParam(@cComando," ")
Endif

if .Not. lAdditive
   Set Relation To
Endif

if Empty(cComando)
   Return NIL
Endif

if .Not. " into " $ Lower(cComando)
   msginfo("Parametros invalidos")
   Return NIL
Endif

// retira parametros to, into

Declare acRelationTo[8],acRelationInto[8]
afill( acRelationTo, "" )
afill( acRelationInto, "" )
nQtRelation := 0
Do While Len(cComando) != 0 .And. nQtRelation < 8
   nQtRelation += 1
   acRelationTo[ nQtRelation ]   = substr( cComando, 1, at( " into ", Lower( cComando) )-1 )
   acRelationInto[ nQtRelation ] = substr( cComando, at( " into ", Lower( cComando ) ) + 6 )
Enddo

// valida relacoes, valida alias e executa

if .Not. lAdditive
   set relation to
Endif

For nCont = 1 to nQtRelation - 1

   cRelationInto := acRelationInto[nCont]
   cRelationTo   := acRelationTo[nCont]

   if Type( cRelationInto ) = "N"
      if Alias(cRelationInto) = 0
         msginfo("Area nao esta' em uso " + cRelationInto)
         Return NIL
      Endif
   Elseif Select(cRelationInto) = 0
      msginfo("Area nao esta' em uso " + cRelationInto)
      Return NIL
   Endif
   nSelect := Select()
   select (Select(cRelationInto))
   If Empty( OrdKey() )
      if cRelationTo != "recno()"
         Select (nSelect)
         msginfo("Sem indice nao pode ser feito este relacionamento")
         Return NIL
      Endif
   Else
      cOrdKeyFromType := Type(OrdKey(IndexOrd()))
      Select (nSelect)
      cOrdKeyToType := Type(cRelationTo)
      if cOrdKeyFromType != cOrdKeyToType
         Select (nSelect)
         msginfo("Tipo da chave "+cOrdKeyToType+", tipo indicado "+cOrdKeyFromType)
         Return NIL
      Endif
   Endif
   Select (nSelect)
   Set Relation Additive To &(cRelationTo) into &(cRelationInto)

Next
Return NIL
*----------------------------------------------------------------

Static Function RotinaStore()

if .Not. " to " $ Lower( mTexto )
   msginfo("Faltou TO")
   Return NIL
Endif

m_nomvar = PegaParam( @mTexto, "to" )
m_Conte  = mTexto

if .Not. Type( m_Conte ) $ "NCLD"
   msginfo("Conteudo invalido")
   Return NIL
Endif

//declare m_lista[ 100 ]
//m_qtparam = PegaParam( @mTexto, "par,", @m_lista )
//
//for m_Cont = 1 to m_qtparam
//   m_nomevar  = m_lista[ m_Cont ]
   &m_nomvar = &m_Conte
//next
Return NIL
*----------------------------------------------------------------

Static Function RotinaAppend()

if Empty(mTexto)
   GoTo bottom
   skip
   RotinaEdit("append")
   Return NIL
Endif

// verifica se e' append blank

if Lower( mTexto ) == "blan" .or. Lower( mTexto ) == "blank"
   append blank
   Do While NetErr()
      Inkey(.2)
      append blank
   Enddo
   Return NIL
Endif

// valida append from

if Lower(PegaParam( @mTexto, " " )) != "from"
   msginfo("Parametro invalido")
   Return NIL
Endif

// parametros default

m_For    = ".t."
m_while  = ".t."
m_sdf    = .f.
m_all    = .f.
m_Record = 0
m_Next   = 0

// valida para append sdf

m_sdf      = PegaParam( @mTexto, "sdf" )

m_filename = PegaParam( @mTexto, " " )

if .Not. "." $ m_filename
   m_filename = m_filename + iif( m_sdf, ".txt", ".dbf" )
Endif

if .Not. file( m_filename )
   msginfo("Arquivo nao existe")
   Return NIL
Endif

if select( m_filename ) != 0
   msginfo("Arquivo esta' em uso")
   Return NIL
Endif

if .Not. PegaParam( @mTexto, "escopo" )
   Return NIL
Endif

if len( mTexto ) != 0 .or. m_Record != 0 .or. m_Next != 0 .or. m_While != ".t."
   msginfo("Parametros invalidos para APPEND")
   Return NIL
Endif

// executa comando

mQtRec := LastRec()
if m_sdf
   append from &m_filename for &m_For while ( Inkey()!=27 ) sdf
Else
   append from &m_filename for &m_For while ( INKEY()!=27 )
Endif
msginfo(Ltrim(Str(LastRec()-mQtRec))+" Registro(s) incluso(s)")
Return NIL
*----------------------------------------------------------------

Static Function RotinaCopy()

// valida parametros

m_all    = .f.
m_Record = 0
m_Next   = 0
m_For    = ".t."
m_while  = ".t."
m_struct = PegaParam( @mTexto, "structure" )
m_extend = PegaParam( @mTexto, "extended" )
m_sdf    = PegaParam( @mTexto, "sdf" )
m_To     = PegaParam( @mTexto,"to")
if .Not. PegaParam( @mTexto, "escopo" )
   Return NIL
Endif
if len( mTexto ) != 0
   msginfo("Parametro invalido " + mTexto)
   Return NIL
Endif
if len( m_to ) = 0
   msginfo("Faltou o arquivo destino")
   Return NIL
Endif
if m_Next == 0 .And. m_Record == 0
   m_Next := LastRec()
Endif

if .Not. "." $ m_to
   m_to = m_to + ".dbf"
Endif

if file( m_to )
   if .Not. msginfo("Arquivo ja existe, sobrepor?",{"Sim","Nao"})=1
      msginfo("Operacao cancelada")
      Return NIL
   Endif
Endif

Do Case
case m_struct
   if m_extend
      copy to ( m_to ) structure extended
   Else
      copy to ( m_to ) structure
   Endif

case m_Record != 0
   if m_Sdbf
      copy to (m_To) sdf record (m_Record)
   Else
      copy to (m_To) record (m_Record)
   Endif

case m_While != ".t." .or. "while .t." $ Lower(CfgHistoTxt[CfgHistNum])
   if m_Sdbf
      copy to (m_To) for &m_For while &m_While next m_Next sdf
   Else
      copy to (m_To) for &m_For while &m_While next m_Next
   Endif

case .Not. m_Next != 0
   if m_Sdf
      copy to (m_To) for &m_For next m_Next sdf
   Else
      copy to (m_To) for &m_For next m_Next
   Endif

otherwise
   GoTo top
   if m_sdf
      copy to ( m_to ) for &m_For sdf
   Else
      copy to ( m_to ) for &m_For
   Endif

EndCase
Return NIL
*----------------------------------------------------------------

Static Function RotinaReplace()

m_all    = .f.
m_Record = 0
m_Next   = 0
m_For    = ".t."
m_while  = ".t."

if " all " $ Lower( mTexto )
   m_all = .t.
   mTexto = stuff( mTexto, at( " all ", Lower( mTexto ) ), 4, "" )
Endif

if .Not. PegaParam( @mTexto, "escopo" )
   Return NIL
Endif

if m_Record=0 .And. m_Next=0 .And. m_For == ".t." ;
              .And. m_while=".t." .And. .Not. m_all
   m_Record = recno()
Endif

// retira nomes dos campos e conteudos

if len( mTexto ) = 0
   msginfo("Parametros invalidos")
   Return NIL
Endif

declare m_name[ 100 ], m_with[ 100 ]
afill( m_name, "" )
m_Cont = 1
Do While len( mTexto) > 0
   m_expr  = alltrim( substr( mTexto, rat( " with ", ;
             Lower( mTexto ) ) + 5 ) )
   mTexto = alltrim( substr( mTexto, 1, rat( " with ", ;
             Lower( mTexto ) ) ) )
   mTexto = "," + mTexto
   m_campo = alltrim( substr( mTexto, rat( ",", ;
             Lower( mTexto ) ) + 1 ) )
   mTexto = alltrim( substr( mTexto, 2, rat( ",", ;
             Lower( mTexto ) ) - 2 ) )
   Do Case
   case Type( m_expr ) $ "U,UI,UE"
      msginfo("Expressao invalida")
      Return NIL

   case Type( m_campo ) $ "U,UI,UE"
      msginfo("Campo invalido")
      Return NIL

   case Type( m_campo ) != Type( m_expr )
      msginfo("Tipos nao combinam -> " + m_campo + " with " + m_expr)
      Return NIL
   EndCase
   m_name[ m_Cont ] = m_campo
   m_with[ m_Cont ] = m_expr
   m_Cont = m_Cont + 1
Enddo

// executa comando

Do Case
case m_all
   GoTo top
case m_Record != 0
   GoTo m_Record
EndCase

m_Contreg = 0
m_Contrep = 0
mInkey   = 0
*msginfo("ReplaceII")
Do While mInkey != 27 .And. .Not. Eof()
   mInkey = INKEY()
   if .Not. &m_while
      Exit
   Endif
   m_Contreg = m_Contreg + 1
   if &m_For
      Do While .t.
         if rLock()
            Exit
         Endif
         @ Row(), 0 Say space(79)
         @ Row(), 0 Say "Aguardando liberacao do registro " + ;
                    str( recno() )
      Enddo

      m_Cont = 1
      for m_Cont = 1 to 100
         if len( m_name[ m_Cont ] ) = 0
            Exit
         Endif
         m_campo = m_name[ m_Cont ]
         m_expr  = m_with[ m_Cont ]
         replace &m_campo with &m_expr
      next

      m_Contrep = m_Contrep + 1
         if mod( m_Contrep, CfgOdometer ) = 0
            @ row(), 0 Say str( m_Contrep ) + ;
               " registro(s) bloqueado(s) e trocado(s)"
         Endif
   Endif
   if m_Record != 0
      Exit
   Endif
   skip
   if m_Contreg = m_Next
      Exit
   Endif
Enddo
@ row(), 0 Say str( m_Contrep ) + ;
   " registro(s) bloqueado(s) e trocado(s)"
if LastKey() = 27
   msginfo("Operacao cancelada")
Endif
Return NIL
*----------------------------------------------------------------

Static Function RotinaLocate()

m_all    = .t.
m_Record = 0
m_Next   = 0
m_For    = ".t."
m_while  = ".t."

if .Not. PegaParam( @mTexto, "escopo" )
   Return NIL
Endif

if len( mTexto ) != 0 .or. m_Record != 0
   msginfo("Parametro invalido " + mTexto)
   Return NIL
Endif

if m_all
   GoTo top
Endif

locate for &m_For while &m_while .And. INKEY()!=27

if LastKey() = 27
   msginfo("Operacao cancelada")
Else
   if Eof() .or. .Not. &m_while
      msginfo("Nao encontrado")
   Endif
Endif
Return NIL
*----------------------------------------------------------------

Static Function RotinaModifyStructure()

// salva configuracao atual

m_row    = row()
m_col    = col()
tela:=SAVESCREEN(0,0,24,79)
Scroll(2,0,MaxRow()-3,MaxCol(),0)

// prepara tela da estrutura

@ 4,20 Say "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
@ 5,20 Say "³                                      ³"
@ 6,20 Say "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"
@ 7,20 Say "³ Nome         Tipo        Tam.    Dec ³"
@ 8,20 Say "ÃÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÂÄÄÄÄÄ´"
mTextovazia = "³            ³           ³       ³     ³"
for i=9 to 19
   @ i,20 Say mTextovazia
next
@ 20,20 Say "ÃÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÁÄÄÄÄÄ´"
@ 21,20 Say "³    ESC ENTER Inclui Exclui Grava   ³"
@ 22,20 Say "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

m_vetorvazio = substr( mTextovazia, 2, len( mTextovazia ) - 2 )
m_tipos      = "CaractereNumerico Data     Logico   Memo     "

if len( mTexto ) = 0
   mTexto    = Alias()
   m_jaexiste = .T.
Else
   m_jaexiste = .F.
Endif

// mostra campos na tela

declare m_campos[ 200 ]
afill( m_campos, "" )
m_campos[ 1 ] = m_vetorvazio
@ 5, 20 + int( ( 38 - len( mTexto ) ) / 2 ) Say mTexto

if m_jaexiste
   m_regs = fcount()
   declare m_name[ m_regs ], ;
           m_type[ m_regs ], ;
           m_len[  m_regs ], ;
           m_dec[  m_regs]
   afields( m_name, m_type, m_len, m_dec )
   for m_Cont=1 to m_regs
      m_campos[ m_Cont ] = " " + pad( m_name[ m_Cont ], 10 ) + " ³ " + ;
              substr( "CaractereNumerico Logico   Data     Memo     ", ;
              at( m_type[ m_Cont ], "CNLDM" ) * 9 - 8, 9 ) + " ³  " +  ;
              str( m_len[ m_Cont ], 3 ) + "  ³ " + ;
              str( m_dec[ m_Cont ], 3 ) + " "
   next
   m_campos[ m_regs + 1 ] = m_vetorvazio
Endif

// permite selecao e alteracao

m_mudou = .F.
store 1 to m_opc, m_inivet
Do While .t.
   achoice( 9, 21, 19, 58, m_campos, .t., "func_modi", m_opc, m_inivet )
   Do Case
   case LastKey()==27 .or. Lower( chr( LastKey() ) ) == "q"
      if msginfo("Abandona?",{"Sim","Nao"})=1 && ("Abandona?")
         Exit
      Endif

   case Lower( chr( LastKey() ) ) == "e"
      m_row = ROW()
      IF m_campos[ m_opc ] # m_vetorvazio
         adel(   m_campos, m_opc )
         scroll( m_row, 21, 19, 58, 1 )
         @ 19,21 Say m_vetorvazio
         m_mudou = .t.
      Endif

   case Lower( chr( LastKey() ) ) = "g"
      if m_campos[ 1 ] == m_vetorvazio .or. .Not. m_mudou
         Exit
      Endif
      if .Not. msginfo("Confirma?",{"Sim","Nao"})=1
         loop
      Endif
      mTempFile := Sistema:TempFile()
      create (mTempFile)
      for m_Cont = 1 to 200
         if m_campos[ m_Cont ] == m_vetorvazio
            m_Cont = 200
         Else
            m_name = substr( m_campos[ m_Cont ], 2, 10 )
            m_type = substr( m_campos[ m_Cont ], 15, 1 )
            m_len  = val( substr( m_campos[ m_Cont ], 28, 3 ) )
            m_dec  = val( substr( m_campos[ m_Cont ], 35, 3 ) )
            append blank
            replace field_name with m_name, field_type with m_type,;
                    field_len  with m_len,  field_dec  with m_dec
         Endif
      next
      if lastrec() > 0
         if m_jaexiste
            use
            if file(mTexto+".bak")
               fErase(mTexto+".bak")
            Endif
            fRename(mTexto+".dbf",mTexto+".bak")
         Endif
         create (mTexto) from (mTempFile)
         use ( mTexto )
         if m_jaexiste
            append from (mTexto+".bak")
         Endif
         use (mTexto)
      Endif
      fErase(mTempFile)
      Exit

   case Lower( chr( LastKey() ) ) == "i" .or. LastKey()==13
      m_row = ROW()
      if Lower( chr( LastKey() ) ) == "i" .or. ;
         m_campos[ m_opc ] = m_vetorvazio
         if m_row < 19
            scroll( m_row, 21, 19, 58, -1 )
            @ m_row, 21 Say m_vetorvazio
         Endif
         ains( m_campos, m_opc )
         m_campos[ m_opc ] = m_vetorvazio
      Endif
      m_name = substr( m_campos[ m_opc ], 2, 10 )
      m_type = substr( m_campos[ m_opc ], 15, 1 )
      m_len  = val( substr( m_campos[ m_opc ], 28, 3 ) )
      m_dec  = val( substr( m_campos[ m_opc ], 35, 3 ) )
      m_row  = row()
      @ m_row, 22 Get m_name Picture "@!"  Valid name_ok()
      @ m_row, 35 Get m_type Picture "!A"  Valid type_ok()
      @ m_row, 48 Get m_len  Picture "999" Valid len_ok()
      @ m_row, 56 Get m_dec  Picture "99"  Valid dec_ok()
      read
      if LastKey()#27
         m_campos[ m_opc ] = " " + m_name + " ³ " + ;
            substr( m_tipos, at( m_type, m_tipos ), 9 ) + ;
            " ³  " + str( m_len, 3 ) + "  ³ " + str( m_dec, 3 ) + " "
         m_mudou = .t.
      Else
         adel( m_campos, m_opc )
      Endif
   EndCase
Enddo
RESTSCREEN(0,0,24,79,tela)
Return NIL
*----------------------------------------------------------------

// funcao de movimentacao

function func_modi

parameters modo, opc, inivet

m_opc    = opc
m_inivet = inivet
Do Case
case modo#3
   Return 2
case LastKey()=1
   keyboard chr(31)
   Return 2
case LastKey()=6
   keyboard chr(30)
   Return 2
case str( LastKey(), 3 ) $ " 27, 13"
   Return 0
case Lower( chr( LastKey() ) ) $ "qgie"
   Return 0
EndCase
Return 2
*----------------------------------------------------------------

// funcao para validar nome

function name_ok

Do Case
case LastKey() =27
   Return .t.
case empty( m_name )
   Return .f.
EndCase
for m_Cont=1 to 200
   Do Case
   case m_campos[ m_Cont ] = m_vetorvazio
      m_Cont = 200
   case substr( m_campos[ m_Cont ], 2, 10 ) == m_name .And. m_Cont#m_opc
      Return .f.
   EndCase
next
Return .t.
*----------------------------------------------------------------

// funcao para validar tipo

function type_ok

Do Case
CASE m_Type $"CN"
   @ m_row,35 Say iif( Lower( m_type ) == "c", "Caractere","Numerico " )
   Return .t.
case m_Type $ "LDM"
   m_len = iif( Lower( m_type ) == "l", 1, ;
           iif( Lower( m_type ) == "d", 8, 10 ) )
   m_dec = 0
   keyboard chr(13)+chr(13)
   Return .t.
EndCase
@ m_row,35 Say space(9)
Return (LastKey()==5)
*----------------------------------------------------------------

// funcao para validar tamanho

function len_ok

Do Case
case m_Type=="L" .And. m_len=1
   Return .t.
case m_type == "D" .And. m_len=8
  Return .t.
case m_type == "M" .And. m_len=10
   Return .t.
case m_len > 0
   Return .t.
EndCase

Return (LastKey()==5)
*----------------------------------------------------------------

// funcao para validar decimais

function dec_ok

Do Case
case m_type $ "LDM" .And. m_dec=0
   Return .t.
case m_dec > 15 .And. m_type == "N"
   Return .f.
case m_dec >= 0
   Return .t.
EndCase
Return .f.
*----------------------------------------------------------------

Static Function RotinaPrint()
private m_picture, m_lista[ 100 ], m_qtparam, m_item, m_picture

if Empty(mTexto)
   msginfo("Print")
   Return NIL
Endif

m_qtparam = PegaParam( mTexto, "par,", @m_lista )

mTexto := ""
for m_Cont = 1 to m_qtparam
   m_item = m_lista[ m_Cont ]
   if .Not. Type(m_item) $ "NCLDM"
      if right( m_item, 1 ) == ","
         m_item = substr( m_item, 1, len( m_item ) - 1 )
      Endif
      msginfo("variavel nao encontrada")
      Return NIL
   Endif
   Do Case
   case Type( m_item ) $ "CLDN"
      mTexto += Transform(&m_Item,"") + " "
   case Type( m_item ) = "M"
      mTexto += "memo" + " "
   EndCase
next
msginfo(mTexto)
Return NIL
*----------------------------------------------------------------

Static Function RotinaUse()

private m_file, m_Exclusive, m_alias, m_indice[ 7 ]

afill( m_indice, "" )


if Empty(mTexto)
   use
   Return NIL
Endif

m_file = PegaParam( @mTexto, " " )

if len( m_file ) = 0
   msginfo("Nome de arquivo invalido")
   Return NIL
Endif

if .Not. "." $ m_file
   m_file = m_file + ".dbf"
Endif

if .Not. file( m_file )
   msginfo("Arquivo nao encontrado")
   Return NIL
Endif

// Valida uso exclusivo

m_Exclusive = PegaParam( @mTexto, "Exclusive" )

// Valida nome de alias

m_alias = PegaParam( @mTexto, "alias" )

if .Not. param_ok( m_alias, "alias" )
   msginfo("Alias invalido")
   Return NIL
Endif

If Len(m_Alias) == 0
   If Len(Substr(m_File,1,At(".",m_File+".")-1)) > 8
      m_Alias := "TMP" + StrZero(nTempAlias,7)
   Else
      m_Alias := Substr(m_File,1,At(".",m_File+".")-1)
   Endif
Endif

// Abre e confirma abertura de dbfs
*paiva aqui Exclusive   criar um campo para saber se quer exclusive
*if  at("EXCLUSIVE", upper(mTexto_ant)) > 0
*    m_Exclusive = .t.
*    Set Exclusive on
*endif
if m_Exclusive
   use ( m_file ) alias &m_alias Exclusive
   if NetErr()
      msginfo("Nao pode abrir arquivo para uso exclusivo")
      Return NIL
   Endif
Else
   use ( m_file ) alias &m_alias
   if NetErr()
      msginfo("Esta' em uso exclusivo por outro usuario")
      Return NIL
   Endif
Endif

nTempAlias += 1

// Valida abertura de indice

if .Not. PegaParam( @mTexto, "index" )
   Return NIL
Endif
Do While .t.
   mIndice := PegaParam(@mTexto,",")
   if Len(mIndice) = 0
      Exit
   Endif
   if .Not. "." $ mIndice
      mIndice += ".idx"
      if .Not. file(mIndice)
         msginfo( mIndice + " nao encontrado")
      Else
         dbSetIndex(mIndice)
      Endif
   Endif
Enddo
Return NIL
*----------------------------------------------------------------

Static Function RotinaRecall(cComando)
Local lparAll := .f., lParRecord := 0, lParNext := 0, cParFor := ".t.", cParWhile := ".t."
Local nContReg := 0, nContDel := 0, mInkey := 0

if .Not. PegaParam( @cComando, "escopo" )
   Return NIL
Endif

if Len(cComando) != 0
   msginfo("Parametro invalido " + cComando)
   Return NIL
Endif

if nParRecord=0 .And. nParNext=0 .And. cParFor == ".t." ;
              .And. cParWhile == ".t." .And. .Not. lParAll
   lParRecord := RecNo()
Endif

Do Case
case lParAll
   GoTo top
case nParRecord != 0
   GoTo (nParRecord)
EndCase

nContReg = 0
nContDel = 0
nInkey   = 0
msginfo("Reccal")
Do While nInkey != 27 .And. .Not. Eof()
   nInkey = INKEY()
   if .Not. &(cParWhile)
      Exit
   Endif
   nContreg += 1
   if &(cParFor)
      * Bloqueia(.t.)
                RLOCK()
      Recall
      nContDel += 1
      if Mod( nContDel, CfgOdometer ) = 0
         @ MaxRow()-3, 0 Say Str(nContDel) + " registro(s) recuperado(s)"
      Endif
   Endif
   if nParRecord != 0
      Exit
   Endif
   skip
   if nContReg == nParNext
      Exit
   Endif
Enddo
@ MaxRow()-3, 0 Say Str(nContDel) + " registro(s) recuperado(s)"

if LastKey() = 27
   msginfo("Interrompido")
Endif
Return NIL
*----------------------------------------------------------------

Static Function RotinaSet(cComando)
Local cSet, lOnOff

cSet := Lower(Trim(Left(PegaParam(@cComando," "),3)))
Do Case
Case cSet $ "cen,del,uni,con,exc"
   if Upper(cComando) != "ON" .And. Upper(cComando) != "OFF"
      msginfo("So' pode usar ON ou OFF")
      Return NIL
   Endif
   lOnOff := iif(Upper(cComando)=="ON",.t.,.f.)
   Do Case
   Case cSet == "cen"
      Set Century (lOnOff)
   Case cSet == "con"
      Set Confirm (lOnOff)
   case cSet == "del"
      Set Deleted (lOnOff)
   Case cSet == "uni"
      Set Unique (lOnOff)
   Case cSet == "exc"
      Set Exclusive (lOnOff)
      CfgSetExclusive := (lOnOff)
   EndCase
Case cSet $ "fil,his,ind,ord,rel"
   if cSet $ "fil,ind,ord,rel" .And. .Not. Used()
      msginfo("Nao tem arquivo em uso")
      Return NIL
   Endif
   if Lower(PegaParam(@cComando," ")) != "to"
      msginfo("Sintaxe errada")
      Return NIL
   Endif
   If cSet == "rel"
      RotinaSetRelation(cComando)
   Elseif cSet == "ord"
      if Empty(cComando)
         Set Order to 1
         Return NIL
      Endif
      if Type(cComando) != "N"
         msginfo("Ordem so' pode ser numerica")
         Return NIL
      Endif
      Set Order To &(cComando)
   Elseif cSet == "fil"
      if Empty(cComando)
         Set Filter To
         Return NIL
      Endif
      if Type(cComando) != "L"
         msginfo("Filtro so' pode ser verdadeiro ou falso")
         Return NIL
      Endif
      Set Filter To &(cTexto)
   Elseif cSet == "ind"
      Set Index To
      If Len(cComando) == 0
         Return NIL
      Endif
      Do While .t.
         cIndice := PegaParam(@cComando,",")
         if Len(cIndice) = 0
            Exit
         Endif
         If .Not. "." $ cIndice
            If .Not. file(cIndice+".cdx")
               msginfo(cIndice + " nao encontrado")
            Else
               dbSetIndex(cIndice)
            Endif
         Endif
      Enddo
   Endif
Otherwise
   msginfo("Configuracao invalida ou nao permitida")
EndCase
Return NIL
*----------------------------------------------------------------

Static Function RotinaDir(cComando)
Local acTmpFile, nTotalSize, nCont, nLin

if Empty(cComando)
   acTmpFile := Directory("*.dbf")
   nTotalSize := 0
   nLin := 0
   For nCont = 1 to Len(acTmpFile)
      use (acTmpFile[mCont,1]) alias temp
      msginfo( Pad(acTmpFile[nCont,1],15) + Transform(LastRec(),"99,999,999") + " " + ;
         Transform(acTmpFile[nCont,2],"999,999,999,999") + " " + Dtoc(acTmpFile[nCont,3]) + " " + acTmpFile[nCont,4])
      nTotalSize += acTmpFile[nCont,2]
      nLin += 1
      use
      if nLin > MaxRow()-7
         msginfo("Tecle algo para prosseguir")
         if INKEY(0) == 27
            Exit
         Endif
         nLin := 0
      Endif
   Next
   msginfo("Total "+Str(Len(acTmpFile))+" arquivo(s) " + Transform(nTotalSize,"999,999,999")+" byte(s)")
Else
   acTmpFile := Directory(cComando)
   nTotalSize := 0
   For nCont = 1 to Len(acTmpFile)
      msginfo(Pad(acTmpFile[nCont,1],15)+Transform(acTmpFile[nCont,2],"999,999,999")+" "+;
               dtoc(acTmpFile[nCont,3])+" "+acTmpFile[nCont,4])
      nTotalSize += acTmpFile[nCont,2]
   Next
   msginfo("Total "+Str(Len(acTmpFile))+" arquivo(s) " + Transform(nTotalSize,"999,999,999")+" byte(s)")
Endif
Return NIL
*----------------------------------------------------------------