ASP.NET与相关数据库技术高级指南

代码下载部分

中国水利水电出版社

第一章 ASP部分

1.1 背景知识

019 如何动态生成WBMP？

<%@ Language=VBScript %>
<%
Function StoB(varstr)
str2bin = ""
For i = 1 To Len(varstr)
varchar = Mid(varstr, i, 1)
str2bin = str2bin & ChrB(AscB(varchar))
Next
StoB = str2bin
End Function
img=chr(0) & chr(0) & chr(5) & chr(2) & chr(0) & chr(&Hf8)

Response.ContentType="image/vnd.wap.wbmp"
Response.BinaryWrite stob(img)
%>

025 如何处理超时事件？

1、IIS为一个死循的执行过程设定执行时间（缺省为90秒）超时事件：
<%response.buffer=true%>
<body><html>
<%
DO
counter=counter+1
response.write counter & "<br>"
response.flush
LOOP
%>
</body></html>

2、自定义时间。用程序设定超时事件的时间段：
<%
response.buffer=true
server.scripttimeout=20
%>
<body><html>
<%
DO
counter=counter+1
response.write counter & "<br>"
response.flush
LOOP
%>
</body></html>

3、干涉超时时间段。捕获超时：
<%@ trANSACTION=Required%>
<%
response.buffer=true
server.scripttimeout=20
%>
<html><body>
</body>
<%
DO
counter=counter+1
response.write counter & "<br>"
LOOP
response.flush
response.write "脚本运行完啦!"
%>
</html>
<%
Sub OnTransactionAbort()
response.clear
Response.Write "噢,脚本运行超时了!"
end sub
%>

4、绕过超时事件：
<%@ trANSACTION=Required%>
<%
response.buffer=true
server.scripttimeout=40
%>
<html><body>
</body>
<%
DO UNTIL counter=400
counter=counter+1
response.write counter & "<br>"
LOOP
response.flush
response.write "脚本运行完啦!"
%>
</html>
<%
Sub OnTransactionAbort()
response.clear
Response.Write "噢,脚本运行超时了!"
end sub
%>

1.2 代码技术

何时将数据装载到Application 或 Session 对象中去？

＜%
Function GetEmploymentStatusList
Dim d
d = Application(?EmploymentStatusList?)
If d = ?? Then
' FetchEmploymentStatusList 函数从数据库取数据,返回一个数组
d = FetchEmploymentStatusList()
Application(?EmploymentStatusList?) = d
End If
GetEmploymentStatusList = d
End Function
%＞

如何处理包含JavaScript语句时的间隔符？

struserlist = struserlist & "<a href='#' onclick=\" & chr(34) &_

"sendmsg('" & usernick & "');return false;\" & chr(34) &_

" class='l_line'><span class=lineinfo>" & usernick & "</span></a>"

' StrUserList字串被赋值给另一个页面上的一个表单中隐藏文本单元.

if (top.LineInfo.document.forms.length == 1)

{

top.LineInfo.document.forms[0].userlist.value = "<% =GetAppUserList() %>";

if (top.MainFrame.mylayer != null)

top.MainFrame.ShowLineInfo();

}

在主页帧中显示:

function ShowLineInfo()

{

var userlist;

if (top.LineInfo.document.forms.length == 1)

userlist = top.LineInfo.document.forms[0].userlist.value

else

userlist = "<span class='lineinfo'>欢迎光临闪亮日子之春风精彩!</span>";

userlist = userlist + " <a href='<% =path %>/listuser.asp'>" +

"<span class='lineinfo'>显示列表</span></a><a href='#' onclick='top.RefFrame.location=" +

""<% =path %>/refresh.asp?stat=manu"'><span class='lineinfo'> 刷新</span></a>";

if (mylayer != null)

{

mylayer.innerhtml = "";

mylayer.filters[0].Apply();

mylayer.innerhtml = userlist

mylayer.filters[0].Play();

}

如何侦测HTTP表头信息？

<html>

<head>

<title> 千花飞舞之HTTP headERS侦测< /title>

</head>

<body>

<% For Each key In Request.ServerVariables %>

<tr>

<td>

If Request.ServerVariables(key) = "" Then

If GetAttribute(key) = "" Then

Response.Write " "

Else

Response.Write GetAttribute(key)

End If

Else

Response.Write Request.ServerVariables(key)

End If

Response.Write "</td>"

</tr>

<% Next %>

</TABLE>

</body></html>

Function GetAttribute(AttrName)

Dim AllAttrs

Dim RealAttrName

Dim Location

Dim Result

AllAttrs = Request.ServerVariables("ALL_HTTP")

RealAttrName = AttrName

Location = instr(AllAttrs, RealAttrName & ":")

If Location <= 0 Then

GetAttribute = ""

Exit Function

End If

Result = mid(AllAttrs, Location + Len(RealAttrName) + 1)

Location = instr(Result, chr(10))

If Location <= 0 Then Location = len(Result) + 1

GetAttribute = left(Result, Location - 1)

End Function

如何提高Request集合的使用效率？

strtitle=Request.Form("title")

strFirstName=Request.Form("FirstName")

strLastName=Request.Form("LastName")

If Len(strtitle) Then strtitle=strtitle & " "

If strFirstName="" Then strFullName=strtitle & " " & strLastName

Elseif Len(strFirstName)=1 Then

strFullName=strtitle & strFirstName & ". " & strLastName

Else

strFullName=strtitle & strFirstName & " " & strLastName

End If

如何用htmlEncode来显示Unicode？

<%@ Language=VBScript %>
<html>
<head>
<title>千花飞舞之UNICODE编码</title>
</head>
<body>
<%
Dim strU
dim strNormal
strU= ChrW(7913)
strNormalANSI= "aiN"
%>

<font face="arial" size=+1>
<P>An ANSI value: <%=strNormalANSI%>
<P>An htmlencoded String: <%=Server.htmlEncode(strU)%>
</font>

如何在ADSI中查询用户属性？

<%
Dim x

On error resume next
'Set x = GetObject("WinNT://kenfilszwin2k/allen")
strLDAP="LDAP://kenfilszwin2k/CN=Allen He,OU=kenfilsz,dc=kenfilsz,dc=com"

set x=getobject(strLDAP)
Response.Write "Object Name: " & x.Name & "<br>"
Response.Write "Object Class: " & x.Class & "<br>"

Set cls = GetObject(x.Schema)
For Each op In cls.MandatoryProperties

' 返回用户对象必须设置的属性
v = x.Get(op)
Response.Write "必须设置:"& op & "=" &v & "<br>"
Next
For Each op In cls.OptionalProperties

' 返回用户对象可选的属性
v = x.Get(op)
Response.Write "可选:"& op & "=" &v & "<br>"
Next
set cls=nothing
set x=nothing
response.end
%>

如何在ASP里建立表格？

Dim conn

Set conn = Server.CreateObject("ADODB.Connection")

conn.Open "DSN=blah"

' 建立连接

Dim strSQL

strSQL = "CREATE TABLE test (name varchar(50), age int)"

conn.Execute strSQL

如何将访问者数目周期性地保存？

SUB Session-OnStart

...

Application.Lock

Application("visitors")=Application("visitors") + 1

' 增加访问计数

t-visitors = Application("visitors")

Application.UnLock

Session("VisitorID")=t-visitors

If t－visitors MOD 15 = 0 Then

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

Set Out=FileObject.CreateTextFile－(Application

("VisitorCountFilename"),trUE,FALSE)

' 周期性地保存到文件中

Application.Lock

Out.Write(t－visitors)

Application.UnLock
End If

...

END SUB

</script>

如何编写一个过滤掉HTML代码的函数？

<%
Function Filterhtml(strToFilter)
Dim strTemp
strTemp = strToFilter
While Instr(1,strTemp,"<") AND Instr(1, strTemp, ">")
strTemp = Left(strTemp, Instr(1, strTemp, "<")-1) & Right(strTemp, Len(strTemp)-Instr(1,strTemp, ">"))
WEnd
Filterhtml = strTemp
End Function
%>

如何编写一个创建FTP站点的函数？

Function ASTCreateFtpSite(IPAddress, RootDirectory, ServerComment, HostName, PortNum, Computer, Start,LogFileDirectory)
    Dim MSFTPSVC, FtpServer, NewFtpServer, NewDir
    Dim Bindings, BindingString, NewBindings, Index, SiteObj, bDone
        On Error Resume Next
        Err.Clear
        Set MSFTPSVC = GetObject("IIS://" & Computer & "/MSFTPSVC")
        If Err.Number <> 0 Then
            WScript.Echo "无法打开: "&"IIS://" & Computer & "/MSFTPSVC" & VbCrlf & "程序将退出!"
            WScript.Quit (1)
        End If

        BindingString = IpAddress & ":" & PortNum & ":" & HostName
        For Each FtpServer in MSFTPSVC
            If FtpServer.Class="IIsFtpServer" Then
            Bindings = FtpServer.ServerBindings
            If BindingString = Bindings(0) Then
                WScript.Echo "噢,IP地址冲突:" & IpAddress & ",请检测IP地址！" & VbCrlf & "取消创建本站点."
                Exit Function
            End If
            End If
        Next

        Index = 1
        bDone = False

        While (Not bDone)
            Err.Clear
            Set SiteObj = GetObject("IIS://"&Computer&"/MSFTPSVC/" & Index)
            If (Err.Number = 0) Then
                Index = Index + 1
            Else
                Err.Clear
                Set NewFtpServer = MSFTPSVC.Create("IIsFtpServer", Index)
                If (Err.Number <> 0) Then
                    Index = Index + 1
                Else
                    Err.Clear
                    Set SiteObj = GetObject("IIS://"&Computer&"/MSFTPSVC/" & Index)
                    If (Err.Number = 0) Then
                        bDone = True
                    Else
                        Index = Index + 1
                    End If
                End If
            End If

            If (Index > 10000) Then
                WScript.Echo "噢,创建站点异常!正在创建的站点的序号为:"&Index&"." & VbCrlf & "取消创建本站点."
                Exit Function
            End If
        Wend

        NewBindings = Array(0)
        NewBindings(0) = BindingString
        NewFtpServer.ServerBindings = NewBindings
        NewFtpServer.ServerComment = ServerComment
        NewFtpServer.AllowAnonymous = False
        NewFtpServer.AccessWrite = True
        NewFtpServer.AccessRead = True
        NewFtpServer.DontLog = False
        NewFtpServer.LogFileDirectory = LogFileDirectory
        NewFtpServer.SetInfo

        Set NewDir = NewFtpServer.Create("IIsFtpVirtualDir", "ROOT")
        NewDir.Path = RootDirectory
        NewDir.AccessRead = true
        Err.Clear
        NewDir.SetInfo
        If (Err.Number = 0) Then
        Else
            WScript.Echo "噢,主目录创建时出错!"
        End If

        If Start = True Then
            Err.Clear
            Set NewFtpServer = GetObject("IIS://" & Computer & "/MSFTPSVC/" & Index)
            NewFtpServer.Start
            If Err.Number <> 0 Then
                WScript.Echo "噢,启动站点时出错!"
                Err.Clear
            Else
            End If
        End If
        ASTCreateFtpSite = Index
End Function

如何编写一个加法器？

equals

Dim result

If Request("operation") = "plus" Then

result = CLng(Request("op1")) + CLng(Request("op2"))

Else

result = "?"

End If

Response.Write result

</form>

如何实现非大小写的替换？

Function ReplaceNoIgnoreCase(str,replStr)

If len(replStr)<1 or str="" Then
ReplaceTest=str
Exit function
End If

Dim LoopN
LoopN=1

Dim TmpStr,inStrN,LenreplStr,Ustr,UreplStr
LenreplStr = Len(replStr)
TmpStr = str
Ustr = Ucase(str)
UreplStr = Ucase(replStr)
str=""

inStrN = inStr(Ustr,UreplStr)

Do While inStrN>0 and TmpStr<>""
LoopN = LoopN+1
If LoopN>10 Then Exit Function
str=str & Left(TmpStr,inStrN-1)
TmpStr = Mid(TmpStr,inStrN)
UStr = Mid(UStr,inStrN)
str=str & "<font color=ff0000>" & Left(TmpStr,LenreplStr) & "</font>"
TmpStr = Mid(TmpStr,LenreplStr+1)
UStr = Mid(UStr,LenreplStr+1)
inStrN = inStr(Ustr,UreplStr)
If inStrN<1 Then str=str&TmpStr
Loop
ReplaceTest = str

End Function

Response.Write "<p>result:"&ReplaceNoIgnoreCase("Flying Happy in the Sun ")

如何终止浏览器的Cahce页面？

Function Redirect( NewURL )

If Not IsEmpty( NewURL & "" ) Then

Dim QuestionMark

QuestionMark = Instr( NewURL, "?" )

If QuestionMark = 0 Then

Response.Redirect NewURL & "?" & NoCacheURL()

Response.End

Else

Response.Redirect NEWURL & "&" & NoCacheURL()

Response.End

End If

Function NoCacheURL()

On Error Resume Next

Randomize

NoCacheURL = "NoCache=" & Server.URLEncode(rnd)

End Function

如何做一个检索结果带链接的检索？

<%
data=request.form("search_data")

' 从FORM变量集得到要查询的文件名称所要包含的字符串
p=search_folder(data,"http://jack/cgi-bin","c:\intels\wwwroot\cgi-bin")

' 调用函数查询目标查询目录下的所有子目录(所有子树),方法:search_folder(要查询的字符串,查询目标的虚拟绝对路径,查询目标的真实绝对路径)

' 目录检索函数
if not isempty(search_data) and len(search_data)>0 then

' 确定查询字符串有效非空
set file_system=createobject("scripting.filesystemobject")

' 建立文件系统对象
set cur_folder=file_system.getfolder(c_path)

' 建立建立当前目录对象
set sub_folders=cur_folder.subfolders

' 建立当前目录的子目录对象集合
for each each_sub_folder in sub_folders

' 对子目录集合进行遍历
if each_sub_folder.attributes=16 then

' 确定子目录的属性为普通子目录
sub_v_path=v_path&"/"&each_sub_folder.name
sub_c_path=c_path&""&each_sub_folder.name

'得到当前的子虚拟绝对路径与真实绝对路径,默认子目录与子虚拟目录级别名称完全相同

p=search_file(search_data,sub_v_path,sub_c_path)

' 调用文件检索函数对当前子目录下的文件进行字符串匹配检索
p=search_folder(search_data,sub_v_path,sub_c_path)

end if
next
set each_sub_folder=nothing
set sub_folders=nothing
set cur_folder=nothing
set file_system=nothing

' 清空

end if
end function
--------------------------------------------------------------------------------------------------------------------------------

function search_file(search_data,v_path,c_path)
dim file_system,sub_files,sub_file_v_path,sub_out_v_path

' 文件匹配检索函数
if not isempty(c_path) then

' 确认路径不为空
set file_system=createobject("scripting.filesystemobject")
set cur_folder=file_system.getfolder(c_path)
set sub_files=cur_folder.files

' 建立检索目录下的文件对象集合
for each each_file in sub_files

' 遍历文件对象集合
if instr(each_file.name,search_data)<>0 then

' 匹配字符串与文件名
sub_file_v_path=v_path&"/"&each_file.name

' 建立可用链接,输出匹配文件
sub_out_v_path=Replace(sub_file_v_path," ","%20")

' 替换路径及文件名中的空格,以便系统确定路径
response.write("<p><a
href="&sub_out_v_path&">"&sub_file_v_path&"</a>")
end if
next
set sub_out_v_path=nothing
set sub_file_v_path=nothing
set each_file=nothing
set sub_files=nothing
set file_system=nothing
end if
end function
</script>

1.3 窗口表框

如何让一个方框栏内的文字滚动显示？

dim NewsStr(1,5)

NewsStr(0,0)="下载本栏链接"

NewsStr(1,0)="http://www.intels.net/"

NewsStr(0,1)="中国水利水电出版社"

NewsStr(1,1)="http://www.waterpub.com.cn/"

NewsStr(0,2)= "随风起舞"

NewsStr(1,2)="http://www.intels.net/"

NewsStr(0,3)="闪亮日子"

NewsStr(1,3)="http://www.flashday.net/ "

NewsStr(0,4)="我的TOM"

NewsStr(1,4)= "http://www.tom.com/ "

NewsStr(0,5)="交易的乐趣"

NewsStr(1,5)= "http://www.eachnet.com"

...

ShowNews "友情链接","","08-10-17",10,100,NewsStr

如何控制弹出一个NTLM验证窗口？

<%
Response.Status = "401 Unauthorized"
Response.Addheader "WWW-Authenticate","NTLM"
response.write "user=" & Request.ServerVariables("LOGON_USER") & "<br>"
response.write "用户登录"
response.end
%>

如何制作一个弹出式的调查窗口？

<%
Dim bSurvey