大部分是我自己写的
' =============================================
' 功能:删除指定的文件
' 参数:sPathFile 要删除的文件路径
' 返回值:无
' =============================================
Sub DoDelFile(sPathFile)
On Error Resume Next
Dim oFSO
Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
oFSO.DeleteFile(Server.MapPath(sPathFile))
Set oFSO = Nothing
End 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 = Nothing
End Sub
'=======================================
'功能:上传文件
'参数:Tofilepath:要保存到的文件夹路径,以“/”结束 strFileName:源文件路径,一般从INPUT-FILE表单中读取
'=======================================
Function GetFileName(ByVal strFile)
If strFile <> "" Then
GetFileName = mid(strFile,InStrRev(strFile, "/")+1)
Else
GetFileName = ""
End If
End 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.Close
End Sub
<%
'=============================================================
'功能:用于显示某一变量的值,两边用"|00|"包住
'参数:VarName:显示的变量名称,以便与其他显示的变量区分 myVar:变量名
'=============================================================
Sub ShowVar(VarName,myVar)
Response.Write(VarName & "|||00|||__" & myVar & "__|||00|||<br>")
End Sub
'=============================================================
'功能:得到文件名
'参数:strFile:文件的路径
'返回值:文件名,不包含“/”等的纯文件名
'=============================================================
Function GetFileName(ByVal strFile)
If strFile <> "" Then
GetFileName = mid(strFile,InStrRev(strFile, "/")+1)
Else
GetFileName = ""
End If
End function
'=============================================================
'功能:打开名为"myRst"的记录集
'参数:tableName:数据库中的表名 condition:ssql中的条件 a:OPEN的参数 b:OPEN的参数
'返回值:无
'备注:使用时应在使用页面定义一个全局变量MyRst,因为过程中的是局部变量
'=============================================================
Sub OpenMyRst(tableName,condition,a,b)
DIM MyRst_SSql
Set myRst = Server.CreateObject("adodb.Recordset")
MyRst_ssql = "SELECT * FROM "& tableName &" " & condition
if a = "" then a = 1
if b = "" then b = 1
myRst.open MyRst_ssql,cnn,a,b
End Sub
'=============================================================
'功能:关闭名为"myRst"的记录集
'参数:无
'返回值:无
'=============================================================
Sub CloseMyRst()
MyRst.close
End Sub
'=======================================================================================
'函数功能:返回当前页码在总页数中的位置是“首页”“中间”还是“末页”
'参数:fCurrentPage:当前页码;fTotalpage:总页数
'返回值:"begin":字符型,表示在首页;"mid":字符型,表示在中间;"end":字符型,表示在末尾;"error":字符型,表示当前页码超出了总页数范围
'备注:只有一页则返回"begin"
'备注:如有两页:当前页是1时,返回BEGIN,当前页是2时,返回END,不会出现MID
'=======================================================================================
Function getPosition(fCurrentPage,fTotalPage)
fCurrentPage = Cint(fCurrentPage)
fTotalPage = Cint(fTotalPage)
IF fCurrentPage = 1 THEN
getPosition = "begin"
ELSE IF fCurrentPage = fTotalPage THEN
getPosition = "end"
ELSE IF fCurrentPage < fTotalPage AND fCurrentPage > 0 THEN
getPosition = "mid"
ELSE
getPosition ="error"
END IF
END IF
END 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
'====================================================
'====================================================
' SUB功能:显示由ChgToArray()转换来的字符串数组
' 参数:要显示的字符串数组
' 返回值:无
'====================================================
Sub ShowStrArray(str)
for i = 1 to ubound(str)
response.write(str(i))
next
End 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 = str
End 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 = Ustr
End Function
'====================================================
'====================================================
'函数功能:转换为安全String字符串,只含字母、数字
'参数:要被转换的字符串
'返回值:转换完成的字符串
'====================================================
Function GetMoreSafeString(sStr)
Dim str
str = sStr
str = strCombine( GetMoreSafeStrArray( ChgToArray(str) ) )
GetMoreSafeString = str
End Function
%>
<%
'=====================================================================================================
'功能:显示标题
'查询字符串,显示的标题个数(>=1)|单元格样式(插入<td>中还可控制单元格其他属性)|行头是否使用小圆点|小圆点样式|链接使用的样式名(不包括"Class=")|是否显示红色“荐”|是否显示日期|日期样式(如为空则默认为使用graydate)
'参数(按参数位置):查询字符串,显示的标题个数(>=1)|单元格样式(插入<td>中还可控制单元格其他属性)|行头是否使用小圆点|小圆点样式|链接使用的样式名(不包括"Class=")|是否显示红色“荐”|是否显示日期|日期样式(如为空则默认为使用graydate)
'备注:最好在SSQL中用“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)
'备注:最好在SSQL中用“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: 1=显示所有审核过的4=显示某一类别的文章)
'==================================================================
Sub ShowClassList(MaxPerpage,numOnTop,sShowWhat)
dim ssql, condition, sType
IF sShowWhat = "" THEN
sShowWhat =1
ELSE IF not Isnumeric(sShowWhat) THEN
response.Write("错!showwhat不是数值型!")
response.End()
END IF
END IF
SELECT CASE sShowWhat
CASE 1
condition = "WHERE D_Checked=true order by d_id desc"
CASE 4
sType = GetSafeStr(Request("Type"))
IF numOnTop = 1 Then
condition = "WHERE D_Checked=True and D_Type='" & sType &"' order by d_Ontop,d_id desc"
Else
condition = "WHERE D_Checked=True and D_Type='" & sType &"' order by d_id desc"
END IF
CASE ELSE
IF numOnTop = 1 Then
condition = "WHERE D_Checked=True and D_Type='" & sType &"' order by d_Ontop,d_id desc"
Else
condition = "WHERE D_Checked=True and D_Type='" & sType &"' order by d_id desc"
END IF
END SELECT
Dim oRs
Set oRs = Server.CreateObject("adodb.Recordset")
ssql = "SELECT * FROM Article " & condition
oRs.open ssql,cnn,1,1
IF oRs.eof THEN
Response.Write("错!没有符合条件的记录!")
Else '这个ELSE包括下面全部在找得到记录时的程序
'初始化分页变量
DIM CurrentPage, TotalRecord, TotalPage, StartPosition
TotalRecord = oRs.recordcount '总记录数
'=============================================================
'获得总页数TOTALPAGE
'=============================================================
IF (TotalRecord mod MaxPerpage)<>0 then
TotalPage = fix(TotalRecord / MaxPerpage) + 1
ELSE
TotalPage = TotalRecord / MaxPerpage
END IF
'=============================================================
CurrentPage = Trim(request("page")) '获取当前页码
'=============================================================
'开始判断CurrentPage是不是可用1、是数字,2、在页码范围内
'=============================================================
IF CurrentPage="" THEN
CurrentPage = 1
END 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%">
<!-- 开始循环显示标题 -->
<%
Call ShowListInClass( MaxPerpage,"",1,"","",1,1,"",oRs)
%></td>
</tr>
<tr>
<td><table width="100%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td style="padding-left:12px ">
<% IF getPosition(CurrentPage,TotalPage) = "begin" then %>
首页
<%ELSE %>
<a href="?Type=<%= sType %>&ShowWhat=<%= sShowWhat %>&page=1">首页</a>
<% END IF %>
<% IF getPosition(CurrentPage,TotalPage) = "begin" then %>
上一页
<%ELSE %>
<a href="?Type=<%= sType %>&ShowWhat=<%= sShowWhat %>&page=<%=CurrentPage - 1 %>">上一页</a>
<% END IF %>
<% IF getPosition(CurrentPage,TotalPage) = "end" OR TotalPage = 1 THEN %>
下一页
<%ELSE %>
<a href="?Type=<%= sType %>&ShowWhat=<%= sShowWhat %>&page=<%=CurrentPage + 1 %>">下一页</a>
<% END IF %>
<% IF getPosition(CurrentPage,TotalPage) = "end" OR TotalPage = 1 THEN %>
末页
<%ELSE %>
<a href="?Type=<%= sType %>&ShowWhat=<%= sShowWhat %>&page=<%=TotalPage %>">末页</a>
<% END IF %>
转到
<% call CreateSelection(CurrentPage,TotalPage,"Type="&sType,"ShowWhat="&sShowWhat,"") %> </td>
</tr>
</table></td>
</tr>
<!-- 循环结束 -->
</table>
<% END IF %>
<% End Sub %>
<%
'=====================================================================================================
'更新日期:2006.03.03
'功能:显示标题,比ShowListInClasspp增加了标题字数限制功能,悬停显示完整标题
'查询字符串,显示的标题个数(>=1)|单元格样式(插入<td>中还可控制单元格其他属性)|行头是否使用小圆点|小圆点样式|链接使用的样式名(不包括"Class=")|是否显示红色“荐”|是否显示日期|日期样式(如为空则默认为使用graydate)
'参数(按参数位置):查询字符串,显示的标题个数(>=1)|单元格样式(插入<td>中还可控制单元格其他属性)|行头是否使用小圆点|小圆点样式|链接使用的样式名(不包括"Class=")|是否显示红色“荐”|是否显示日期|日期样式(如为空则默认为使用graydate)|每个标题显示的字数
'备注:最好在SSQL中用“top n”限定显示的条数,这样更高效
'=====================================================================================================
Sub ShowListInClasspp( numMaxTitle, strTdStyle, numUsePoint, strPointStyle, strLinkStyle, numShowRecommended, numShowDate , strDateStyle,sORS,numCharacter)
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" title="<%= oRs("D_Title") %>"><%= left(oRs("D_Title"),numCharacter) %></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
%>
<%
'==================================
'功能:隐藏IP地址字符串的最后一部分
'参数:IP地址(字符串)
'返回:以*号代替最后一部分的IP地址
'==================================
function hideIPLastPart(strIP)
target = "."
position = instr( instr( instr(strIP,target)+1 , strIP,target)+1 ,strIP,target)
hideIPLastPart = left(strIP,position) +"*"
end function
'============================
'功能:获取IP
'参数:无
'返回值:IP地址
'============================
Function getIP()
Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If
getIP = Trim(Mid(strIPAddr, 1, 30))
End Function
%>