Results 1 to 3 of 3
  1. #1
    Join Date
    Apr 2002
    Location
    Austin, Texas
    Posts
    4

    Unhappy Unanswered: Database Web Access

    A couple of years ago, a project hired a student to write VB5 code to link a Microsoft Access 97 database to their website. This was originally setup on a Windows NT 4.0 server. We moved the site to a Windows 2000 server and everything seems to work except opening the database. No experts on VB5 here anymore. We know that it is not a permissions issue. Here is the main code for opening the database. Is there something we have to change to make it work on Windows 2000.

    Dim ProfileName As String, ProfileDate As String, StartTime As String
    Dim i As Integer
    Dim MyFile As String
    Dim MyWorkspace As Workspace, MyDatabase As Database
    Dim Rs As Recordset
    Dim SQLquery As String
    Dim ErrorCondition As Integer

    MyFile = "d:\wwwroot\_vti_log\beach.mdb"
    ' MyFile = "d:\thscmp_cgi\Beach.mdb"
    On Error GoTo DBErrorHandler
    Set MyWorkspace = Workspaces(0)

    ' Send "reach request profile </body></html>"

    Set MyDatabase = MyWorkspace.OpenDatabase(MyFile)

    ' Send "reach request profile </body></html>"

    If Not ErrorCondition Then
    On Error GoTo RecordErrorHandler
    'open record set
    SQLquery = "SELECT * FROM [Beach profiles]"
    Set Rs = MyDatabase.OpenRecordset(SQLquery, dbOpenDynaset)

  2. #2
    Join Date
    Apr 2002
    Location
    London
    Posts
    10

    Question

    That doesn't look like all the code to me, do you want to post again?

  3. #3
    Join Date
    Apr 2002
    Location
    Austin, Texas
    Posts
    4
    Sorry.

    Attribute VB_Name = "requestProfile_main"
    Sub CGI_Main()
    'send html header
    Send "Status: 200 OK"
    Send "Content-type: text/html" & vbCrLf
    Send "<HTML><HEAD><TITLE>Data Input Form</TITLE></HEAD>"
    Send "<body background=""http://129.116.232.193/thscmp/inmotion.gif"" bgcolor=""#FFFFFF""" & _
    "link=""#003366"" vlink=""#003366"" alink=""#003366"" leftmargin=""15"" topmargin=""20"">"
    Send "<BASEFONT FACE=""Verdana,Arial,Helvetica"">"

    Dim ProfileName As String, ProfileDate As String, StartTime As String
    Dim i As Integer
    Dim MyFile As String
    Dim MyWorkspace As Workspace, MyDatabase As Database
    Dim Rs As Recordset
    Dim SQLquery As String
    Dim ErrorCondition As Integer

    MyFile = "d:\wwwroot\_vti_log\beach.mdb"
    ' MyFile = "d:\thscmp_cgi\Beach.mdb"
    On Error GoTo DBErrorHandler
    Set MyWorkspace = Workspaces(0)

    ' Send "reach request profile </body></html>"

    Set MyDatabase = MyWorkspace.OpenDatabase(MyFile)

    ' Send "reach request profile </body></html>"

    If Not ErrorCondition Then
    On Error GoTo RecordErrorHandler
    'open record set
    SQLquery = "SELECT * FROM [Beach profiles]"
    Set Rs = MyDatabase.OpenRecordset(SQLquery, dbOpenDynaset)
    If Not ErrorCondition Then
    If IsRecordsetEmpty(Rs) Then
    Send "<h4><font color =""#408080""> Recordset is empty </font></h4>"
    Send "<p>Check Profile Name, Date and Start Time. Make sure those values are correct.</p>"
    Send "<a href=""http://129.116.232.193/thscmp/query%20database.htm"">"
    Send "<img src=""http://129.116.232.193/thscmp/gif_jpg_img/back.gif"" width=""20"" height=""20""></a>"
    Send "<a href=""http://129.116.232.193/thscmp/query%20database.htm"">Back</a>"
    Send "</BODY></HTML>"
    Exit Sub
    End If
    Dim counter As Integer
    Rs.MoveLast
    counter = Rs.RecordCount
    Rs.MoveFirst
    Send "<font face=""arial, helvetica""><b>Request Profiles:</b><br><br>"
    Send "<p><font face=""arial, Helvetica, sans-serif"" size=""2"">"
    Send "xxxxx-yyyyyy-zzzz: x = name of profile location, y = date in year/month/day format, "
    Send "z = time in 24 hr. format. </font></p><!-- #EndLibraryItem -->"
    Send "<form method=""POST"" action=""http://129.116.232.193/scripts/thscmp_cgi/queryDatabase.exe"">"
    Send "<input type=""hidden"" name=""querytype"" value=""single"">"
    Send "<select name=""profile"" size=""1"">"

    For i = 1 To counter
    Send "<option>" & Rs![Profile name] & "-" & Rs![Date] & "-" & Rs![Start time] & "</option>"
    Rs.MoveNext
    Next i
    Rs.Close
    Send "</select> &nbsp;&nbsp; <input type=""submit"" value=""Request""> </form>"

    Send "<br>"
    Send "<a href=""http://129.116.232.193/thscmp/query%20database.htm"">"
    Send "<img src=""http://129.116.232.193/thscmp/gif_jpg_img/back.gif"" width=""20"" height=""20""></a>"
    Send "<a href=""http://129.116.232.193/thscmp/query%20database.htm"">Back</a>"
    Send "</BODY></HTML>"
    End If
    MyDatabase.Close
    End If
    On Error GoTo 0
    Exit Sub
    DBErrorHandler:
    ErrorCondition = True
    Send "Can't open database"
    Send "</BODY></HTML>"
    Resume Next
    RecordErrorHandler:
    ErrorCondition = True
    Send "Open record set failed"
    Send "</body></html>"
    Resume Next
    End Sub
    Private Function IsRecordsetEmpty(Rs As Recordset) As Boolean
    If Rs.BOF = True And Rs.EOF = True Then
    IsRecordsetEmpty = True
    Else
    IsRecordsetEmpty = False
    End If
    End Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •