『转载』用来收集一些自写的asp函数

 『转载』用来收集一些自写的asp函数

 转载自邪恶八进制

作者天下第七

: ' ============================================
' 格式化时间(显示)
' 参数：n_Flag
' 1:"yyyy-mm-dd hh:mm:ss"
' 2:"yyyy-mm-dd"
' 3:"hh:mm:ss"
' 4:"yyyy年mm月dd日"
' 5:"yyyymmdd"
' ============================================
Function Format_Time(s_Time, n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
If len(m) = 1 Then m = "0" & m
d = cstr(day(s_Time))
If len(d) = 1 Then d = "0" & d
h = cstr(hour(s_Time))
If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1
' yyyy-mm-dd hh:mm:ss
Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 2
' yyyy-mm-dd
Format_Time = y & "-" & m & "-" & d
Case 3
' hh:mm:ss
Format_Time = h & ":" & mi & ":" & s
Case 4
' yyyy年mm月dd日
Format_Time = y & "年" & m & "月" & d & "日"
Case 5
' yyyymmdd
Format_Time = y & m & d
End Select
End Function

' ============================================
' 把字符串进行HTML解码,替换server.htmlencode
' 去除Html格式，用于显示输出
' ============================================
Function outHTML(str)
Dim sTemp
sTemp = str
outHTML = ""
If IsNull(sTemp) = True Then
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
sTemp = Replace(sTemp, Chr(10), "<br>")
outHTML = sTemp
End Function

' ============================================
' 去除Html格式，用于从数据库中取出值填入输入框时
' 注意：value="?"这边一定要用双引号
' ============================================
Function inHTML(str)
Dim sTemp
sTemp = str
inHTML = ""
If IsNull(sTemp) = True Then
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
inHTML = sTemp
End Function

' ============================================
' 检测上页是否从本站提交
' 返回:True,False
' ============================================
Function IsSelfRefer()
Dim sHttp_Referer, sServer_Name
sHttp_Referer = CStr(Request.ServerVariables("HTTP_REFERER"))
sServer_Name = CStr(Request.ServerVariables("SERVER_NAME"))
If Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name Then
IsSelfRefer = True
Else
IsSelfRefer = False
End If
End Function

' ============================================
' 得到安全字符串,在查询中使用
' ============================================
Function Get_SafeStr(str)
Get_SafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")
End Function

' ============================================
' 取实际字符长度
' ============================================
Function Get_TrueLen(str)
Dim l, t, c, i
l = Len(str)
t = l
For i = 1 To l
c = Asc(Mid(str, i, 1))
If c < 0 Then c = c + 65536
If c > 255 Then t = t + 1
Next
Get_TrueLen = t
End Function

' ============================================
' 判断是否安全字符串,在注册登录等特殊字段中使用
' ============================================
Function IsSafeStr(str)
Dim s_BadStr, n, i
s_BadStr = "' 　&<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32)
n = Len(s_BadStr)
IsSafeStr = True
For i = 1 To n
If Instr(str, Mid(s_BadStr, i, 1)) > 0 Then
IsSafeStr = False
Exit Function
End If
Next
End Function
Function CheckCardId(e) 
arrVerifyCode = Split("1,0,x,9,8,7,6,5,4,3,2", ",") 
Wi = Split("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2", ",") 
Checker = Split("1,9,8,7,6,5,4,3,2,1,1", ",") 

If Len(e) < 15 Or Len(e) = 16 Or Len(e) = 17 Or Len(e) > 18 Then 
CheckCardId= "身份证号共有 15 码或18位" 
CheckCardId = False 
Exit Function 
End If 

Dim Ai 
If Len(e) = 18 Then 
Ai = Mid(e, 1, 17) 
ElseIf Len(e) = 15 Then 
Ai = e 
Ai = Left(Ai, 6) & "19" & Mid(Ai, 7, 9) 
End If 
If Not IsNumeric(Ai) Then 
CheckCardId= "身份证除最后一位外，必须为数字！" 

Exit Function 
End If 
Dim strYear, strMonth, strDay 
strYear = CInt(Mid(Ai, 7, 4)) 
strMonth = CInt(Mid(Ai, 11, 2)) 
strDay = CInt(Mid(Ai, 13, 2)) 
BirthDay = Trim(strYear) + "-" + Trim(strMonth) + "-" + Trim(strDay) 
If IsDate(BirthDay) Then 
If DateDiff("yyyy",Now,BirthDay) <-140 or cdate(BirthDay)> date() Then 

CheckCardId= "身份证输入错误！" 
Exit Function 
End If 
If strMonth > 12 Or strDay > 31 Then 
CheckCardId= "身份证输入错误！" 
Exit Function 
End If 
Else 
CheckCardId= "身份证输入错误！" 
Exit Function 
End If 
Dim i, TotalmulAiWi 
For i = 0 To 16 
TotalmulAiWi = TotalmulAiWi + CInt(Mid(Ai, i + 1, 1)) * Wi(i) 
Next 
Dim modValue 
modValue = TotalmulAiWi Mod 11 
Dim strVerifyCode 
strVerifyCode = arrVerifyCode(modValue) 
Ai = Ai & strVerifyCode 
CheckCardId = Ai 

If Len(e) = 18 And e <> Ai Then 
CheckCardId= "身份证号码输入错误！" 
Exit Function 
End If 
End Function 


Function CreateMdbRecordset(数据库文件名, 数据表名或Select语句 )
　 Dim conn,Provider,DBPath
　 ’建立Connection 对象
　 Set conn = Server.CreateObject(“ADODB.Connection”)
　 Provider=“Provider=Microsoft.Jet.OLEDB.4.0；”
　 DBPath = “Data Source=” ＆ Server.MapPath(“数据库文件名”)
　 ’打开数据库
　 conn.Open Provider ＆ DBPath
　 Set CreateMdbRecordset = Server.CreateObject(“ADODB.Recordset”)
　 ’打开数据表
　 CreateMdbRecordset.Open “数据表名”, conn, 2, 2
End Function



2.建立带密码的MDB数据库的Recordset对象。它的建立方式与建立不带密码的MDB数据库的Recordset对象类似，只是多了一个密码参数，即在与数据库连接时，必须给出密码信息。



Function CreateSecuredMdbRecordset( 数据库文件名, 数据表名或Select语句，password )
　Dim conn,Provider,DBPath
　’建立Connection 对象
　Set conn = Server.CreateObject(“ADODB.Connection”)
　Provider = “Provider=Microsof.Jet.OLEDB.4.0；”
　DBPath = “Data Source=”＆ Server.MapPath(“数据库文件名”)
　’连接数据库,注意要带有密码参数
　conn.Open Provider ＆ DBPath＆“Jet OLEDB:Database Password=”＆assword
　Set CreateSecuredMdbRecordset = Server.
　CreateObject(“ADODB.Recordset”)
　’打开数据表
　CreateSecuredMdbRecordset.Open “数据表名”, conn, 2, 2
End Function
Function CreateDbfRecordset( 目录名, DBF文件名或Select语句 )
　Dim conn,Driver,SourceType,DBPath
　’建立Connection 对象
　Set conn = Server.CreateObject(“ADODB.Connection”)
　Driver=“Driver={Microsoft Visual FoxProDriver};” SourceType = “SourceType=DBF;”
　DBPath=“SourceDB=” ＆ Server.MapPath(“目录名”)
　’调用Open 方法打开数据库
　conn.Open Driver ＆ SourceType ＆ DBPath
　Set CreateDbfRecordset = Server.CreateObject(“ADODB.Recordset”)
　’打开DBF文件
　CreateDbfRecordset.Open “DBF文件名或Select语句”, conn, 2, 2
End Function






Function CreateDbcRecordset( DBC数据库文件名, 数据表名或Select语句 )
　Dim conn,Driver,SourceType,DBPath
　’建立Connection 对象
　Set conn = Server.CreateObject(“ADODB.Connection”)
　Driver=“Driver={Microsoft Visual FoxPro Driver};”
　SourceType = “SourceType=DBC;” 
　DBPath = “SourceDB=” ＆ Server.MapPath(“DBC数据库文件名”)
　’连接数据库
　conn.Open Driver ＆ SourceType ＆ DBPath
　Set CreateDbcRecordset = Server.CreateObject(“ADODB.Recordset”)
　’打开数据表 
　CreateDbcRecordset.Open“数据表名或Select语句”, conn, 2, 2
End Function







Function CreateExcelRecordset(XLS文件名,Sheet名)
　Dim conn.Driver,DBPath
　’建立Connection对象
　Set conn = Server.CreateObject(“ADODB.Connection”)
　Driver=“Driver={Microsoft Excel Driver (＊.xls)};”
　DBPath = “DBQ=” ＆ Server.MapPath(“XLS文件名”)
　’调用Open 方法打开数据库
　conn.Open Driver ＆ DBPath
　Set CreateExcelRecordset = Server.CreateObject(“ADODB.Recordset”)
　’打开Sheet
　CreateExcelRecordset.Open “Select ＊ From [”＆sheet＆“＄]”, conn, 2, 2
End Function







Function CreateSQLServerRecordset(计算机名称,用户ID, 用户密码,数据库名称 数据表或查看表或Select指令 )
　Dim Params, conn
　Set CreatSQLServerConnection = Nothing
　Set conn = Server.CreateObject (“ADODB.Connection”)
　Params = “Provider=SQLOLEDB.1”
　Params = Params ＆ “;Data Source=” ＆ Computer
　Params = Params ＆ “;User ID=” ＆ UserID
　Params = Params ＆ “;Password=” ＆ Password
　Params = Params ＆ “.Initial Catalog=”＆数据库名称
　Conn open Paras
　Set CreateSQLServerRecordset = Server. CreateObject(“ADODB.Recordset")
　CreateSQLServerRecordset.Open source, conn, 2, 2
End Function
'*======================================
'* 名称：useDb.asp
'* 功能：数据库操作函数库
'* 作者：intereye
'* 信箱：inteye@163.com
'* 主页：http://www.inteye.net
'* BLOG：http://blog.youkuaiyun.com/intereye
'*======================================

'* 函数：openDb(dbType,dbUser,dbPass,dbName,dbServer,dbPath)
'* 功能：打开数据库连接
'* 参数：dbType->数据库类型 MDB ACCESS数据库 || SQLSERVER SQLSERVER数据库
'* 参数：dbUser->访问数据库用户名
'* 参数：dbPass->访问数据库密码
'* 参数：dbName->数据库名称
'* 参数：dbServer->数据库Host
'* 参数：dbPath->数据库路径

Function openDb(dbType,dbUser,dbPass,dbName,dbServer,dbPath)
Dim Conn
Set Conn = Server.CreateObject("ADODB.Connection")
Select case dbType
  case "MDB":
  connStr = "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath(""&dbPath&dbName&"")
  case "SQLSERVER":
  connStr = "Provider=SQLOLEDB.1;Password="&dbPass&";Persist Security Info=True;User ID="&dbUser&";Initial Catalog="&dbName&";Data Source="&dbServer&""
End Select
Conn.Open connStr
End Function

'* 函数：add(tabname,fieldlist,dblist)
'* 功能：在数据库中插入一条记录
'* 参数：tabname->数据表名
'* 参数：dblist->数据表字段名数组
'* 参数：fieldlist->表单变量名数组
'* 返回：0 false || 1 true

Function add(tabname,dblist,fieldlist)
Sql = "INSERT INTO "&tabname&"("
Value = ""
Field = ""
For Each v in dblist
  Field = Field & v & ","
Next 
Field = Left(Field,Len(Field)-1)
Value = Field & ") VALUES("
For Each v in fieldlist
  If Request.Form(v) <> "" Then
  Value = Value & "'" & Request.Form(v) & "',"
  Else
  Value = Value & "'" & v & "',"
  End If
Next
Value = Left(Value,Len(Value)-1)
Sql = Sql & Value & ")"
Conn.Execute(Sql)
CloseDb()
If Err Then
  add = 0
Else
  add = 1
End If
End Function

'* 函数：update(tabname,dblist,fieldlist,id)
'* 功能：更新数据库中指定的一条记录
'* 参数：tabname->数据表名
'* 参数：dblist->数据库字段名称数组
'* 参数：fieldlist->表单变量名数组
'* 参数：id->数据ID号
'* 返回：0 false || 1 true

Function update(tabname,dblist,fieldlist,id)
Sql = "UPDATE " & tabname & " Set "
Value = ""
For i=0 to ubound(dblist)
  Value = Value & dblist(i) & "='"
  If Request.Form(fieldlist(i)) <> "" Then
  Value = Value & Request.Form(fieldlist(i)) & "',"
  Else
  Value = Value & fieldlist(i) & "',"
  End If
Next
Value = Left(Value,Len(Value)-1)
Sql = Sql & Value & " WHERE id=" & id
Conn.Execute(Sql)
CloseDb()
If Err Then
  update = 0
Else
  update = 1
End If 
End Function

'* 函数：del(tabname,id)
'* 功能：从数据库中删除一条指定记录
'* 参数：tabname->数据表名称
'* 参数：id->数据ID号
'* 返回：0 false || 1 true

Function del(tabname,id)
Sql = "DELETE FROM " & tabname & " WHERE id in(" & id & ")"
Conn.Execute(Sql)
CloseDb()
If Err Then
  del = 0
Else
  del = 1
End If
End Function

'* 函数：getRow(tabname,fieldlist,caseStr)
'* 功能：从数据库中取得一行
'* 参数：tabname->数据表名
'* 参数：fieldlist->数据字段数组
'* 参数：caseStr->Sql条件语句

Function getRow(tabname,fieldlist,caseStr)
If Not isArray(fieldlist) Then
  fieldlist = "*"
Else
  Field = ""
  For Each val in fieldlist
  Field = Field & val & ","
  Next
  fieldlist = Left(Field,Len(Field)-1)
End If
Sql = "SELECT " & fieldlist & " FROM " & tabname & caseStr
Set Rs = Conn.Execute(Sql)
If Rs.Eof AND Rs.Bof Then
  getRow = 0
Else
  getRow = 1
End If
End Function

'* 函数：CloseDb()
'* 功能：关闭数据库连接并释放对象

Function CloseDb()
Conn.Close
Set Conn = Nothing
End Function
Sub TurnPage(ByRef Rs_tmp,PageSize) 'Rs_tmp 记录集 ; PageSize 每页显示的记录条数;
Dim TotalPage '总页数
Dim PageNo '当前显示的是第几页
Dim RecordCount '总记录条数
Rs_tmp.PageSize = PageSize
RecordCount = Rs_tmp.RecordCount
TotalPage = INT(RecordCount / PageSize * -1)*-1
PageNo = Request.QueryString ("PageNo")
'直接输入页数跳转；
If Request.Form("PageNo")<>"" Then PageNo = Request.Form("PageNo")
'如果没有选择第几页，则默认显示第一页；
If PageNo = "" then PageNo = 1 
If RecordCount <> 0 then
Rs_tmp.AbsolutePage = PageNo
End If

'获取当前文件名，使得每次翻页都在当前页面进行；
Dim fileName,postion
fileName = Request.ServerVariables("script_name")
postion = InstrRev(fileName,"/")+1
'取得当前的文件名称，使翻页的链接指向当前文件；
fileName = Mid(fileName,postion) 
%>
<table border=0 width='100%'> 
<tr> 
<td align=left> 总页数：<font color=#ff3333><%=TotalPage%></font>页
当前第<font color=#ff3333><%=PageNo%></font>页</td>
<td align="right"> 
<%If RecordCount = 0 or TotalPage = 1 Then 
Response.Write "首页|前页|后页|末页"
Else%>
<a href="<%=fileName%>?PageNo=1">首页|</a>
<%If PageNo - 1 = 0 Then
Response.Write "前页|"
Else%>
<a href="<%=fileName%>?PageNo=<%=PageNo-1%>">前页|</a>
<%End If

If PageNo+1 > TotalPage Then
Response.Write "后页|"
Else%>
<a href="<%=fileName%>?PageNo=<%=PageNo+1%>">后页|</a>
<%End If%>

<a href="<%=fileName%>?PageNo=<%=TotalPage%>">末页</a>
<%End If%></td>
<td width=95>转到第
<%If TotalPage = 1 Then%>
<input type=text name=PageNo size=3 readonly disabled style="background:#d3d3d3">
<%Else%>
<input type=text name=PageNo size=3 value="" title=请输入页号,然后回车>
<%End If%>页
</td>
</tr>
</table>
<%End Sub%>
实现上一篇和下一篇文章。。
dim newsup '定义上一篇纪录
dim newsnext ‘定义下一篇纪录
set rst=server.CreateObject("adodb.recordset")
newssql="select top 1 newsid,title from news where typeid="&newstypeid&" and newsid<"&newsid&" order by newsid desc "
rst.open newssql,conn,1,1
if rst.eof then
newsup = "没有了" 
else
newsup = "<a href=readnews.asp?id="&rst("newsid")&">"&rst("title")&"</a>"
end if
newsup="上一篇："&newsup
rst.close

newssql="select top 1 newsid,title from news where typeid="&newstypeid&" and newsid>"&newsid
rst.open newssql,conn,1,1
if rst.eof then
newsnext = "没有了" 
else
newsnext = "<a href=readnews.asp?id="&rst("newsid")&">"&rst("title")&"</a>"
end if
newsnext="下一篇："&newsnext
rst.close
set rst=nothing
%>
<!--程序开始-->
'定义一个thenext函数来找出下一篇的ID，如果当前记录已经是最后一条记录，则输出文字“没有了”
<% 
function thenext
newrs=server.CreateObject("adodb.recordset")
sql="select top 1 * from articles where id>"&a1&" order by id"
set newrs=conn.execute(sql)
if newrs.eof then
response.Write("没有了")
else
a2=newrs("id")
response.Write("<a href='view.asp?id="&a2&"'>下一篇</a>")
end if
end function
%>
'定义一个thehead函数来找出下一篇的ID，如果当前记录已经是最前面的一条记录，则输出文字“没有了”
<% 
function thehead
headrs=server.CreateObject("adodb.recordset")
sql="select top 1 * from articles where id<"&a1&" order by id desc"
set headrs=conn.execute(sql)
if headrs.eof then
response.Write("没有了")
else
a0=headrs("id")
response.Write("<a href='view.asp?id="&a0&"'>上一篇</a>")
end if
end function
%>
'数据库连接文件
<!--#include file="conn.asp"-->
'取得传递过来的ID，显示文章标题作者和内容
<% 
id=request("id") 
sql="select * from articles where id="&id
set rs=conn.execute(sql)
%>
<% boardid=rs("boardid") %>
<title>文章系统-<% =rs("title") %></title><body leftmargin="0" topmargin="0">
<!--#include file="top.asp" -->
<%
Do While Not rs.EOF
%> 
<table width="773" border="0" cellspacing="0" cellpadding="0" align="center">
<tr> 
<td width="576" align="left">
<table width="557" border="0" cellspacing="5" cellpadding="4" align="left">
    <tr> 
      <td colspan="2" align="center"><span style="font-size:9pt color:#efefef"><%= rs("title") %><br>
        <div align="right"><span style="font-size:9pt color:#efefef">作者：<%= rs("author") %></span></div>
        </span></td>
    </tr>
    <tr> 
      <td colspan="2" ><span style="font-size:9pt color:#efefef"><!--将数据库的资料取出，经过编码后输出，保持输入时的格式不变--><%= replace(server.HTMLEncode(rs("content")),chr(13),"<br>") %></span></td>
    </tr>
<% a1=rs("id") %>
    <tr> 
      <td width="269" align="right"><!--调用前面定义的显示上一篇的函数--><% thehead %></td>
      <td width="257" align="right"><!--调用前面定义的显示下一篇的函数--><% thenext %></td>
    </tr>
    <% rs.MoveNext%>
    <%Loop%>
    </table></td>
  <td width="217" valign="top" align="left">相关文章： 
'根据当前文章的栏目号，找出同一栏目的文章   
<% 
sql="select * from articles where boardid="&boardid&"" 
set rs=conn.execute(sql)
%> 
<%
  Do While Not rs.EOF
  %>
<table width="207" border="0" cellspacing="2" cellpadding="2">
<tr>
      <td height="20"><a href="view.asp?id=<%=rs("id")%>"><%= rs("title") %></a></td>
</tr>
</table>
<% rs.MoveNext%>
<%Loop%> 
  </td>
</tr>
</table>
</body>
<!--程序结束-->
Rem==上一篇==
Rem======================================================
Rem= 参数说明:
Rem= pid当前ID,prame:栏目前辍(如一般web_news表,字段时一般为wn_**,prame就代表wn)
Rem= ptable(表前辍.如一般表名是:站点名_表名(shenzhe_news) ptable:就代表shenzhe)
Rem= 说明:采用上面命名法,可使该过程达到通用
Rem=====================================================
Function GetPre(pid,prame,ptable)
id = prame&"_id"
title = prame&"_title"
table = "city_"&ptable
url = "show_"&ptable
sql = "SELECT TOP 1 "&id&","&title&" FROM "&table&" WHERE "&id&"<"&pid&" ORDER BY "&id&" DESC"
set rs = Conn.Execute(sql)
If rs.eof or rs.bof Then
pre = "上一篇:没有新闻了"
Else
pre = "<a href="&url&".asp?"&id&"="&rs(0)&">"&rs(1)&"</a>"
End If
GetPre = pre
End Function

Rem = 下一篇
Rem=============
Rem= 参数函意和上过程一样
Rem==========
Function GetNext(nid,nrame,ntable)
id = nrame&"_id"
title = nrame&"_title"
table = "city_"&ntable
url = "show_"&ntable
sql = "SELECT TOP 1 "&id&","&title&" FROM "&table&" WHERE "&id&">"&nid&" ORDER BY "&id&" "
set rs = Conn.Execute(sql)
If rs.eof or rs.bof Then
nnext = "下一篇:没有新闻了"
Else
nnext = "<a href="&url&".asp?"&id&"="&rs(0)&">下一篇:"&rs(1)&"</a>"
End If
GetNext = nnext
End Function

实现代码:
偶数据库里有表:
city_active city_date city_note
city_active主要字段有: ca_id,cd_title
city_date主要字段有: cd_id,cd_title
city_note主要字段有: cn_id, cn_title

这样引用就可:
在show_note.asp?cn_id=4里引用上一篇下一篇
<%=GetPre(cn_id,"cn","note")%> ' 上一篇
<%=GetNext(cn_id,"cn","note")%> ' 下一篇
' 错误返回处理
' ============================================
Sub GoError(str)
Call DBConnEnd()
Response.Write "<script language=javascript>alert('" & str & " 系统将自动返回前一页面...');history.back();</script>"
Response.End
End Sub

' ============================================
' 得到安全字符串,在查询中或有必要强行替换的表单中使用
' ============================================
Function GetSafeStr(str)
GetSafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")
End Function
' ============================================
' 把字符串进行HTML解码,替换server.htmlencode
' 去除Html格式，用于显示输出
' ============================================
Function outHTML(str)
Dim sTemp
sTemp = str
outHTML = ""
If IsNull(sTemp) = True Then
  Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
sTemp = Replace(sTemp, Chr(10), "<br>")
outHTML = sTemp
End Function

' ============================================
' 去除Html格式，用于从数据库中取出值填入输入框时
' 注意：value="?"这边一定要用双引号
' ============================================
Function inHTML(str)
Dim sTemp
sTemp = str
inHTML = ""
If IsNull(sTemp) = True Then
  Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
inHTML = sTemp
End Function

' ===============================================
' 初始化下拉框
' s_FieldName : 返回的下拉框名 
' a_Name   : 定值名数组
' a_Value   : 定值值数组
' v_InitValue : 初始值
' s_Sql   : 从数据库中取值时,select name,value from table
' s_AllName : 空值的名称,如:"全部","所有","默认"
' ===============================================
Function InitSelect(s_FieldName, a_Name, a_Value, v_InitValue, s_Sql, s_AllName)
Dim i
InitSelect = "<select name='" & s_FieldName & "' size=1>"
If s_AllName <> "" Then
  InitSelect = InitSelect & "<option value=''>" & s_AllName & "</option>"
End If
If s_Sql <> "" Then
  oRs.Open s_Sql, oConn, 0, 1
  Do While Not oRs.Eof
    InitSelect = InitSelect & "<option value=""" & inHTML(oRs(1)) & """"
    If oRs(1) = v_InitValue Then
    InitSelect = InitSelect & " selected"
    End If
    InitSelect = InitSelect & ">" & outHTML(oRs(0)) & "</option>"
    oRs.MoveNext
  Loop
  oRs.Close
Else
  For i = 0 To UBound(a_Name)
    InitSelect = InitSelect & "<option value=""" & inHTML(a_Value(i)) & """"
    If a_Value(i) = v_InitValue Then
    InitSelect = InitSelect & " selected"
    End If
    InitSelect = InitSelect & ">" & outHTML(a_Name(i)) & "</option>"
  Next
End If
InitSelect = InitSelect & "</select>"
End Function