100ASP实例

来源：互联网发布：ajax获取不到json数据编辑：程序博客网时间：2024/05/21 06:59

实例01-helloworld.asp

<%@ LANGUAGE = VBScript %>

<HTML>

<TITLE>

Hello World

</TITLE>

<BODY>

'以下循环输出Hello World字符串,字体由小变大

for i=1 to 5

response.write "<font size=" & i & ">hello world</font><br>"

</BODY>

</HTML>

实例02-Restrict.asp

<%@ Language=VBScript %>

<html>

<title>

本站主页

</title>

<body>

'本例根据远程主机地址来进行判断,如果为本地

'地址则进入欢迎页面,否则显示出错信息.

dim address

address = request.servervariables("REMOTE_ADDR")

if address="127.0.0.21" then

'如果为本地,则显示欢迎页面.

response.write "你好,欢迎进入本站点."

else

'否则显示出错信息.

response.write "对不起,你无权查看内部站点."

end if

</body>

</html>

实例03-CountDown.asp

<%@ Language=VBScript %>

<html>

<title>

倒记时间

</title>

<body>

response.write "今天是"

response.write formatDateTime(Date(),1) & ","

'格式化为长日期格式输出显示

response.write " 离高考还有"

response.write "<font color=blue><u>"

'调用DateDiff函数,计算日期间隔.

response.write DateDiff("d",Date(),"01-07-07")

response.write "</font></u>"

response.write "天"

</body>

</html>

实例04-WEBTEST.ASP

<HTML>

<HEAD>

<TITLE>测试WEB服务器</TITLE>

</HEAD>

<BODY>

response.write ("<table border=1>");

response.write ("<tr><td>脚本引擎</td><td>");

response.write (ScriptEngine()+"</td></tr>");

response.write ("<tr><td>编译版本</td><td>");

response.write (ScriptEngineBuildVersion()+"</td></tr>");

response.write ("<tr><td>主版本</td><td>");

response.write (ScriptEngineMajorVersion()+"</td></tr>");

response.write ("<tr><td>次版本</td><td>");

response.write (ScriptEngineMinorVersion()+"</td></tr>");

response.write ("</table>");

</script>

response.write "<table border=1>"

response.write "<tr><td>脚本引擎</td><td>"

response.write ScriptEngine() & "</td></tr>"

response.write "<tr><td>编译版本</td><td>"

response.write ScriptEngineBuildVersion() & "</td></tr>"

response.write "<tr><td>主版本</td><td>"

response.write ScriptEngineMajorVersion() & "</td></tr>"

response.write "<tr><td>次版本</td><td>"

response.write ScriptEngineMinorVersion() & "</td></tr>"

response.write "</table>"

</script>

</body>

实例05-Random.asp

<%@ LANGUAGE = VBScript %>

<html>

<title>

生成随机字符串

</title>

<body>

Function gen_key(digits)

'定义并初始化数组

dim char_array(80)

'初始化数字

For i = 0 To 9

char_array(i) = CStr(i)

'初始化大写字母

For i = 10 To 35

char_array(i) = Chr(i + 55)

'初始化小写字母

For i = 36 To 61

char_array(i) = Chr(i + 61)

Randomize '初始化随机数生成器。

do while len(output) < digits

num = char_array(Int((62 - 0 + 1) * Rnd + 0))

output = output + num

loop

'设置返回值

gen_key = output

End Function

'把结果返回给浏览器

response.write "本实例生成的十三位随机字符串为:"

response.write "<center>"

response.write gen_key(13)

response.write "</center>"

</body>

</html>

实例06-ChangeColor.asp

<%@ Language=VBScript %>

<html>

<title>

移动鼠标改变背景颜色

</title>

<!--

function MakeColor(ThisColor) {

document.bgColor = ThisColor;

}

//-->

</SCRIPT>

<tr>

Dim I1, I2, I3 ' Looping variables for RGB Color

For I1 = 0 to 15 step 3

For I2 = 0 to 15 step 3

For I3 = 0 to 15 step 3

Color = Hex(I1) & Hex(I1) & Hex(I2) & Hex(I2) & Hex(I3) & Hex(I3)

</td>

</tr>

<tr>

</tr>

</table>

</center>

</html>

实例07-Login.asp

<HTML>

<BODY>

<TITLE>

用户登录

</TITLE>

if Request.Form.Count=0 then

请输入用户名和密码

</tr>

</tr>

</Table>

</FORM>

<%else%>

Dim user

dim pwd

user=Request.Form("username")

pwd=Request.Form("password")

if user="fenfang" then

if pwd="1234" then

Response.write "用户登录成功"

else

Response.write "用户密码无效"

end if

else

Response.write "用户无效"

end if

实例08-ORDER.ASP

<%@ Language=VBScript %>

<HTML>

<TITLE>

订购水果

</TITLE>

<BODY>

请选择你所要订购的水果

<hr>

<input name="fruit" type=checkbox value="苹果">苹果

<Br>

<input name="fruit" type=checkbox value="香蕉">香蕉

<Br>

<input name="fruit" type=checkbox value="菠萝">菠萝

<Br>

<input name="fruit" type=checkbox value="桔子">桔子

</FORM>

<hr>

if Request.QueryString("fruit").Count=0 then

你没有订购水果

<%else%>

你订购了

for each fruit in Request.QueryString("fruit")

response.write "<br><font color=green>" & fruit & "</font>"

end if

</BODY>

</HTML>

实例09-calculator.asp

<html>

<title>

计算器

</title>

<body>

操作数1: <input type=text name=num1><br>

操作数2: <input type=text name=num2><br>

<p>

选择你要进行的操作<br>

</form>

<hr>

dim n1,n2,op

if request.form.count=0 then

response.end

end if

n1=request.form("num1")

n2=request.form("num2")

op=request.form("operation")

if op="加" then

response.write n1

response.write "+"

response.write n2

response.write "="

response.write clng(n1)+clng(n2)

elseif op="减" then

response.write n1

response.write "-"

response.write n2

response.write "="

response.write clng(n1)-clng(n2)

elseif op="乘" then

response.write n1

response.write "*"

response.write n2

response.write "="

response.write clng(n1)*clng(n2)

elseif op="除" then

response.write n1

response.write "/"

response.write n2

response.write "="

response.write clng(n1)/clng(n2)

end if

</body>

</html>

实例10-Calendar.asp

<%@ Language=VBScript %>

<Html>

<Title>

小日历

</title>

<body>

Function CountDays(iMonth,iYear)

Select Case iMonth

case 1,3,5,7,8,10,12

CountDays=31

case 2

if IsDate("2/29/" & iYear) Then

CountDays=29

else

CountDays=28

end if

case 4,6,9,11

CountDays=30

End Select

End Function

Function FirstDay(iMonth,iYear)

FirstDay=WeekDay(iMonth & "/1/" & iYear)

End Function

dim mMonth,mYear

mMonth=Month(Date())

mYear=Year(Date())

mDate=Day(Date())

response.write "<center>" & mYear & "年" & mMonth & "月" & "</center><hr>"

</tr><tr>

j=1

for i=1 to 42

response.write "<td align=right>"

if i>=FirstDay(mMonth,mYear) and j<=CountDays(mMonth,mYear) then

if mDate=j then

response.write "<font color=blue>" & j & " </font>"

else

response.write j

end if

j=j+1

else

response.write "   "

end if

response.write "</td>"

if i mod 7=0 then

response.write "</tr><tr>"

end if

</tr></table>

</body>

</html>

实例11-Base64.asp

OPTION EXPLICIT

const BASE_64_MAP_INIT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

dim newline

dim Base64EncMap(63)

dim Base64DecMap(127)

'初始化函数

PUBLIC SUB initCodecs()

' 初始化变量

newline = "<P>" & chr(13) & chr(10)

dim max, idx

max = len(BASE_64_MAP_INIT)

for idx = 0 to max - 1

Base64EncMap(idx) = mid(BASE_64_MAP_INIT, idx + 1, 1)

for idx = 0 to max - 1

Base64DecMap(ASC(Base64EncMap(idx))) = idx

END SUB

'Base64加密函数

PUBLIC FUNCTION base64Encode(plain)

if len(plain) = 0 then

base64Encode = ""

exit function

end if

dim ret, ndx, by3, first, second, third

by3 = (len(plain) / 3) * 3

ndx = 1

do while ndx <= by3

first = asc(mid(plain, ndx+0, 1))

second = asc(mid(plain, ndx+1, 1))

third = asc(mid(plain, ndx+2, 1))

ret = ret & Base64EncMap( (first / 4) AND 63 )

ret = ret & Base64EncMap( ((first * 16) AND 48) + ((second / 16) AND 15 ) )

ret = ret & Base64EncMap( ((second * 4) AND 60) + ((third / 64) AND 3 ) )

ret = ret & Base64EncMap( third AND 63)

ndx = ndx + 3

loop

if by3 < len(plain) then

first = asc(mid(plain, ndx+0, 1))

ret = ret & Base64EncMap( (first / 4) AND 63 )

if (len(plain) MOD 3 ) = 2 then

second = asc(mid(plain, ndx+1, 1))

ret = ret & Base64EncMap( ((first * 16) AND 48) + ((second / 16) AND 15 ) )

ret = ret & Base64EncMap( ((second * 4) AND 60) )

else

ret = ret & Base64EncMap( (first * 16) AND 48)

ret = ret '& "="

end if

ret = ret '& "="

end if

base64Encode = ret

END FUNCTION

'Base64解密函数

PUBLIC FUNCTION base64Decode(scrambled)

if len(scrambled) = 0 then

base64Decode = ""

exit function

end if

dim realLen

realLen = len(scrambled)

do while mid(scrambled, realLen, 1) = "="

realLen = realLen - 1

loop

dim ret, ndx, by4, first, second, third, fourth

ret = ""

by4 = (realLen / 4) * 4

ndx = 1

do while ndx <= by4

first = Base64DecMap(asc(mid(scrambled, ndx+0, 1)))

second = Base64DecMap(asc(mid(scrambled, ndx+1, 1)))

third = Base64DecMap(asc(mid(scrambled, ndx+2, 1)))

fourth = Base64DecMap(asc(mid(scrambled, ndx+3, 1)))

ret = ret & chr( ((first * 4) AND 255) + ((second / 16) AND 3))

ret = ret & chr( ((second * 16) AND 255) + ((third / 4) AND 15))

ret = ret & chr( ((third * 64) AND 255) + (fourth AND 63))

ndx = ndx + 4

loop

if ndx < realLen then

first = Base64DecMap(asc(mid(scrambled, ndx+0, 1)))

second = Base64DecMap(asc(mid(scrambled, ndx+1, 1)))

ret = ret & chr( ((first * 4) AND 255) + ((second / 16) AND 3))

if realLen MOD 4 = 3 then

third = Base64DecMap(asc(mid(scrambled,ndx+2,1)))

ret = ret & chr( ((second * 16) AND 255) + ((third / 4) AND 15))

end if

base64Decode = ret

END FUNCTION

' 初始化

call initCodecs

' 测试代码

dim inp, encode

inp = "1234567890"

encode = base64Encode(inp)

response.write "加密前为:" & inp & newline

response.write "加密后为:" & encode & newline

response.write "解密后为:" & base64Decode(encode) & newline

实例12-LastVisit.asp

<%@ LANGUAGE = VBScript %>

<% Option Explicit %>

'Cookies通过HTTP Headers来从服务器端返回到浏览器上.

'在发送Cookies之前,不能向浏览器端发送任何数据.

Response.Expires = 0

'从Cookie中取出上一次访问的日期和时间

Dim LastVisit

LastVisit = Request.Cookies("LastVisitCookie")

Response.Cookies("LastVisitCookie") = FormatDateTime(NOW)

<HTML>

<HEAD>

<TITLE>上次访问时间</TITLE>

</HEAD>

<B>使用Cookies</B></FONT><BR>

If (LastVisit = "") Then

'如果Cookie从未被写过,则用户是第一次访问本页

Response.Write("欢迎光临本页")

Else

'显示上一次访问日期及时间

Response.Write("你上一次访问本页在" + LastVisit)

End If

<P><A HREF="LastVisit.asp">重新访问本页</A>

</BODY>

</HTML>

实例13-COLORS.ASP

<%@ LANGUAGE = VBScript %>

<% Option Explicit %>

Dim bgcolor, textcolor

'bgcolor 背景颜色

'textcolor 字体颜色

' 从Form表单中取得变量信息

bgcolor = Request.Form("bg_red") & Request.Form("bg_green") & Request.Form("bg_blue")

textcolor = Request.Form("text_red") & Request.Form("text_green") & Request.Form("text_blue")

If len(bgcolor) = 6 Then

bgcolor = " BGCOLOR=#" & bgcolor

Else

bgcolor = ""

End If

If len(textcolor) = 6 Then

textcolor = " COLOR=#" & textcolor

Else

textcolor = ""

End If

<TR>

<FONT SIZE="6"<%= textcolor %>>你喜欢哪种颜色</FONT></STRONG></TD>

</TR>

</TABLE>

<TR>

</TR>

<TR>

<TD>

</select>

</TD>

<TD>

</select>

</TD>

<TD>

</select>

</TD>

</TR>

<TR>

<TD>

</select>

</TD>

<TD>

</select>

</TD>

<TD>

</select>

</TD>

</TR>

</TABLE>

</FORM>

实例14-ServerVariables.asp

<%@ Language=VBScript %>

Option Explicit

Dim Sv

<HTML>

<Head><title>显示服务器变量</title></Head>

<BODY>

<tr>

<td align=CENTER bgcolor="#800000" width=20%> <font style="ARIAL NARROW" color="#ffffff" size="2">环境变量名</font></td>

</tr>

WITH Response

for each Sv In Request.ServerVariables

.Write "<tr>"

.Write "<td bgcolor='f7efde' align=CENTER> <font style='ARIAL NARROW' size='2'>"

.Write Sv

.Write "</font></td>"

.Write "<td bgcolor='f7efde' align=CENTER> <font style='ARIAL NARROW' size='2'>"

.Write Request.ServerVariables(Sv)

.Write "</font></td></tr>"

END WITH

</table>

</BODY>

</HTML>

实例15-Column.asp

<HTML>

<TITLE>

柱状图

</TITLE>

<BODY>

function MakeColumn(title, numarray, labelarray, maxheight, maxwidth)

dim ColumnString

dim max

dim maxlength

dim tempnumarray

dim templabelarray

dim heightarray

Dim colorarray

Dim multiplier

if maxheight > 0 and maxwidth > 0 and ubound(labelarray) = ubound(numarray) then

colorarray = array("red","blue","yellow","navy","orange","purple","green")

templabelarray = labelarray

tempnumarray = numarray

heightarray = array()

max = 0

maxlength = 0

ColumnString = "<TABLE bgcolor='gold' border='6'><tr><td><TABLE border='0' cellspacing='1' cellpadding='0'>" & vbCrLf

for each stuff in tempnumarray

if stuff > max then max = stuff end if

multiplier = maxheight/max

for counter = 0 to ubound(tempnumarray)

if tempnumarray(counter) = max then

redim preserve heightarray(counter)

heightarray(counter) = maxheight

else

redim preserve heightarray(counter)

heightarray(counter) = tempnumarray(counter) * multiplier

end if

ColumnString = ColumnString & "<TR><TH colspan='" & ubound(tempnumarray)+1 & "'>" & _

"<FONT SIZE='1'><U>" & title & "</TH></TR>" & vbCrLf & "<TR>" & vbCrLf

for counter = 0 to ubound(tempnumarray)

ColumnString = ColumnString & vbTab & "<TD valign='bottom' align='center' >" & _

"<FONT SIZE='1'><table border='0' cellpadding='0' width='" & maxwidth & "'><tr><tr><td valign='bottom' bgcolor='"

ColumnString = ColumnString & colorarray(counter mod (ubound(colorarray)+1))

ColumnString = ColumnString & "' height='" & round(heightarray(counter),2) & "'></td></tr></table>"

ColumnString = ColumnString & "<BR>" & tempnumarray(counter)

ColumnString = ColumnString & "</TD>" & vbCrLf

ColumnString = ColumnString & "</TR>" & vbCrLf

for each stuff in labelarray

if len(stuff) >= maxlength then maxlength = len(stuff)

for each stuff in labelarray

ColumnString = ColumnString & vbTab & "<TD align='center'><FONT SIZE='1'><B> "

for count = 0 to round((maxlength - len(stuff))/2)

ColumnString = ColumnString & " "

if maxlength mod 2 <> 0 then ColumnString = ColumnString & " "

ColumnString = ColumnString & stuff

for count = 0 to round((maxlength - len(stuff))/2)

ColumnString = ColumnString & " "

ColumnString = ColumnString & " </TD>" & vbCrLf

ColumnString = ColumnString & "</TABLE></td></tr></table>" & vbCrLf

MakeColumn = ColumnString

else

Response.Write "柱状图函数参数有错"

end if

end function

dim stuff

dim labelstuff

stuff = Array(72,39,60,42)

labelstuff = Array("北京", "上海","广州","重庆")

Response.Write MakeColumn("演示", stuff, labelstuff, 150,30)

</SCRIPT>

</BODY>

</HTML>

实例16-OUTLINE.ASP

<%@ Language=VBScript %>

<%Option Explicit%>

Dim items(10,2), maxItems

maxItems = 9

items(0,0) = "节点 1"

items(1,0) = "节点 1"

items(2,0) = "节点 1"

items(3,0) = "节点 2"

items(4,0) = "节点 2"

items(5,0) = "节点 2"

items(6,0) = "节点 3"

items(7,0) = "节点 3"

items(8,0) = "节点 3"

items(9,0) = "节点 3"

items(0,1) = "子节点 1.1"

items(1,1) = "子节点 1.2"

items(2,1) = "子节点 1.3"

items(3,1) = "子节点 2.1"

items(4,1) = "子节点 2.2"

items(5,1) = "子节点 2.3"

items(6,1) = "子节点 3.1"

items(7,1) = "子节点 3.2"

items(8,1) = "子节点 3.3"

items(9,1) = "子节点 3.4"

Dim index,currentItem, openItem

openItem = Request.QueryString("open")

<HTML>

<HEAD>

<TITLE>ASP提纲</TITLE>

</HEAD>

<BODY>

<h2>ASP提纲</h2>

<UL>

index = 0

Do while index <= maxItems

if items(index,0) <> currentItem then

If items(index,0) <> openItem then _

Response.Write("<a href='outline.asp?open=" & _

Server.URLEncode( items(index,0) ) & "'>" )

Response.Write( "<LI>" & items(index,0) & "</a>" )

End If

currentItem = items(index,0)

If items(index,0) = openItem then

Response.Write("<UL>")

Do While index <= maxItems AND items(index,0) = openItem

Response.Write( "<LI>" & items(index,1) )

index = index + 1

Loop

Response.Write("</UL>")

End If

index = index + 1

Loop

</UL>

</BODY>

</HTML>

实例17-onlinetime.asp

<Html>

<Head>

<Title>

显示在某一页停留的时间

</Title>

</Head>

<Body>

If Request.QueryString("time")="" then

你还未点击过下面的链接。<BR>

Else

你在上页停留了<%=DateDiff("s",Request.QueryString("time"),Now())%>

秒。

<BR>

<%End if%>

<Br>

我在这一页停留了多久了?</A><BR>

<BR>

</Body>

</Html>

实例18-BUTTON.ASP

<html>

<head>

<title>禁止鼠标右键</title>

</head>

<body>

var mMsg = "你的鼠标右键被禁止了!";

function disableRightClick(btnClick)

{

if (navigator.appName == "Netscape" && btnClick.which == 3)

{

alert(mMsg);

return false;

}

else if (navigator.appName =="Microsoft Internet Explorer" && event.button == 2)

{

alert(mMsg);

return false;

}

document.onmousedown = disableRightClick;

</script>

</body>

</html>

实例19-PASSWORD.ASP

authUser=trim(request.servervariables("AUTH_USER"))

IF authUser="" Then

Response.Status="401 Not Authorized"

Response.AddHeader "WWW-Authenticate","Basic Realm="" SUPEREXPERT"""

Response.End

End if

<Html>

<Head>

<Title>

NT身份认证

</Title>

</Head>

<Body>

<%=authUser%>你好!<br>

欢迎你光临我的主页<br>

你已经成功通过身份认证。

</center>

</Body>

</Html>

实例20-INDEX.ASP

Function ComputerChoose()

Dim RandomNum

Dim choice

Randomize

RandomNum=int(rnd*3)+1

if RandomNum=1 then

choice="R"

elseif RandomNum=2 then

choice="S"

else

choice="P"

end if

ComputerChoose=choice

End Function

Sub DetermineWinner(playerChoice,computerChoice)

if playerChoice="R" then

if computerChoice="R" then

response.write "<font color=red>石头</font>-----<font color=blue>石头</font><br>"

response.write "我们平手了"

elseif computerChoice="S" then

response.write "<font color=red>石头</font>-----<font color=blue>剪子</font><br>"

response.write "恭喜你，你赢了"

elseif computerChoice="P" then

response.write "<font color=red>石头</font>-----<font color=blue>布</font><br>"

response.write "恭喜你，你赢了"

end if

elseif playerChoice="S" then

if computerChoice="R" then

response.write "<font color=red>剪子</font>-----<font color=blue>石头</font><br>"

response.write "恭喜你，你赢了"

elseif computerChoice="S" then

response.write "<font color=red>剪子</font>-----<font color=blue>剪子</font><br>"

response.write "我们平手了"

elseif computerChoice="P" then

response.write "<font color=red>剪子</font>-----<font color=blue>布</font><br>"

response.write "恭喜你，你赢了"

end if

elseif playerChoice="P" then

if computerChoice="R" then

response.write "<font color=red>布</font>-----<font color=blue>石头</font><br>"

response.write "恭喜你，你赢了"

elseif computerChoice="S" then

response.write "<font color=red>布</font>-----<font color=blue>剪子</font><br>"

response.write "这次我赢了"

elseif computerChoice="P" then

response.write "<font color=red>布</font>-----<font color=blue>布</font><br>"

response.write "我们平手了"

end if

End sub

<html>

<body>

玩家:<font color=white>------</font>电脑:<br>

dim player

dim computer

player=request("choice")

if player="P" or player="R" or player="S" then

computer=ComputerChoose()

call DetermineWinner(player,computer)

end if

<hr>

请选择你的武器:

</form>

</center>

</body>

</html>

实例21-SessionID.asp

<%@ LANGUAGE = VBScript %>

<% Option Explicit %>

Sub showsessionID()

MsgBox "你的SessionID是:" & <%= Session.SessionID %>

End Sub

</SCRIPT>

<HTML>

<HEAD>

<TITLE>显示SessionID</TITLE>

</HEAD>

<B>本实例显示SessionID</B><P>

</BODY>

</HTML>

实例22-onLine.asp

<%@language=VBscript%>

<Html>

<head>

<title>

显示在线人数

</title>

</head>

<body>

欢迎光临本网站,当前共有<%=Application("OnLine")%>在线

</center>

</body>

实例23-Game.asp

response.Expires=0

<html>

<body>

function test4(m,n)

if m>3 or n>3 or m<0 or n<0 then exit function

if a(m,1)=a(m,2) and a(m,2)=a(m,3) then

if a(m,1)=1 then

test4=1

exit function

end if

if a(1,n)=a(2,n) and a(2,n)=a(3,n) then

if a(1,n)=1 then

test4=1

exit function

end if

if a(1,1)=a(2,2) and a(1,1)=a(3,3) then

if a(2,2)=1 then

test4=1

exit function

end if

if a(1,3)=a(2,2) and a(2,2)=a(3,1) then

if a(2,2)=1 then

test4=1

exit function

end if

test4=0

end function

function test3(m)

dim i

for i=1 to 3

if a(i,1)=a(i,2) and a(i,3)=0 then

if a(i,1)=m then

a(i,3)=2

test3=1

exit function

end if

elseif a(i,2)=a(i,3) and a(i,1)=0 then

if a(i,2)=m then

a(i,1)=2

test3=1

exit function

end if

elseif a(i,1)=a(i,3) and a(i,2)=0 then

if a(i,1)=m then

a(i,2)=2

test3=1

exit function

end if

for i=1 to 3

if a(1,i)=a(2,i) and a(3,i)=0 then

if a(1,i)=m then

a(3,i)=2

test3=1

exit function

end if

elseif a(2,i)=a(3,i) and a(1,i)=0 then

if a(2,i)=m then

a(1,i)=2

test3=1

exit function

end if

elseif a(1,i)=a(3,i) and a(2,i)=0 then

if a(1,i)=m then

a(2,i)=2

test3=1

exit function

end if

if a(1,1)=a(2,2) and a(3,3)=0 then

if a(1,1)=m then

a(3,3)=2

test3=1

exit function

end if

elseif a(1,1)=a(3,3) and a(2,2)=0 then

if a(1,1)=m then

a(2,2)=2

test3=1

exit function

end if

elseif a(2,2)=a(3,3) and a(1,1)=0 then

if a(2,2)=m then

a(1,1)=2

test3=1

exit function

end if

elseif a(1,3)=a(3,1) and a(2,2)=0 then

if a(1,3)=m then

a(2,2)=2

test3=1

exit function

end if

elseif a(1,3)=a(2,2) and a(3,1)=0 then

if a(2,2)=m then

a(3,1)=2

test3=1

exit function

end if

elseif a(2,2)=a(3,1) and a(1,3)=0 then

if a(2,2)=m then

a(1,3)=2

test3=1

exit function

end if

test3=0

end function

function test2

dim m,n

dim RowArray(10)

dim LineArray(10)

dim Count

dim Rand

Count=0

for m=1 to 3

for n=1 to 3

if a(m,n)=0 then

count=count+1

LineArray(count)=m

RowArray(count)=n

end if

if count=0 then

test2=0

exit function

else

randomize

Rand=Int(rnd * Count + 1 )

a(LineArray(Rand),RowArray(Rand))=2

test2=1

end if

end function

dim a(3,3)

dim over

x=request("X")

y=request("Y")

if x>0 and y>0 and x<4 and y<4 then

a(x,y)=1

elseif x=0 then

if y=0 then

session("a")=a

session("race")=-1

else

session("a")=a

session("race")=-2

end if

session("race")=session("race")+1

for j=1 to 3

for i=1 to 3

if session("a")(i,j)=1 then

a(i,j)=1

elseif session("a")(i,j)=2 then

a(i,j)=2

end if

over=0

if session("race")>=0 then

if test4(x,y)=1 then

over=1

response.write "You won"

elseif test3(2)=1 then

response.write "I won"

session("race")=session("race")+1

over=2

elseif test3(1)=1 then

session("race")=session("race")+1

elseif test2=1 then

session("race")=session("race")+1

else

over=3

end if

else

session("race")=0

end if

response.write " "

if session("race")=9 then

response.write "Game Over"

end if

session("a")=a

for j=1 to 3

response.write "<tr>"

for i=1 to 3

if session("a")(i,j)=0 then

if over=0 then

response.write "<td><a href=Game.asp?X=" & i & "&Y=" & j & " > <font color=white><b> ⊙ </b></font></a></td>"

else

response.write "<td><font color=white><b> ⊙ </b></font></td>"

end if

elseif session("a")(i,j)=1 then

response.write "<td><font color=blue><b> ★ </b></font></td>"

elseif session("a")(i,j)=2 then

response.write "<td><font color=red><b> ⊙ </b></font></td>"

end if

response.write "</tr> "

</table>

<hr>

<%=session("race")%>

</center>

实例24-GuessNumber.asp

<%@ LANGUAGE = VBScript %>

<% Option Explicit %>

<Html>

<title>猜数字游戏</title>

<body>

'设置页面不使用缓存

Response.Expires = 0

dim GuessNum

on error resume next

GuessNum=Request("Number")

if GuessNum="" then GuessNum="0" End if

GuessNum=Clng(GuessNum)

Session("Count")=Session("Count") + 1

if Session("Count") < 10 and GuessNum <> session("Number") then

</form>

<hr>

end if

if GuessNum<0 or guessNum>100 then

Response.write "请输入1~100之间的整数"

elseif GuessNum=0 then

session("Count") = 0

Randomize

session("Number") = Int(rnd * 100 + 1)

Response.write "请输入1~100之间的整数"

elseif GuessNum > session("Number") then

response.write "你猜的太大了"

elseif GuessNum < session("Number") then

response.write "你猜的太小了"

elseif GuessNum = session("Number") then

response.write "祝贺你,猜对了"

end if

Response.write "<br>共猜了" & Session("Count") & "次"

if Session("Count")=10 then

Response.write "答案是" & Session("Number")

end if

</body>

</html>

实例25-500-100.ASP

<%@ language="VBScript" %>

Option Explicit

Const lngMaxFormBytes = 200

Dim objASPError, blnErrorWritten, strServername, strServerIP, strRemoteIP

Dim strMethod, lngPos, datNow, strQueryString, strURL

If Response.Buffer Then

Response.Clear

Response.Status = "500 Internal Server Error"

Response.ContentType = "text/html"

Response.Expires = 0

End If

Set objASPError = Server.GetLastError

<html>

<title>本页无法显示</title>

<td>

Dim bakCodepage

bakCodepage = Session.Codepage

Session.Codepage = 936

Response.Write Server.HTMLEncode(objASPError.Category)

If objASPError.ASPCode > "" Then Response.Write Server.HTMLEncode(", " & objASPError.ASPCode)

Response.Write Server.HTMLEncode(" (0x" & Hex(objASPError.Number) & ")" )

</td></tr><tr><td>错误描述:</td><td>

If objASPError.ASPDescription > "" Then Response.Write Server.HTMLEncode(objASPError.ASPDescription)

</td></tr><tr><td>错误定位:</td><td>

blnErrorWritten = False

If objASPError.Source > "" Then

strServername = LCase(Request.ServerVariables("SERVER_NAME"))

strServerIP = Request.ServerVariables("LOCAL_ADDR")

strRemoteIP = Request.ServerVariables("REMOTE_ADDR")

If (strServername = "localhost" Or strServerIP = strRemoteIP) And objASPError.File <> "?" Then

Response.Write Server.HTMLEncode(objASPError.File)

If objASPError.Line > 0 Then Response.Write ", 第 " & objASPError.Line & " 行"

If objASPError.Column > 0 Then Response.Write ", 第 " & objASPError.Column & " 列"

Response.Write Server.HTMLEncode(objASPError.Source) & "<br>"

If objASPError.Column > 0 Then Response.Write String((objASPError.Column - 1), "-") & "^<br>"

blnErrorWritten = True

End If

If Not blnErrorWritten And objASPError.File <> "?" Then

Response.Write "<b>"

Response.Write Server.HTMLEncode(objASPError.File)

If objASPError.Line > 0 Then Response.Write Server.HTMLEncode(", 第 " & objASPError.Line & " 行")

If objASPError.Column > 0 Then Response.Write ", 第 " & objASPError.Column & " 列"

Response.Write "</b><br>"

End If

</td></tr>

<tr><td>浏览器类型：</td><td>

<%= Request.ServerVariables("HTTP_USER_AGENT") %>

</td></tr>

datNow = Now()

Response.Write Server.HTMLEncode(FormatDateTime(datNow, 1) & ", " & FormatDateTime(datNow, 3))

Session.Codepage = bakCodepage

</td></tr>

</table>

</body>

</html>

实例25-TEST.ASP

<html>

<title>这是一个测试</title>

<body>

response.wrte "这是一个测试"

</body>

</html>

实例26-HTMLencode.asp

<Html>

<Head>

<Title>

显示超链接

</Title>

</Head>

<Body>

s_message="<a href=hello.asp>hello</a>"

Response.Write "这是转换前的输出:<br>"

Response.Write s_message & "<br>"

Response.Write "这是用to_html函数转换后的输出:<br>"

Response.Write to_html(s_message) & "<br>"

Response.Write "这是用Server.HTMLencode函数转换后的输出:<br>"

Response.Write Server.HTMLEncode(s_message)

Function to_html(s_string)

to_html = Replace(s_string, """", """)

to_html = Replace(to_html, "<", "<")

to_html = Replace(to_html, ">", ">")

to_html = Replace(to_html, vbcrlf, "<br>")

to_html = Replace(to_html, "/<", "<")

to_html = Replace(to_html, "/>", ">")

to_html = edit_hrefs(to_html)

End Function

function edit_hrefs(s_html){

// 一个使用正则表达式的典范

// 转换文本中所有的超链接和电子邮件格式

s_str = new String(s_html);

s_str = s_str.replace(//bhttp/:////www(/.[/w+/./:///_]+)/gi,

"http/:////¬¤¸$1");

s_str = s_str.replace(//b(http/://///w+/.[/w+/./:///_]+)/gi,

"<a href=/"$1/">$1<//a>");

s_str = s_str.replace(//b(www/.[/w+/./:///_]+)/gi,

"<a href=/"http://$1/">$1</a>");

s_str = s_str.replace(//bhttp/:////¬¤¸(/.[/w+/./:///_]+)/gi,

"<a href=/"http/:////www$1/">http/:////www$1</a>");

s_str = s_str.replace(//b(/w+@[/w+/.?]*)/gi,

"<a href=/"mailto/:$1/">$1</a>");

return s_str;

}

</script>

</Body>

</Html>

实例27-COUNTER.ASP(GLOBAL.ASA)

<%@language=VBscript%>

<Html>

<head>

<title>

防止刷新的计数器

</title>

</head>

<body>

欢迎光临本网站,当前共有<%=Application("OnLine")%>人访问本网站

</font>

</center>

</body>

GLOBAL.ASA

Sub Application_onStart

Application("OnLine") = 0

End Sub

Sub Session_onStart

Application.Lock

Application("OnLine") = Application("OnLine") + 1

Application.Unlock

End Sub

</SCRIPT>

实例28-CALENDAR.ASP

Class Calendar

Public Top

Public Left

Public Width

Public Height

Public Position

Public ZIndex

Public TitlebarColor

Public TitlebarFont

Public TitlebarFontColor

Public TodayBGColor

Public OnDayClick

Public OnNextMonthClick

Public OnPrevMonthClick

Public ShowDateSelect

Private mdDate

Private msToday

Private mnDay

Private mnMonth

Private mnYear

Private mnDayMonthStarts

Private mnDaysInMonth

Private mcolDays

Private mbDaysInitialized

Private Sub Class_Initialize()

Top = 0

Left = 0

Width = 500

Height= 500

Position = "absolute"

TitlebarColor = "darkblue"

TitlebarFont = "arial"

TitlebarFontColor = "white"

TodayBGColor = "skyblue"

ShowDateSelect = True

msToday = FormatDateTime(DateSerial(Year(Now()), Month(Now()), Day(Now())), 2)

zIndex = 1

Set mcolDays = Server.CreateObject("Scripting.Dictionary")

If Request("date") <> "" Then SetDate(Request("date")) Else SetDate(Now())

OnDayClick = Request.ServerVariables("SCRIPT_NAME")

OnNextMonthClick = Request.ServerVariables("SCRIPT_NAME") & "?date=" & Server.URLEncode(DateSerial(mnYear, mnMonth + 1, mnDay))

OnPrevMonthClick = Request.ServerVariables("SCRIPT_NAME") & "?date=" & Server.URLEncode(DateSerial(mnYear, mnMonth - 1, mnDay))

mbDaysInitialized = False

End Sub

Private Sub Class_Terminate()

If IsObject(mcolDays) Then

mcolDays.RemoveAll

Set mcolDays = Nothing

End If

End Sub

Public Property Get GetDate()

GetDate = mdDate

End Property

Public Property Get DaysInMonth()

DaysInMonth = mnDaysInMonth

End Property

Public Property Get WeeksInMonth()

If (mnDayMonthStarts + mnDaysInMonth - 1) > 35 Then

WeeksInMonth = 6

Else

WeeksInMonth = 5

End If

End Property

Public Property Get Days(nIndex)

If Not mbDaysInitialized Then InitDays()

If mcolDays.Exists(nIndex) Then Set Days = mcolDays.Item(nIndex)

End Property

Private Sub InitDays()

Dim nDayIndex

Dim objNewDay

If mcolDays.Count > 0 Then mcolDays.RemoveAll()

For nDayIndex = 1 To mnDaysInMonth

Set objNewDay = New CalendarDay

objNewDay.DateString = FormatDateTime(DateSerial(mnYear, mnMonth, nDayIndex),2)

objNewDay.OnClick = OnDayClick

mcolDays.Add nDayIndex, objNewDay

mbDaysInitialized = True

End Sub

Public Sub SetDate(dDate)

mdDate = CDate(dDate)

mnDay = Day(dDate)

mnMonth = Month(dDate)

mnYear = Year(dDate)

mnDaysInMonth = Day(DateAdd("d", -1, DateSerial(mnYear, mnMonth + 1, 1)))

mnDayMonthStarts = WeekDay(DateAdd("d", -(Day(CDate(dDate)) - 1), CDate(dDate)))

End Sub

Public Sub Draw()

Dim nDayCount

Dim nCellWidth, nCellHeight, nFontSizeRatio

Dim objDay

If Not mbDaysInitialized Then InitDays()

nCellWidth = CInt(Width / 7)

If (mnDayMonthStarts + mnDaysInMonth - 1) > 35 Then

nCellHeight = CInt((Height - 80) / 6)

Else

nCellHeight = CInt((Height - 80) / 5)

End If

nFontSizeRatio = Fix(Width / 200)

Send "<div id=""calendar"" style=""top: " & CStr(Top) & "px; left: " & CStr(Left) & "px; position: " & Position & "; z-index: " & ZIndex & """>"

Send "<table border=""1"" width=""" & Width & """ height=""" & Height & """ cellspacing=""0"">"

Send "<tr><td colspan=""7"" height=""10"" bgcolor=""" & TitlebarColor & """>"

Send " <table border=""0"" width=""100%"" cellspacing=0>"

Send " <tr>"

Send " <td align=""left""><a style=""text-decoration: none; color: " & TitlebarFontColor & ";"" href=""" & Replace(OnPrevMonthClick, "$date", DateSerial(mnYear, mnMonth - 1, mnDay)) & """><font face=""" & TitlebarFont & """ size=""" & nFontSizeRatio & """><b> <<</b></font></a></td>"

Send " <td align=""center""><font size=""" & nFontSizeRatio & """ face=""" & TitlebarFont & """ color=""" & TitlebarFontColor & """><b>" & MonthName(mnMonth) & " " & mnYear & "</b></font></td>"

Send " <td align=""right""><a style=""text-decoration: none; color: " & TitlebarFontColor & ";"" href=""" & Replace(OnNextMonthClick, "$date", DateSerial(mnYear, mnMonth + 1, mnDay)) & """><font face=""" & TitlebarFont & """ size=""" & nFontSizeRatio & """><b>>> </b></font></a></td>"

Send " </tr>"

Send " </table>"

Send "</td></tr>"

Send "<tr>"

Send "<td height=""20"" width=""" & CStr(nCellWidth) & """ align=""center""><small>S</small></td>"

Send "<td height=""20"" width=""" & CStr(nCellWidth) & """ align=""center""><small>M</small></td>"

Send "<td height=""20"" width=""" & CStr(nCellWidth) & """ align=""center""><small>T</small></td>"

Send "<td height=""20"" width=""" & CStr(nCellWidth) & """ align=""center""><small>W</small></td>"

Send "<td height=""20"" width=""" & CStr(nCellWidth) & """ align=""center""><small>T</small></td>"

Send "<td height=""20"" width=""" & CStr(nCellWidth) & """ align=""center""><small>F</small></td>"

Send "<td height=""20"" width=""" & CStr(nCellWidth) & """ align=""center""><small>S</small></td>"

Send "</tr>"

Send "<tr>"

For nDayCount = 1 To mnDayMonthStarts - 1

Send "<td height=""" & CStr(nCellHeight) & """ width=""" & CStr(nCellWidth) & """ bgcolor=""#dddddd""> </td>"

nDayCount = nDayCount - 1

For Each objDay In mcolDays.Items

If nDayCount = 7 Then

Send "</tr><tr>"

nDayCount = 0

End If

Response.Write "<td height=""" & CStr(nCellHeight) & """ width=""" & CStr(nCellWidth) & """ valign=""top"" bgcolor="""

If objDay.DateString = msToday Then Send TodayBGColor & """>" Else Send "white"">"

objDay.Draw()

Send "</td>"

nDayCount = nDayCount + 1

If nDayCount < 7 Then

For nDayCount = nDayCount To 6

Send "<td height=""" & CStr(nCellHeight) & """ width=""" & CStr(nCellWidth) & """ bgcolor=""#dddddd""> </td>"

End If

Send "</tr>"

If ShowDateSelect Then

Send "<tr><td height=""30"" colspan=""7"" align=""center"">"

DrawDateSelect()

Send "</td></tr>"

End If

Send "</table>"

Send "</div>"

End Sub

Private Sub DrawDateSelect()

Dim nIndex

Send " <form id=frmGO name=frmGO>"

Send " <table border=""0"">"

Send " <tr>"

Send " <td><select name=""month"">"

For nIndex = 1 To 12

Response.Write "<option value=""" & nIndex & """"

If nIndex = Month(mdDate) Then Response.Write " selected"

Send ">" & MonthName(nIndex, True) & "</option>"

Send " </select></td>"

Send " <td><select name=""year"">"

For nIndex = Year(Now()) - 4 To Year(Now()) + 6

Response.Write "<option value=""" & nIndex & """"

If nIndex = Year(mdDate) Then Response.Write " selected"

Send ">" & CStr(nIndex) & "</option>"

Send " </select></td>"

Send " <td><input type=""button"" Value=""Go"" onclick=""document.location='" & Request.ServerVariables("SCRIPT_NAME") & "?date='+this.form.month.options[this.form.month.selectedIndex].value+'/1/'+this.form.year.options[this.form.year.selectedIndex].value;"" id=1 name=1></td>"

Send " </form>"

Send " </tr></table>"

End Sub

Private Sub Send(sHTML)

Response.Write sHTML & vbCrLf

End Sub

End Class

Class CalendarDay

Public DateString

Public OnClick

Private mcolActivities

Private mbActivitiesInit

Private Sub Class_Initialize()

mbActivitiesInit = False

End Sub

Private Sub Class_Terminate()

If IsObject(mcolActivities) Then

mcolActivities.RemoveAll()

Set mcolActivities = Nothing

End If

End Sub

Private Sub InitActivities()

Set mcolActivities = Server.CreateObject("Scripting.Dictionary")

mbActivitiesInit = True

End Sub

Public Sub AddActivity(sActivity, sColor)

If Not mbActivitiesInit Then InitActivities()

mcolActivities.Add mcolActivities.Count + 1, "bgcolor=""" & sColor & """>" & sActivity

End Sub

Public Sub Draw()

Dim objActivity

Send "<table width=""100%"" border=""0"" cellspacing=""2"" cellpadding=""1"">"

Send "<tr><td align=""left"" valign=""top""><a href=""" & Replace(OnClick, "$date", DateString) & """><small>" & Day(DateString) & "</small></a></td></tr>"

If mbActivitiesInit Then

For Each objActivity In mcolActivities.Items

Send "<tr><td height=""20""" & objActivity & "</td></tr>"

End If

Send "</table>"

End Sub

Private Sub Send(sHTML)

Response.Write sHTML & vbCrLf

End Sub

End Class

实例28-calendarexample.asp

<%@ Language=VBScript %>

<%Option Explicit%>

<HTML>

<HEAD>

<TITLE>面向对象日历</TITLE>

</HEAD>

Dim MyCalendar

Set MyCalendar = New Calendar

MyCalendar.Top = 50

MyCalendar.Left = 150

MyCalendar.Position = "absolute"

MyCalendar.Height = "200"

MyCalendar.Width = "300"

MyCalendar.TitlebarColor = "darkblue"

MyCalendar.TitlebarFont = "arial"

MyCalendar.TitlebarFontColor = "white"

MyCalendar.TodayBGColor = "skyblue"

MyCalendar.ShowDateSelect = True

MyCalendar.OnDayClick = "javascript:alert('你点击了: $date')"

Select Case Month(MyCalendar.GetDate())

Case 1

MyCalendar.Days(1).AddActivity "<small><b>New Years</b></small>", "limegreen"

Case 12

MyCalendar.Days(25).AddActivity "<small><b>Christmas</b></small>", "limegreen"

End Select

MyCalendar.Draw()

</BODY>

</HTML>

实例29-TRANSACTION.asp

<%@ TRANSACTION=Required %>

'缓存输出以便显示不同的页。

Response.Buffer = True

<HTML>

<BODY>

<H1>欢迎使用联机银行服务</H1>

<P>谢谢。正在处理您的事务。</P>

</BODY>

</HTML>

'如果事务成功则显示该页。

Sub OnTransactionCommit()

<HTML>

<BODY>

谢谢。您的帐号已获得信任。

</BODY>

</HTML>

Response.Flush()

End Sub

'如果事务失败则显示该页。

Sub OnTransactionAbort()

Response.Clear()

<HTML>

<BODY>

无法完成您的事务。

</BODY>

</HTML>

Response.Flush()

End Sub

实例30-STAR.ASP

Response.buffer=false

Server.ScriptTimeOut=150

<Html>

<Head>

</Head>

dim startx

dim k,i

dim nextsecond

for k=1 to 60

nextsecond=dateadd("s",2,time)

do while time<nextsecond

loop

Randomize

star=int(50*rnd())

for i=1 to star

Response.Write "<font color=000000> </font>"

Response.Write "<font color=#00ffff>*</font>"

if k mod 3=2 then response.write "<br>"

</body>

</html>

实例31-COUNTER.ASP

<html>

<head>

<title>

图像计数器

</title>

</head>

<body>

dim visitors

whichfile=server.mappath("counter.txt")

set fs=createobject("Scripting.FileSystemObject")

set thisfile=fs.opentextfile(whichfile)

visitors=thisfile.readline

thisfile.close

CountLen=len(visitors)

response.write "<center>你是第"

for i=1 to 6-countLen

response.write "<img src=num/0.gif></img>"

for i=1 to countlen

response.write "<img src=num/" & mid(visitors,i,1) & ".gif></img>"

response.write "位访问本站</center>"

visitors=visitors+1

set out=fs.createtextfile(whichfile)

out.writeLine(visitors)

out.close

set fs=nothing

</body>

</html>

实例32-DRIVER.ASP

<Html>

<head>

<title>

磁盘驱动器浏览器

</title>

</head>

<body>

Function Tran(Driver)

Select Case Driver

Case 0: Tran="设备无法识别"

Case 1: Tran="软盘驱动器"

Case 2: Tran="硬盘驱动器"

Case 3: Tran="网络硬盘驱动器"

Case 4: Tran="光盘驱动器"

Case 5: Tran="RAM虚拟磁盘"

End Select

End Function

set fs=Server.CreateObject("Scripting.FileSystemObject")

<tr>

</tr>

on error resume next

For each Drive in fs.Drives

Response.Write "<Tr>"

Response.Write "<Td>" & Drive.DriveLetter & " </td>"

Response.write "<Td> " & Tran(Drive.DriveType) & " </td>"

Response.write "<Td> " & Drive.VolumeName & " </td>"

Response.write "<Td> " & cstr(Drive.TotalSize) & " </td>"

Response.write "<Td> " & cstr(Drive.Availablespace) & " </td>"

Response.write "<Td> " & (Drive.FileSystem) & " </td>"

Response.Write "</Tr>"

set fs=nothing

</table>

</body>

</html>

实例33-viewCODE.ASP

SUB PrintLine (ByVal strLine)

strLine=server.HTMLEncode(strLine)

strLine=replace(strLine,"<%","<FONT COLOR=#ff0000><%")

strLine=replace(strLine,"%>","%></FONT>")

strLine=replace(strLine,"<SCRIPT","<FONT COLOR=#0000ff><SCRIPT",1,-1,1)

strLine=replace(strLine,"</SCRIPT>","</SCRIPT></FONT>",1,-1,1)

strLine=replace(strLine,"<!--","<FONT COLOR=#008000><!--",1,-1,1)

strLine=replace(strLine,"-->","--></FONT>",1,-1,1)

Response.Write strLine

END SUB

Function ShowCode(filename)

Dim strFilename

Dim FileObject, oInStream, strOutput

strFilename = filename

Set FileObject = Server.CreateObject("Scripting.FileSystemObject")

Set oInStream = FileObject.OpenTextFile(strFilename, 1, 0, 0 )

While NOT oInStream.AtEndOfStream

strOutput = oInStream.ReadLine

Call PrintLine(strOutput)

Response.Write("<BR>")

Wend

end function

<HTML>

<HEAD>

<TITLE>ASP源码浏览器</TITLE>

</HEAD>

请输入ASP文件名

</form>

on error resume next

dim file

file=request.form("filename")

response.write file & "源程序如下<hr>"

if trim(file)<> "" then

call showcode(file)

end if

</FONT>

</BODY>

</HTML>

实例34-FileView.asp

<%@ LANGUAGE="VBSCRIPT" %>

<% Option Explicit %>

<HTML>

<HEAD> <TITLE>文件浏览器</TITLE> </HEAD>

<BODY>

</TR>

Dim objFSO

Dim objFile

Dim objFolder

Dim sMapPath

Set objFSO = CreateObject("Scripting.FileSystemObject")

sMapPath ="c:/windows"

Set objFolder = objFSO.GetFolder(sMapPath)

For Each objFile In objFolder.Files

Response.Write objFile.Name

</A>

</FONT>

</TD>

<TD>

If objFile.Size <1024 Then

Response.Write objFile.Size & " Bytes"

ElseIf objFile.Size < 1048576 Then

Response.Write Round(objFile.Size / 1024.1) & " KB"

Else

Response.Write Round((objFile.Size/1024)/1024.1) & " MB"

End If

</FONT>

</TD>

<TD>

Response.Write objFile.DateLastModified

</FONT>

</TD>

</FONT>

</TD>

</TR>

</TABLE>

</BODY>

</HTML>

实例35-netconfig.asp

<%@ Language="VBScript" %>

<% Option Explicit %>

<html>

<head>

<title>查看网络设置</title>

</head>

dim strHost

dim oShell,oFS,oTF

dim i,Data,tempData

strHost="ipconfig"

Set oShell = Server.CreateObject("Wscript.Shell")

oShell.Run "%ComSpec% /c ipconfig > C:/" & strHost & ".txt", 0, True

Set oFS = Server.CreateObject("Scripting.FileSystemObject")

Set oTF = oFS.OpenTextFile("C:/" & strHost & ".txt")

Do While Not oTF.AtEndOfStream

Data = Trim(oTF.Readline)

If i > 2 Then

tempData = tempData & Data & "<BR>"

End If

i = (i + 1)

Loop

response.write tempData

oTF.Close

oFS.DeleteFile "C:/" & strHost & ".txt"

Set oFS = Nothing

</font>

</body>

</html>

实例36-SEARCH.ASP(SEARCH.HTM)

<HTML>

<HEAD>

<TITLE>'<%=Request("SearchText")%>'的搜索结果</TITLE>

</HEAD>

<BODY>

<B>'<%=Request("SearchText")%>'的搜索结果</B><BR>

Const fsoForReading = 1

Dim objFile, objFolder, objSubFolder, objTextStream

Dim bolCase, bolFileFound, bolTagFound

Dim strCount, strDeTag, strExt, strFile, strContent, strRoot, strTag, strText, strTitle, strTitleL

strFile = ".asp .htm .html .js .txt .css"

strRoot = "/"

strText = Request("SearchText")

strTag = Chr(37) & Chr(62)

bolFileFound = False

bolTagFound = False

If Request("Case") = "on" Then bolCase = 0 Else bolCase = 1

Set objFSO = Server.CreateObject("Scripting.FileSystemObject")

RealPath=Server.MapPath(strRoot)

VirtualPath="http://" & Request.ServerVariables("SERVER_NAME")

Set objFolder = objFSO.GetFolder(RealPath)

schSubFol(objFolder)

Sub schSubFol(objFolder)

on error resume next

For Each objFile in objFolder.Files

If strText = "" Then Exit Sub

If Response.IsClientConnected Then

Set objTextStream = objFSO.OpenTextFile(objFile.Path,fsoForReading)

strContent = objTextStream.ReadAll

If InStr(1, strContent, strTag, bolCase) Then

Else

If Mid(objFile.Name, Len(objFile.Name) - 1, 1) = "." Then strExt = Mid(objFile.Name, Len(objFile.Name) - 1, 2)

If Mid(objFile.Name, Len(objFile.Name) - 2, 1) = "." Then strExt = Mid(objFile.Name, Len(objFile.Name) - 2, 3)

If Mid(objFile.Name, Len(objFile.Name) - 3, 1) = "." Then strExt = Mid(objFile.Name, Len(objFile.Name) - 3, 4)

If Mid(objFile.Name, Len(objFile.Name) - 4, 1) = "." Then strExt = Mid(objFile.Name, Len(objFile.Name) - 4, 5)

If InStr(1, strContent, strText, bolCase) And Instr(1, strFile, strExt, 1) Then

If InStr(1, strContent, "<TITLE>", 1) Then

strTitle = Mid(strContent, InStr(1, strContent, "<TITLE>", 1) + 7, InStr(1, strContent, "</TITLE>", 1))

Else

strTitle = "未命名"

end if

myFile=objFile.Path

myFile=replace(myfile,RealPath,VirtualPath,1,-1,1)

myFile=replace(myfile,"/","/")

strCount = strCount + 1

Response.Write "<DL><DT><B><I>"& strCount &"</I></B> - <A HREF=" & myFile & ">" & strTitle & "</A></A></DT><BR><DD>"

strTitleL = InStr(1, strContent, "</TITLE>", 1) - InStr(1, strContent, "<TITLE>", 1) + 7

strDeTag = ""

bolTagFound = False

Do While InStr(strContent, "<")

bolTagFound = True

strDeTag = strDeTag & " " & Left(strContent, InStr(strContent, "<") - 1)

strContent = MID(strContent, InStr(strContent, ">") + 1)

Loop

strDeTag = strDeTag & strContent

If Not bolTagFound Then strDeTag = strContent

Response.Write replace(Mid(strDeTag, strTitleL, 200),strText,"<font color=red>" & strText & "</font>",1,-1,bolcase)

Response.Write "...<BR><b><FONT SIZE='2'>URL: " & myFile

Response.Write " - 上次修改时间: " & objFile.DateLastModified

Response.Write " - " & FormatNumber(objFile.Size / 1024)

Response.Write "Kbytes</FONT></b></DD></DL>"

bolFileFound = True

End If

objTextStream.Close

End If

End Sub

For Each objSubFolder in objFolder.SubFolders

schSubFol(objSubFolder)

If Not bolFileFound then Response.Write "没有匹配结果"

If bolFileFound then Response.Write "<B>搜索结束</B>"

Set objTextStream = Nothing

Set objFolder = Nothing

Set objFSO = Nothing

</BODY></HTML>

实例36-SEARCH.HTM

<HTML>

<HEAD>

<TITLE>文件搜索引擎</TITLE>

</HEAD>

<BODY>

<TR>

请输入所要搜索的字符串:

</tr>

</TABLE>

</FORM>

</CENTER>

</BODY>

</HTML>

实例37-UPLOAD.ASP(UPLOAD.HTM uploadexmple.asp)

Class FileUploader

Public File

Private Sub Class_Initialize()

Set File = Server.CreateObject("Scripting.FileSystemObject")

End Sub

Private Sub Class_Terminate()

set File=nothing

End Sub

Public Property Get Form(sIndex)

Form = ""

End Property

Public Default Sub Upload()

Dim biData, sInputName

Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos

Dim nPosFile, nPosBound

biData = Request.BinaryRead(Request.TotalBytes)

nPosBegin = 1

nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))

If (nPosEnd-nPosBegin) <= 0 Then Exit Sub

vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)

nDataBoundPos = InstrB(1, biData, vDataBounds)

Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))

nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))

nPos = InstrB(nPos, biData, CByteString("name="))

nPosBegin = nPos + 6

nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))

sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))

nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))

nPosBound = InstrB(nPosEnd, biData, vDataBounds)

If nPosFile <> 0 And nPosFile < nPosBound Then

Dim oUploadFile, sFileName

Set oUploadFile = New UploadedFile

nPosBegin = nPosFile + 10

nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))

sFileName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))

oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "/"))

nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))

nPosBegin = nPos + 14

nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))

oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))

nPosBegin = nPosEnd+4

nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2

oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)

set File=oUploadFile

Else

nPos = InstrB(nPos, biData, CByteString(Chr(13)))

nPosBegin = nPos + 4

nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2

End If

nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)

Loop

End Sub

Private Function CByteString(sString)

Dim nIndex

For nIndex = 1 to Len(sString)

CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))

End Function

Private Function CWideString(bsString)

Dim nIndex

CWideString =""

For nIndex = 1 to LenB(bsString)

CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1)))

End Function

End Class

Class UploadedFile

Public ContentType

Public FileName

Public FileData

Public Property Get FileSize()

FileSize = LenB(FileData)

End Property

Public Sub SaveToDisk(sPath)

Dim oFS, oFile

Dim nIndex

If sPath = "" Or FileName = "" Then Exit Sub

If Mid(sPath, Len(sPath)) <> "/" Then sPath = sPath & "/"

Set oFS = Server.CreateObject("Scripting.FileSystemObject")

If Not oFS.FolderExists(sPath) Then Exit Sub

Set oFile = oFS.CreateTextFile(sPath & FileName, True)

For nIndex = 1 to LenB(FileData)

oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))

oFile.Close

End Sub

End Class

实例37-UPLOAD.HTM

<HTML>

<HEAD>

</HEAD>

<BODY>

<tr><td><b>选取所要上载的文件:</b>

</TABLE>

</FORM>

</BODY>

</HTML>

实例37-uploadexmple.asp

<%@ Language=VBScript %>

<%Option Explicit%>

<html>

<title>

文件上载

</title>

<body>

Dim Uploader, File

Set Uploader = New FileUploader

on error resume next

Uploader.Upload()

uploader.File.SaveToDisk "E:/"

if err.number=0 then

Response.Write "<center><b>祝贺你已经成功上载了" & Uploader.File.FileName & "文件</b><br></center><hr>"

Response.Write "<table align=center border=0>"

Response.Write "<tr><td><font color=red>文件名称:</font></td><td> "

Response.Write Uploader.File.FileName & "</td></tr>"

Response.Write "<tr><td><font color=red>文件大小:</font></td><td> "

Response.Write Uploader.File.FileSize & " bytes</td></tr>"

Response.Write "<tr><td><font color=red>文件类型:</font></td><td> "

Response.Write Uploader.File.ContentType & "</td></tr>"

end if

</body>

</html>

实例38-POLL.ASP(POLL.HTM POLL.TXT)

<html>

<title>

简单民意调查

</title>

<body>

dim numberstring

dim numA,numB,numC,numD

whichfile=server.mappath("poll.txt")

set fs=createobject("Scripting.FileSystemObject")

set thisfile=fs.opentextfile(whichfile)

numberstring=thisfile.readline

thisfile.close

numA=clng(mid(numberstring,instr(numberstring,"A")+1,instr(numberstring,"B")-instr(numberstring,"A")-1))

numB=clng(mid(numberstring,instr(numberstring,"B")+1,instr(numberstring,"C")-instr(numberstring,"B")-1))

numC=clng(mid(numberstring,instr(numberstring,"C")+1,instr(numberstring,"D")-instr(numberstring,"C")-1))

numD=clng(mid(numberstring,instr(numberstring,"D")+1,len(numberstring)-instr(numberstring,"D")))

select case request.form("Editor")

case "A": numA=numA+1

case "B": numB=numB+1

case "C": numC=numC+1

case "D": numD=numD+1

end select

numberstring="A" & cstr(numA) & "B" & cstr(numB) & "C" & cstr(numC) & "D" & cstr(numD)

set out=fs.createtextfile(whichfile)

out.writeLine(numberstring)

out.close

set fs=nothing

response.write "<br>谢谢你的参与,"

response.write "调查结果为:"

<tr><td>JavaScript:</td><td><%=numA%></td></tr>

<tr><td>VBScript:</td><td><%=numB%></td></tr>

<tr><td>PerlScript:</td><td><%=numC%></td></tr>

</table>

</center>

</body>

</html>

POLL.HTM

<html>

<title>

不用数据库的民意调查

</title>

<body>

你最常用的ASP脚本编辑器为:<br><hr>

<input type=radio name=Editor value=A checked> JavaScipt

</td></tr>

<input type=radio name=Editor value=B> VBScript

</td></tr>

<input type=radio name=Editor value=C> PerlScript

</td></tr>

<input type=radio name=Editor value=D> 其他

</td></tr>

</td></tr>

</table>

</form>

</center>

</body>

</html>

POLL.TXT

A108B243C44D24

实例39-STORY.ASP

If not request.Form("NextLine")="" then

Set mFileObject=Server.CreateObject("Scripting.FileSystemobject")

set mFile=mFileObject.OpenTextFile("d:/Story.txt",8,Ture)

mFile.WriteLine(Request.Form("NextLine"))

mFile.Close

end if

<Html>

<Head>

<Title>

在线故事接龙

</Title>

</Head>

<Body>

<Center><h2>在线故事接龙</h2></Center>

<hr>

Set mFileObject=Server.CreateObject("Scripting.FileSystemObject")

set mFile=mFileObject.OpenTextFile("D:/story.txt")

while not mFile.AtEndOfStream

Response.Write "  " & mFile.ReadLine

wend

mFile.close

<hr>

<h3>请输入这个故事的新行:</h3>

</form>

</html>

STORY.TXT

2010年的某一天，在一个森林深处.

实例40-DOWNLOAD.ASP(DOWNLOAD.HTM)

<%@language=VBscript%>

Const ForReading=1

Const TristateTrue=-1

Const FILE_TRANSFER_SIZE=16384

Response.Buffer = True

Function TransferFile(path, mimeType, filename)

Dim objFileSystem, objFile, objStream

Dim char

Dim sent

send=0

TransferFile = True

Set objFileSystem = Server.CreateObject("Scripting.FileSystemObject")

Set objFile = objFileSystem.GetFile(Path)

Set objStream = objFile.OpenAsTextStream(ForReading, TristateTrue)

Response.AddHeader "content-type", mimeType

response.AddHeader "Content-Disposition","attachment;filename=" & filename

Response.AddHeader "content-length", objFile.Size

Do While Not objStream.AtEndOfStream

char = objStream.Read(1)

Response.BinaryWrite(char)

sent = sent + 1

If (sent MOD FILE_TRANSFER_SIZE) = 0 Then

Response.Flush

If Not Response.IsClientConnected Then

TransferFile = False

Exit Do

End If

Loop

Response.Flush

If Not Response.IsClientConnected Then TransferFile = False

objStream.Close

Set objStream = Nothing

Set objFileSystem = Nothing

End Function

Dim path, mimeType, sucess,downfilename

downfilename=request("filename")

path = Server.MapPath(downfilename)

mimeType="text/plain"

sucess = TransferFile(path, mimeType,downfilename)

Response.End

DOWNLOAD.HTM