Adding ASP example files

master
Michael Reber 3 years ago
parent 8c9a19ec97
commit 8258e10e80
  1. 165
      asp/ActiveX_ADO_Arrays/ADO Schemas to list tables & fields.asp
  2. 35
      asp/ActiveX_ADO_Arrays/ADO Techniques -- The .maxrecords property.asp
  3. 82
      asp/ActiveX_ADO_Arrays/Add New Record with ADO.asp
  4. 134
      asp/ActiveX_ADO_Arrays/Another month, day, year dropdown creator.asp
  5. 37
      asp/ActiveX_ADO_Arrays/Arrays to store data.asp
  6. 24
      asp/ActiveX_ADO_Arrays/CombSort Function.asp
  7. 30
      asp/ActiveX_ADO_Arrays/Count the Number of Lines.asp
  8. 225
      asp/ActiveX_ADO_Arrays/Database Paging.asp
  9. 59
      asp/ActiveX_ADO_Arrays/How to filter a recordset.asp
  10. 102
      asp/ActiveX_ADO_Arrays/How to shutdown reboot logoff WIndows 9x NT Me 2000.asp
  11. 154
      asp/ActiveX_ADO_Arrays/Index Server Access via ADO.asp
  12. 69
      asp/ActiveX_ADO_Arrays/Insert TEXT blob using ADO.asp
  13. 84
      asp/ActiveX_ADO_Arrays/Pagination Script in ASP.asp
  14. 62
      asp/ActiveX_ADO_Arrays/ProgIDInfo Object.asp
  15. 25
      asp/ActiveX_ADO_Arrays/Random Array.asp
  16. 22
      asp/ActiveX_ADO_Arrays/SelectionSort Function.asp
  17. 32
      asp/ActiveX_ADO_Arrays/Send a Ringtone to Nokia phones in ASP.asp
  18. 34
      asp/ActiveX_ADO_Arrays/Send an Operator Logo to Nokia phones in ASP.asp
  19. 40
      asp/ActiveX_ADO_Arrays/Sort arrays.asp
  20. 19
      asp/ActiveX_ADO_Arrays/Using a Stored Procedure with ADO.asp
  21. 36
      asp/ActiveX_ADO_Arrays/Version Check.asp
  22. 130
      asp/Components/ASP Mail Interface.asp
  23. 34
      asp/Components/Auto Generate Password.asp
  24. 20
      asp/Components/Know all drive properties through file system.asp
  25. 53
      asp/Components/Limiting the Upload Size.asp
  26. 33
      asp/Components/MkSheet Statement.asp
  27. 221
      asp/Components/Open Office.asp
  28. 73
      asp/Components/Protect your Client Side Script with ASP.asp
  29. 52
      asp/Components/Selected item in Combo Box from database - more thoughts.asp
  30. 29
      asp/Components/Send a 1-Way SMS in ASP.asp
  31. 159
      asp/Components/System Detector.asp
  32. 36
      asp/Components/URL Decode.asp
  33. 87
      asp/Components/Universal URL check.asp
  34. 61
      asp/Components/Uploading with SA-FileUp.asp
  35. 44
      asp/Components/WSH Script to remove un-needed IIS Script-Mappings.asp
  36. 149
      asp/Data_Access_DateTime/ASP Date Picker.asp
  37. 36
      asp/Data_Access_DateTime/Convert Records To Arrays Using GetRows.asp
  38. 87
      asp/Data_Access_DateTime/DIGITAL CLOCK.asp
  39. 28
      asp/Data_Access_DateTime/Diff Business Days.asp
  40. 111
      asp/Data_Access_DateTime/Dynamic Database Tables.asp
  41. 24
      asp/Data_Access_DateTime/Dynamic Dropdown Boxes.asp
  42. 24
      asp/Data_Access_DateTime/Dynamic Table.asp
  43. 39
      asp/Data_Access_DateTime/European Weeknumber.asp
  44. 179
      asp/Data_Access_DateTime/Format Dates.asp
  45. 52
      asp/Data_Access_DateTime/Paging in ASP.asp
  46. 70
      asp/Data_Access_DateTime/Query database and Variables.asp
  47. 161
      asp/Data_Access_DateTime/Retrieve Text-Image fields using OpenX.asp
  48. 22
      asp/Data_Access_DateTime/StripHTML.asp
  49. 20
      asp/Data_Access_DateTime/SwapDate Function.asp
  50. 20
      asp/Data_Access_DateTime/SwapDate Function~.asp
  51. 35
      asp/Data_Access_DateTime/simplifying ADO parameters.asp
  52. 17
      asp/FilesMaths/ASP source viewer.asp
  53. 66
      asp/FilesMaths/Base 64 Encode - Decode.asp
  54. 27
      asp/FilesMaths/Binary to Integer.asp
  55. 54
      asp/FilesMaths/CBit Function.asp
  56. 37
      asp/FilesMaths/CalcArea Function.asp
  57. 49
      asp/FilesMaths/Convert Bytes.asp
  58. 129
      asp/FilesMaths/Delete Files.asp
  59. 94
      asp/FilesMaths/Directory Search Object.asp
  60. 208
      asp/FilesMaths/Directory Viewer.asp
  61. 19
      asp/FilesMaths/Drive Function.asp
  62. 16
      asp/FilesMaths/File Length Function.asp
  63. 158
      asp/FilesMaths/File Upload.asp
  64. 17
      asp/FilesMaths/File-Path-Extension Stripping.asp
  65. 23
      asp/FilesMaths/FileCopy Statement.asp
  66. 16
      asp/FilesMaths/FileDateTime Function.asp
  67. 18
      asp/FilesMaths/FileRead Function.asp
  68. 23
      asp/FilesMaths/FileWrite Statement.asp
  69. 24
      asp/FilesMaths/Find And Delete.asp
  70. 33
      asp/FilesMaths/Format Numbers.asp
  71. 74
      asp/FilesMaths/GUID Generator - 26 Characters.asp
  72. 37
      asp/FilesMaths/Hex to Bin.asp
  73. 185
      asp/FilesMaths/INITool Object.asp
  74. 28
      asp/FilesMaths/Kill Statement.asp
  75. 16
      asp/FilesMaths/Make HTML File.asp
  76. 50
      asp/FilesMaths/MkDatabase Function.asp
  77. 22
      asp/FilesMaths/MkDir Statement.asp
  78. 27
      asp/FilesMaths/MkFile Statement.asp
  79. 49
      asp/FilesMaths/Mortgage Amortization.asp
  80. 50
      asp/FilesMaths/Nautical-Flight Functions.asp
  81. 22
      asp/FilesMaths/Number to Decimal.asp
  82. 90
      asp/FilesMaths/RC4 Class.asp
  83. 139
      asp/FilesMaths/Recurse and Rename.asp
  84. 21
      asp/FilesMaths/Remove Directory Statement.asp
  85. 61
      asp/FilesMaths/SQL AverageNumber.asp
  86. 63
      asp/FilesMaths/Scripting.Decoder for Microsoft Encoding.asp
  87. 50
      asp/FilesMaths/Search Function.asp
  88. 50
      asp/FilesMaths/Search Function1.asp
  89. 35
      asp/FilesMaths/SetAttr Statement.asp
  90. 40
      asp/FilesMaths/StandardToMetric Function.asp
  91. 19
      asp/FilesMaths/Title Function.asp
  92. 27
      asp/FilesMaths/WriteLog Statement.asp
  93. 74
      asp/Miscellaneous/Better Email and Domain Validation.asp
  94. 58
      asp/Miscellaneous/Breakup sentences longer than x Characters.asp
  95. 24
      asp/Miscellaneous/Compare List.asp
  96. 170
      asp/Miscellaneous/DB Viewer.asp
  97. 29
      asp/Miscellaneous/Detects if user has Flash.asp
  98. 80
      asp/Miscellaneous/Disk Space Usage.asp
  99. 165
      asp/Miscellaneous/Display States according to Country selection....asp
  100. 81
      asp/Miscellaneous/Display a list of image files for viewing.asp
  101. Some files were not shown because too many files have changed in this diff Show More

@ -0,0 +1,165 @@
<html><head>
<TITLE>dbschemas.asp</TITLE>
</head>
<body bgcolor="#FFFFFF">
<!--#INCLUDE VIRTUAL="/ADOVBS.INC" -->
<!--#INCLUDE VIRTUAL="/learn/test/lib_fieldtypes.asp" -->
<%
myDSN="DSN=Student;uid=student;pwd=magic"
Set conntemp=Server.CreateObject("adodb.connection")
conntemp.open myDSN
Set rsSchema = conntemp.OpenSchema(adSchemaColumns)
thistable=""
pad=" "
Do UNTIL rsSchema.EOF
prevtable=thistable
thistable=rsSchema("Table_Name")
thiscolumn=rsSchema("COLUMN_NAME")
If thistable<>prevtable Then
Response.Write "Table=<b>" & thistable & "</b><br>"
Response.Write "TABLE_CATALOG=<b>" & rsSchema("TABLE_CATALOG") & "</b><br>"
Response.Write "TABLE_SCHEMA=<b>" & rsSchema("TABLE_SCHEMA") & "</b><p>"
End If
Response.Write "<br>" & pad & "Field=<b>" & thiscolumn & "</b><br>"
Response.Write pad & "Type=<b>" & fieldtypename(rsSchema("DATA_TYPE")) & "</b><br>"
Dim colschema(27)
colschema(0)="TABLE_CATALOG"
colschema(1)="TABLE_SCHEMA"
colschema(2)="TABLE_NAME"
colschema(3)="COLUMN_NAME"
colschema(4)="COLUMN_GUID"
colschema(5)="COLUMN_PROP_ID"
colschema(6)="ORDINAL_POSITION"
colschema(7)="COLUMN_HASDEFAULT"
colschema(8)="COLUMN_DEFAULT"
colschema(9)="COLUMN_FLAGS"
colschema(10)="IS_NULLABLE"
colschema(11)="DATA_TYPE"
colschema(12)="TYPE_GUID"
colschema(13)="CHARACTER_MAXIMUM_LENGTH"
colschema(14)="CHARACTER_OCTET_LENGTH"
colschema(15)="NUMERIC_PRECISION"
colschema(16)="NUMERIC_SCALE"
colschema(17)="DATETIME_PRECISION"
colschema(18)="CHARACTER_SET_CATALOG"
colschema(19)="CHARACTER_SET_SCHEMA"
colschema(20)="CHARACTER_SET_NAME"
colschema(21)="COLLATION_CATALOG"
colschema(22)="COLLATION_SCHEMA"
colschema(23)="COLLATION_NAME"
colschema(24)="DOMAIN_NAME"
colschema(25)="DOMAIN_CATALOG"
colschema(26)="DOMAIN_SCHEMA"
colschema(27)="DESCRIPTION"
On Error Resume Next
For counter=4 To 27
thisColInfoType=colschema(counter)
thisColInfo=rsSchema(thisColInfoType)
If Err.number<>0 Then
thiscolinfo="-error-"
Err.Clear
End If
If thisColInfo<>"" Then
Response.Write pad & pad & pad & thiscolinfotype
Response.Write "=<b>" & thiscolinfo & "</b><br>"
End If
Next
Response.Flush
rsSchema.MoveNext
Loop
rsSchema.Close
Set rsSchema=Nothing
conntemp.close
Set conntemp=Nothing
%>
</body></html>
Here Is the contents of lib_fieldtypes.asp which Is included To make this example work:
<%
Function fieldtypename(parm1)
Select Case Parm1
Case 0
fieldtypename="adEmpty"
Case 16
fieldtypename="adTinyInt"
Case 2
fieldtypename="adSmallInt"
Case 3
fieldtypename="adInteger"
Case 20
fieldtypename="adBigInt"
Case 17
fieldtypename="adUnsignedTinyInt"
Case 18
fieldtypename="adUnsignedSmallInt"
Case 19
fieldtypename="adUnsignedInt"
Case 21
fieldtypename="adUnsignedBigInt"
Case 4
fieldtypename="adSingle"
Case 5
fieldtypename="adDouble"
Case 6
fieldtypename="adCurrency"
Case 14
fieldtypename="adDecimal"
Case 131
fieldtypename="adNumeric"
Case 11
fieldtypename="adBoolean"
Case 10
fieldtypename="adError"
Case 132
fieldtypename="adUserDefined"
Case 12
fieldtypename="adVariant"
Case 9
fieldtypename="adIDispatch"
Case 13
fieldtypename="adIUnknown"
Case 72
fieldtypename="adGUID"
Case 7
fieldtypename="adDate"
Case 133
fieldtypename="adDBDate"
Case 134
fieldtypename="adDBTime"
Case 135
fieldtypename="adDBTimeStamp"
Case 8
fieldtypename="adBSTR"
Case 129
fieldtypename="adChar"
Case 200
fieldtypename="adVarChar"
Case 201
fieldtypename="adLongVarChar"
Case 130
fieldtypename="adWChar"
Case 202
fieldtypename="adVarWChar"
Case 203
fieldtypename="adLongVarWChar"
Case 128
fieldtypename="adBinary"
Case 204
fieldtypename="adVarBinary"
Case 205
fieldtypename="adLongVarBinary"
Case Else
fieldtypename="Undefined by ADO"
End Select
End Function
%>

@ -0,0 +1,35 @@
ADO Techniques -- The .maxrecords property
<html><head>
<TITLE>dbmaxrecs.asp</TITLE>
</head><body bgcolor="#FFFFFF">
<!--#INCLUDE VIRTUAL="/ADOVBS.INC" -->
<%
Set rstemp=Server.CreateObject("adodb.Recordset")
rstemp.maxrecords=15
connectme="DSN=Student;uid=student;pwd=magic"
rstemp.open "select * from titles", _
connectme,adopenstatic
' table display
howmanyfields=rstemp.fields.count -1
%>
<table border=1><tr>
<%
For i=0 To howmanyfields %>
<td><b><%=rstemp(i).name %></B></TD>
<% Next %>
</tr>
<%
Do While Not rstemp.eof %>
<tr>
<% For i = 0 To howmanyfields%>
<td valign=top><% = rstemp.fields(i).value %> </td>
<% Next %>
</tr>
<%
rstemp.movenext
Loop
rstemp.close
Set rstemp=Nothing
%>
</table></body></html>

@ -0,0 +1,82 @@
<html><head>
<title>dbnewrec.asp</title></head>
<body bgcolor="#FFFFFF">
<% ' My ASP program that allows you to append a record %>
<form name="myauthor" action="dbnewADOrespond.asp" method="GET">
<p>Author ID: <Input Type="TEXT" name="id"></p>
<p> Author Name: <Input Type="TEXT" name="name"></p>
<p> Year Born: <Input Type="TEXT" name="year"></p>
<p> <Input Type="SUBMIT"> </p>
</form></body></html>
The form responder looks like this:
<TITLE>dbnewADO.asp</TITLE>
<body bgcolor="#FFFFFF">
<HTML>
<!--#INCLUDE VIRTUAL="/ADOVBS.INC" -->
<!--#INCLUDE VIRTUAL="/learn/test/lib_errors.asp" -->
<%
On Error Resume Next
auname=Request.QueryString("name")
auyear=Request.QueryString("year")
auID=Request.QueryString("ID")
If auid<9000 Then
auid=auid+9000
End If
conn="DSN=Student;uid=student;pwd=magic"
Set RS = Server.CreateObject("ADODB.Recordset")
RS.Open "authors",Conn,adopenstatic,adlockoptimistic
RS.AddNew
'RS("AU_ID")=auid
RS("Author") = auname
RS("Year_Born")= Int(auyear)
RS.Update
Call ErrorVBscriptReport("Adding Record")
Call ErrorADOReport("Adding Record",RS.activeconnection)
RS.Close
Set rs=Nothing
%>
</BODY>
</HTML>
Here Is the include file that displays appropriate errors:
<%
Sub ErrorVBScriptReport(parm_msg)
If Err.number=0 Then
Exit Sub
End If
pad=" "
Response.Write "<b>VBScript Errors Occured!<br>"
Response.Write parm_msg & "</b><br>"
Response.Write pad & "Error Number= #<b>" & Err.number & "</b><br>"
Response.Write pad & "Error Desc.= <b>" & Err.description & "</b><br>"
Response.Write pad & "Help Context= <b>" & Err.helpcontext & "</b><br>"
Response.Write pad & "Help File Path=<b>" & Err.helpfile & "</b><br>"
Response.Write pad & "Error Source= <b>" & Err.source & "</b><br><hr>"
End Sub
Sub ErrorADOReport(parm_msg,parm_conn)
HowManyErrs=parm_conn.errors.count
If HowManyErrs=0 Then
Exit Sub
End If
pad=" "
Response.Write "<b>ADO Reports these Database Error(s) executing:<br>"
Response.Write SQLstmt & "</b><br>"
For counter= 0 To HowManyErrs-1
errornum=parm_conn.errors(counter).number
errordesc=parm_conn.errors(counter).description
Response.Write pad & "Error#=<b>" & errornum & "</b><br>"
Response.Write pad & "Error description=<b>"
Response.Write errordesc & "</b><p>"
Next
End Sub
%>

@ -0,0 +1,134 @@
<script language=javascript>
function fnSubmit(strPage)
{
document.forms[0].action= strPage
document.forms[0].submit()
}
</script>
<%
'here is the call
writedropdowns
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub writeDropDowns()
Dim strSelfLink
strSelfLink = request.servervariables("SCRIPT_NAME")
response.Write "<form name=dates method=post>" & vbcrlf
response.Write MonthDropDown("month1",False,request("month1"),strSelfLink) & " " & DayDropDown("day1", "",getDaysInMonth(request("month1"),request("year1")),request("day1")) & " " & YearDropDown("year1","","", request("year1"),strSelfLink) & vbcrlf
response.Write "</form>" & vbcrlf
End Sub
'MonthDropDown
'strName = name of drop down
'blnNum = 'If blnNUM Is True, Then show As numbers
'strSelected = the currenct selected month
'strSelfLink = link to current page
Function MonthDropDown(strName, blnNum, strSelected, strSelfLink)
Dim strTemp, i, strSelectedString
strTemp = "<select name='" & strName& "' onchange='javascript: fnSubmit(" & chr(34) & strSelfLink & chr(34) & ")'>" & vbcrlf
strTemp = strTemp & "<option value='" & 0 & "'>" & "Month" & "</option>" & vbcrlf
For i = 1 To 12
If strSelected = CStr(i) Then
strSelectedString = "Selected"
Else
strSelectedString = ""
End If
If blnNum Then
strTemp = strTemp & "<option value='" & i & "' " & strSelectedString & " >" & i & "</option>" & vbcrlf
Else
strTemp = strTemp & "<option value='" & i & "' " & strSelectedString & " >" & MonthName(i) & "</option>" & vbcrlf
End If
Next
strTemp = strTemp & "</select>" & vbcrlf
MonthDropDown = strTemp
End Function
'YearDropDown
'strName = name of dropdown
'intStartYear = year to start options list
'intEndYear = year to end options list
'strSelected = the currenct selected year
'strSelfLink = link To currentpage
Function YearDropDown(strName, intStartYear, intEndYear, strSelected, strSelfLink)
Dim strTemp, i, strSelectedString
If intStartYear = "" Then
intStartYear = Year(now())
End If
If intEndYear = "" Then
intEndYear = Year(now()) + 9
End If
strTemp = "<select name='" & strName& "' onchange='javascript: fnSubmit(" & chr(34) & strSelfLink & chr(34) & ")'>" & vbcrlf
strTemp = strTemp & "<option value='" & 0 & "'>" & "Year" & "</option>" & vbcrlf
For i = intStartYear To intEndYear
If strSelected = CStr(i) Then
strSelectedString = "Selected"
Else
strSelectedString = ""
End If
strTemp = strTemp & "<option value='" & i & "' " & strSelectedString & " >" & i & "</option>" & vbcrlf
Next
strTemp = strTemp & "</select>" & vbcrlf
YearDropDown = strTemp
End Function
'DayDropDown
'strName = name of drop down
'intStartDay = day to start with
'intEndDay = day to end with
'strSelected = current slected day
Function DayDropDown(strName, intStartDay, intEndDay, strSelected )
Dim strTemp, i, strSelectedString
If intStartDay = "" Then
intStartDay = 1
End If
If intEndDay = "" Then
intEndDay = getDaysInMonth(Month(now()),Year(now()))
End If
strTemp = "<select name='" & strName& "'>" & vbcrlf
strTemp = strTemp & "<option value='" & 0 & "'>" & "Day" & "</option>" & vbcrlf
For i = intStartDay To intEndDay
If strSelected = CStr(i) Then
strSelectedString = "Selected"
Else
strSelectedString = ""
End If
strTemp = strTemp & "<option value='" & i & "' " & strSelectedString & " >" & i & "</option>" & vbcrlf
Next
strTemp = strTemp & "</select>" & vbcrlf
DayDropDown = strTemp
End Function
'getDaysInMonth
'strMonth = month as number
'strYear = year
Function getDaysInMonth(strMonth,strYear)
Dim strDays
Select Case CInt(strMonth)
Case 1,3,5,7,8,10,12:
strDays = 31
Case 4,6,9,11:
strDays = 30
Case 2:
If ( (CInt(strYear) Mod 4 = 0 And CInt(strYear) Mod 100 <> 0) Or ( CInt(strYear) Mod 400 = 0) ) Then
strDays = 29
Else
strDays = 28
End If
'Case Else:
End Select
getDaysInMonth = strDays
End Function
%>

@ -0,0 +1,37 @@
<html><head>
<title>arraysredim.asp</title>
</head><body bgcolor="#FFFFFF">
<%
' this code
Dim a_array(100)
' this code will fail
x=100
Dim my_array(x)
%>
</body></html>
Assigning an Array size With a variable produces an Error unless the ReDim command Is used.
<html><head>
<title>arraysredimcorrect.asp</title>
</head><body bgcolor="#FFFFFF">
<%
Dim my_array()
x=100
ReDim preserve my_array(x)
my_array(20)="Hi!"
my_array(40)="How are You"
lowcount=LBound(my_array)
highcount=UBound(my_array)
Response.Write "lowcount=" & lowcount & ";highcount=" & highcount & "<p>"
For counter=lowcount To highcount
Response.Write counter & " "
Response.Write my_array(counter) & "<br>"
Next
%>
</body></html>

@ -0,0 +1,24 @@
<%
Private Function CombSort(ByVal UnsortedArray)
Dim I, J, Temp, Gap, Swapped
Dim ArrSize, Combcom, Combswap
Const Shrink = 1.3
ArrSize = UBound( UnsortedArray )
Gap = Arrsize - 1
Do
Gap = Int(Gap / Shrink)
Swapped = True
Combcom = Combcom + 1
For J = 0 To Arrsize - Gap
If UnsortedArray(J) > UnsortedArray(J + Gap) Then
Temp = UnsortedArray(J)
UnsortedArray(J) = UnsortedArray(J + Gap)
UnsortedArray(J + Gap) = Temp
Swapped = False
Combswap = Combswap + 1
End If
Next
Loop Until Not Swapped And Gap = 1
CombSort = UnsortedArray
End Function
%>

@ -0,0 +1,30 @@
<!-- #Include file="connect_strings.asp" -->
<!-- #Include file="adovbs.inc" -->
<%
Dim strSql, rsScript
strSql = "SELECT ScriptCode FROM Scripts"
Set rsScript = objConn.Execute(strSql) 'execute sql call
%>
<html>
<head>
</head>
<body>
<%
Dim CodeLine, StrCode, StrAll, CountAll, LineCount
CodeLine = ""
Do Until rsScript.EOF
StrCode = (rsScript("ScriptCode"))
CodeLine = "" & CodeLine & StrCode
rsScript.MoveNext
Loop
StrAll = Trim(Server.HTMLEncode(CodeLine))
CountAll = Split(StrAll,vbLf, -1, 1)
StrAll = ""
LineCount = UBound(CountAll)
Response.Write LineCount
%>
</body>
</html>
<% Call DBConnClose(ObjConn) %>

@ -0,0 +1,225 @@
<%@ Language=VBScript %>
<!--#include File="_fpclass/adovbs.inc"-->
<%
gend = CStr(Request.QueryString("gender"))
Dim iPageSize 'How many records To show
Dim iRecCurrent ' The page we want To show
Dim sSQL 'SQL command To execute
Dim RecSet 'The ADODB recordset object
Dim I 'Standard looping var
Dim iRecEnd ' Last Record
Dim iRecMax ' Max of record Loop
Dim J ' Loop variabel
Dim iRecNext ' Var of Next record To start at
Dim iRecPrev ' Var of Previous record
Dim sGender ' Var For displaying whether Women's or Men's race
Dim iNumPage ' Number of pages
' Get parameters
iPageSize = 20
' Retrieve page to show or default to 0
If Request.QueryString("page") = "" Then
iRecCurrent = 0 ' First Record
Else
iRecCurrent = CInt(Request.QueryString("page"))
End If
' Assign value to race
If gend = "Male" Then
sGender = "Men's"
Else
sGender = "Women's"
End If
' SQL statement
sSQL = "SELECT * FROM 5KResults WHERE Gender='"
sSQL = sSQL & gend & "' ORDER BY Time"
Set RecSet = Server.CreateObject("ADODB.Recordset")
RecSet.Open sSQL,"DSN=chiledadsn",adOpenForwardOnly,adLockReadOnly
' Get the count of the records
Do While Not RecSet.EOF
J = J + 1
RecSet.MoveNext
Loop
iRecEnd = J -1
' Get the number of pages
iNumPage = CInt(iRecEnd/iPageSize)
' If the request page falls outside the
' acceptable range,
' give them the closest match (0 or max)
'
If iRecCurrent > iRecEnd Then iRecCurrent = iRecEnd
If iRecCurrent < 0 Then iRecCurrent = 0
If iRecCurrent < iRecEnd Then
iRecNext = iRecCurrent + iPageSize
Else
iRecNext = iRecEnd
End If
If iRecCurrent > 0 Then
iRecPrev = iRecCurrent - iPageSize
Else
iRecPrev = 0
End If
' Do this so when calling the las page w
' e only loop through
' the number of records we have if less
' than the iPageSize
If (iRecNext - iRecEnd ) > 0 Then
iRecMax = iRecEnd - iRecCurrent
Else
iRecMax = iPageSize
End If
' Start at the beginning of the database
'
RecSet.MoveFirst
'Move to the record we want to start at
RecSet.Move(iRecCurrent)
' use this when creating links
' doesn't matter what this page is named
'
strScriptName = Request.ServerVariables("SCRIPT_NAME")
%>
<%
Sub NavBar()
Dim iPage
Dim iVue
Dim sNumbers
Dim sPrev
Dim sNext
Dim sFirst
Dim sLast
Dim sNavBar
Dim iLastPage
iLastPage = iRecEnd - iPageSize
For i = 0 To (iNumPage - 1)
iPage = i * iPageSize
iVue = i + 1
sNumbers = sNumbers & NavLink(strScriptName,iPage,gend,iVue)
Next
If iRecCurrent <> 0 Then
sFirst = NavLink(strScriptName,0,gend,"First")
sPrev = NavLink(strScriptName,iRecPrev,gend,"Previous")
End If
If (iRecCurrent + iRecMax) < iRecEnd Then
sNext = NavLink(strScriptName,iRecNext,gend,"Next")
sLast = NavLink(strScriptName,iLastPage,gend,"Last")
End If
sNavBar = sNumbers & "<BR>" & sFirst & sPrev & sNext & sLast
Response.Write(sNavBar)
End Sub
%>
<%
' Creates the link used by the navigatio
' n sub
Function NavLink(scriptName,pageNum,gendr, sWord)
Dim strLink
strLink = strLink & "<A HREF='"
strLink = strLink & scriptName
strLink = strLink & "?page="
strLink = strLink & pageNum
strLink = strLink & "&gender="
strLink = strLink & gendr
strLink = strLink & "'>"
strLink = strLink & sWord
strLink = strLink & "</A> "
NavLink = strLink
End Function
%>
<HTML>
<HEAD>
<TITLE>5K Race Results </TITLE>
<META name="description" content="An example of paging through a database.">
<META name="keywords" content="Active Server Pages, ASP, database, paging">
<META http-equiv="Content-Type" content="text/html; charset=windows-1252">
<BASE target="_top">
<META name="language" content="en-us">
<META name="robots" content="INDEX">
<META name="revisit-after" content="14 days">
<META http-equiv="pragma" content="no-cache">
</HEAD>
<BODY>
<!-- Database Table -->
<H3><% =sGender %> 5K Race</H3>
<P><STRONG>Records</STRONG>: <% =iRecCurrent %> - <% = iRecCurrent + iRecMax %> of <% =iRecEnd %></P>
<P><% NavBar %></P>
<%
' Use these for debugging
'Response.Write ("iRecCurrent: " & iRecC
' urrent & "<BR>")
'Response.Write("iRecEnd: " & iRecEnd &
' "<BR>")
'Response.Write("iRecMax: " & iRecMax &
' "<BR>")
'Response.Write("iRecNext: " & iRecNext
' & "<BR>")
'Response.Write("iRecPrev: " & iRecPrev
' & "<BR>")
'Response.Write(CInt(iRecEnd/iPageSize)
' & "<BR>")
%>
<TABLE border="0" cellPadding="1" cellSpacing="0" width="425px">
<TR bgColor="blue">
<TD style="WIDTH: 130px" width="150" bgcolor="#388C40"><STRONG>Name</STRONG></TD>
<TD style="WIDTH: 35px" width="35" bgcolor="#388C40"><STRONG>Age</STRONG></TD>
<TD style="WIDTH: 90px" width="150" bgcolor="#388C40"><STRONG>City</STRONG></TD>
<TD style="WIDTH: 35px" width="45" bgcolor="#388C40"><STRONG>State</STRONG></TD>
<TD style="WIDTH: 50px" width="75" bgcolor="#388C40"><STRONG>Time</STRONG></TD>
<TD style="WIDTH: 50px" width="75" bgcolor="#388C40"><STRONG>Pace</STRONG></TD></TR>
<%
For i = 0 To iRecMax
If i Mod 2 Then
Response.Write ("<TR bgColor=""#008080""><TD>")
Else
Response.Write("<TR><TD>")
End If
Response.Write(RecSet("FirstName") & " ")
Response.Write(RecSet("LastName")& "</TD>")
Response.Write("<TD>" & RecSet("age") & "</TD>")
Response.Write("<TD>" & RecSet("City") & "</TD>")
Response.Write("<TD>" & RecSet("State") & "</TD>")
Response.Write("<TD>" & RecSet("Time" )& "</TD>")
Response.Write("<TD>" & RecSet("Pace") & "</TD>")
Response.Write("</TR>")
' Move to the next record
RecSet.MoveNext
Next
' Clean up after yourself
RecSet.Close
Set RecSet = Nothing
%>
</TABLE>
<P><% Call NavBar %></P>
<!-- End Database Table -->
</BODY>
</HTML>

@ -0,0 +1,59 @@
<HTML>
<HEAD><TITLE>Place Document Title Here</TITLE></HEAD>
<BODY BGColor=ffffff Text=000000>
<%
Set cn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
cn.Open Application("guestDSN")
rs.ActiveConnection = cn
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.Source = "SELECT * FROM authors"
rs.Open
%>
<TABLE BORDER=1>
<TR>
<TH Colspan=<%= rs.Fields.Count %>><B>Before Filter</B></TH>
</TR>
<TR>
<% For i = 0 To RS.Fields.Count - 1 %>
<TD><B><%= RS(i).Name %></B></TD>
<% Next %>
</TR>
<% Do While Not RS.EOF %>
<TR>
<% For i = 0 To RS.Fields.Count - 1 %>
<TD><%= RS(i) %></TD>
<% Next %>
</TR>
<%
RS.MoveNext
Loop
rs.Filter = "phone LIKE '415%'"
rs.MoveFirst
%>
</TABLE>
<P>
<TABLE BORDER=1>
<TR>
<TH Colspan=<%= rs.Fields.Count %>><B>After Filter</B></TH>
</TR>
<TR>
<% For i = 0 To RS.Fields.Count - 1 %>
<TD><B><%= RS(i).Name %></B></TD>
<% Next %>
</TR>
<% Do While Not RS.EOF %>
<TR>
<% For i = 0 To RS.Fields.Count - 1%>
<TD><%= RS(i) %></TD>
<% Next %>
</TR>
<%
RS.MoveNext
Loop
rs.MoveFirst
RS.Close
Cn.Close
%>
</TABLE>

@ -0,0 +1,102 @@
program shutdown;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;
var
logoff: boolean = false;
reboot: boolean = false;
warn: boolean = false;
downQuick: boolean = false;
cancelShutdown: boolean = false;
powerOff: boolean = false;
timeDelay: integer = 0;
function HasParam(Opt: Char): Boolean;
var
x: integer;
begin
result := false;
for x := 1 to paramCount do
if (paramstr(x) = '-'+opt) or (paramstr(x) = '/'+opt) then result := true;
end;
function GetErrorString: String;
var
lz: Cardinal;
err: array[0..512] of Char;
begin
lz := GetLastError;
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, lz, 0, @err, 512, nil);
result := string(err);
end;
procedure DoShutdown;
var
rl,flgs: Cardinal;
hToken: Cardinal;
tkp: TOKEN_PRIVILEGES;
begin
flgs := 0;
if downQuick then flgs := flgs or EWX_FORCE;
if not reboot then flgs := flgs or EWX_SHUTDOWN;
if reboot then flgs := flgs or EWX_REBOOT;
if poweroff and (not reboot) then flgs := flgs or EWX_POWEROFF;
if logoff then flgs := (flgs and (not (EWX_REBOOT or EWX_SHUTDOWN or EWX_POWEROFF))) or EWX_LOGOFF;
if Win32Platform = VER_PLATFORM_WIN32_NT then begin
if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
Writeln('Cannot open process token. ['+GetErrorString+']')
else begin
if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then begin
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
tkp.PrivilegeCount := 1;
AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);
if GetLastError <> ERROR_SUCCESS then
Writeln('Error adjusting process privileges.');
end else Writeln('Cannot find privilege value. ['+GetErrorString+']');
end;
{ if CancelShutdown then
if AbortSystemShutdown(nil) = False then
Writeln(\'Cannot abort. [\'+GetErrorString+\']\')
else
Writeln(\'Cancelled.\')
else begin
if InitiateSystemShutdown(nil, nil, timeDelay, downQuick, Reboot) = False then
Writeln(\'Cannot go down. [\'+GetErrorString+\']\')
else
Writeln(\'Shutting down!\');
end;}
end;
// else begin
ExitWindowsEx(flgs, 0);
// end;
end;
begin
Writeln('Shutdown v0.3 for Win32 (similar to the Linux version)');
Writeln('X Software. All Rights Reserved.');
if HasParam('?') or (ParamCount=0) then begin
Writeln('Usage: shutdown [-akrhfnc] [-t secs]');
Writeln(' -k: don''t really shutdown, only warn.');
Writeln(' -r: reboot after shutdown.');
Writeln(' -h: halt after shutdown.');
Writeln(' -p: power off after shutdown');
Writeln(' -l: log off only');
Writeln(' -n: kill apps that don''t want to die.');
Writeln(' -c: cancel a running shutdown.');
end else begin
if HasParam('k') then warn := true;
if HasParam('r') then reboot := true;
if HasParam('h') and reboot then begin
Writeln('Error: Cannot specify -r and -h parameters together!');
Exit;
end;
if HasParam('h') then reboot := false;
if HasParam('n') then downQuick := true;
if HasParam('c') then cancelShutdown := true;
if HasParam('p') then powerOff := true;
if HasParam('l') then logoff := true;
DoShutdown;
end;
end.

@ -0,0 +1,154 @@
<html><head>
<title>iskeyword.asp</title>
</head><body bgcolor="#FFFFFF">
<Form action = "iskeywordRespond.asp" method="get">
Choose The Word You Want To Search For::<p>
Search Word: <Input NAME="Keyword" size ="30"><br>
<Input Type="submit" value="Find The Documents!">
</form>
</body></html>
The iskeywordrespond.asp looks like this:
<html><head>
<title>iskeywordrespond.asp</title>
</head>
<body>
<%
Set objQuery = Server.CreateObject("ixsso.query")
Set objUtil = Server.CreateObject("ixsso.util")
my_keyword=request("keyword")
' keyword search
myquery=myquery & "$CONTENTS " & my_keyword
' Exclude specific folders
%>
<!--#include virtual="/search/exclude.asp"-->
<%
' Exclude specific filenames
myquery=myquery & " and not #filename indexmaster.asp"
myquery=myquery & " and not #filename index.asp"
myquery=myquery & " and not #filename indexold.asp"
' Exclude specific extensions
myquery=myquery & " and not #filename *.|(txt|,inc|,htm|,mdb|,cnt|,class|,toc|,html|,css|)"
'myquery="$CONTENTS dsn"
objQuery.Query=myQuery
objQuery.Columns = "Vpath, DocTitle, Filename, Characterization, Contents,DocKeyWords, Rank"
'objquery.Columns = "DocTitle, vpath, filename, size, write, characterization, rank"
objQuery.SortBy = "Rank [d]"
objQuery.MaxRecords = 50
objquery.catalog="learnasp"
'objUtil.AddScopeToQuery objQuery, "/", "deep"
objquery.LocaleID = objutil.ISOToLocaleID("EN-US")
linebr="<br>" & vbCrLf
Set rstemp = objQuery.CreateRecordSet("nonsequential")
Do UNTIL rstemp.eof
For Each key In rstemp.fields
keyname=LCase(key.name)
Select Case keyname
Case "vpath"
Response.Write "<a href='"
Response.Write key
Response.Write "'>" & key & "</a>" & linebr
Case Else
Response.Write "<b>" & keyname & ":</b>" & linebr
Response.Write key & linebr
End Select
Next
Response.Write "<br><hr>"
rstemp.movenext
Loop
' clean up
rstemp.close
Set rstemp=Nothing
Set objQuery = Nothing
Set objUtil = Nothing
%>
</body>
</html>
It has To exclude many folders On my site And the following file excludes directories:
<%
myquery=myquery & " and not #Vpath = **_* "
myquery=myquery & " and not #Vpath = *_contents* "
myquery=myquery & " and not #Vpath = *_raw* "
myquery=myquery & " and not #Vpath = *ads* "
myquery=myquery & " and not #Vpath = *aspace* "
myquery=myquery & " and not #Vpath = *advicedraft* "
'myquery=myquery & " and not #Vpath = *asplists* "
myquery=myquery & " and not #Vpath = *aspmagazine
ew* "
myquery=myquery & " and not #Vpath = *aspfuture* "
myquery=myquery & " and not #Vpath = *asptraining* "
myquery=myquery & " and not #Vpath = *aspynews* "
myquery=myquery & " and not #Vpath = *activeserverpages* "
myquery=myquery & " and not #Vpath = *contribute* "
myquery=myquery & " and not #Vpath = *cst* "
myquery=myquery & " and not #Vpath = *charlescarrolldraft* "
myquery=myquery & " and not #Vpath = *charlesteam* "
myquery=myquery & " and not #Vpath = *dcline* "
myquery=myquery & " and not #Vpath = *drafts* "
myquery=myquery & " and not #Vpath = *experiments* "
myquery=myquery & " and not #Vpath = *genericdb* "
myquery=myquery & " and not #Vpath = *future* "
myquery=myquery & " and not #Vpath = *home* "
myquery=myquery & " and not #Vpath = *how* "
myquery=myquery & " and not #Vpath = *images* "
myquery=myquery & " and not #Vpath = *library* "
myquery=myquery & " and not #Vpath = *learncover* "
myquery=myquery & " and not #Vpath = *learnsecurityrisk* "
myquery=myquery & " and not #Vpath = *
aoko* "
myquery=myquery & " and not #Vpath = *private* "
myquery=myquery & " and not #Vpath = *perlscript* "
myquery=myquery & " and not #Vpath = *
eference* "
myquery=myquery & " and not #Vpath = *
edesign* "
myquery=myquery & " and not #Vpath = *search* "
myquery=myquery & " and not #Vpath = *searchasplists* "
myquery=myquery & " and not #Vpath = *secret* "
myquery=myquery & " and not #Vpath = *sites* "
myquery=myquery & " and not #Vpath = *search* "
myquery=myquery & " and not #Vpath = *speedsitelaws* "
myquery=myquery & " and not #Vpath = *start* "
myquery=myquery & " and not #Vpath = * rash* "
myquery=myquery & " and not #Vpath = * est* "
myquery=myquery & " and not #Vpath = *upload* "
myquery=myquery & " and not #Vpath = *upload ests* "
myquery=myquery & " and not #filename indexmaster.asp"
myquery=myquery & " and not #filename index.asp"
myquery=myquery & " and not #filename indexold.asp"
myquery=myquery & " and not #filename *.|(txt|,inc|,htm|,mdb|,cnt|,class|,toc|,html|,css|)"
%>

@ -0,0 +1,69 @@
<%@ Language=VBScript %>
<%
Option Explicit
Response.Expires = 0
' *****************************
' Variable Declarations
' *****************************
' Strings
Dim SQL
' Integers & Numerics
' Objects
Dim cn, rs
' Other
' *****************************
' Initialize Variables
' *****************************
%>
<HTML>
<HEAD>
<!-- #INCLUDE Virtual="/include/ForceFrame.htm" -->
<TITLE>Insert using SPT (SQL pass-thru)</TITLE></HEAD>
<BODY>
<BASEFont Face="Verdana,Arial">
<%
If Request.Form("TextCol") = "" Then
%>
<FORM Action=SQLInsert.asp Method=Post>
<TEXTAREA Rows=10 Cols=45 Name=TextCol>This example uses SQL Pass-thru To insert
a record into a database. This method allows us To insert into BLOB fields such As
SQL Server Text fields, FoxPro Memo fields, Or other fields > 255 characters.
This has an embedded Single quote(') To show how these can be handled With
an SQL insert.</TEXTAREA><P>
<Input Type=Submit Name=btnSubmit Value="Submit">
</FORM>
<%
Else
Set cn = Server.CreateObject("ADODB.Connection")
cn.Open Application("guestDSN")
SQL = "INSERT INTO pubs..paulen (TextCol) "
SQL = SQL & " VALUES ('" & padQuotes(Request("TextCol")) & "')"
cn.Execute SQL
Response.Write "<B>Inserted:</B><BR>" & Request("TextCol")
End If
%>
<P>
<%
Function padQuotes( instring )
REM This Function pads an extra Single q
' uote in strings containing quotes for
REM proper SQL searching.
Dim bodybuild
Dim bodystring
Dim Length
Dim i
bodybuild = ""
bodystring = instring
Length = Len(bodystring)
For I = 1 To length
bodybuild = bodybuild & Mid(bodystring, I, 1)
If Mid(bodystring, I, 1) = Chr(39) Then
bodybuild = bodybuild & Mid(bodystring, I, 1)
End If
Next
bodystring = bodybuild
padQuotes = bodystring
End Function
%>
</BODY>
</HTML>

@ -0,0 +1,84 @@
Pagination Script in ASP
' iNumPerPage is the number of items to
' display on each page
' sURL is the page to put with the link
' , sQuerystring is additional qs stuff
' adodbConnection, adodbCommand, sTable
' are all for the table to get row count from. *
' *
' Print out the numbers (if any) betwee
' n the "previous" and "next" buttons
' It'll act like this (current # is in
' bold):
' 1 2 3 4 5 6 7 8 9 <b>10</b> >> next
' previous << <b>11</b> 12 13 14 15 16 17 18 *
' *
'' ****************************************
Sub PrintRecordsetNav( iNumPerPage, adodbConnection, adodbCommand, sTable, sURL, sQuerystring )
Dim iTtlNumItems, iDBLoc, sSqlTemp, iTtlTemp
Dim iDBLocTemp, sURLBeg, iA, iB, x, iTemp, rsObj
iDBLoc = CInt(Request("iDBLoc"))
iTtlNumItems = CInt(Request("iTtlNumItems"))
' Get ttl num of items from the database if it's Not already In the QueryString
If (iTtlNumItems = 0) Then
Set rsObj = Server.CreateObject("ADODB.Recordset")
sSqlTemp = "SELECT COUNT(*) FROM " & sTable
adodbCommand.CommandText = sSqlTemp
rsObj.Open adodbCommand
If Not(rsObj.EOF) Then
iTtlNumItems = rsObj(0)
End If
rsObj.Close
Set rsObj = Nothing
End If
iTtlTemp = iTtlNumItems iNumPerPage ' this is the number of numbers overall (use the "" To return int)
iDBLocTemp = iDBLoc iNumPerPage ' this is which number we are currently On (use the "" To return int)
If (sQuerystring <> "") Then
sURLBeg = "<A href = """ & sURL & "?" & sQuerystring & "&iTtlNumItems=" & iTtlNumItems & "&iDBLoc="
Else
sURLBeg = "<A href = """ & sURL & "?iTtlNumItems=" & iTtlNumItems & "&iDBLoc="
End If
'***** BEGIN DISPLAY *****
' Print the "Previous"
If (iDBLoc <> 0) Then
Response.Write sURLBeg & (iDBLoc - iNumPerPage) & """>Previous</A> "
End If
' Print the <<
If (iDBLocTemp >= iNumPerPage) Then
Response.Write sURLBeg & (( iDBLocTemp iNumPerPage ) * iNumPerPage ^ 2) - (iNumPerPage * 9) & """><<</A> "
End If
' Print the numbers in between. Print them out in sets of 10.
iA = ( iDBLocTemp iNumPerPage ) * iNumPerPage
iB = ( iDBLocTemp iNumPerPage ) * iNumPerPage + iNumPerPage
For x = iA To iB
iTemp = (x * iNumPerPage)
If (iTemp < iTtlNumItems) Then ' takes care of extra numbers after the overall final number
If (iDBLoc = iTemp) Then
Response.Write " <B>[" & x+1 & "]</B>"
Else
Response.Write " " & sURLBeg & (x * iNumPerPage) & """>" & x+1 & "</A>"
End If
Else
Exit For
End If
Next
' Print the >>
If (iTtlTemp > iDBLocTemp) Then
If ((iDBLocTemp + iNumPerPage) <= iTtlTemp) Then
Response.Write " " & sURLBeg & (( iDBLocTemp iNumPerPage ) * iNumPerPage + iNumPerPage ) * iNumPerPage & """>>></A> "
End If
End If
' Print the "Next"
If ((iDBLoc + iNumPerPage) < iTtlNumItems) Then
Response.Write " " & sURLBeg & (iDBLoc + iNumPerPage) & """>Next</A>"
End If
'***** End DISPLAY *****
End Sub

@ -0,0 +1,62 @@
<%
Class Program
Public Description, ClsID, ProgID, Path, TypeLib, Version, DLLName
End Class
Class ProgIDInfo
Private WshShell, sCVProgID, oFSO
Private Sub Class_Initialize()
On Error Resume Next
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
End Sub
Private Sub Class_Terminate()
If IsObject(WshShell) Then Set WshShell = Nothing
If IsObject(oFSO) Then Set oFSO = Nothing
End Sub
Private Function IIf(ByVal conditions, ByVal trueval, ByVal falseval)
If CBool(conditions) Then IIf = trueval Else IIf = falseval
End Function
Public Function LoadProgID(ByVal sProgramID)
Dim sTmpProg, oTmp, sRegBase, sDesc, sClsID
Dim sPath, sTypeLib, sProgID, sVers, sPathSpec
If IsObject(WshShell) Then
On Error Resume Next
sCVProgID = WshShell.RegRead("HKCR" & _
sProgramID & "CurVer")
sTmpProg = IIf(Err.number = 0, sCVProgID, sProgramID)
sRegBase = "HKCR" & sTmpProg
sDesc = WshShell.RegRead(sRegBase & "")
sClsID = WshShell.RegRead(sRegBase & "clsid")
sRegBase = "HKCRCLSID" & sClsID
sPath = WshShell.RegRead(sRegBase & "InprocServer32")
sPath = WshShell.ExpandEnvironmentStrings(sPath)
sTypeLib = WshShell.RegRead(sRegBase & "TypeLib")
sProgID = WshShell.RegRead(sRegBase & "ProgID")
sVers = oFSO.getFileVersion(sPath)
sPathSpec = Right(sPath, Len(sPath) - _
InStrRev(sPath, ""))
Set oTmp = New Program
oTmp.Description = sDesc
oTmp.ClsID = IIf(sClsID <> "", sClsID, "undetermined")
oTmp.Path = IIf(sPath <> "", sPath, "undetermined")
oTmp.TypeLib = IIf(sTypeLib <> "", _
sTypeLib, "undetermined")
oTmp.ProgID = IIf(sProgID <> "", _
sProgID, "undetermined")
oTmp.DLLName = IIf(sPathSpec <> "", _
sPathSpec, "undetermined")
oTmp.Version = IIf(sVers <> "", sVers, "undetermined")
Set LoadProgID = oTmp
Else
Set LoadProgID = Nothing
End If
End Function
End Class
%>

@ -0,0 +1,25 @@
Function RandomArray(alen, LBound, UBound)
Dim i, j, exists, nextrand, newrandom, result
result = Null
If (alen >= 1) Then
ReDim result(alen - 1)
Randomize
For i = 0 To alen - 1
nextrand = True
Do While nextrand
exists = False
newrandom = Int((UBound - LBound + 1) * Rnd + LBound)
For j = 0 To i - 1
exists = exists Or (result(j) = newrandom)
Next
If (Not exists) Then
nextrand = False
result(i) = newrandom
End If
Loop
Next
End If
RandomArray = result
End Function

@ -0,0 +1,22 @@
<%
Private Function SelectionSort(ByVal unsortedarray)
Dim Front, Back, I, Loc, Selcom
Dim Temp, Selswap, Arrsize
Arrsize = UBound(unsortedarray)
For Front = 0 To Arrsize - 1
Loc = Front
For Back = Front To Arrsize
Selcom = Selcom + 1
If unsortedarray(Loc) > _
unsortedarray(Back) Then
Loc = Back
End If
Next
Selswap = Selswap + 1
Temp = unsortedarray(Loc)
unsortedarray(Loc) = unsortedarray(Front)
unsortedarray(Front) = Temp
Next
SelectionSort = unsortedarray
End Function
%>

@ -0,0 +1,32 @@
<%
Set sms = Server.CreateObject( "Simplewire.SMS" )
' Subscriber Settings
sms.SubscriberID = "123-123-123-12345"
sms.SubscriberPassword = "Password Goes Here"
' Message Settings
sms.MsgPin = "+1 100 510 1234"
sms.MsgFrom = "Demo"
sms.MsgCallback = "+1 100 555 1212"
' Smart Message Settings
sms.OptPhone = "nokia"
sms.MsgRingtone = "Simplewire:d=4,o=5,b=63:8a,8e,32a,32e,16a,8c6,8a,32c6,32a,16c6,8e6,8c6,32e6,32c6,16e6,8g6,32g,32p,16g,32c6,32g,16c6,8e6,32p"
Response.Write("<b>Sending message to Simplewire...</b><br>")
' Send Message
sms.MsgSend
' Check For Errors
If (sms.Success) Then
Response.Write("<b>Message was sent!</b><br>")
Else
Response.Write("<b>Message was not sent!</b><br>")
Response.Write("Error Code: " & sms.ErrorCode & "<br>")
Response.Write("Error Desc: " & sms.ErrorDesc & "<br>")
End If
Set sms = Nothing
%>

@ -0,0 +1,34 @@
<%
Set sms = Server.CreateObject( "Simplewire.SMS" )
' Subscriber Settings
sms.SubscriberID = "123-123-123-12345"
sms.SubscriberPassword = "Password Goes Here"
' Message Settings
sms.MsgPin = "+1 100 510 1234"
sms.MsgFrom = "Demo"
sms.MsgCallback = "+1 100 555 1212"
' Smart Message Settings
sms.OptPhone = "nokia"
sms.OptCountryCode = "Country Code goes here"
sms.OptNetworkCode = "Network Code goes here"
sms.MsgOperatorLogoFilename = Server.MapPath("example.gif")
Response.Write("<b>Sending message to Simplewire...</b><br>")
' Send Message
sms.MsgSend
' Check For Errors
If (sms.Success) Then
Response.Write("<b>Message was sent!</b><br>")
Else
Response.Write("<b>Message was not sent!</b><br>")
Response.Write("Error Code: " & sms.ErrorCode & "<br>")
Response.Write("Error Desc: " & sms.ErrorDesc & "<br>")
End If
Set sms = Nothing
%>

@ -0,0 +1,40 @@
Sort arrays
'--------Begin Function----
Function fnSort(aSort, intAsc)
Dim intTempStore
Dim i, j
For i = 0 To UBound(aSort) - 1
For j = i To UBound(aSort)
'Sort Ascending
If intAsc = 1 Then
If aSort(i) > aSort(j) Then
intTempStore = aSort(i)
aSort(i) = aSort(j)
aSort(j) = intTempStore
End If 'i > j
'Sort Descending
Else
If aSort(i) < aSort(j) Then
intTempStore = aSort(i)
aSort(i) = aSort(j)
aSort(j) = intTempStore
End If 'i < j
End If 'intAsc = 1
Next 'j
Next 'i
fnSort = aSort
End Function 'fnSort
'-------------------------
Dim aUnSort(3), aSorted
aUnSort(0) = 4
aUnSort(1) = 2
aUnSort(2) = 6
aUnSort(3) = 20
'call the function
'second argument:
' * ascending sorted = 1
' * descending sorting = any other chara
' cter
aSorted = fnSort(aUnSort, 1)
Erase aUnSort

@ -0,0 +1,19 @@
Using a Stored Procedure with ADO
Dim cn As New ADODB.Connection
cn.Open sConStr
Dim cmd As New ADODB.Command
cn.CursorLocation = adUseClient
Set cmd.ActiveConnection = cn
cmd.CommandText = "addNew_Service"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Refresh
cmd.Parameters.Item("@wsdlfilename") = CStr(services(serviceId).wsdlfilename)
cmd.Parameters.Item("@WSMLFileName") = CStr(services(serviceId).WSMLFileName)
cmd.Parameters.Item("@name") = CStr(services(serviceId).name)
cmd.Parameters.Item("@description") = CStr(services(serviceId).description)
cmd.Parameters.Item("@uuid") = CStr(sUUID)
cmd.Parameters.Item("@Service_ID") = 0
cmd.Execute
Debug.Print Err.description
newService_ID = cmd.Parameters("@Service_ID").Value

@ -0,0 +1,36 @@
<%@ language=vbscript%>
<HTML>
<HEAD>
<TITLE>versioncheck.asp</TITLE>
</HEAD>
<body bgcolor="#FFFFFF">
<script language=jscript runat=server>
Response.Write ("scripting engine=<b>" + ScriptEngine() + "</b><br>");
Response.Write ("buildversion=<b>" + ScriptEngineBuildVersion() + "</b><br>");
Response.Write ("majorversion=<b>" + ScriptEngineMajorVersion() + "</b><br>");
Response.Write ("minorversion=<b>" + ScriptEngineMinorVersion() + "</b><br>");
</script>
<%
Response.Write "<hr><br>"
Response.Write "scripting engine=<b>" & ScriptEngine() & "</b><br>"
Response.Write "buildversion=<b>" & ScriptEngineBuildVersion() & "</b><br>"
Response.Write "majorversion=<b>" & ScriptEngineMajorVersion() & "</b><br>"
Response.Write "minorversion=<b>" & ScriptEngineMinorVersion() & "</b><br>"
Response.Write "<hr><br>"
Set tempconn=Server.CreateObject("adodb.connection")
Response.Write "ado version=<b>"
Response.Write tempconn.version & "</b><br>"
Set tempconn=Nothing
Response.Write "<hr><br>"
serversoftware=Request.ServerVariables("server_software")
Response.Write "server software=<b>"
Response.Write serversoftware & "</b><br>"
Response.Write "Script Timeout = <b>" & Server.ScriptTimeout & " seconds</b><br>"
Response.Write "Session Timeout = <b>" & Session.Timeout & " minutes</b><br>"
%>
</BODY></HTML>

@ -0,0 +1,130 @@
<SCRIPT LANGUAGE="VBScript" RUNAT=SERVER>
' requires: _const, _err
Function GetMailObject
Dim mo
On Error Resume Next
PushLocalError
GetMailObject = Null
Set mo = Server.CreateObject("SMTPsvg.Mailer")
If CheckPopError Then
Exit Function
End If
mo.CharSet = 2
mo.ContentType = "text/html"
mo.FromName = fromname
mo.FromAddress = fromaddress
mo.Organization = company
mo.Priority = 3
mo.RemoteHost = mailhost
Set GetMailObject = mo
PopError
End Function
Function SendMailEx(SendName, SendAddr, Subject, Body)
Dim mo, i, result
On Error Resume Next
PushLocalError
If (root = "Local") Then
SendMailEx = True
PopError
Exit Function
End If
SendMailEx = False
Set mo = GetMailObject
If CheckError Or IsNull(mo) Then
PopError
Exit Function
End If
' mo.SMTPLog = uploadroot & "log.txt"
mo.Subject = Subject
mo.BodyText = Body
If IsArray(SendName) And IsArray(SendAddr) Then
For i = LBound(SendName) To UBound(SendName)
mo.AddBCC SendName(i), SendAddr(i)
Next
Else
mo.AddRecipient SendName, SendAddr
End If
result = mo.SendMail
If CheckPopError Then
Exit Function
End If
SendMailEx = result