Classic ASP (VB Script) « It's Not A Bug, It's A Feature

9Jun/102

Classic ASP String Builder Class

Here's a handy little class file I built a few years back, because I got tired of building string with "mydata" & "mydata" and then continuing the lines with & _ and I really like the string builder in VB.Net. So I wrote this which makes working with string concatenation a whole lot easier.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

Class StringBuilder
Private arr 'the array of strings to concatenate
Private growthRate 'the rate at which the array grows
Private itemCount 'the number of items in the array

Private Sub Class_Initialize()
growthRate = 10
itemCount = 0
ReDim arr(growthRate)
End Sub

'Append a new string to the end of the array. If the
'number of items in the array is larger than the
'actual capacity of the array, then "grow" the array
'by ReDimming it.
Public Sub Append(ByVal strValue)
strValue=strValue & "" 'code borrowed from FastString to prevent crash on NULL'
If itemCount > UBound(arr) Then
ReDim Preserve arr(UBound(arr) + growthRate)
End If

arr(itemCount) = strValue
itemCount = itemCount + 1
End Sub

'Concatenate the strings by simply joining your array
'of strings and adding no separator between elements.
Public Function ToString()
ToString = Join(arr, "")
End Function
End Class

'Example usage
Dim MessageBody : Set MessageBody = New StringBuilder
MessageBody.Append("------------------------------------------------------------------------" & vbcrlf & vbcrlf)
MessageBody.Append("Order Number: " & Request("ord") & vbcrlf)
MessageBody.Append("Name: " & Request("name") & vbcrlf)
MessageBody.Append("Phone: " & Request("phone") & vbcrlf)
MessageBody.ToString() 'Returns the full string of data
Set MessageBody = Nothing

Tagged as: Classic ASP (VB Script) 2 Comments

18May/100

Classic ASP Function of the day

So here is classic asp function for your enjoyment. Generates a random Alpha Numeric password. found it digging through some old project, and I have used it some many times it's ridiculous. so I felt like sharing it.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

<%
Function RandomPassWord(myLength)
Dim X, Y, strPW
For X = 1 To myLength
'Randomize the type of this character
Y = Int((3 * Rnd) + 1) '(1) Numeric, (2) Uppercase, (3) Lowercase
Select Case Y
Case 1
'Numeric character
Randomize
strPW = strPW & CHR(Int((9 * Rnd) + 48))
Case 2
'Uppercase character
Randomize
strPW = strPW & CHR(Int((25 * Rnd) + 65))
Case 3
'Lowercase character
Randomize
strPW = strPW & CHR(Int((25 * Rnd) + 97))
End Select
Next
RandomPassWord = strPW
End Function
%>

Tagged as: Classic ASP (VB Script) No Comments

6May/107

Multi Dimensional Dictionary Object in Classic ASP

Well, the name really says it all, there is no real built in object in ASP for doing anything like this so I threw this together as a little experiment. feel free to use and abuse it.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159

<%
'Option Explict

Class MultiDimensionalDictionary
'######################################################################
'Named Dictionary Recordset Object
'######################################################################
Public SetKey
Private Dict
Private AddNewRecord
'######################################################################
Private Sub Class_Initialize
Set Dict = Server.CreateObject("Scripting.Dictionary")
Set AddNewRecord = Server.CreateObject("Scripting.Dictionary")
End Sub
'######################################################################
Private Sub Class_Terminate
Set Dict = Nothing
Set AddNewRecord = Nothing
End Sub
'######################################################################
Public Sub Update
Dict.Add SetKey, AddNewRecord
Set AddNewRecord = Server.CreateObject("Scripting.Dictionary")
End Sub
'######################################################################
Public Function GetCollection
Set GetCollection = Dict
End Function
'######################################################################
Public Sub SetField(byVal Key, byVal Value)
If AddNewRecord.Exists(Key) = False Then
AddNewRecord.Add Key, Value
Else
AddNewRecord(Key) = Value
End If
End Sub
'######################################################################
Public Function Records
Records = Dict.Keys
End Function
'######################################################################
Public Function Fields(byVal PrimaryKey)
Fields = Dict(PrimaryKey).Keys
End Function
'######################################################################
Public Function Item(byVal Key, byVal Value)
On Error Resume Next
If Dict.Item(Key).Exists(Value) Then
Item = Dict.Item(Key).Item(Value)
End If
On Error Goto 0
End Function
'######################################################################
Public Function Exists(byVal Key, byVal Value)
'On Error Resume Next
If IsNull(Value) Or Value = "" Then
Exists = Dict.Item(Key).Exists
Else
Exists = Dict.Item(Key).Exists(Value)
End If
'On Error Goto 0
End Function

Public Function Count
Count = Dict.Count
End Function
'######################################################################
End class
'######################################################################
'Example Usage
Dim Dict 'The Dict Object
Dim Record 'The Record Object
Dim Field 'The Field Object
Set Dict = New MultiDimensionalDictionary 'Create an Instance of the Class
'######################################################################
'ADDING RECORDS TO DICTIONARY
'######################################################################
'EACH NEW KEY MUST BE UNIQUE OTHERWISE IT WILL OVERWRITE THE PREVIOUS
'KEY WITH THE SAME NAME.
'EACH FIELD MUST ALSO BE UNIQUE IN EACH RECORD OTHERWISE IT WILL
'OVERWRITE THE PREVIOUS KEY IN THE SAME RECORD WITH THE NEW VALUE

Response.Write "Dict.Count = " & Dict.Count & " "

Dict.SetKey = "First" 'Key the first record
Dict.SetField "1", "Record1 Field 1 Value"
Dict.SetField "2", "Record1 Field 2 Value"
Dict.SetField "3", "Record1 Field 3 Value"
Dict.SetField "4", "Record1 Field 4 Value"
Dict.SetField "5", "Record1 Field 5 Value"
Dict.Update 'Bind the new record and preapre for the next record

Dict.SetKey = "Second" 'Key the second record
Dict.SetField "Alpha", "Record2 Field 1 Value"
Dict.SetField "Beta", "Record2 Field 2 Value"
Dict.SetField "Charlie", "Record2 Field 3 Value"
Dict.SetField "Delta", "Record2 Field 4 Value"
Dict.SetField "Echo", "Record2 Field 5 Value"
Dict.Update 'Bind the new record and preapre for the next record

Dict.SetKey = "Third" 'Key the third record
Dict.SetField "A", "Record3 Field 1 Value"
Dict.SetField "B", "Record3 Field 2 Value"
Dict.SetField "C", "Record3 Field 3 Value"
Dict.SetField "D", "Record3 Field 4 Value"
Dict.SetField "E", "Record3 Field 5 Value"
Dict.Update

Dict.SetKey = 4 'Key the third record
Dict.SetField 0, "Record4 Field 1 Value"
Dict.SetField 1, "Record4 Field 2 Value"
Dict.SetField 2, "Record4 Field 3 Value"
Dict.SetField 3, "Record4 Field 4 Value"
Dict.SetField 4, "Record4 Field 5 Value"
Dict.Update

Response.Write "Dict.Count = " & Dict.Count & " "
'######################################################################
'ENUMERATE RECORDS
'This method shows you how to enumerate the record/field collection.
'######################################################################
Response.Write("-- ENUMERATE RECORDS -- ")
For Each Record in Dict.Records
Response.Write("Record: " & Record & " ")
For Each Field in Dict.Fields(Record)
Response.Write("& _nbsp;& _nbsp;& _nbsp;Field Name: " & Field & " : Value: " & Dict.Item(Record, Field) & " ")
Next
Response.Write("<hr>")
Next
'######################################################################
'CALL A SINGLE NAMED RECORD WITH THE ITEM METHOD
'this example show you how to call a single record/field value. if record does not
'exist the call will return an empty string
'######################################################################
Response.Write("-- CALL A SINGLE NAMED RECORD -- ")
Response.Write( "Dict.Item(""First"", ""1"") = " & Dict.Item("First", "1") & " ")
Response.Write( "Dict.Item(""Second"", ""Alpha"") = " & Dict.Item("Second", "Alpha") & " ")
Response.Write( "Dict.Item(""Third"", ""c"") = " & Dict.Item("Third", "C") & " ")
Response.Write( "Dict.Item(4, 1) = " & Dict.Item(4, 1) & " ")
Response.Write("<hr>")
'######################################################################
'USING THE EXISTS METHOD
Response.Write("-- EXISTS -- ")
Response.Write( "Dict.Exists(""First"", ""1"") = " & Dict.Exists("First", "1") & " ")
Response.Write("<hr>")
'######################################################################
'TODO: Need to add a method for updating a existing record.
'TODO: Add a method for adding new records to an existing set.
'######################################################################
Set Dict = Nothing
'######################################################################
If err.number <> 0 Then
Response.Write err.number & " : " & Err.Description
End If
Dim response_time
response_time = cdbl(timer() - s_time)
Response.Write("This page was generated in " & response_time & " seconds.")
%>

Tagged as: Classic ASP (VB Script), Dictionary Object, Hash Table 7 Comments

1May/100

Project Vault

Its been a while since I have made any effort to work on this site, been busy working on my frame off build on my 72 Chevelle and it has been monopolizing all my free time. So today I added a new section to the site 'Project Vault' and I am going to post up the code to various old projects I started and never finished. feel free to use and abuse anything you see fit.

I just posted up the docs and files for my old Advanced ASP template parser, and will be posting various other projects over the next few weeks and months so keep checking back.

Project Vault

Tagged as: Classic ASP (VB Script) No Comments

« Newer Entries

It's Not A Bug, It's A Feature Just another Developer weblog

Classic ASP String Builder Class

Classic ASP Function of the day

Multi Dimensional Dictionary Object in Classic ASP

Project Vault

Sponsors

Categories

Site Links

Blogroll

The Cloud