// 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)