Robert G. Erhart Bob Erhart Rochester New York

HOME

ADD MESSAGE

PAGE/EMAIL

TAKE A DEMO SURVEY

SEE DEMO SURVEY RESULTS

VBA DEMO

BACK TO SOURCE CODE LISTING

'======================================================================
'Function Name      :ADOGetUserInfo(strAuthUser)
'Programmer         :R.G. Erhart, 121931
'Date Written       :11/17/1999
'Purpose            :Query the Database for information about the user.
'                    This will include the users name and contact information
'                    and the users access privilages.
'					 Populate global array
'					 If the user ID is not found, the requery for default user
'					 This is done so the user privilages can be set to visitor
'-------------------+---------------------------+-----------------------
'Parameters         |Name                       |Description
'                   |strAuthUser                |The User accessing the script
'                   |adoConnectString_Data_Read |The ADO Connect String 
'-------------------+---------------------------+-----------------------
'Dependencies      
'   Functions()     :SingleQuote()
'   Subs()          :None
'   Globals         :aryUserInfo(24,2)          |Array that hold all the
'                                 ^ ^           |Employeeinfo Values. If 
'                                 | |           |
'                    Field Number-+ |           |       
'                    Field Value ---+           |
'Return Value       :ADOGetUserInfo             |Access Privilage
'======================================================================
Dim intUserInfoRecordCount
Dim intUserInfoFieldCount
Dim aryUserInfo(64,2)
Private Function ADOGetUserInfo(strAuthUser)
 Dim lngRecordsFound 
     lngRecordsFound    = 0 
 Dim lngRecordsFound1 
     lngRecordsFound1    = 0 
 Dim lngOrdinalPosition 
     lngOrdinalPosition = 0 
 Dim lngFieldCount    
     lngFieldCount      = 0
 
 Dim adoTableName
 Dim strSql
 Dim intAccessPrivilage
 Dim intZeroPad
 Dim strUserID
 Dim booRecordFound
     booRecordFound = False
 Dim objConnSession
 Dim objRS
 Dim intPtr
 Dim objSessionID

'----------------------------------------------------------------------
 'Query the Database and see if the Userid passed is in the Database.
 'If found, set all the userID info to the Global aryUserInfo() array,
 'and return the Access Privilages for this UserID.
 '----------------------------------------------------------------------    
	adoTableName			= "UserInfo"
 strSql					    = "SELECT * FROM [" & adoTableName & "] WHERE [UserID]=" & SingleQuote(strAuthUser) & ";"
	Session.timeout        = 1
	objSessionID           = Session.SessionID
	Set objConnSession     = Server.CreateObject("ADODB.Connection")
     objConnSession.Open adoConnectString_Data_Read
	Set objRS              = objConnSession.Execute(strsql)
		   lngFieldCount      = objRS.Fields.Count
	On Error Resume Next     
	objRS.MoveFirst  
	intAccessPrivilage	    = objRS.Fields("AccessPrivilage").Value
	strUserID              = objRS.Fields("UserID").Value
 do while Not objRS.eof		
  lngRecordsFound	      = lngRecordsFound + 1
  booRecordFound = True
	 For intPtr  = 0 to lngFieldCount
	  aryUserInfo(intPtr,0) = objRS.Fields(intPtr).Name           
	  aryUserInfo(intPtr,1) = objRS.Fields(intPtr).Value       		    
  Next
  objRS.MoveNext
 loop       
	objRS.Close      
	objConnSession.close

Select Case lngRecordsFound
  Case False
   '----------------------------------------------------------------------
   'Query the Database and see if the Userid passed is in the Database.
   'If found, set all the userID info to the Global aryUserInfo() array,
   'and return the Access Privilages for this UserID.
   '----------------------------------------------------------------------    
	  adoTableName			= "UserInfo"
   strSql					= "SELECT * FROM [" & adoTableName & "] WHERE [UserID]=" & SingleQuote("NEWUSER") & ";"
	  'Response.Write(strSql)
	  Session.timeout        = 1
	  objSessionID           = Session.SessionID
	  Set objConnSession     = Server.CreateObject("ADODB.Connection")
		                          objConnSession.Open adoConnectString_Data_Read
	  Set objRS              = objConnSession.Execute(strsql)
		     lngFieldCount        = objRS.Fields.Count
	  On Error Resume Next     
	  objRS.MoveFirst  
	  intAccessPrivilage	    = objRS.Fields("AccessPrivilage").Value
	  strUserID              = objRS.Fields("UserID").Value
   do while Not objRS.eof		
    lngRecordsFound	    = lngRecordsFound + 1 
    booRecordFound = True
	   For intPtr  = 0 to lngFieldCount     
	    aryUserInfo(intPtr,0) = objRS.Fields(intPtr).Name           
	    aryUserInfo(intPtr,1) = objRS.Fields(intPtr).Value         		     
    Next
    objRS.MoveNext
   loop       
	  objRS.Close      
	  objConnSession.close
  Case Else
   'Do Nothing
 End Select

intUserInfoRecordCount = lngRecordsFound
 intUserInfoFieldCount  = lngFieldCount
 ADOGetUserInfo         = intAccessPrivilage
End Function