Destrinchar Fonte

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

joao
Usuário Nível 1
Usuário Nível 1
Mensagens: 5
Registrado em: 06 Jun 2010 09:46
Localização: teresina

Destrinchar Fonte

Mensagem por joao »

Por favor estou querendo incrementa meu program com estas rotinas que pegue na internet
mais, não tô conseguindo entender o seu funcionamento. Se alguem poder me ajudar agradeço:

Código: Selecionar todos

#Include "msgbox.ch"
#Include "box.ch"
#Include "inkey.ch"
#Include "sistema.ch"

#IfNDef SERVICO

FUNCTION LibSistema
Local cTabFil, cArqTmp, cTexto, cSep, cLinha,;
      cCNPJ, cInsc, cMac,;
      I, X,;
      lOk
Parameters lTesta
Private cGetMac, dLimite, nCodErro
lTesta   := If( lTesta==Nil , .T. , lTesta )
lOk      := .F.
nCodErro := 0
Pilha_Tela(.T.,24,00,24,79)
SetCursor( 0 )
Begin Sequence
Mensagem("Inicializando o sistema ... Aguarde ...")
#IfDef SQL
  Use &("a_empres") Alias EMPRESAS VIa _sqlrdd New Shared
  If NetErr()
      Alerta("NÆo foi poss¡vel abrir o arquivo A_EMPRES !",.T.,10)
      Break
  Endif
  Use &("a_estaca") Alias ESTACOES Via _sqlrdd New Shared
  If NetErr()
      Alerta("NÆo foi poss¡vel abrir o arquivo A_ESTACA !",.T.,10)
      Break
  Endif
  DbGoTop()
  If EOF()
      Alerta("NÆo h  esta‡äes cadastradas no sistema!",.T.,10)
      Break
  Endif
#Else
  Use &(cDirSisData+"a_empres") Alias EMPRESAS New Shared
  If NetErr()
      Alerta("NÆo foi poss¡vel abrir o arquivo A_EMPRES.DBF !",.T.,10)
      Break
  Endif
  Use &(cDirSisData+"a_estaca") Alias ESTACOES New Shared
  If NetErr()
      Alerta("NÆo foi poss¡vel abrir o arquivo A_ESTACA.DBF !",.T.,10)
      Break
  Endif
  DbGoTop()
  If EOF()
      Alerta("NÆo h  esta‡äes cadastradas no sistema!",.T.,10)
      Break
  Endif
#EndIf
Locate for c_num=="001"
If EOF()
    Alerta("Esta‡Æo de trabalho 001 nÆo encontrada!",.T.,10)
    Break
Else
    cTexto := If( Empty(c_impref) , c_impref , Cript(c_impref,.F.) )
    cCNPJ  := cInsc := cMAC := dLimite := ""
    For I := 1 to 15
        cCNPJ   += SubStr( cTexto , I*4-3 , 1 )
        cInsc   += SubStr( cTexto , I*4-2 , 1 )
        cMAC    += SubStr( cTexto , I*4-1 , 1 )
        dLimite += SubStr( cTexto , I*4   , 1 )
    Next I
    cCNPJ   := Trim( cCNPJ )
    cInsc   := Trim( cInsc )
    cMAC    := Trim( cMAC  )
    dLimite := CtoD( SubStr(dLimite,7,2)+"/"+;
                     SubStr(dLimite,5,2)+"/"+;
                     SubStr(dLimite,1,4) )
    Select EMPRESAS
    DbGoTo( 1 )
    #IfDef SQL
       cTabFil := "a_filial"
    #Else
       cTabFil := cDirSis+AllTrim(c_apelido)+"\data\a_filial.dbf"
    #EndIf
    cArqTmp := cDirSis+AllTrim(c_apelido)+"\tmp\printer.tmp"
    #IfDef LINUX
        cTabFil := StrTran( Lower( cTabFil ) , "\" , "/" )
        cArqTmp := StrTran( Lower( cArqTmp ) , "\" , "/" )
        cSep    := ":"
    #Else
        cSep := "-"
    #Endif
    cGetMac := AllTrim( GetEnv( "MACSERVER" ) )
    If Empty( cGetMac )
        FErase( cArqTmp )
        #IfDef LINUX
            Run ( "/sbin/ifconfig eth0 > "+cArqTmp )
        #Else
            Run ( "ipconfig /all > "+cArqTmp )
        #Endif
        cTexto  := MemoRead( cArqTmp )
        cGetMac := Nil
        FErase( cArqTmp )
        For I := 1 to MLCount( cTexto , 100 )
            cLinha := MemoLine( cTexto , 100 , I )
            For X := 1 to Len( cLinha ) - 16
                cGetMac := SubStr( cLinha , X , 17 )
                If ! " " $ cGetMac .and. StrOcorr( cSep , cGetMac )==5
                    Exit
                Endif
                cGetMac := Nil
            Next X
            If cGetMac != Nil
                Exit
            Endif
        Next I
        If cGetMac==Nil
            Alerta( "Erro na inicializa‡Æo do sistema (43) !",.T.,10)
            Break
        Endif
    Endif
    cGetMac := StrTran( cGetMac , cSep , "" )
    #IfDef SQL
       Use ( cTabFil ) Alias FILIAIS Via _RDD Connection Getconn( u_apelido ) New Shared
    #Else
       Use ( cTabFil ) Alias FILIAIS New Shared
    #EndIf
    If NetErr()
        Alerta("Erro ao abrir o arquivo "+cTabFil+" !" , .T. , 10 )
        Break
    Endif
    Locate for c_codigo=="00"
    If EOF()
        Alerta("A loja 00 da empresa "+Alltrim(EMPRESAS->c_apelido)+" nÆo foi encontrada!",.T.,10)
        Break
    Endif
    If lTesta
        If cCNPJ != ExtraiNumero( Cript(c_cgc ,.F.) ) .or. ;
           cInsc != ExtraiNumero( Cript(c_insc,.F.) )
            nCodErro := 1
        Elseif cMAC != cGetMac
            nCodErro := 2
        Elseif u_Data > dLimite
            nCodErro := 3
        Endif
        lOk := ( nCodErro==0 )
    Endif
Endif
lOk := ( lOk .or. SisAutentica() )
End Sequence
If Select("FILIAIS") > 0
    FILIAIS->( DbCloseArea() )
Endif
If Select("ESTACOES") > 0
    ESTACOES->( DbCloseArea() )
Endif
If Select("EMPRESAS") > 0
    EMPRESAS->( DbCloseArea() )
Endif
Pilha_Tela(.F.)
Return ( lOk )
*********
* f i m *
*********
FUNCTION SisAutentica
Local cLetras, cTexto, cVar, cDig, cChave,;
      cCNPJ, cInsc,;
      dData,;
      nSData, nSoma, nVal, I,;
      lOk
cLetras := "U7IAW1KET6BXQL5FP0GSH4D9ZCJV3N8RYM2"
nSData  := If( Empty(dLimite) , 0 , Day(dLImite)+;
                                    Month(dLimite)+;
                    Year(dLimite)+;
                    Dow(dLimite) )
cTexto  := ""
nSoma   := 0
cCNPJ   := ExtraiNumero( Cript( FILIAIS->c_cgc , .F. ) )
cInsc   := ExtraiNumero( Cript( FILIAIS->c_insc, .F. ) )
cVar    := cCNPJ+cInsc+cGetMac
For I := 1 to Len( cVar )
    cDig  := SubStr( cVar , I , 1 )
    nVal  := If( cDig $ "0123456789" , Val(cDig) , Asc(cDig) )
    nSoma += nSData * ( I+nVal )
Next I
For I := 1 to 12
    nVal    := Max( 1 , nSoma % Len(cLetras) )
    cTexto  += SubStr( cLetras , nVal , 1 )
    cLetras := Left(cLetras,nVal-1) + SubStr(cLetras,nVal+1)
Next I
cChave := Space(16)
Pilha_Tela(.T.,02,00,24,79)
CriaJanela(08,20,16,60,"AUTENTICAۂO DO SISTEMA")
SetColor( cor_linjan )
@ 14,21 to 14,59
SetColor( cor_say+","+cor_get )
If lTesta
    @ 10,21 Say "C¢d.Erro :"
    @ 10,31 Say StrZero(nCodErro,2) Color cor_get2
Endif
@ 10,42 Say "Validade :"
@ 10,52 Get dLimite When .F.
@ 12,21 Say "Chave de libera‡Æo :"
lOk := .F.
Do While ! lOk
    _aBotoes := {}
    BT_Iniciar(15,37,"   ^OK   ")
    BT_Iniciar(15,49,"^Cancelar")
    Teclas_Fun("Informe a chave de libera‡Æo do sistema.                                ESC-Sair",{"ESC"})
    @ 12,41 Get cChave Picture "@KR !!!!-!!!!-!!!!-!!!!" Valid ! Empty( cChave )
    DefTecla( K_ALT_F2 , .T. , { || GeraChaveLib( cTexto , cLetras ) } )
    Ler_Get()
    DefTecla( K_ALT_F2 , .F. )
    If LastKey()==K_ESC .or. BT_Executa()!=1
        Exit
    Elseif Left( cChave , 12 )==cTexto
        nSoma := 0
        For I := 1 to Len( cChave )-1
            cDig  := SubStr( cChave , I , 1 )
            nSoma += If( cDig $ "0123456789" , Val(cDig) , Asc(cDig) )
        Next I
        lOk := ( nSoma%10 == Val(Right(cChave,1)) )
    Endif
    If ! lOk
        Alerta("A chave informada ‚ inv lida!",.T.,10)
    Endif
Enddo
Pilha_Tela( .F. )
If lOk
    cLetras := cTexto + cLetras
    cDig    := ""
    For I := 1 to 3
        cDig    += StrZero( At( SubStr(cChave,12+I,1) , cLetras ) , 2 )
        cLetras := Right( cLetras , Len(cLetras)-2 ) + Left(cLetras , 2 )
    Next I
    dData := CtoD( SubStr(cDig,1,2)+"/"+;
                   SubStr(cDig,3,2)+"/"+;
                   SubStr(cDig,5,2) )
    Select FILIAIS
    cCNPJ   := PadR( cCNPJ       , 15 )
    cInsc   := PadR( cInsc       , 15 )
    cGetMac := PadR( cGetMac     , 15 )
    dData   := PadR( DtoS(dData) , 15 )
    cTexto  := ""
    For I := 1 to 15
        cTexto += SubStr( cCNPJ  , I , 1 )+;
                  SubStr( cInsc  , I , 1 )+;
                  SubStr( cGetMac, I , 1 )+;
                  SubStr( dData  , I , 1 )
    Next I
    Select ESTACOES
    Locate for c_num=="001"
    Bloq_Reg(.T.)
    Replace c_impref With Cript( cTexto , .T. )
    DbCommit()
    DbUnlock()
    Mensagem("Autentica‡Æo conclu¡da.")
    Alerta( "O Sistema foi autenticado com sucesso!" , .T. , 10 )
Endif
Return ( lOk )
*********
* f i m *
*********
FUNCTION GeraChaveLib( cTexto , cLetras )
Local cChave, cDig, cSenha,;
      nPos, I, nSoma,;
      dData,;
      lCent
If "SUPORTE" != Trim(u_User)
    Return ( Nil )
Endif
Private GetList := {}
lCent := __SetCentury(.T.)
Begin Sequence
Pilha_Tela(.T.,18,00,24,79)
CriaJanela(18,00,22,28,"LIBERACAO")
SetColor(cor_linjan)
@ 22,01 to 22,27
SetColor(cor_say+","+cor_get)
@ 20,01 Say "Chave ......... :"
@ 21,01 Say "Informe a senha :"
cChave := StrZero( HB_RandomInt(1000000,9999999) , 7 )
@ 20,18 Say cChave Color cor_get2
cSenha := Senha(21,18)
Pilha_Tela(.F.)
If cSenha==Nil
    Break
Elseif cSenha != PadR( SenhaSuporte(cChave)+StrZero(SomaDigitos(DtoS(Date())),2) , 10 )
    Alerta("A senha informada ‚ inv lida!",.T.,10)
    Break
Endif
__SetCentury( lCent )
dData := u_Data
Pilha_Tela(.T.,20,00,24,79)
Janela(20,00,22,27,cor_janela,B_SINGLE,.F.,.T.)
SetColor(cor_say+","+cor_get)
@ 21,02 Say "Informe a data :"
@ 21,18 Get dData
Ler_Get()
If LastKey()!=K_ESC
    cChave  := cTexto
    cLetras := cTexto + cLetras
    For I := 1 to 3
        nPos    := Val( SubStr( DtoC(dData) , I*3-2 , 2 ) )
        cChave  += SubStr( cLetras , nPos , 1 )
        cLetras := Right( cLetras , Len(cLetras)-2 ) + Left( cLetras , 2 )
    Next I
    nSoma := 0
    For I := 1 to Len( cChave )
        cDig  := SubStr( cChave , I , 1 )
        nSoma += If( cDig $ "0123456789" , Val(cDig) , Asc(cDig) )
    Next I
    cChave += Str( nSoma % 10 , 1 )
    Keyboard cChave
Endif
Pilha_Tela(.F.)
End Sequence
__SetCentury( lCent )
Return

#Endif

*********
* f i m *
*********
FUNCTION SenhaSuporte( cChave )  // chave = numero com 7 digitos
Local cTexto, cSenha, nPos, I
cChave := cChave + StrZero( SomaDigitos( DtoS(Date()) ) , 2 ) + Str( Dow(Date()) , 1 )
cTexto := "p2o4i7u8y9t03r2e1wq4a5s6d3f9gh76j2k5zlm0n9b8v3c2x3"
cSenha := ""
For I := 1 to 7
    nPos   := SomaDigitos( cChave ) % Len( cTexto )
    cSenha += SubStr( cTexto , If(nPos=0,Len(cTexto),nPos) , 1 )
    cChave += SubStr( cChave , I , 1 )
    cTexto := Right( cTexto , Len(cTexto)-nPos ) + Left( cTexto , nPos )
Next I
Return ( cSenha )
*********
* f i m *
*********
Nota de Moderação:
por Maligno: Mensagem editada para colocar a tag [ code ]
Veja como utilizar esta tag: faq.php?mode=bbcode#f2r1
Editado pela última vez por Toledo em 07 Jun 2010 22:22, em um total de 5 vezes.
Razão: Observando os nomes da funções (com mais de 10 caracteres) e a utilização da função HB_RandomInt(), o código acima tem referência com o Harbour, por este motivo o presente tópico foi movido da seção CA-Clipper para a seção [x]Harbour.
Avatar do usuário
rochinha
Administrador
Administrador
Mensagens: 4664
Registrado em: 18 Ago 2003 20:43
Localização: São Paulo - Brasil
Contato:

Re: Destrinchar Fonte

Mensagem por rochinha »

Amiguinho,

Pelo que pude reparar voce poderá enchertar as funções existentes neste código e somente elas em seu sistema alterando alguma coisa relativa a apresentação da tela.

A função SisAutentica() se encarregará de pedir os dados para liberação do uso fazendo toda critica e liberando o sistema.

A função SenhaSuporte( cChave ) receberá a chave que será passada na SisAutentica() para liberar ou não a continuidade.

Analisei o código de forma superficial para te dar uam alusão do mesmo.

pode ser necessário encontrar algumas funções que ali aparecem com Crypt() e Pilha_Tela()
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
joao
Usuário Nível 1
Usuário Nível 1
Mensagens: 5
Registrado em: 06 Jun 2010 09:46
Localização: teresina

Re: Destrinchar Fonte

Mensagem por joao »

Tudo bem até ai, mais a minha principal duvida é no processo de formação da senha do suporte e de liberação do sistema, como seria isso?
Avatar do usuário
Dr.Microso
Usuário Nível 3
Usuário Nível 3
Mensagens: 173
Registrado em: 12 Jan 2009 21:26
Localização: Belo Horizonte, MG

Re: Destrinchar Fonte

Mensagem por Dr.Microso »

João, boa tarde!
Seja bem-vindo à este seleto grupo!
João escreveu:estou querendo incrementar meu programa com estas rotinas... mas, não tô conseguindo entender o seu funcionamento...
Nosso colega Rochinha tem razão, dentro deste código há dependências de outros. Seria muito interessante você ZIPAR a pasta com os PRGs e CHs (ou citar a fonte de cópia) pelo menos, para uma melhor apreciação. Assim entendemos melhor como é o "espírito da coisa".
A depender do conjunto, poder ser muito code para uma funcionalidade pequena, que pode ser resumida à poucas linhas.

Um abraço!
"O que domina aos outros é forte; o que domina a si mesmo é poderoso." [ Lao-Tsé - séc VII AC]
"É tipo uma Alquimia... Porções de código viram soluções que mutam-se fisicamente em sorrisos e outros, como o notebook que uso para escrever estas linhas..." dr.microso@hotmail.com
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Destrinchar Fonte

Mensagem por Pablo César »

Isso aí... mas primeiro de tudo... você tem que saber o que está querendo fazer com o seu sistema. Pelo que parece, você pegou um código qualquer e porque viu algum texto você quer adaptar ao seu sistema. Eu acredito que para fazer um sistema, deve visualizar o que está querendo obter, para depois implementar conforme a disponibilidade dos dados que ja possui no sistema. Nós não sabemos quais são os requisitos do seu sistema e muito menos como é composto a estrutura do sistema (código e banco de dados).

Como disse o colega, você deixou de disponibilizar outras funções desse código, daí fica dificil analisar o código quando é incompleto.
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
joao
Usuário Nível 1
Usuário Nível 1
Mensagens: 5
Registrado em: 06 Jun 2010 09:46
Localização: teresina

Re: Destrinchar Fonte

Mensagem por joao »

estou enviando Outro fonte pra clarear melhor, este u de inicialização.

Código: Selecionar todos

/*

   SISTEMA....: (MicroTurbo)AUTOMACAO COMERCIAL
   VERSAO.....: (Multi-Usuario)
   PROGRAMADOR: João Pedro Gomes
   LINGUAGEM..: Clipper 5.2 e Harbour

*/


#Include "msgbox.ch"
#Include "box.ch"
#Include "inkey.ch"
#Include "sistema.ch"


#IfDef LINUX
   #IfDef SQL
      REQUEST DBFNTX
      #include "sqlrdd.ch"
      #include "directry.ch"
      #include "pgs.ch"
      REQUEST SQLRDD
      REQUEST SR_ODBC
      REQUEST SR_PGS
   #EndIf
#EndIf

Static lTelaInicial

FUNCTION Main()
Parameters pEstacao
Local I, cIndice, nOp, lSisLib

Local GetList := {}

lTelaInicial := .T.

Cores( .T. )
Public _RDD := "DBFNTX"	

#IfDef LINUX
*   #Include "/usr/include/xharbour/set.ch"
    #Include "/usr/include/xharbour/set.ch"

    SET(_SET_FILECASE,1)
    SET(_SET_DIRCASE,1)
    SET(_SET_DIRSEPARATOR,"/")
    Public cDirSis := StrTran( "/"+Left(CurDir(),RAt("/",CurDir())) , "/" , "\" )
    Public Backg := .f.
    	
    #IfDef SQL
       _RDD := "SQLRDD"
       SR_SetSyntheticIndexMinimun(10)
       Sr_setSyntheticIndex(.f.)
       Connect("POSTGRES")
       set autopen Off
       sr_fetchSize(30)
       sr_SetFastOpen(.T.)
    #EndIf
#Else
    Public cDirSis := "\"+Left(CurDir(),RAt("\",CurDir()))
    FreeTSlice()    // funcao em C para diminuir consumo da CPU
#Endif


Public cDirSisBin  := cDirSis+"Bin\",;
       cDirSisData := cDirSis+"Data\",;
       cDirSisIdx  := cDirSis+"Idx\"
#IfDef SQL
   Use ("A_CFGSIS") Alias CONFSIS Via _RDD New Shared
#Else
   Use (cDirSisData+"A_CFGSIS") Alias CONFSIS Via _RDD New Shared
#EndIf
If NetErr()
    Tone(300,1)
    ? "Erro ao abrir o arquivo de inicializa‡Æo!"
    Return
Endif
Public sysVersao   := Trim(c_versao),;
       sysCodEmp   := c_empresa

DbCloseArea()

#IfNDef HARBOUR
    VgaPalette("B",10,5,35)
    VgaPalette("R",35,0,0)
    VgaPalette("G",15,30,30)
    VgaPalette("BG",5,35,35)
    VgaPalette("GR",41,31,24)
#EndIf

Set Date British
Set Wrap On
Set Deleted On
Set Console Off
Set Scoreboard Off
Set Bell Off
Set Epoch to 1920
Set Confirm On
SetCursor(0)
SetBlink(.f.)
AltD(0)

Private _aBotoes   := {},;
        _aMenu     := {},;
        w_confsys  := .T.,;
        w_caixa    := "01",;
        w_dtcaixa  := Date(),;
        u_FilPrc   := 'CONFIG->( If(c_prcfil=="S",u_Filial,"00") )',;
        u_PortaPrn,u_Impress,u_Preview:=NIL,u_ArqPrn,u_CmdPrn,u_CadImpres,u_tipodescgrade,u_ativagradereferencia,u_tpprc,;
        u_DocBxa, u_DataBxa
Do While .T.
    If lTelaInicial
        #IfNDef HARBOUR
	    ShowTime()
	#Endif
        If ! Abertura()
            Exit
        Endif
        lTelaInicial := .F.
        w_confsys    := .T.
    Endif
    If w_confsys
        TelaSistema(.T.)
        #IfDef DES
            lSisLib := .T.
        #Else
            lSisLib := If( lSisLib==Nil , LibSistema() , lSisLib )
        #Endif
        If ! lSisLib .or. ! TefPendencia()
            Exit
        Endif
        w_confsys := .F.
    Endif
    SetKey( K_ALT_P   , { || p_Produt()    } )
    SetKey( K_ALT_A   , { || Atalho()      } )
    SetKey( K_ALT_R   , { || p_ConPed()    } )
    SetKey( K_ALT_G   , { || p_BrowGr()    } )
    SetKey( K_ALT_J   , { || CalculaJuros() } )
    SetKey( K_ALT_F2  , { || Calculadora() } )
    SetKey( K_ALT_F3  , { || Calendario()  } )
    SetKey( K_ALT_F5  , { || Autorizacao() } )
    Rotina("ACESSO BASICO")
    If u_Nivel==97 .or. u_Nivel==98 .or. u_Nivel==95
        If u_Nivel==97
            Menu("V00",.f.,.t.)
        Elseif u_Nivel==98
            Menu("C00",.F.,.T.)
        Elseif u_Nivel==95
            Menu("T00",.F.,.T.)
        Endif
        lTelaInicial := (Lastkey()==K_ESC)
    Else
        Teclas_Fun("Selecione o m¢dulo desejado.                                        ESC-Finaliza",{"ESC"})
        CriaJanela(04,03,19,76,"ACESSO AOS MàDULOS DO SISTEMA")
        nKey := 0
        nOp  := Max( 1 , If( nOp==Nil , 1 , nOp ) )
        Do While nKey!=K_ENTER .and. nKey!=K_ESC
            SayPasta( nOp )
            DefTecla( K_CTRL_L , .T. , { || AcessoLj() } )
            nKey := Pausa( 0 )
            DefTecla( K_CTRL_L , .F. )
            If nKey==K_UP
                nOp := If(nOp==1,5,nOp-1)
            Elseif nKey==K_DOWN
                nOp := If(nOp==5,1,nOp+1)
            Elseif nKey==K_ESC
                nOp := 0
            Elseif nKey != K_ENTER
                nKey := At( Upper(Chr(nKey)) , "12345" )
                nOp  := If( nKey==0 , nOp , nKey )
            Endif
        Enddo
        Limpa()
        If nOp==1
            Rotina("Cadastros e Tabelas")
            Menu("100",.f.,.t.)
        Elseif nOp==2
            Rotina("Estoques e Faturamento")
            Menu("200",.f.,.t.)
        Elseif nOp==3
            Rotina("Contas a Pagar/Receber")
            Menu("300",.f.,.t.)
        Elseif nOp==4
            Rotina("Caixas e Bancos")
            Menu("400",.f.,.t.)
        Elseif nOp==5
            Rotina("Utilit rios")
            Menu("500",.f.,.t.)
        Else
            lTelaInicial := .T.
        Endif
    Endif
    SetKey( K_ALT_P   , Nil )
    SetKey( K_ALT_R   , Nil )
    SetKey( K_ALT_G   , Nil )
    SetKey( K_ALT_J   , Nil )
    SetKey( K_ALT_F2  , Nil )
    SetKey( K_ALT_F3  , Nil )
    SetKey( K_ALT_F5  , Nil )
    SetKey( K_ALT_F7  , Nil )
    SetKey( K_ALT_F1  , Nil )
    SetKey( K_ALT_F12 , Nil )
    If lTelaInicial
        LogUsuario( "O" , "Saiu do sistema" )
    Endif
Enddo
#IfNDef HARBOUR
    VgaPalette()
#EndIf
Close DataBases
SetColor("w/n")
SetCursor(1)
Cls
Return
*********
* f i m *
*********
FUNCTION Fim_Menu()
Keyboard Chr(K_ESC)
Return
*********
* f i m *
*********
FUNCTION Abertura
Local cArea := Alias(), cFundo, cIndice, cTexto, lOk, lArqLogo, I
#IfNDef HARBOUR
    ShowTime()
#EndIf
Cores( .T. )
Close DataBases
#IfDef SQL
   Use &("a_empres") Alias EMPRESAS Via _RDD New Shared
   Use &("a_contro") Alias MENUS    Via _RDD New Shared
   Use &("a_usuari") Alias USUARIOS Via _RDD New Shared
   Use &("a_acesso") Alias ACESSOS  Via _RDD New Shared
   Use &("a_tabsis") Alias TABSIS   Via _RDD New Shared
#Else
   Use &(cDirSisData+"a_empres") Alias EMPRESAS  New Shared
   Use &(cDirSisData+"a_contro") Alias MENUS     New Shared
   Use &(cDirSisData+"a_usuari") Alias USUARIOS  New Shared
   Use &(cDirSisData+"a_acesso") Alias ACESSOS   New Shared
   Use &(cDirSisData+"a_tabsis") Alias TABSIS    New Shared
#EndIf
lOk := ( Select("EMPRESAS")>0 .and. Select("MENUS")  >0 .and. ;
         Select("USUARIOS")>0 .and. Select("ACESSOS")>0 .and. ;
         Select("TABSIS")>0 )
If lOk
    Select ACESSOS
    #IfDef SQL
       DbSetIndex( "c_nivel" )
       Select USUARIOS
       DbSetIndex( "c_usuario" )
       Select EMPRESAS
       DbSetIndex( "c_apelido" )
       DbGoTop()
    #Else
       If !File( cDirSisIdx+"I_ACESSO.NTX" )
           Index on c_nivel to &(cDirSisIdx+"I_ACESSO")
       Endif
       DbSetIndex( cDirSisIdx+"I_ACESSO" )
       Select USUARIOS
       If !File( cDirSisIdx+"I_USUAR1.NTX" )
           Index on c_usuario to &(cDirSisIdx+"I_USUAR1")
       Endif
       DbSetIndex( cDirSisIdx+"I_USUAR1" )
       Select EMPRESAS
       If ! File( cDirSisIdx+"I_EMPRES.NTX" )
           Index on c_apelido to &(cDirSisIdx+"I_EMPRES")
       Endif
       DbSetIndex( cDirSisIdx+"I_EMPRES" )
       DbGoTop()
    #EndIF
    
    SetColor("gr+/b")
    Cls
    Backg := .f.
    DispBegin()
    lArqLogo := File( cDirSisData+"logo.sys" )
    If lArqLogo
        cTexto := MemoRead( cDirSisData+"logo.sys" )
        #IfDef LINUX
            cTexto := StrTran( cTexto , Chr(13) , "" )
        #Endif
        For I := 1 to MLCount(cTexto,80)
            @ I,00 Say MemoLine(cTexto,80,I)
        Next I
    Else
        @ 01,12 Say "xxxxxxxxxxxxxx"
        @ 02,12 Say "xxxxxxxxxxxxxxx"
        @ 03,12 Say "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
        @ 04,12 Say "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
        @ 05,12 Say "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
        @ 06,12 Say "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
        @ 07,12 Say "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
        @ 08,12 Say "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
        @ 09,12 Say "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
        @ 10,12 Say "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
        @ 11,12 Say "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
        @ 12,12 Say "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
    Endif
    cFundo := SaveScreen(01,00,24,79)
    #IfDef HARBOUR
        cFundo := StrTran( cFundo , "^"+Chr(14) , "Ü"+Chr(8) )
        cFundo := StrTran( cFundo , "~"+Chr(14)+chr(32) , "ß"+Chr(8)+Chr(96) )
        cFundo := StrTran( cFundo , "'"+Chr(14)+Chr(32) , chr(219)+Chr(8)+Chr(96) )
    #Else
        cFundo := StrTran( cFundo , "^"+Chr(30) , "Ü"+Chr(16) )
        cFundo := StrTran( cFundo , "~"+Chr(30) , "ß"+Chr(16) )
        cFundo := StrTran( cFundo , "'"+Chr(30) , "Û"+Chr(16) )
    #EndIf   
    RestScreen(01,00,24,79,cFundo)
    If ! lArqLogo
        @ 13,12 Say "Sistema de Automa‡Æo Comercial"+PadL("VersÆo "+sysVersao,28)
        @ 15,00,23,46 Box "  ÛÛßßß " Color "n/b"
        Janela(15,00,22,45,"gr+/b",B_MOLDURA1,.F.)
        @ 17,01 to 17,44
        SetColor("w+/b")
        @ 16,02 Say "MICROTURBO Informatica"
        @ 18,02 Say "Rua Goiania, 110/N Centro"
        @ 19,02 Say "Teresina-PI CEP 64002-420 Tel(86)3235-7397"
        @ 20,02 Say "Home Page: www.microturbo.com.br"
        @ 21,02 Say "E-Mail   : suporte@microturbo.com.br"
    Endif
    DispEnd()
    lOk := ( USUARIOS->( UserAcess() ) .and. ConfEstacao() )
    If lOk
        Arq_Auditoria()    // funcao para verificar arquivo de auditoria (p_audito.prg)
        Public _aTabSys := {},;
               _aDbInfo := {}
        Select TABSIS
        DbGoTop()
        Do While ! Eof()
            If ! Empty( c_diret )
                #IfDef SQL
	           Aadd( _aTabSys , {AllTrim(c_diret)  , AllTrim(c_tablesql) , AllTrim(c_alias) } )
		   For I := 1 to 15
                       cIndice := &( "c_indice"+StrZero(I,2) )
                       If ! Empty( cIndice )
                           Aadd( _aTabSys[ Len(_aTabSys) ] , AllTrim(cIndice) )
                       Endif
                   Next I
		#Else
	           Aadd( _aTabSys , { AllTrim(c_diret) , AllTrim(c_tabela)+".dbf" , AllTrim(c_alias) } )
		   For I := 1 to 15
                       cIndice := &( "c_indice"+StrZero(I,2) )
                       If ! Empty( cIndice )
                           Aadd( _aTabSys[ Len(_aTabSys) ] , AllTrim(cIndice) )
                       Endif
                   Next I
                #EndIf
            Endif
            DbSkip()
        Enddo
	
        #IfDef SQL
	   Use ( "A_AUTORI" ) Alias PERMISSOES Via _RDD New Exclusive
        #Else
	   Use ( cDirData+"A_AUTORI" ) Alias PERMISSOES New Exclusive
	#EndIf
	If ! NetErr()
            Zap
            DbCloseArea()
        Endif
        lOk := Arquivo( { {"CONFIG",,.F.} } )
        If lOk
            LogUsuario( "O" , "Entrou no sistema. Empresa: "+sysCodEmp+" Loja: "+u_Filial+" Data: "+DtoC(u_Data) )
            u_CadImpres := ( IniLerSecao( cDirIni+"ICOMP.INI" , "Impressoras" , "UsaCadastro" , "N")=="S" )
	    u_AtivaGradeReferencia := ( IniLerSecao( cDirIni+"ICOMP.INI" , "Produtos" , "AtivaGradeReferencia" , "N")=="S" )
	    u_TipoDescGrade := ( IniLerSecao( cDirIni+"ICOMP.INI" , "Produtos" , "MostraDescComplAmbos" , "A") )
            u_tpprc      := c_tpprc
            cDirServData := CONFIG->( If(c_iserv=="S",Trim(c_dirserv)+"\Data\" , Nil ) )
        Else
            Alerta("NÆo foi poss¡vel abrir o arquivo A_CONFIG.DBF !",.T.,10)
        Endif
    Endif
    EMPRESAS->( DbCloseArea() )
    MENUS   ->( DbCloseArea() )
    USUARIOS->( DbCloseArea() )
    ACESSOS ->( DbCloseArea() )
    TABSIS  ->( DbCloseArea() )
Else
    Alerta("Erro ao abrir os arquivos de inicializa‡Æo!",.T.,10)
Endif
Return ( lOk )
*********
* f i m *
*********
FUNCTION UserAcess
Local lOk, lCent, I, cSen
Public u_user, u_Cod, u_Nivel, u_Vended,;
       u_Filial, u_nFilial, u_Fantasia, u_Cidade, u_Data, u_lojas
Private lSuporte
lOk   := lSuporte := .F.
lCent := __SetCentury(.T.)
Select USUARIOS
Pilha_Tela(.T.,15,00,24,79)
@ 15,49,23,78 Box "  ÛÛßßß " Color "n/b"
Janela(15,49,22,77,"gr/w",B_SINGLE,.f.)
@ 15,49 Say PadC("ACESSO AO SISTEMA",29) Color "b/w*"
Botao(16,49,22,77)
SetColor("b/w,w/n,,,r/w")
@ 17,51 Say "Usu rio  :"
@ 18,51 Say "Senha .. :"
@ 19,51 Say "Empresa  :"
@ 20,51 Say "Loja ... :"
@ 21,51 Say "Data ... :"
Do While ! lOk
    Teclas_Fun("Informe o seu Nome de Usu rio. ESC-Sair",{"ESC"})
    u_User :=  Space(15)
    @ 17,61 Get u_user Picture "@!"  Valid !Empty(u_user)
    Ler_get()
    If Lastkey()=K_ESC
        Exit
    Endif
    lOk := DbSeek( u_user )
    If ! lOk
        Alerta("Nome de usu rio inexistente!",.T.,10)
    Endif
    lSuporte := ( u_user==PadR("SUPORTE",15) )
Enddo
If lOk
    lOk := .F.
    For I := 1 to 3
        Mensagem("Informe a sua senha de acesso")
        cSen := Senha(18,61)
        If cSen==Nil .or. cSen==If( lSuporte , PadR( "hbtdf" + StrZero( SomaDigitos( DtoC(Date()) ) , 3 ) , 10 ) ,;
                                               Cript(c_senha,.f.) )
            lOk := ( cSen != Nil )
            Exit
        Endif
        Alerta("A senha informada ‚ inv lida!",.T.,10)
    Next I
Endif
If lOk
    u_Nivel   := If( lSuporte , 0 , Val( Cript(c_Nivel,.F.) ) )
    u_Cod     := c_codigo
    u_Vended  := c_vended
    sysCodEmp := If( Empty(c_empresa) , sysCodEmp , c_empresa )
    u_Filial  := If( Empty(c_filial)  , "00"     , c_filial  )
    u_Data    := Date()
    Teclas_Fun("F2-Consulta Empresas/Lojas                                              ESC-Sair",{"F2","ESC"})
    @ 19,61 Get sysCodEmp Picture "@!" Valid FunUser1()
    @ 20,61 Get u_Filial  Picture "@K" Valid Alin_get(u_Filial,2,"0") .and. FunUser1()
    @ 21,61 Get u_Data ;
            When u_Nivel!=97 ;
            Valid u_Data>=CtoD("01/01/1980")
    DefTecla( K_F2 ,.T. , { || ConsTabelas() } )
    Ler_get()
    DefTecla( K_F2 , .F. )
    lOk := ( LastKey() != K_ESC )
Endif
Pilha_Tela(.F.)
If lOk
    Cores()
    AcessoMenu()
Endif
__SetCentury( lCent )
Return ( lOk )


STATIC FUNCTION ConsTabelas
Local cVar := ReadVar()
If cVar=="U_FILIAL"
    Cons_Fil()
ElseIf cVar=="SYSCODEMP"
    Cons_Empresa()
Endif
Return

                       
STATIC FUNCTION FunUser1
Local cVar := ReadVar(), cEmpresa, cIntegra, lOk := .F.
If LastKey()==K_UP
    lOk := .T.
Elseif cVar=="SYSCODEMP"
    If EMPRESAS->( ! DbSeek( sysCodEmp ) )
        Alerta("A empresa informada nÆo existe!",.T.,10)
    Elseif u_Nivel>0 .and. USUARIOS->( !Empty(c_empresa) .and. sysCodEmp != c_empresa )
        Alerta("Acesso nÆo autorizado!",.T.,10)
    Else
        Select EMPRESAS
        cEmpresa := AllTrim( c_apelido )
        cIntegra := AllTrim( c_integra )
       
        Public u_Empresa  := Trim( c_empresa ),;
               u_apelido  := Trim( c_apelido ),;
               u_tipoemp  := c_tipo,;
	       u_codemp   := "",;
               cDirData   := cDirSis+cEmpresa+"\Data\",;
               cDirIni    := cDirSis+cEmpresa+"\Data\",;
               cDirIdx    := cDirSis+cEmpresa+"\Idx\" ,;
               cDirMod    := cDirSis+cEmpresa+"\Mod\" ,;
               cDirImp    := cDirSis+cEmpresa+"\Imp\" ,;
               cDirExp    := cDirSis+cEmpresa+"\Exp\" ,;
               cDirPalm   := cDirSis+cEmpresa+"\Palm\",;
               cDirTmp    := cDirSis+cEmpresa+"\Tmp\" ,;
               cDirProd   := cDirSis+If( c_prod  , cIntegra , cEmpresa )+"\Data\",;
               cDirCli    := cDirSis+If( c_cli   , cIntegra , cEmpresa )+"\Data\",;
               cDirForn   := cDirSis+If( c_forn  , cIntegra , cEmpresa )+"\Data\",;
               cDirVend   := cDirSis+If( c_vend  , cIntegra , cEmpresa )+"\Data\",;
               cDirOpCom  := cDirSis+If( c_opcom , cIntegra , cEmpresa )+"\Data\",;
               cDirPlan   := cDirSis+If( c_plan  , cIntegra , cEmpresa )+"\Data\",;
               cDirPlCon  := cDirSis+If( c_plcon , cIntegra , cEmpresa )+"\Data\",;
               cDirCust   := cDirSis+If( c_cust  , cIntegra , cEmpresa )+"\Data\",;
               cDirDoc    := cDirSis+If( c_doc   , cIntegra , cEmpresa )+"\Data\",;
               cDirBan    := cDirSis+If( c_ban   , cIntegra , cEmpresa )+"\Data\",;
               cDirCtBan  := cDirSis+If( c_ctban , cIntegra , cEmpresa )+"\Data\",;
               cDirCxa    := cDirSis+If( c_cxa   , cIntegra , cEmpresa )+"\Data\",;
               cDirHist   := cDirSis+If( c_hist  , cIntegra , cEmpresa )+"\Data\",;
               cDirTrp    := cDirSis+If( c_trp   , cIntegra , cEmpresa )+"\Data\",;
               cDirMot    := cDirSis+If( c_mot   , cIntegra , cEmpresa )+"\Data\",;
               cDirServData, cDirSrv

        cDirSrv  := IniLerSecao( cDirIni+"ICOMP.INI" , "Integracao" , "DirSrv" , "" )
        cDirPalm := IniLerSecao( cDirIni+"ICOMP.INI" , "PalmTop" , "DirPalm" , cDirPalm )
        Select USUARIOS
	#IfDef SQL
	   u_codemp  := EMPRESAS->c_codigo
	   lOk := sr_file( "A_FILIAL" ) 
	#Else
           lOk := File( cDirData+"A_FILIAL.DBF" )
        #EndIF
	If ! lOk
            Alerta("O arquivo "+cDirData+"A_FILIAL nÆo existe!",.T.,10)
        Endif
    Endif
Elseif cVar=="U_FILIAL"
    #IfDef SQL
       Use ("a_filial") Alias FILIAIS Via _RDD New Shared
       Sr_SetFilter("c_emp='"+u_codemp+"'")
    #Else
       Use (cDirData+"a_filial") Alias FILIAIS New Shared
    #EndIf
    If NetErr()
        Alerta("NÆo foi poss¡vel abrir o arquivo A_FILIAL.DBF!",.T.,10)
    Elseif u_Nivel>0 .and. USUARIOS->( !Empty(c_lojas) .and. ! u_filial $ Transform(c_lojas,"@KR 99-99-99-99-99-99-99-99") )
        Alerta("Acesso nÆo autorizado!",.T.,10)
        FILIAIS->(DbCloseArea())
    Else
        #IfDef SQL
           DbSetIndex( "c_codigo" )
	#Else
           If ! File( cDirIdx+"i_filia1.ntx" )
               Index on c_codigo to &(cDirIdx+"i_filia1")
           Endif
           DbSetIndex( cDirIdx+"i_filia1" )
        #EndIf
	   lOk := DbSeek( u_Filial )
	If lOk
            u_lojas    := USUARIOS->c_lojas  
            u_nFilial  := Trim( c_filial )
            u_Fantasia := AllTrim( FILIAIS->c_fantasia )
            u_Cidade   := c_cidade+"-"+c_uf
        Else
           Alerta("A loja informada nÆo existe!",.T.,10)
        Endif
	
	DbCLearIndex()
        DbCloseArea()

    EndIf
    Select USUARIOS
Endif
Return ( lOk )
*********
* f i m *
*********
STATIC FUNCTION SayPasta( nPasta )
Local cCor := SubStr( cor_say , At("/",cor_say) )
SetColor(cor_say)
@ 05,03 Clear to 19,30
Destaque(06,05,"^1.Cadastros e Tabelas")
Destaque(09,05,"^2.Estoques e Faturamento")
Destaque(12,05,"^3.Contas a Pagar/Receber")
Destaque(15,05,"^4.Caixas e Bancos")
Destaque(18,05,"^5.Utilit rios")
Botao(05,30,19,76)
Botao(06,31,18,75,.t.)
Botao(02+nPasta*3,03,04+nPasta*3,30)
@ 02+nPasta*3,30 Say If(nPasta==1,"Ä","Ù") Color "w+"+cCor
@ Row()+1    ,30 Say " "
@ Row()+1    ,30 Say If(nPasta==5,"Ä","¿") Color If(nPasta==5,"n","w+")+cCor
SetColor(cor_menu2)
@ 07,32 Clear to 17,74
If nPasta==1
    @ 08,32 Say " Neste m¢dulo vocˆ ter  acesso a:          "
    @ 09,32 Say "                                           "
    @ 10,32 Say "  þ Clientes         þ Bancos/portadores   "
    @ 11,32 Say "  þ Fornecedores     þ Centros de custo    "
    @ 12,32 Say "  þ Produtos         þ Documentos          "
    @ 13,32 Say "  þ Vendedores       þ Tabela de impostos  "
    @ 14,32 Say "  þ Transportadoras  þ Lojas e filiais     "
    @ 15,32 Say "  þ Op.Comerciais    þ Plano de contas     "
    @ 16,32 Say "  þ Planos de pagto  þ Contas banc rias    "
Elseif nPasta==2
    @ 08,32 Say " Principais fun‡äes dispon¡veis:           "
    @ 09,32 Say "                                           "
    @ 10,32 Say "  þ Compras           þ Curvas ABC         "
    @ 11,32 Say "  þ Vendas            þ Notas Fiscais      "
    @ 12,32 Say "  þ Or‡amentos        þ Cupom fiscal       "
    @ 13,32 Say "  þ Pedidos           þ Credi rio          "
    @ 14,32 Say "  þ Transferˆncias    þ Balan‡os           "
    @ 15,32 Say "  þ Cargas            þ Invent rios        "
    @ 16,32 Say "  þ Comissäes         þ Ficha de Estoque   "
Elseif nPasta==3
    @ 08,32 Say " Principais fun‡äes dispon¡veis:           "
    @ 09,32 Say "                                           "
    @ 10,32 Say "  þ Cadastro de titulos  þ Cartäes         "
    @ 11,32 Say "  þ Baixas               þ Faturas         "
    @ 12,32 Say "  þ Cobran‡a interna     þ Rec. x Despesas "
    @ 13,32 Say "  þ Cobran‡a banc ria    þ Boletos         "
    @ 14,32 Say "  þ Renegocia‡Æo         þ Recibos         "
    @ 15,32 Say "  þ SPC                                    "
    @ 16,32 Say "  þ Controle de cheques                    "
Elseif nPasta==4
    @ 08,32 Say " Principais fun‡äes dispon¡veis:           "
    @ 09,32 Say "                                           "
    @ 10,32 Say "  þ Abertura                               "
    @ 11,32 Say "  þ Lan‡amentos de Entrada/Sa¡da           "
    @ 12,32 Say "  þ Atendimento balcÆo                     "
    @ 13,32 Say "  þ Fechamento                             "
    @ 14,32 Say "  þ Movimento Banc rio                     "
Elseif nPasta==5
    @ 08,32 Say " Principais fun‡äes dispon¡veis:           "
    @ 09,32 Say "                                           "
    @ 10,32 Say " þ Manuten‡Æo de arquivos  þ Cores         "
    @ 11,32 Say " þ Integra‡Æo de lojas     þ Desktop       "
    @ 12,32 Say " þ PalmTop's               þ Impres.Fiscal "
    @ 13,32 Say " þ SINTEGRA                þ Esta‡äes trab."
    @ 14,32 Say " þ Editor de Textos        þ Parƒmetros    "
    @ 15,32 Say " þ Seguran‡a                               "
    @ 16,32 Say " þ N¡veis de usu rios                      "
Endif
SetColor(cor_say+","+cor_get)
Return
*********
* f i m *
*********
[code]
Avatar do usuário
sygecom
Administrador
Administrador
Mensagens: 7131
Registrado em: 21 Jul 2006 10:12
Localização: Alvorada-RS
Contato:

Re: Destrinchar Fonte

Mensagem por sygecom »

Olá João,
As vez pegar codigo de terceiro da mais trabalho do que fazer do zero, tente explicar melhor e com mais detalhes do que você deseja.
Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
Responder