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: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


%>

阅读更多
个人分类: Web
上一篇使所有复选框被选中、密码相同性验证(JavaScript)
下一篇CCTV感动中国2005年度人物候选:黄伯云(转载)
想对作者说点什么? 我来说一句

没有更多推荐了,返回首页

关闭
关闭
关闭