PC Toledo

Código: Selecionar todos

function GetPassword( oGet )

LOCAL nKey,              ;
      nChar,             ;
      cKey

  // read the GET if the WHEN condition is satisfied
  IF ( GetPreValidate(oGet) )
    // activate the GET for reading
    oGet:SetFocus()

    oGet:cargo := ""
    DO WHILE ( oGet:exitState == 0 )
      // check for initial typeout (no editable positions)
      IF ( oGet:typeOut )
        oGet:exitState := GE_ENTER
      ENDIF

      // apply keystrokes until exit
      DO WHILE ( oGet:exitState == 0 )
        nKey := InKey(0)
        IF nKey >= 32 .AND. nKey <= 255
          oGet:cargo += Chr(nKey)
          GetApplyKey(oGet, Asc("*"))
       	ELSEIF nKey == K_BS
          oGet:cargo := Substr(oGet:cargo, 1, Len(oGet:cargo) - 1)
          GetapplyKey(oGet, nKey)
        ELSEIF nKey == K_ENTER
          GetApplyKey(oGet, nKey)
        ENDIF
      ENDDO

      // disallow exit if the VALID condition is not satisfied
      IF ( !GetPostValidate(oGet) )
        oGet:exitState := 0
      ENDIF
    ENDDO
    // de-activate the GET
    oGet:KillFocus()
  ENDIF
  IF oGet:exitState != 7
    oGet:varPut(oGet:cargo)
  ENDIF

RETURN

Código: Selecionar todos

   cUsuSis := ""
   cSenSis := ""
   *
   DO WHILE .T.
      GetLoginUsuario(@cUsuSis, @cSenSis)
      IF Empty(cUsuSis) .AND. Empty(cSenSis)
        SaidaSist() //função para sair do sistema
      ENDIF
      cChave := cUsuSis + cSenSis
      IF ! USUARIO->( DbSeek( cChave ) )
         IF hwg_MsgYesNo( "Usuário ou senha inválida, tentar outra vez?", "Atenção" )
            LOOP
         ENDIF
         SaidaSist()
      ENDIF
      EXIT
   ENDDO

Código: Selecionar todos

FUNCTION GetLoginUsuario( cUsuario, cSenha )
LOCAL lOk:=.F., oFont, vSenha := Space(1), vUsuario := Space(1) 
LOCAL oIconOk := HIcon():AddResource("ICON_OK16"), oIconSair := HIcon():AddResource("ICON_SAIR16"), lContinua := .T.
PRIVATE lValida := .F., oGetcUsuario, oGetcSenha
   
   oFont := HFont():Add( "Courier New", 0, -16, 550 ) 

   DO WHILE lContinua

      INIT DIALOG oDlgAcesso TITLE "Acesso ao Sistema" ;
                  AT 0, 0 ;
                  SIZE 230, 150 ;
                  STYLE DS_CENTER + WS_VISIBLE + WS_SYSMENU ;
                  ICON HIcon():AddResource("ICON_CADEADO") ;
                  FONT oFont ;
                  CLIPPER ; 
                  NOEXIT ;
                  ON INIT { | o | o:nInitFocus:=oGetcUsuario } 
      
      @  30, 20 SAY "Usuário" SIZE 80, 20 
      
      @ 110, 17 GET oGetcUsuario VAR vUsuario SIZE 80, 28 PICTURE '@!' STYLE WS_DLGFRAME MAXLENGTH 6 COLOR ::hwg_RGB(0, 0, 255) BACKCOLOR 16777172 TOOLTIP "Digite o usuário." 

      @  30, 50 SAY "Senha" SIZE 80, 20 Tooltip 'Digite a Senha' 
      
      @ 110, 47 GET oGetcSenha VAR vSenha SIZE 80, 28 PASSWORD STYLE WS_DLGFRAME MAXLENGTH 6 COLOR ::hwg_RGB(0, 0, 255) BACKCOLOR 16777172 TOOLTIP "Digite a senha de acesso." 
      
      @  30, 85 BUTTONEX btnOk ;
                         CAPTION  "Entrar" ;
                         ON CLICK {||IF(!ValidaUsuarioSenha( @cUsuario, @cSenha ), oGetcUsuario:SetFocus(), hwg_EndDialog())} ;
                         SIZE     70, 20 ;
                         ICON     oIconOk:handle  ;
                         FONT HFont():Add( "Arial", 0, -13, 550 ) ;
                         STYLE WS_TABSTOP ;
                         TOOLTIP   "Entrar com a senha de acesso." 

      @ 120, 85 BUTTONEX btnSair ;
                         CAPTION  "Sair" ;
                         ON CLICK {||HWG_EndDialog()} ;
                         SIZE     70, 20 ;
                         ICON     oIconSair:handle  ;
                         FONT HFont():Add( "Arial", 0, -13, 550 ) ;
                         STYLE WS_TABSTOP ;
                         TOOLTIP   "Sair do sistema." 

      oDlgAcesso:Activate()

      lOk := lValida
      RELEASE lValida
      EXIT
   ENDDO
   
   oFont:Release()
      
RETURN lOk

FUNCTION ValidaUsuarioSenha( cUsuario, cSenha ) 
LOCAL cErro:="", lResp:=.T.
      DO CASE
      CASE Empty(oGetcUsuario:VarGet()) .AND. Empty(oGetcSenha:VarGet())
         cErro := "Usuário e senha inválida."
      CASE Empty(oGetcUsuario:VarGet())
         cErro := "Usuário inválido."
      CASE Empty(oGetcSenha:VarGet())
         cErro := "Senha inválida."
      ENDCASE
      lValida := Empty(cErro)
      IF !lValida
         IF hwg_MsgYesNo(cErro+" tentar outra vez?", "Atenção")
            oGetcUsuario:VarPut(Space(6))
            oGetcSenha:VarPut(Space(6))
            oGetcUsuario:Refresh()
            oGetcSenha:Refresh()
         ELSE
            lValida  := .T.
            cUsuario := ""
            cSenha   := ""
         ENDIF
      ELSE
         cUsuario := AllTrim(oGetcUsuario:VarGet())
         cSenha   := AllTrim(oGetcSenha:VarGet())
      ENDIF
RETURN lValida