michael/programming-examples
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Adding ASP example files

Browse Source
This commit is contained in:
Michael Reber 2019-11-18 14:25:58 +01:00
parent 8c9a19ec97
commit 8258e10e80
241 changed files with 11840 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

165
asp/ActiveX_ADO_Arrays/ADO Schemas to list tables & fields.asp Normal file
View File

@ -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
%>

35
asp/ActiveX_ADO_Arrays/ADO Techniques -- The .maxrecords property.asp Normal file
View File

@ -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>

82
asp/ActiveX_ADO_Arrays/Add New Record with ADO.asp Normal file
View File

@ -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
%>

134
asp/ActiveX_ADO_Arrays/Another month, day, year dropdown creator.asp Normal file
View File

@ -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
%>

37
asp/ActiveX_ADO_Arrays/Arrays to store data.asp Normal file
View File

@ -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>

24
asp/ActiveX_ADO_Arrays/CombSort Function.asp Normal file
View File

@ -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
%>

30
asp/ActiveX_ADO_Arrays/Count the Number of Lines.asp Normal file
View File

@ -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) %>

225
asp/ActiveX_ADO_Arrays/Database Paging.asp Normal file
View File

@ -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>

59
asp/ActiveX_ADO_Arrays/How to filter a recordset.asp Normal file
View File

@ -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>

102
asp/ActiveX_ADO_Arrays/How to shutdown reboot logoff WIndows 9x NT Me 2000.asp Normal file
View File

@ -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.

154
asp/ActiveX_ADO_Arrays/Index Server Access via ADO.asp Normal file
View File

@ -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|)"
%>

69
asp/ActiveX_ADO_Arrays/Insert TEXT blob using ADO.asp Normal file
View File

@ -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>

84
asp/ActiveX_ADO_Arrays/Pagination Script in ASP.asp Normal file
View File

@ -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

62
asp/ActiveX_ADO_Arrays/ProgIDInfo Object.asp Normal file
View File

@ -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
%>

25
asp/ActiveX_ADO_Arrays/Random Array.asp Normal file
View File

@ -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

22
asp/ActiveX_ADO_Arrays/SelectionSort Function.asp Normal file
View File

@ -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
%>

32
asp/ActiveX_ADO_Arrays/Send a Ringtone to Nokia phones in ASP.asp Normal file
View File

@ -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
%>

34
asp/ActiveX_ADO_Arrays/Send an Operator Logo to Nokia phones in ASP.asp Normal file
View File

@ -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
%>

40
asp/ActiveX_ADO_Arrays/Sort arrays.asp Normal file
View File

@ -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

19
asp/ActiveX_ADO_Arrays/Using a Stored Procedure with ADO.asp Normal file
View File

@ -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

36
asp/ActiveX_ADO_Arrays/Version Check.asp Normal file
View File

@ -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>

130
asp/Components/ASP Mail Interface.asp Normal file
View File

@ -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
PopError
End Function
Function SendMail(SendTo, Subject, Body)
SendMail = SendMailEx(SendTo, SendTo, Subject, Body)
End Function
Function SendMailFromFile(SendTo, Subject, FileName)
Dim mo, i, result
On Error Resume Next
PushLocalError
If (root = "Local") Then
SendMailFromFile = True
PopError
Exit Function
End If
SendMailFromFile = False
Set mo = GetMailObject
If CheckError Or IsNull(mo) Then
PopError
Exit Function
End If
' mo.SMTPLog = uploadroot & "log.txt"
mo.Subject = Subject
If IsArray(SendTo) Then
For i = LBound(SendTo) To UBound(SendTo)
mo.AddBCC SendTo(i), SendTo(i)
Next
Else
mo.AddRecipient SendTo, SendTo
End If
result = mo.GetBodyTextFromFile(FileName, False, False)
If CheckPopError Then
Exit Function
End If
If result Then
result = mo.SendMail
If CheckPopError Then
Exit Function
End If
End If
SendMailFromFile = result
PopError
End Function
</SCRIPT>

34
asp/Components/Auto Generate Password.asp Normal file
View File

@ -0,0 +1,34 @@
<%@ Language=VBScript %>
<HTML>
<HEAD>
</HEAD>
<BODY>
<%
Function gen_key(digits)
dim char_array(50)
iTestChar = Asc("0")
For i = 0 To 9
char_array(i) = Chr(iTestChar)
iTestChar = iTestChar + 1
Next
iTestChar = Asc("A")
For i = 10 To 10 + 25
char_array(i) = Chr(iTestChar)
iTestChar = iTestChar + 1
Next
randomize
do while len(output) < digits
num = char_array(Int((35 - 12 + 1) * Rnd + 5))
output = output + num
loop
gen_key = output
End Function
response.write gen_key(13)
%>
</BODY>
</HTML>

20
asp/Components/Know all drive properties through file system.asp Normal file
View File

@ -0,0 +1,20 @@
<%
'Know all drive properties through file system object
Dim fso, drv, s,strDir
'if directory name is H:\docuemnts strDir="H:\docuemnts\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set drv = fso.GetDrive(fso.GetDriveName(strDir))
s = "Drive " & UCase(drv.Path) & "<br>"
s = s & drv.driveType & "<br>"
s = s & drv.FileSystem & "<br>"
s = s & drv.IsReady & "<br>"
s = s & drv.Path & "<br>"
s = s & drv.RootFolder & "<br>"
s = s & drv.ShareName & "<br>"
s = s & drv.VolumeName & "<br>"
s = s & drv.driveType & "<br>"
Response.Write s
%>

53
asp/Components/Limiting the Upload Size.asp Normal file
View File

@ -0,0 +1,53 @@
<html>
<head>
<title>Limit File Size</title>
</head>
<body>
Thank you For uploading your file.<br>
<% Set upl = Server.CreateObject(SoftArtisans.FileUp) %>
<% upl.MaxBytes = 1000 '--- limit the upload size to 1000 bytes %>
The maximum file size that you are permitted To upload Is <%=upl.MaxBytes%> bytes.<br>
<% upl.SaveAs C: empupload.out %>
Total Bytes Written: <%=upl.TotalBytes%><br>
Server File Name: <%=upl.ServerName%><br>
Total Bytes Transmitted: <%=Request.TotalBytes%>
</body>
</html>
Restricting File Types
Use SA-FileUp's ContentType property and a Select condition to save only files of a specific type.
<html>
<head>
<title>Limit File Type</title>
</head>
<body>
<% Set upl = Server.CreateObject("SoftArtisans.FileUp")
'--- Parse out the file name