Search Search

#1 worldwide
FREE Coding Lessons

since 1996
   THE BEST WAY to learn ASP & Asp.net!
Advertise Here!
click for details
Credits Host:
DiscountASP.net
Server Admin:
The "Team"
Contact Info.
Charles M. Carroll

my Blog
[prev. Lesson]  VB: ADO, Run It!
     [next Lesson]  VB: Warnings/Guidelines

VB Component: DBHelper by Charles Carroll

This page has the source code to the component. We have specified:
     project name=charlescarroll
     class name=dbhelperver001
Remember these are the names set in the property window, not neccesarily the filenames.

This example will not compile unless you go to the "Project; References" menu and check/turn on the following libraries:

  • Microsoft "Active Data Objects" object library
  • Microsoft "Active Server Pages" object library
   filename=/learn/test/charlescarrolldbhelperver001.cls

<Test Script Below>


VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "dbhelperver001"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
' projectname =charlescarroll
' classname   =dbhelperver001
Private ASPresponse As Response
Private ASPserver As Server
Private htmlstart, htmlend, rowstart, rowend
Private fieldstart, fieldend, namestart, nameend
Public Sub onstartpage(sc As ScriptingContext)
       Set ASPresponse = sc.Response()
       Set ASPserver = sc.Server()
End Sub
Public Property Let connect(temp As Variant)
       myconnect = temp
End Property
Public Property Get connect() As Variant
       connectme = myconnect
End Property
Public Property Get fieldnames() As Variant
       fieldnames = myfieldnames
End Property

Public Property Let fieldnames(temp As Variant)
       myfieldnames = temp
End Property

Public Property Let query(temp As Variant)
       myquery = temp
End Property
Public Property Get query() As Variant
       query = myquery
End Property

Public Property Let selectdefault(temp As Variant)
       myselectdefault = temp
End Property
Public Property Get selectdefault() As Variant
       selectdefault = myselectdefault
End Property
Public Property Let selectname(temp As Variant)
       myselectname = temp
End Property
Public Property Get selectname() As Variant
       selectname = myselectname
End Property

Public Sub query2list()
   htmlstart = "<select name='" & selectname & "'>"
   htmlend = "</select>"
   rowstart = "<option>"
   rowend = "</option>"
   fieldstart = ""
   fieldend = ""
   Call query2html
End Sub

Public Sub query2table()
   htmlstart = "<table border=1>"
   htmlend = "</table>"
   rowstart = "<tr>"
   rowend = "</tr>"
   fieldstart = "<td valign=top>"
   fieldend = "</td>"
   Call query2html
End Sub

Public Sub query2form()
   htmlstart = ""
   htmlend = ""
   rowstart = ""
   rowend = "<hr>"
   fieldstart = ""
   fieldend = "<br>"
   fieldnames = True
   namestart = ""
   nameend = "&nbsp;=&nbsp;"
   Call query2html
End Sub

Public Sub query2entryform()
   htmlstart = ""
   htmlend = ""
   rowstart = ""
   rowend = ""
   fieldstart = "%name%&nbsp;=&nbsp;<input type='text name='%name%' value='"
   fieldend = "' size='%size%'><br>"
   fieldnames = False
   namestart = ""
   nameend = "&nbsp;&nbsp;="
   Call query2html
End Sub

Public Sub CustomDisplay(PARMhtmlstart, PARMhtmlend, PARMrowstart, PARMrowend, _
                      PARMfieldstart, PARMfieldend, PARMfieldnames, _
                      PARMnamestart, PARMnameend)
   htmlstart = PARMhtmlstart
   htmlend = PARMhtmlend
   rowstart = PARMrowstart
   rowend = PARMrowend
   fieldstart = PARMfieldstart
   fieldend = PARMfieldend
   fieldnames = PARMfieldnames
   namestart = PARMnamestart
   nameend = PARMnameend
   Call query2html
End Sub


Private Sub query2html()
       On Error GoTo Badnews
       attempt = "creating connection"
       Set conntemp = ASPserver.CreateObject("adodb.connection")
       
       attempt = "opening connection"
       conntemp.Open myconnect
       
       attempt = "making recordset"
       Set rstemp = conntemp.Execute(myquery)
       howmanyfields = rstemp.Fields.Count - 1
       ReDim fsa(howmanyfields)
       ReDim fea(howmanyfields)
       For i = 0 To howmanyfields
            tempstart = Replace(fieldstart, "%name%", rstemp(i).Name)
            tempend = Replace(fieldend, "%name%", rstemp(i).Name)
            tempstart = Replace(tempstart, "%size%", rstemp(i).ActualSize)
            tempend = Replace(tempend, "%size%", rstemp(i).ActualSize)
       fsa(i) = myfieldstart
       fea(i) = myfieldend
       Next
       ASPresponse.Write htmlstart & vbCrLf
       Counter = 0
       Do While Not rstemp.EOF
       ASPresponse.Write rowstart & vbCrLf
       For i = 0 To howmanyfields
       If fieldnames = True Then
       ASPresponse.Write namestart & rstemp(i).Name & nameend
       End If
       ASPresponse.Write fsa(i) & rstemp(i) & fea(i) & vbCrLf
       Next
       ASPresponse.Write rowend & vbCrLf
       Counter = Counter + 1
       rstemp.MoveNext
       Loop
       rstemp.Close
       Set rstemp = Nothing
       conntemp.Close
       Set conntemp = Nothing
       ASPresponse.Write htmlend
       Exit Sub
Badnews:
       temp = "Error: " & attempt & "<br>"
       temp = temp & Err.Description & "<br>"
       temp = temp & Err.Number
       ASPresponse.Write temp
End Sub

There are many worthy charities!!. But perhaps help starving children in Africa or South America AND help Charles too. a $5 tip buys him lunch at McDonalds, a $20 tip buys his kid Hitoshi a new computer game, a $39 tip buys his daughter Michiko a few nice outfits. See our donor list.