```<!--#INCLUDE FILE="adovbs.inc"-->

<HTML>
<TITLE>Test ASP</TITLE>
<BODY>

<%
Dim x

'************************************************************************
'*                                                                      *
'* VBScript Value Keywords:                                             *
'*    False                Empty                Null                    *
'*    True                 Nothing                                      *
'*                                                                      *
'************************************************************************
b = False
c = True
x = Null
x = Empty
Set x = Nothing

'************************************************************************
'*                                                                      *
'* VBScript Operator Precedence:                                        *
'*    ^     exponentiation                >     greater than            *
'*    -     negation                      <=    less than or equal      *
'*    *, /  multiply, divide              >=    greater than or equal   *
'*    \     integer divide                Is    type compare            *
'*    Mod   modulus                       Not   logical not             *
'*    +, -  addition, subtraction         And   logical and             *
'*    &     concat                        Or    logical or              *
'*    =     equal                         Xor   logical xor             *
'*    <>    not equal                     Eqv   logical equivalence     *
'*    <     less than                     Imp   implies                 *
'*                                                                      *
'************************************************************************
x = -2                              ' negation
x = 2 + 2                           ' add
x = 4 - 2                           ' subtract
x = 2 * 2                           ' multiply
x = 4 / 2                           ' divide
x = 4 \ 2                           ' integer divide
x = 5 Mod 2                         ' modulus
x = 2^4                             ' exponentiation
x = "ab" & 2                        ' concatenation

x = (2 = 2)                         ' equal
x = (3 <> 2)                        ' not equal
x = (2 < 3)                         ' less than
x = (3 > 2)                         ' greater than
x = (2 <= 3)                        ' less than or equal
x = (3 >= 2)                        ' greater than or equal

x = (Nothing Is Nothing)            ' reference compare
x = Not(b)                          ' logical not
x = (b And c)                       ' logical and
x = (b Or c)                        ' logical or
x = (b Xor c)                       ' logical xor
x = (b Eqv c)                       ' logical equivalence
x = (b Imp c)                       ' logical implies

'************************************************************************
'*                                                                      *
'* VBScript Statements:                                                 *
'*    Call                                                              *
'*    Class...End Class                   Private                       *
'*    Const                               Public                        *
'*    Dim                                 Randomize                     *
'*    Do...Loop                           ReDim                         *
'*    Erase                               Rem                           *
'*    Exit                                Select Case...EndSelect       *
'*    For...Next                          Set                           *
'*    For Each...Next                     Sub...End Sub                 *
'*    Function...End Function             While...Wend                  *
'*    If...Then...Else...End If           With...End With               *
'*    On Error                                                          *
'*                                                                      *
'************************************************************************

Rem This is a comment.  Single quote is equivalent.

Const pi = 3.14                     ' declare constant
Public pubVar                       ' declare public variable
Private privVar                     ' declare private variable
Dim dimVar                          ' declare variable
Dim arrVar(5)                       ' declare an array variable
ReDim dimVar(10)                    ' redimension an array
Erase dimVar                        ' clear an array
b = True                            ' declaration on the fly
c = False

If (b) Then                         ' if then else
x = 1
ElseIf (c) Then
x = 2
Else
x = 3
End If

x = 10
While (x > 0)                       ' while condition
x = x - 1
Wend

x = 10
Do While (x > 0)                    ' do while condition loop
x = x - 1
Exit Do
Loop

x = 10
Do Until (x = 0)                    ' do until condition loop
x = x - 1
Exit Do
Loop

x = 10
Do                                  ' do while condition loop - test at loop end
x = x - 1
Exit Do
Loop While (x > 0)

x = 10
Do                                  ' do until condition loop - test at loop end
x = x - 1
Exit Do
Loop Until (x = 0)

For i = 1 To 10 Step 2              ' for loop
x = x + 1
Exit For
Next

Select Case (x)                     ' select case
Case 0:    x = 0
Case Else: x = -1
End Select

Randomize                           ' Randomize the random number generator

On Error Resume Next                ' Error handling logic - VBScript does not have labels
On Error GoTo 0

Call MySub(1, 2)                    ' Call a procedure
x = MyFunction(1, 2)                ' Call a function

Set circ = New Circle               ' Set variable reference - allocate object
call circ.init(10, 20, 8)

With circ                           ' executes a series of statements on a single object
.x = 10
.y = 20
End With

Dim scribble(2)
Set scribble(0) = New Circle
Set scribble(1) = New Circle
scribble(0).init 10, 20, 5
scribble(1).init 15, 25, 8

For Each shape In scribble          ' for each iteration
x = shape.getX()
Exit For
Next

Sub MySub(a, b)                     ' User defined procedure
Dim x
x = a + b
Exit Sub
End Sub

Function MyFunction(a, b)           ' User defined function
Dim x
x = a + b
MyFunction = x
Exit Function
End Function

Class Circle                        ' User defined class
' declare class attributes
Dim x
Dim y

' initialize the attributes (constructors not supported)
Sub init(initx, inity, initradius)
x = initx
y = inity
End Sub

Function getX
getX = x
End Function
Function getY
getY = y
End Function
End Function

' write accessors
Sub setX(newx)
x = newx
End Sub
Sub setY(newy)
y = newy
End Sub
End Sub

' move the shape coordinates
Sub moveTo(newx, newy)
setX newx
setY newy
End Sub
Sub rMoveTo(deltax, deltay)
moveTo (x + deltax), (y + deltay)
End Sub
End Class

'************************************************************************
'*                                                                      *
'* VBScript Functions:                                                  *
'*    Abs                  FormatPercent        Right                   *
'*    Array                GetObject            Rnd                     *
'*    Asc                  Hex                  Round                   *
'*    Atn                  Hour                 RTrim                   *
'*    CBool               -InputBox             ScriptEngine            *
'*    CByte                InStr                ScriptEngineBuildVersion*
'*    CCur                 InStrRev             ScriptEngineMajorVersion*
'*    CDate                Int                  ScriptEngineMinorVersion*
'*    CDbl                 IsArray              Second                  *
'*    Chr                  IsDate               Sgn                     *
'*    CInt                 IsEmpty              Sin                     *
'*    CLng                 IsNull               Space                   *
'*    Cos                  IsNumeric            Split                   *
'*    CreateObject         IsObject             Sqr                     *
'*    CSng                 Join                 StrComp                 *
'*    CStr                 LBound               StrReverse              *
'*    Date                 LCase                String                  *
'*    DateAdd              Left                 Tan                     *
'*    DateDiff             Len                  Time                    *
'*    DatePart             LoadPicture          TimeSerial              *
'*    DateSerial           Log                  TimeValue               *
'*    DateValue            LTrim                Trim                    *
'*    Day                  Mid                  TypeName                *
'*    Exp                  Minute               UBound                  *
'*    Filter               Month                UCase                   *
'*    Fix                 -MsgBox               VarType                 *
'*    FormatCurrency       Now                  Weekday                 *
'*    FormatDateTime       Oct                  Year                    *
'*    FormatNumber         Replace                                      *
'*                                                                      *
'************************************************************************
' array functions
Dim arr
arr = Array(4,3,2,1)                ' return variant array
x = LBound(arr)                     ' lower array boundary index
x = UBound(arr)                     ' upper array boundary index

' conversion functions
x = CBool(0)                        ' to boolean
x = CByte(2)                        ' to byte
x = CCur(1.23)                      ' to currency
x = CDate("1/1/2000")               ' to date
x = CDbl(2)                         ' to double
x = CInt(1.23)                      ' to integer
x = CLng(1.23)                      ' to long
x = CSng(2)                         ' to single
x = CStr(1.23)                      ' to string
x = Chr(13)                         ' to char
x = Asc("A")                        ' to ascii int
x = Hex(255)                        ' to hex string
x = Oct(127)                        ' to octal string

' math functions
x = Abs(-2)                         ' absolute value
x = Int(1.55)                       ' truncate
x = Fix(1.55)                       ' truncate
x = Round(1.55)                     ' round
x = Sgn(-2)                         ' sign (1, 0, or -1)
x = Atn(0.5)                        ' arctan
x = Cos(0.5)                        ' cosine
x = Sin(0.5)                        ' sine
x = Tan(0.5)                        ' tangent
x = Exp(2)                          ' e to power
x = Log(100)                        ' natural log (e)
x = Sqr(25)                         ' square root
x = Rnd()                           ' random number

' variant functions
b = IsArray(x)                      ' test array value
b = IsDate(x)                       ' test date value
b = IsEmpty(x)                      ' test empty value
b = IsNull(x)                       ' test null value
b = IsNumeric(x)                    ' test numeric value
b = IsObject(x)                     ' test object reference
s = TypeName(b)                     ' variant type as string
x = VarType(b)                      ' variant type as int

' string functions
x = Len("Hello")                    ' string length
s = Left("Hello", 3)                ' left substring
s = Right("Hello", 3)               ' right substring
s = Mid("Hello", 2, 3)              ' middle substring
s = UCase("Hello")                  ' to upper case
s = LCase("Hello")                  ' to lower case
s = Space(5)                        ' n space characters
s = LTrim(" Hello ")                ' trim leading spaces
s = RTrim(" Hello ")                ' trim trailing spaces
s = Trim(" Hello ")                 ' trim leading and trailing spaces
s = StrReverse("Hello")             ' reverse string order
s = String(5, "X")                  ' repeating character string
x = StrComp("ABC", "DEF")           ' compare strings: less(-1), greater(1), equal(0)
x = InStr("ABCD", "BC")             ' position of first substring (not found = 0)
x = InStr(1, "ABCD", "BC")          '    with offset
x = InStrRev("ABCD", "BC")          ' position of last substring (not found = 0)
x = InStrRev("ABCD", "BC", 4)       '    with offset
s = Replace("Hxyo", "xy", "ell")    ' replace substring
s = Replace("Hxyo", "xy", "ell", 2) '    with offset
x = Split("AB CD EF")               ' split string into an array
x = Split("AB:CD:EF", ":")          '    with delimiter
s = Join(x)                         ' join an array into a string
s = Join(x, ":")                    '    with delimiter
y = Filter(x, "CD")                 ' return all array elements that match string
y = Filter(x, "CD", False)          ' return all array elements that do not match string

' date functions
x = Date()                          ' current date
x = Time()                          ' current time
d = Now()                           ' current date/time
x = Year(d)                         ' year part of date (YYYY)
x = Month(d)                        ' month part of date (1-12)
x = Day(d)                          ' day part of date (1-31)
x = Hour(d)                         ' hour part of time (0-23)
x = Minute(d)                       ' minute part of time (0-59)
x = Second(d)                       ' second part of time (0-59)
x = Weekday(d)                      ' day of week (1-7)
d = DateValue("12/31/2000")         ' convert string to date
x = TimeValue("4:27:44 PM")         ' convert string to time
x = DateSerial(2000, 12, 31)        ' convert to date
x = TimeSerial(23, 59, 59)          ' convert to time
x = DateAdd("d", 1, d)              ' add year
x = DatePart("d", d)                ' get date part
x = DateDiff("d", Now(), d)         ' date difference
' yyyy year          w Weekday
'    q Quarter      ww Week of year
'    m Month         h Hour
'    y Day of year   m Minute
'    d Day           s Second

' format functions
x = FormatNumber(1.23)              ' convert number to string format
x = FormatNumber(1.23, 2)           '    with decimal places
x = FormatNumber(0.25, 2, vbFalse)  '    with lead zero flag
x = FormatPercent(0.25)             ' convert number to percent string format
x = FormatPercent(0.25, 0)          '    with decimal places
x = FormatPercent(0.25, 0, vbFalse) '    with lead zero flag
x = FormatCurrency(1.23)            ' convert number to currency string format
x = FormatCurrency(1.23, 2)         '    with decimal places
x = FormatCurrency(0.25, 2, vbFalse)'    with lead zero flag
x = FormatDateTime(Now())           ' convert date to string format
x = FormatDateTime(Now(), vbGeneralDate)
x = FormatDateTime(Now(), vbLongDate)
x = FormatDateTime(Now(), vbShortDate)
x = FormatDateTime(Now(), vbLongTime)
x = FormatDateTime(Now(), vbShortTime)

' script engine functions
x = ScriptEngineBuildVersion        ' build version number of the script engine
x = ScriptEngineMajorVersion        ' major version number of the script engine
x = ScriptEngineMinorVersion        ' minor version number of the script engine
x = ScriptEngine                    ' scripting language in use as string

' Automation Object functions
Set xlapp = CreateObject("Excel.Application")
Set xlbook = xlapp.Workbooks.Add
Set xlsheet = xlbook.Worksheets(1)
xlsheet.Name = "Test"
xlsheet.Cells(1, 1).Value = "Hello Spreadsheet"
xlbook.SaveAs "d:\InetPub\wwwroot\test\testobj.xls"
xlbook.Close
xlapp.Quit
Set xlsheet = Nothing
Set xlbook = Nothing
Set xlapp = Nothing

'Set x = CreateObject("d:\InetPub\wwwroot\test\Rectangle.dll", "Shape.Rectangle")
'Set x = Nothing

' io functions
'x = MsgBox("My Message")
'x = InputBox("My Input")

'************************************************************************
'*                                                                      *
'* Err Object:                                                          *
'*                                                                      *
'*    Properties:                                                       *
'*       Description             HelpFile             Source            *
'*       HelpContext             Number                                 *
'*                                                                      *
'*    Methods:                                                          *
'*       Clear                   Raise                                  *
'*                                                                      *
'************************************************************************
On Error Resume Next

Err.Raise 255, "Hello.asp", "Testing"     ' Throw an exception
x = Err.Number                            ' error number
x = Err.Source                            ' source of error
x = Err.Description                       ' description of error
x = Err.HelpFile                          ' associated help file
x = Err.HelpContext                       ' associated help context
Err.Clear                                 ' Clear the exception

On Error GoTo 0

'************************************************************************
'*                                                                      *
'* Dictionary Object:                                                   *
'*                                                                      *
'*    Properties:                                                       *
'*       CompareMode             Item                 Key               *
'*       Count                                                          *
'*                                                                      *
'*    Methods:                                                          *
'*       Add                     Items                Remove            *
'*       Exists                  Keys                 RemoveAll         *
'*                                                                      *
'************************************************************************
Dim empstatus
Dim xarr
Set empstatus = CreateObject("Scripting.Dictionary")

empstatus.Add "000", "Active"       ' add key/item to dictionary
empstatus.Add "002", "Part time"
empstatus.Item("002") = "Part Time" ' set item value in dictionary
empstatus.Item("030") = "Retired "  '    if not found then added
empstatus.Key("002") = "001"        ' replace key value

x = empstatus.Count                 ' number of entries in dictionary
x = empstatus.Exists("000")         ' test if key is in dictionary
x = empstatus.Item("001")           ' retrieve item value from dictionary

xarr = empstatus.Items              ' returns array of items
xarr = empstatus.Keys               ' returns array of keys
empstatus.Remove "001"
empstatus.RemoveAll

'************************************************************************
'*                                                                      *
'* FileSystemObject Object:                                             *
'*                                                                      *
'*    Methods:                                                          *
'*       CreateTextFile          OpenTextFile                           *
'*                                                                      *
'************************************************************************
Set fhs = CreateObject("Scripting.FileSystemObject")

' write out a text file
Set ios = fhs.CreateTextFile("d:\InetPub\wwwroot\test\testfile.txt", True)
ios.WriteLine("Hello text file.")
ios.Close

' read in a text file
Set ios = fhs.OpenTextFile("d:\InetPub\wwwroot\test\testfile.txt")
ios.Close

'************************************************************************
'*                                                                      *
'* TextStream Object:                                                   *
'*                                                                      *
'*    Properties:                                                       *
'*       AtEndOfLine             Column               Line              *
'*       AtEndOfStream                                                  *
'*                                                                      *
'*    Methods:                                                          *
'*       Close                   ReadLine             Write             *
'*       Read                    Skip                 WriteBlankLines   *
'*       ReadAll                 SkipLine             WriteLine         *
'*                                                                      *
'************************************************************************
' write out a text file
Set ios = fhs.CreateTextFile("d:\InetPub\wwwroot\test\testfile.txt", True)
ios.Write("Hello ")
ios.WriteLine("text file.")
ios.WriteBlankLines(2)
ios.WriteLine("Another line.")
ios.Close

' read in a text file
Set ios = fhs.OpenTextFile("d:\InetPub\wwwroot\test\testfile.txt")
ios.SkipLine()
ios.SkipLine()
ios.Skip(8)
b = ios.AtEndOfLine
b = ios.AtEndOfStream
x = ios.Column
x = ios.Line
ios.Close

' read in text file with loop
Set ios = fhs.OpenTextFile("d:\InetPub\wwwroot\test\testfile.txt")
Do While (Not (ios.AtEndOfStream))
Response.Write(x & "<BR>")
Loop

'************************************************************************
'*                                                                      *
'* Constants:                                                           *
'*    Color                            MsgBox                           *
'*       vbBlack                          vbOKOnly                      *
'*       vbRed                            vbOKCancel                    *
'*       vbGreen                          vbAbortRetryIgnore            *
'*       vbYellow                         vbYesNoCancel                 *
'*       vbBlue                           vbYesNo                       *
'*       vbMagenta                        vbRetryCancel                 *
'*       vbCyan                           vbCritical                    *
'*       vbWhite                          vbQuestion                    *
'*    Comparison                          vbExclamation                 *
'*       vbBinaryCompare                  vbInformation                 *
'*       vbTextCompare                    vbDefaultButton1              *
'*       vbDatabaseCompare                vbDefaultButton2              *
'*    Date & Time                         vbDefaultButton3              *
'*       vbSunday                         vbDefaultButton4              *
'*       vbMonday                         vbApplicationModal            *
'*       vbTuesday                        vbSystemModal                 *
'*       vbWednesday                   Tristate                         *
'*       vbThursday                       vbUseDefault                  *
'*       vbFriday                         vbTrue                        *
'*       vbSaturday                       vbFalse                       *
'*       vbUseSystem                   VarType                          *
'*       vbUseSystemDayOfWeek             vbEmpty                       *
'*       vbFirstJan1                      vbNull                        *
'*       vbFirstFourDays                  vbInteger                     *
'*       vbFirstFullWeek                  vbLong                        *
'*    Date Format                         vbSingle                      *
'*       vbGeneralDate                    vbDouble                      *
'*       vbLongDate                       vbCurrency                    *
'*       vbShortDate                      vbDate                        *
'*       vbLongTime                       vbString                      *
'*       vbShortTime                      vbObject                      *
'*    Miscellaneous                       vbError                       *
'*       vbObjectError                    vbBoolean                     *
'*    String                              vbVariant                     *
'*       vbCr                             vbDataObject                  *
'*       vbCrLf                           vbDecimal                     *
'*       vbFormFeed                       vbByte                        *
'*       vbLf                             vbArray                       *
'*       vbNewLine                     File I/O                         *
'*       vbNullChar                       ForReading                    *
'*       vbNullString                     ForWriting                    *
'*       vbTab                            ForAppending                  *
'*       vbVerticalTab                                                  *
'*                                                                      *
'************************************************************************

' VarType constants
Select Case (VarType(x))
Case vbEmpty:      x = ""
Case vbNull:       x = ""
Case vbInteger:    x = CStr(x)
Case vbLong:       x = CStr(x)
Case vbSingle:     x = CStr(x)
Case vbDouble:     x = CStr(x)
Case vbCurrency:   x = CStr(x)
Case vbDate:       x = CStr(x)
Case vbString:     x = x
Case vbObject:     x = ""
Case vbError:      x = ""
Case vbBoolean:    x = CStr(x)
Case vbVariant:    x = CStr(x)
Case vbDataObject: x = ""
Case vbDecimal:    x = CStr(x)
Case vbByte:       x = CStr(x)
Case vbArray:      x = ""
End Select

%>

</BODY>
</HTML>
```