大部分是我自己写的
' =============================================' 功能:删除指定的文件' 参数:sPathFile 要删除的文件路径' 返回值:无' =============================================Sub DoDelFile(sPathFile) On Error Resume Next Dim oFSO Set oFSO = Server.CreateObject("Scripting.FileSystemObject") oFSO.DeleteFile(Server.MapPath(sPathFile)) Set oFSO = NothingEnd Sub
' =============================================' 功能:新闻ID有效性验证，防止有些人恶意的破坏此程序' 参数:t_ID ID' 返回值:无' =============================================Sub CheckVailableID(t_ID)If IsNumeric(t_ID) = False Then GoError "请通过页面上的链接进行操作，不要试图破坏此系统。"End If
' ============================================' 功能:得到安全字符串,在查询中或有必要强行替换的表单中使用' 参数:str 要被转化的字符串' 返回值:安全的字符串' ============================================Function GetSafeStr(str) GetSafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")End Function
' ============================================' 功能:删除指定的文件' 参数:sPathFile:要删除的文件相对于当前文件的路径' 返回值:无' ============================================Sub DoDelFile(sPathFile) On Error Resume Next Dim oFSO Set oFSO = Server.CreateObject("Scripting.FileSystemObject") oFSO.DeleteFile(Server.MapPath(sPathFile)) Set oFSO = NothingEnd Sub
'======================================='功能：上传文件'参数：Tofilepath:要保存到的文件夹路径，以“/”结束 strFileName:源文件路径，一般从INPUT-FILE表单中读取'=======================================Function GetFileName(ByVal strFile)If strFile <> "" ThenGetFileName = mid(strFile,InStrRev(strFile, "/")+1)ElseGetFileName = ""End IfEnd function
SUB UpLoadFile(Tofilepath,strFileName) Set objStream = Server.CreateObject("ADODB.Stream") objStream.Type = 1 ' adTypeBinary objStream.Open objStream.LoadFromFile strFileName objStream.SaveToFile Server.MapPath(Tofilepath & GetFileName(strFileName)),2 objStream.CloseEnd Sub
<%'============================================================='功能：用于显示某一变量的值，两边用"|00|"包住'参数：VarName:显示的变量名称，以便与其他显示的变量区分 myVar:变量名'=============================================================Sub ShowVar(VarName,myVar) Response.Write(VarName & "|||00|||__" & myVar & "__|||00|||<br>")
End Sub
'============================================================='功能：得到文件名'参数：strFile:文件的路径'返回值：文件名，不包含“/”等的纯文件名'=============================================================Function GetFileName(ByVal strFile)If strFile <> "" ThenGetFileName = mid(strFile,InStrRev(strFile, "/")+1)ElseGetFileName = ""End IfEnd function
'============================================================='功能：打开名为"myRst"的记录集'参数：tableName:数据库中的表名 condition:ssql中的条件 a：ＯＰＥＮ的参数 b：ＯＰＥＮ的参数'返回值：无'备注：使用时应在使用页面定义一个全局变量MyRst,因为过程中的是局部变量'=============================================================Sub OpenMyRst(tableName,condition,a,b)DIM MyRst_SSqlSet myRst = Server.CreateObject("adodb.Recordset")MyRst_ssql = "SELECT * FROM "& tableName &" " & conditionif a = "" then a = 1if b = "" then b = 1myRst.open MyRst_ssql,cnn,a,bEnd Sub
'============================================================='功能：关闭名为"myRst"的记录集'参数：无'返回值：无'=============================================================Sub CloseMyRst()MyRst.closeEnd Sub
'======================================================================================='函数功能：返回当前页码在总页数中的位置是“首页”“中间”还是“末页”'参数：fCurrentPage:当前页码；fTotalpage：总页数'返回值："begin":字符型，表示在首页；"mid":字符型，表示在中间；"end"：字符型，表示在末尾；"error"：字符型，表示当前页码超出了总页数范围'备注：只有一页则返回"begin"'备注：如有两页：当前页是１时，返回ＢＥＧＩＮ，当前页是２时，返回ＥＮＤ，不会出现ＭＩＤ'=======================================================================================Function getPosition(fCurrentPage,fTotalPage)fCurrentPage = Cint(fCurrentPage)fTotalPage = Cint(fTotalPage)IF fCurrentPage = 1 THENgetPosition = "begin"ELSE IF fCurrentPage = fTotalPage THEN getPosition = "end" ELSE IF fCurrentPage < fTotalPage AND fCurrentPage > 0 THEN getPosition = "mid" ELSE getPosition ="error" END IF END IFEND IF
End Function%> <% '============================================================= '功能：初始化转页下拉框，可根据当页所显示的内容转向相同内容的网页 '参数：sCurrentPage:当前页码；sTotalPage:总页数；strFollow1...: ?后接的字符串 '返回值：无 '================================================================ Sub CreateSelection(sCurrentPage,sTotalPage,strFollow1,strFollow2,strFollow3) strFollow1 = trim(strFollow1) strFollow2 = trim(strFollow2) strFollow3 = trim(strFollow3) %> <select name='page' size='1' onChange="javascript:window.location='?<% IF strFollow1 <> "" THEN Response.Write(strFollow1&"&") END IF%><% IF strFollow2 <> "" THEN Response.Write(strFollow2&"&") END IF%><% IF strFollow3 <> "" THEN Response.Write(strFollow3&"&") END IF%>page='+this.options[this.selectedIndex].value;"> <% Dim pg pg=1 WHILE pg <= sTotalPage %> <option value='<%= pg %>' <% IF pg = sCurrentPage THEN Response.Write("SELECTED") %>>第<%= pg %>页</option> <% pg = pg + 1 WEND %> </select><% END Sub '=======================================================
'============================================================= '功能：得到安全的字符串，除去 " ' ; '参数：要转化的字符串 '返回值：安全的字符串 '================================================================Function GetSafeStr(str) GetSafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")End Function '=============================================================
'====================================================' 函数功能：使字符串变为字符串数组' 参数：要转换的字符串' 返回值：字符串数组'====================================================Function ChgToArray(str) DIM Lenth, i DIM strArray() str = Trim(str) Lenth = len(str) redim strArray(lenth) FOR i = 1 to Lenth strArray(i) = Mid(str,i,1) NEXT ChgToArray = strArray
END Function'====================================================
'====================================================' ＳＵＢ功能：显示由ChgToArray()转换来的字符串数组' 参数：要显示的字符串数组' 返回值：无'====================================================Sub ShowStrArray(str) for i = 1 to ubound(str) response.write(str(i)) nextEnd Sub'====================================================
'====================================================' 函数功能：返回绝对安全的字符串，除字母外' 参数：要显示的字符串数组' 返回值：无'====================================================Function GetMoreSafeStrArray(sStr) Dim i Dim str str = sStr for i = 1 to ubound(str) IF ("z" >= str(i) and str(i) >= "a") or ("Z" >= str(i) and str(i) >= "A") or ("9" >= str(i) and str(i) >= "0") or (str(i) = "") THEN ' response.write(str(i)&" is suit to the con<br>") ELSE' RESPONSE.WRITE(str(i)&" is not suit to the con<br>") str(i) = "" END IF next GetMoreSafeStrArray = strEnd Function'====================================================
'====================================================' 函数功能：比较两个字符串数组是不是相同，空字符算一个字符' 参数：要比较的两个字符串数组' 返回值：true : 相同 false : 不同'====================================================Function StrCompare(str1,str2)
End Function'====================================================
'====================================================' 函数功能：将字符串数组粘合成一个字符串' 参数：要被粘合的字符串数组' 返回值：String类型'====================================================
Function strCombine(str) DIM i, Ustr FOR i = 0 to Ubound(str) Ustr = Ustr & str(i) NEXT strCombine = UstrEnd Function'====================================================
'===================================================='函数功能：转换为安全String字符串，只含字母、数字'参数：要被转换的字符串'返回值：转换完成的字符串'====================================================Function GetMoreSafeString(sStr) Dim str str = sStr str = strCombine( GetMoreSafeStrArray( ChgToArray(str) ) ) GetMoreSafeString = strEnd Function
%>
<%'====================================================================================================='功能：显示标题'查询字符串，显示的标题个数(>=1)|单元格样式（插入<td>中还可控制单元格其他属性）|行头是否使用小圆点|小圆点样式|链接使用的样式名(不包括"Class="）|是否显示红色“荐”|是否显示日期|日期样式（如为空则默认为使用graydate）'参数（按参数位置）：查询字符串，显示的标题个数(>=1)|单元格样式（插入<td>中还可控制单元格其他属性）|行头是否使用小圆点|小圆点样式|链接使用的样式名(不包括"Class="）|是否显示红色“荐”|是否显示日期|日期样式（如为空则默认为使用graydate）'备注：最好在ＳＳＱＬ中用“top n”限定显示的条数，这样更高效'=====================================================================================================Sub ShowList(strSsql, numMaxTitle, strTdStyle, numUsePoint, strPointStyle, strLinkStyle, numShowRecommended, numShowDate , strDateStyle) DIM oRs , TitleCount , dDate Set oRs = Server.CreateObject("ADODB.Recordset") oRs.open strSsql , cnn , 1 , 1 %> <table width="100%" border="0"> <% '开始循环显示 TitleCount = 0 WHILE not oRs.eof and TitleCount < numMaxTitle %> <tr> <td <%= strTdStyle %>> <!-- 控制小圆点 --> <% If numUsePoint = 1 Then %> <span <% If strPointStyle = "" Then %> class=F7 <% Else Response.Write(strPointStyle) End If %> > ● </span> <% End If %> <!-- 标题 --> <a href="ShowArticle.asp?ID=<%= oRs("D_ID") %>" <%= strLinkStyle %> ><%= oRs("D_Title") %></a> <!-- 控制“荐” --> <% IF numShowRecommended = 1 and oRs("D_Recommended") = true THEN %><font color="#FF0000">荐</font><% End If %> <!-- 控制日期 --> <% dDate = split(oRs("D_Time")) %> <% IF numShowDate = 1 THEN %><font <% If strDateStyle = "" Then %>color="#999999" <% Else %> <%= strDateStyle %> <% End If %>><%= dDate(0) %></font><% End If %></td> </tr> <% TitleCount = TitleCount + 1 oRs.MoveNext WEND %> </table> <% End Sub
'====================================================================================================='功能：显示标题'查询字符串，显示的标题个数(>=1)|单元格样式（插入<td>中还可控制单元格其他属性）|行头是否使用小圆点|小圆点样式|链接使用的样式名(不包括"Class="）|是否显示红色“荐”|是否显示日期|日期样式（如为空则默认为使用graydate）'参数（按参数位置）：查询字符串，显示的标题个数(>=1)|单元格样式（插入<td>中还可控制单元格其他属性）|行头是否使用小圆点|小圆点样式|链接使用的样式名(不包括"Class="）|是否显示红色“荐”|是否显示日期|日期样式（如为空则默认为使用graydate）'备注：最好在ＳＳＱＬ中用“top n”限定显示的条数，这样更高效'=====================================================================================================Sub ShowListInClass( numMaxTitle, strTdStyle, numUsePoint, strPointStyle, strLinkStyle, numShowRecommended, numShowDate , strDateStyle,sORS) DIM TitleCount , dDate , oRs SET oRs = sORS %> <table width="100%" border="0"> <% '开始循环显示 TitleCount = 0 WHILE not oRs.eof and TitleCount < numMaxTitle %> <tr> <td <%= strTdStyle %>> <!-- 控制小圆点 --> <% If numUsePoint = 1 Then %> <span <% If strPointStyle = "" Then %> class=F7 <% Else Response.Write(strPointStyle) End If %> > ● </span> <% End If %> <!-- 标题 --> <a href="ShowArticle.asp?ID=<%= oRs("D_ID") %>" <%= strLinkStyle %> target="_blank" ><%= oRs("D_Title") %></a> <!-- 控制“荐” --> <% IF numShowRecommended = 1 and oRs("D_Recommended") = true THEN %><font color="#FF0000">荐</font><% End If %> <!-- 控制日期 --> <% dDate = split(oRs("D_Time")) %> <% IF numShowDate = 1 THEN %><font <% If strDateStyle = "" Then %>color="#999999" <% Else %> <%= strDateStyle %> <% End If %>><%= dDate(0) %></font><% End If %></td> </tr> <% TitleCount = TitleCount + 1 oRs.MoveNext WEND %> </table> <% End Sub'=================================================================='功能：显示某一大类下的文章。即：显示从？type后传递来的某一类别的文章，分页'参数：每页显示标题数，是否用置顶，显示方式（'ShowWhat: １＝显示所有审核过的４＝显示某一类别的文章）
'==================================================================Sub ShowClassList(MaxPerpage,numOnTop,sShowWhat)dim ssql, condition, sTypeIF sShowWhat = "" THEN sShowWhat =1 ELSE IF not Isnumeric(sShowWhat) THEN response.Write("错！showwhat不是数值型!") response.End() END IFEND IF
SELECT CASE sShowWhatCASE 1condition = "WHERE D_Checked=true order by d_id desc"CASE 4sType = GetSafeStr(Request("Type"))IF numOnTop = 1 Thencondition = "WHERE D_Checked=True and D_Type='" & sType &"' order by d_Ontop,d_id desc"Elsecondition = "WHERE D_Checked=True and D_Type='" & sType &"' order by d_id desc"END IFCASE ELSEIF numOnTop = 1 Thencondition = "WHERE D_Checked=True and D_Type='" & sType &"' order by d_Ontop,d_id desc"Elsecondition = "WHERE D_Checked=True and D_Type='" & sType &"' order by d_id desc"END IFEND SELECT
Dim oRsSet oRs = Server.CreateObject("adodb.Recordset")ssql = "SELECT * FROM Article " & conditionoRs.open ssql,cnn,1,1IF oRs.eof THEN Response.Write("错！没有符合条件的记录！")
Else '这个ＥＬＳＥ包括下面全部在找得到记录时的程序
'初始化分页变量DIM CurrentPage, TotalRecord, TotalPage, StartPosition
TotalRecord = oRs.recordcount '总记录数'============================================================='获得总页数TOTALPAGE'=============================================================IF (TotalRecord mod MaxPerpage)<>0 then TotalPage = fix(TotalRecord / MaxPerpage) + 1 ELSE TotalPage = TotalRecord / MaxPerpageEND IF'=============================================================
CurrentPage = Trim(request("page")) '获取当前页码'============================================================='开始判断CurrentPage是不是可用１、是数字，２、在页码范围内'=============================================================
IF CurrentPage="" THEN CurrentPage = 1END IF
IF not isNumeric(CurrentPage) then Response.Write("出错了！PAGE应是数值<br>")Response.End()ELSE IF getPosition(CurrentPage,TotalPage) = "error" THEN Response.Write("错！page的值超出页码范围！") Response.End() ELSE IF CurrentPage < 1 THEN CurrentPage = 1 ELSE CurrentPage = Cint(CurrentPage) END IF END IF END IF'=============================================================
StartPosition = (CurrentPage - 1) * MaxPerpage '当前应显示的第一条记录在记录中的位置
oRs.move StartPosition,0 '移动到当前应显示的第一条记录在记录中的位置
%><table width="100%" border="0"> <tr> <td width="92%"> <!-- 开始循环显示标题 --> <
