KATHER Produkties

Sub CGI_Main()

    '
    ' Authenticate if no auth info
 present in request
    ' Force auth if extra path info is present
    '
    If CGI_AuthUser = "" Then
        '
        ' Full header, bypass server's header construction
        '
        Send "HTTP/1.0 401 Unauthorized"
        Send ("Server: " + CGI_ServerSoftware)
        Send ("Date: " + WebDate(Now))
        Send ("WWW-Authenticate: Basic realm=""Agenda""")
        Send ("Content-type: text/html")
        Send ("")
        '
        ' This is what the user sees if the cancel button
        ' is pressed on the username/password dialog.
        '
        Send ("")
        Send ("Cancelled")
        Send ("
")
        Send ("You clicked cancel")
        Send ("")
        exit Sub
    end If

'    MsgBox CGI_AuthUser
    
    sSelector = UCase$(Mid$(CGI_LogicalPath, 2))    ' Remove leading "/"

    DataBaseNaam = [yourdatabaselocationandname]
    set db = OpenDatabase(DataBaseNaam)
    
    If CheckUser(CGI_AuthUser) Then
        TabelNaam1 = CGI_AuthUser
        
        Send ("Content-type: text/html")
        Send ("X-CGI-prog: KATHER Produkties v.01 (VB4/32)")
        Send ("")
        Call Header
    
        select
 case UCase$(CGI_RequestMethod)
            case "GET":
                DoGet
            case "POST":
                DoPost
            case Else:
                Send ("Cannot 
do """ & CGI_RequestMethod & """ method")
        end Select
    Else
        Send ("Content-type: text/html")
        Send ("")
        Send ("")
        Send ("Connecting to central database")
        Send ("
")
        Send ("You don't have access to this database")
        Send ("")
        Send ("Please contact your systemmanager:")
        Send ("Username:   " + CGI_AuthUser)
        Send ("")
    end If
    db.Close

End Sub

Private Function CheckUser(name) As Integer
    Dim tb As Recordset
        
    CheckUser = False
    set tb = db.OpenRecordset([yourtable])
    do While Not tb.EOF
	'first fields contains the username!
        If UCase(tb.Fields(0).value) = UCase(name) Then
            CheckUser = True
            exit Function
            tb.Close
        end If
        tb.MoveNext
    Loop
    tb.Close
    
End Function



Return