FiveTech Support Forums

// check for valid user and get and set global rights
// login.prg

lOK    := .F.
oDLG   := NIL
cSAY   := " "

xREAD  := " "
xWRITE := " "
xLOGIN := " "
xSUPER := " "
xAdmin := " "

cAUTH  := 'N'
lOK1   := .F.
DEFINE DIALOG oDlg                                            ;
       FROM 5, 8 to 10, 75                                    ;
       TITLE "Logging In ...... Please be patient"            ;
       STYLE nOr( WS_POPUP,WS_CAPTION,WS_THICKFRAME )

       cSAY :=  "Validating User "

       @ 1,13 SAY oSAY VAR cSAY of oDLG //COLOR "N/W"

       oDLG:bStart := { || lOK1 := _Login( cAUTH, oDLG, @oSAY, @cSAY)}

ACTIVATE DIALOG oDLG CENTERED

IF lOK1 = .F.
   RETURN(NIL)
ENDIF

IF xLOGIN = "UNKNOWN"

   SAYING := "The System could not resolve your UserID "+CHR(10)
   SAYING += UPPER( WNetGetuser() )+CHR(10)
   SAYING += "Would you like to Login Manually ?"+CHR(10)

   IF MsgYesNo( SAYING )
      IF _log_in("L")              // log_in.prg
      ELSE
         CLOSE DATABASES
         RETURN(NIL)
      ENDIF
   ELSE
      CLOSE DATABASES
      RETURN(NIL)
   ENDIF

ENDIF

...
...

// end



//---------------------
FUNC _LOGIN( cAUTH, oDLG, oSAY, cSAY )

LOCAL cNAME,SAYING,nPOS,cDEFA,lOK := .F.
LOCAL oRsStaff,cSql,oErr,cFind,lFirst
Local nEid

#INCLUDE "FIVEWIN.CH"

// -- initial setup

cDEFA  := SET(7)
xLOGIN := substr(upper(WNetGetuser()+space(25)),1,25)   // fivewin

cSAY := "Validating User "+xLOGIN
oSAY:ReFresh()
SysReFresh()

lFirst := .f.

oRsStaff := TOleAuto():New( "ADODB.Recordset" )
oRsStaff:CursorType     := 1        // opendkeyset
oRsStaff:CursorLocation := 3        // local cache
oRsStaff:LockType       := 3        // lockoportunistic

// redundant check .. should never happen unless
// all staff users get deleted

cSql := "Select * From [Staff] where [UserId] = '"+alltrim(xLOGIN)+"'"

TRY
   oRsStaff:Open( cSQL, xCONNECT )
CATCH oErr
   MsgInfo( "Error in Opening STAFF table" )
   oDLG:END()
   RETURN(.F.)
END TRY

IF oRsStaff:eof
   xLOGIN := "UNKNOWN"
   xREAD  := 'Y'
   xWRITE := 'N'
   xSUPER := 'N'
ELSE

   xREAD   := if(empty(oRsStaff:Fields("ReadOnly"):Value), "Y",oRsStaff:Fields("ReadOnly"):Value )
   xWRITE  := if(empty(oRsStaff:Fields("WriteOnly"):Value),"N",oRsStaff:Fields("WriteOnly"):Value )
   xSUPER  := if(empty(oRsStaff:Fields("Super"):Value),    "N",oRsStaff:Fields("Super"):Value )
   xLogin  := alltrim(oRsStaff:Fields("UserId"):Value)  // 25

   oRsStaff:Fields("LastLog"):Value := dtoc(date())+" "+time()
   oRsStaff:Update()

ENDIF

oRsStaff:Close()
oRsStaff := nil
oDLG:END()

RETURN(.T.)

//---------------------
FUNC _log_in( cFROM )

Local lOK
Local oBTN1,oBTN2,oUSERID,oPASS,cUSERID,cPASS,SAYING
Local oDLG, oRsUser, oErr, cSQL, oBMP

Local cMODE := "E"
Local cDEFA := SET(7)

// cFROM is where the variable was passed
//  if "M" .. main menu login .. if password is blank  deny login
//  if "L" .. first login screen .. allow

IF EMPTY( cFROM )
   cFROM := "M"
 *   cFROM := "L"
ENDIF

lOK := .F.

oRsUser := TOleAuto():New( "ADODB.Recordset" )
oRsUser:CursorType     := 1        // opendkeyset
oRsUser:CursorLocation := 3        // local cache
oRsUser:LockType       := 3        // lockoportunistic

cSQL := "SELECT * From [Staff] Order by [Lname]"

TRY
  oRsUser:Open(cSQL,xCONNECT )
CATCH oErr
  MsgInfo( "Error in Opening Staff table" )
  RETURN(.F.)
END TRY

cUSERID   := SPACE(25)
cPASS     := SPACE(15)

//------

DEFINE BITMAP oBmp RESOURCE "USERVIEW"
DEFINE DIALOG oDlg RESOURCE "LOGIN"

   REDEFINE GET oUSERID var cUSERID ID 110 of oDLG   UPDATE
   REDEFINE GET oPASS   var cPASS   ID 120 of oDLG   UPDATE

   REDEFINE BTNBMP oBtn1 ID 111 OF oDlg   ;
         RESOURCE "OK", "DOK", "DOK" ;
         PROMPT "  &Ok    " LEFT 2007;
         ACTION ( IF(cMODE = "V",lOK := .T. , lOK := _busrules( oRsUser, cFROM,;
                                                      @cUserid,@cPass,oUserId,oPass,@lOk,oDlg) ), ;
                  IF(cMODE = "V",lOK := .T. , if(lOK = .T., _doit( oRsUser,cUserId,cPass,@lOk,oDlg), )),;
                  IF(lOK = .T., oDLG:END(), ))

   REDEFINE BTNBMP oBtn2 ID 112 OF oDlg   ;
         RESOURCE "CANCEL", "DCANCEL", "DCANCEL" ;
         PROMPT "&Cancel   " LEFT 2007;
         ACTION ( lOK := .F., oDLG:END() )


ACTIVATE DIALOG oDlg CENTERED ;
         ON PAINT (PalBmpDraw( hDC, 0, 0, oBmp:hBitmap ))


oBmp:End()
oRsUser:Close()

RETURN(lOK)

//----------------------------
Static FUNC _Busrules( oRsUser,cFROM,cUserid,cPass,oUserId,oPass,lOk,oDlg )

LOCAL SAYING,xPASS,xUserid

IF EMPTY( cUSERID )  .or. cUSERID = "  "
   SAYING := "SORRY ... USERID can not be left Blank"
   MsgInfo( SAYING )
   oUSERID:SetFocus()
   RETURN(.F.)
ENDIF

IF EMPTY( cPASS ) .or. cPASS = "  "
   SAYING := "SORRY ... PASSWORD can not be left Blank"
   MsgInfo( SAYING )
   oPASS:SetFocus()
   RETURN(.F.)
ENDIF

cUserId := upper(cUSERID)
cPASS   := substr(alltrim( cPASS )+space(15),1,15)

oRsUser:MoveFirst()
oRsUser:Find("[UserId] = '"+cUSERID+"'" )

IF oRsUser:eof
   SAYING := "SORRY ... UserId   "+alltrim(cUSERID)+"   could not be found "+CHR(10)
   SAYING += "Would you like to try again ?"+CHR(10)

   IF MsgYesNo( SAYING )
      cUSERID := SPACE(25)
      oUSERID:ReFresh()
      oUSERID:SetFocus()
      RETURN(.F.)
   ELSE
      lOK := .F.
      RETURN(.F.)
   ENDIF
ENDIF

IF empty(oRsUser:Fields("PASSWORD"):Value) .or.;
   oRsUser:Fields("PASSWORD"):Value = "  "

   IF cFROM = "L"
   ELSE
      SAYING := "SORRY ... there is no Password set for "+cUSERID+CHR(10)
      SAYING += "You can not Login from the Main Menu Login screen"+chr(10)
      SAYING += "without a Password .. Please contact your SYSTEM Admin"+chr(10)
      SAYING += "to have them re-set or create your password"+chr(10)
      MsgInfo( saying )
      cPASS := SPACE(25)
      oPASS:ReFresh()
      oPASS:SetFocus()
      RETURN(.F.)
   ENDIF

   SAYING := "No Password has been set for User  "+cUSERID+CHR(10)
   SAYING += "Would you like '"+cPASS+"' to be your Password ?"+CHR(10)
   IF MsgYesNo( SAYING )
      oRsUser:Fields("PASSWORD"):Value := substr(ENCRYPT( cPASS )+space(15),1,15)
      oRsUser:Update()
   ELSE
      cPASS := SPACE(15)
      oPASS:ReFresh()
      oPASS:SetFocus()
      RETURN(.F.)
   ENDIF

ENDIF

xPASS := ALLTRIM(oRsUser:Fields("PASSWORD"):Value)
xPASS := DENCRYPT( xPASS )
xPASS := substr(alltrim( xPASS )+space(15),1,15)

IF cPASS = xPASS
ELSE
   SAYING := "SORRY ... You have typed in the Wrong Password "+CHR(10)
   SAYING += "Would you like to try again ?"+CHR(10)

   IF MsgYesNo( SAYING )
      cPASS:= SPACE(15)
      oPASS:ReFresh()
      oPASS:SetFocus()
      RETURN(.F.)
   ELSE
      lOK := .F.
      oDLG:END()
      Return(.f.)
   ENDIF
ENDIF

If empty(oRsUser:FIelds("Active"):Value) .or. ;
         oRsUser:Fields("Active"):Value = "N"
   Saying := "Sorry .. "+cUSERID+" has been marked INACTIVE and can not Login"
   MsgInfo( Saying )
   lOK := .F.
   oDLG:END()
   Return(.f.)
Endif

RETURN(.T.)

//----------------------------
Static FUNC _doit( oRsUser,cUserId,cPass,lOk,oDlg )

Local cName

xLOGIN   := alltrim(oRsUser:Fields("UserId"):Value)
xREAD    := oRsUser:Fields("READONLY"):Value
xWRITE   := oRsUser:Fields("WRITEONLY"):Value
xSUPER   := oRsUser:Fields("SUPER"):Value
xAdmin   := " "

oRsUser:Fields("lastlog"):Value := dtoc(DATE())+" "+Time()
oRsUser:Update()


lOK := .T.
oDLG:END()

RETURN(lOK)