<!--#INCLUDE FILE="adovbs.inc"-->
<HTML>
<HEAD>
<TITLE>Test ASP</TITLE>
</HEAD>
<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)
x = circ.getRadius()
With circ ' executes a series of statements on a single object
.x = 10
.y = 20
.radius = 8
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
Dim radius
' initialize the attributes (constructors not supported)
Sub init(initx, inity, initradius)
x = initx
y = inity
radius = initradius
End Sub
' read accessors
Function getX
getX = x
End Function
Function getY
getY = y
End Function
Function getRadius
getRadius = radius
End Function
' write accessors
Sub setX(newx)
x = newx
End Sub
Sub setY(newy)
y = newy
End Sub
Sub setRadius(newradius)
radius = newradius
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"
xlapp.DisplayAlerts = False
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 = LoadPicture("d:\InetPub\wwwroot\test\images\dresser.gif")
'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")
x = ios.ReadLine()
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")
x = ios.Read(6)
x = ios.ReadLine()
ios.SkipLine()
ios.SkipLine()
ios.Skip(8)
x = ios.ReadAll()
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))
x = ios.ReadLine()
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>