asp常用函数总结

大部分是我自己写的

' =============================================
' 功能:删除指定的文件
' 参数: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：ＯＰＥＮ的参数　b：ＯＰＥＮ的参数
'返回值：无
'备注：使用时应在使用页面定义一个全局变量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"
'备注：如有两页：当前页是１时，返回ＢＥＧＩＮ，当前页是２时，返回ＥＮＤ，不会出现ＭＩＤ
'=======================================================================================
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
'====================================================

 

'====================================================
'　ＳＵＢ功能：显示由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）
'备注：最好在ＳＳＱＬ中用“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, 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 '这个ＥＬＳＥ包括下面全部在找得到记录时的程序

'初始化分页变量
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是不是可用１、是数字，２、在页码范围内
'=============================================================

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）｜每个标题显示的字数
'备注：最好在ＳＳＱＬ中用“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

%>