|
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
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 = " = "
Call query2html
End Sub
Public Sub query2entryform()
htmlstart = ""
htmlend = ""
rowstart = ""
rowend = ""
fieldstart = "%name% = <input type='text name='%name%' value='"
fieldend = "' size='%size%'><br>"
fieldnames = False
namestart = ""
nameend = " ="
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.
|  |
 |  |  |
|
|
|
|