'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 ("Make your choice: ")
Send ("" & LinkStart & "/List"">List of books ")
Send ("" & LinkStart & "/Search"">Search for books ")
Send ("
")
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 ("")
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 ("title auteur ")
Do Until ds.EOF
Send ("")
Send ("" & ds("title") & " ")
Send ("" & ds("auteur") & " ")
Send (" ")
ds.MoveNext
Loop
Send ("
")
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
Return