KATHER Produkties

'there are a few things you have to bare in mind:

'- get the right cgi32.bas file (on http://kather.xs4all.nl/Documents/cgi32.bas)
'- I use O'Reilly webserver software; I really don't tested it on other servers
'- this code is an extract from a working CGI-Executable
'- users can give more search-words with (or without) the AND /OR
'- you have to need access to the cgi-win directory on your server
'- assumed is the existence of a access database in a directory your users can access
'- if you have all that then go on....

'in VB4 (5?)
'make a new module form
'put the next code on the bas-file
'make an executable (named=search.exe) and copy it to the cgi-win directory
'make a link on your html-page like 
'set db = OpenDatabase(DataBaseNaam)

    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

    db.Close

End Sub

Sub DoGet()
    dim LinkStart As String
    dim SQL$
    
    SQL$ = "SELECT * FROM " & TabelNaam
    
    LinkStart = "select case sSelector
        case ""                 ' No "selector", list choices
            Send ("")
            Send ("")
            Send ("")
            Send ("Make your choice:
" & LinkStart & "/List"">List of books
" & LinkStart & "/Search"">Search for books")
            Call Footer
            
        case "LIST"         ' list of all books
            Send ("All the books:")
            SQL$ = SQL$ & " ORDER BY title"
            set ds = db.OpenRecordset(SQL$)
            Call InvullenLijst
            Call Footer
            ds.Close

        case "SEARCH":      ' search for book
            Send ("Search for a book")
            Send ("")
            'make form with inputbox

            Send ("Search for: 
")
            Send ("")
            Send ("")
            Send ("")
            Call Footer
        
        case Else:
            Send ("Bad GET selector """ & sSelector & """")

    end Select

End Sub

Sub DoPost()
    dim
 buffer As String
    dim SQL$
    dim l_counter%
    
    on Error GoTo OnPostError       ' We need to handle errors here
    SQL$ = "SELECT * FROM " & TabelNaam

    select
 case sSelector
        case "SEARCHING":      ' searching for a book
	    buffer = GetSmallField("dZoeken")
	    SQL$ = SQL$ & MaakSQLString(buffer)
            set ds = db.OpenRecordset(SQL$)
            If ds.BOF And ds.EOF Then
                Send ("Nothing found:")
                Send ("Title = " & buffer)
                Call Footer
            Else
                Send ("Found books")
                Call InvullenLijst
                Call Footer
            end If
            ds.Close                    
        
        case Else:
            Send ("Unknown POST selector """ & sSelector & """")

    end Select

DoPostFinish:                   ' Can come here via error,
                                ' State of ds & qd unknown
    on
 Error Resume Next        ' make damn sure ds and qd are closed
    ds.Close                    ' else db.Close will fail and you lose
    qd.Close

    Exit Sub

' =================
' Exception Handler
' =================
'
OnPostError:
    
    If Err >= CGI_ERR_START Then Error Err  ' Resignal if a CGI.BAS error

    Send ("There was a problem:")
    Send ("VB reports: " & Error$ & " (error #" & Err & ")Best Guess:")

    
select
 case sSelector
        case Else:
            Send ("Programmer error: Unknown selector in POST exception handler.")
    end Select
    
    Send ("")
    
    Resume DoPostFinish

End Sub


Sub Header()
    Send ("")
End Sub


Sub Footer()
    Send ("KATHER Produkties
")
    Send ("System Datum/Tijd: " & Now)
    Send ("")
End Sub


Sub InvullenLijst()
    Send ("")
    Send ("")
    Do Until ds.EOF
        Send ("")
        Send ("")
        Send ("")
        Send ("")
        ds.MoveNext
    Loop
    Send ("title auteur
" & ds("title") & " " & ds("auteur") & "")

End Sub

Function MaakSQLString(bron$)
    dim p, l_counter%, t%
    dim TempBron$, tempdata$
    dim criteria() As String
    dim lastCriteria As Boolean
    
    TempBron$ = bron$
    t% = 0
    For l_counter% = 1 To Len(bron$)
        p = InStr(TempBron$, Chr(32))
        If p <> 0 Then
            ReDim Preserve criteria(t%)
            criteria(t%) = Left$(TempBron$, p - 1)
            TempBron$ = Right$(TempBron$, Len(TempBron$) - p)
            t% = t% + 1
            l_counter% = l_counter% + p
        end If
    Next l_counter%
    ReDim Preserve criteria(t%)
    criteria(t%) = TempBron$
    
    lastCriteria = True
    tempdata$ = " WHERE "
    For l_counter% = 0 To t%
        select
 case criteria(l_counter%)
        case "EN", "en", "AND", "and", "+"
            tempdata$ = tempdata$ & " AND "
            lastCriteria = True
        case "OF", "of", "OR", "or"
            tempdata$ = tempdata$ & " OR "
            lastCriteria = True
        case Else
            If Not lastCriteria Then
                tempdata$ = tempdata$ & " AND ( title LIKE '*" & criteria(l_counter%) & "*') "
            Else
                tempdata$ = tempdata$ & "( title LIKE '*" & criteria(l_counter%) & "*') "
                lastCriteria = False
            end If
        end Select
    Next l_counter%
    
    MaakSQLString = tempdata$
    
End Function
title	auteur
" & ds("title") & "	" & ds("auteur") & "
Return