[AccessD] Getting Desperate - Apologies for the OT message

I pasted the code below for the class module that was used for the
<%=dn.HTML("MyFieldName")%> statement in asp.

It was classic ASP, with the code below in a VB 6.0 .dll.  There were other
classes involved, but I'm sure you'll get the gist of it.  I also stripped
most of the SQL statement on the bottom function since it was pretty big!

Drew

-----Original Message-----
From: Christopher Hawkins [mailto:clh at christopherhawkins.com]
Sent: Friday, August 15, 2003 11:10 PM
To: accessd at databaseadvisors.com
Subject: RE: [AccessD] Getting Desperate - Apologies for the OT message


That's very clever.  I'd love to see that code.

Was this ASP.NET or classic ASP?  

-C-

Option Explicit
Public CaseNumber As String
Public Mode As String
Dim Fields As Collection
Dim FSettings As Collection

Function HTML(strField As String)
Dim fs As FieldSetting
Dim strTemp
Set fs = FSettings(strField)
Select Case Mode
    Case "View"
        strTemp = Value(strField)
        Select Case fs.FieldType
            Case "CheckBox"
                HTML = strTemp
            Case Else
                If IsNull(strTemp) Or strTemp = "" Then
                    strTemp = "&nbsp"
                Else
                    strTemp = "<b>" & strTemp & "</b>"
                End If
                HTML = strTemp
        End Select
    Case "Edit"
        Select Case fs.FieldType
            Case "CheckBox"
                HTML = Value(strField)
            Case "Text"
                If fs.Title = "" Or IsNull(fs.Title) Then
                    HTML = "<input type=""text"" value=""" & Value(strField)
& """ size=""" & fs.Size & """ name=""" & fs.FieldName & """>"
                Else
                    HTML = "<input type=""text"" title=""" & fs.Title & """
value=""" & Value(strField) & """ size=""" & fs.Size & """ name=""" &
fs.FieldName & """>"
                End If
            Case "Combo"
                If fs.ComboClass <> "" And IsNull(fs.ComboClass) = False
Then
                    HTML = GetSelectStatement(fs.ComboClass, fs.FieldName,
fs.Size, Value(strField))
                End If
            Case "Memo"
                HTML = "<textarea name=""" & fs.FieldName & """ cols=""" &
fs.Size & """ rows=""" & fs.MatchingField & """>" & Value(strField) &
"</textarea>"
        End Select
    Case "New"
        Select Case fs.FieldType
            Case "CheckBox"
                HTML = Value(strField)
            Case "Text"
                If fs.Title = "" Or IsNull(fs.Title) Then
                    HTML = "<input type=""text"" size=""" & fs.Size & """
name=""" & fs.FieldName & """>"
                Else
                    HTML = "<input type=""text"" title=""" & fs.Title & """
size=""" & fs.Size & """ name=""" & fs.FieldName & """>"
                End If
            Case "Combo"
                If fs.ComboClass <> "" And IsNull(fs.ComboClass) = False
Then
                    HTML = GetSelectStatement(fs.ComboClass, fs.FieldName,
fs.Size, "")
                End If
            Case "Memo"
                HTML = "<textarea name=""" & fs.FieldName & """ cols=""" &
fs.Size & """ rows=""" & fs.MatchingField & """></textarea>"
        End Select
End Select
End Function

Private Function GetSelectStatement(ByVal strClass As String, ByVal
strFieldName As String, ByVal Size As Long, ByVal tmpValue As Variant) As
String
Dim ces As ComboEntries
Dim strTemp As String
Dim i As Long
Dim ce As ComboEntry
Set ces = CreateObject(strClass)
strTemp = "<select name=""" & strFieldName & """ size=""" & Size & """>" &
vbCrLf
ces.GetData
For i = 1 To ces.ItemCount
    Set ce = ces.ItemInfo(i)
    If ce.ValueText = tmpValue Then
        strTemp = strTemp & "<option value=""" & ce.ValueText & """
selected>" & ce.DisplayText & "</option>" & vbCrLf
    Else
        strTemp = strTemp & "<option value=""" & ce.ValueText & """>" &
ce.DisplayText & "</option>" & vbCrLf
    End If
Next i
strTemp = strTemp & "</select>" & vbCrLf
GetSelectStatement = strTemp
End Function

Private Function Value(strField As String)
'On Error Resume Next
Value = ""
Value = Fields(strField).Value
End Function

Function GetData()
On Error Resume Next
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL As String
Dim df As DyncorpField
Dim fs As FieldSetting
Dim i As Long
DBConnect cnn
Set Fields = New Collection
Set rs = New ADODB.Recordset
strSQL = "Big Select statement " & _
"Semi big From Statement " & _
"WHERE (((tblIncidents.I_txtCaseNumber)=""" & CaseNumber & """));"
rs.Open strSQL, cnn, adOpenKeyset, adLockReadOnly
If rs.EOF = False Then rs.MoveFirst
For i = 0 To rs.Fields.Count - 1
    Set df = New DyncorpField
    df.FieldName = rs.Fields(i).Name
    df.Value = rs.Fields(i).Value
    Fields.Add df, df.FieldName
    Set df = Nothing
Next i
rs.Close
Set rs = Nothing
Set rs = New ADODB.Recordset
Set FSettings = New Collection
rs.Open "tblWebFields", cnn, adOpenKeyset, adLockReadOnly, adCmdTableDirect
rs.MoveFirst
Do Until rs.EOF = True
    Set fs = New FieldSetting
    fs.FieldName = rs.Fields(1).Value
    fs.FieldType = rs.Fields(2).Value
    fs.Title = rs.Fields(3).Value
    fs.Size = rs.Fields(4).Value
    fs.MatchingField = rs.Fields(5).Value
    fs.ComboClass = rs.Fields(6).Value
    FSettings.Add fs, fs.FieldName
    Set fs = Nothing
    rs.MoveNext
Loop
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
End Function