栏目导航

热点推荐

阅览排行

当前位置：主页>网络编程>ASP教程>资讯:ASP常用代码段之七

ASP常用代码段之七

www.jz123.cn 2010-09-29 来源: 中国建站责任编辑(袁袁) 我要投递新闻

1：asp截取、测量字符串

<% ' SubStr(str,vnum)
' 截取、测量字符串
'
' #####################################################
'
' str 为原始字符串
' vnum 为截取长度
'
' #####################################################
'
' a = SubStr("这是一个中文字符串",10) ' Return "这是一个.."，截取长度为 10，超出部分用 .. 表示
' a = SubStr("这是一个中文字符串",0) ' Return "这是一个中文字符串"，截取长度为 0，表示不进行截取
' a = SubStr("这是一个中文字符串",-1) ' Return 18，截取长度为 -1，表示测量该字符串长度

Function SubStr(str,vnum)
 Dim vstr,m,n,rstr,tstr,tnum,i
 vstr=str
 m=0:n=0:tnum=0:rstr="":tstr=""
 tstr=ExpStr(vstr,"&#[\d]*;","||")
 vstr=Replace(vstr&""," ",Chr(10))
 For i=1 To Len(vstr)
 If Asc(Mid(vstr,i,1)) < 0 Then
 m=m+2
 rstr=rstr&Mid(vstr,i,1)
 Else
 If TypeName(tstr)="Variant()" And Mid(vstr,i,1)="&" Then
 If Mid(vstr,i,Len(tstr(tnum)))=tstr(tnum) Then
 If CDbl(Replace(Replace(tstr(tnum),";",""),"&#",""))>255 Then
 m=m+2
 Else
 m=m+1
 End if
 rstr=rstr&tstr(tnum)
 i=i+Len(tstr(tnum))-1
 tnum=tnum+1
 Else
 m=m+1
 rstr=rstr&Mid(vstr,i,1)
 End If
 Else
 m=m+1
 rstr=rstr&Mid(vstr,i,1)
 End If
 End If
 If vnum>0 Then
 If m+2>=vnum Then
 If substr(rstr,-1)<substr(vstr,-1)-2 Then
 rstr=rstr&".."
 Else
 rstr=vstr
 End If
 substr=rstr
 Exit Function
 End If
 End If
 Next
 If vnum=-1 Then
 substr=m
 Else
 substr=vstr
 End If
End Function

2：asp返回正则匹配结果

' ExpStr(vStr,vReg,sStr)
' 返回正则匹配结果
'
' #####################################################
'
' vStr 为原始字符串
' vReg 为正则表达式
' sStr 为分隔符（尽量使用原始字符串中不会出现的字符串）
'
' #####################################################
'
' a = ExpStr("<a href=Functions.asp>函数库地址</a> <a href=http://www.x-bs.com>文盲的演示代码</a>","<a[^<>]*>[^<>]*?(</a>)","||")
' IsArray(a) ' Return True
' UBound(a) ' Return 1
' a(0) ' Return "<a href=Functions.asp>函数库地址</a>"
' a(1) ' Return "<a href=http://www.x-bs.com>文盲的演示代码</a>"

Function ExpStr(vStr,vReg,sStr)
 Dim Re,Matchs,Item,tStr
 tStr = ""
 Set Re = New RegExp
 Re.Pattern = vReg
 Re.IgnoreCase = True
 Re.Global = True
 If Re.Test(vStr) Then
 Set Matchs = Re.Execute(vStr)
 For Each Item In Matchs
 tStr = tStr & Item.Value & sStr
 Next
 tStr = Split(Left(tStr,Len(tStr) - Len(sStr)),sStr)
 End If
 Set Re = Nothing
 ExpStr = tStr
End Function

3：asp IP 地址转 10 进制数字

' IP2N(vStr)
' IP 地址转 10 进制数字
'
' #####################################################
'
' vStr 为合法的 IP 地址，或者任意小于 256 的数字与 . 构成的切头尾是数字的字符串
'
' #####################################################
'
' a = IP2N("220.160.4.17")        ' Return 3701474321
' a = IP2N("218.107.61.31")        ' Return 3664461087

Function IP2N(vStr)
    Dim IP,intLoop
    IP2N = 0
    IP = Split(vStr,".")
    For intLoop = 0 To UBound(IP)
        IP2N = 256 ^ (UBound(IP) - intLoop) * CInt(IP(intLoop)) + IP2N
    Next
End Function

' N2IP(vNum)
' 数字转 IP 地址，此函数为 IP2N 的逆运算
'
' #####################################################
'
' 该函数为递归方法
' vNum 为参与计算的正整数数值
'
' #####################################################
'
' a = N2IP("3701474321")        ' Return "220.160.4.17"
' a = N2IP("3664461087") ' Return "218.107.61.31"

Function N2IP(vNum)
    If vNum > 256 Then
        N2IP = N2IP(Int(vNum / 256)) & "." & (vNum - Int(vNum / 256) * 256)
    Else
        N2IP = vNum
    End If
End Function

4：asp数值转计算机字节计算方法

' N2Byte(vNum,lv)
' 数值转计算机字节计算方法
'
' #####################################################
'
' 该函数为递归方法，使用是 lv 的值固定为 0
' vNum 为要转换的数值
'
' #####################################################
'
' a = N2Byte(45872694,0)        ' Return "43.74 MB"
' a = N2Byte(58546985471,0)        ' Return "54.52 GB"

Function N2Byte(vNum,lv)
    If vNum > 1023 Then
        N2Byte = N2Byte(vNum / 1024,lv + 1)
'        N2Byte = N2Byte(Int(vNum/1024),lv + 1) & Right("0000" & (vNum - Int(vNum / 1024) * 1024)
    Else
        N2Byte = Int(vNum * 100)/100
        Select Case lv
            Case 0
                N2Byte = N2Byte & " Bytes"
            Case 1
                N2Byte = N2Byte & " KB"
            Case 2
                N2Byte = N2Byte & " MB"
            Case 3
                N2Byte = N2Byte & " GB"
            Case 4
                N2Byte = N2Byte & " TB"
        End Select
    End If
End Function
%>

5：asp二进制转字符串

<% ' BIN2STR(xBinary,Charset)
' 二进制转字符串
'
' #####################################################
'
' xBinary 为二进制数据流
' Charset 为转换编码
'
' #####################################################
'
' a = BIN2STR(BinaryDate,"GB2312")
' a = BIN2STR(BinaryDate,"UTF-8")

Function BIN2STR(xBinary,Charset)
 Dim RS, LBinary,Binary
 Binary = xBinary
 Const adLongVarChar = 201
 Set RS = CreateObject("ADODB.Stream")
 RS.Type = 1
 RS.Mode =3
 LBinary = LenB(Binary)

 if LBinary>0 then
 RS.Open
 RS.Write Binary
 RS.Position = 0
 RS.Type = 2
 RS.Charset = Charset
 BIN2STR = RS.ReadText
 Else
 BIN2STR = ""
 End If
End Function

6：asp采集函数

' getHttpPage(xUrl,Charset)
' 采集函数
'
' #####################################################
'
' 该函数需要 Microsoft.XMLHTTP 组件支持
'
' xUrl 为要采集信息的地址
' Charset 为要采集的编码
'
' #####################################################
'
' a = BIN2STR(BinaryDate,"GB2312")
' a = BIN2STR(BinaryDate,"UTF-8")

Function getHttpPage(xUrl,Charset)
 On Error Resume Next
 Dim Http
 Set Http = Server.CreateObject("Microsoft.XMLHTTP")
 Http.Open "GET",xUrl,False
 Http.Send()
 If Http.ReadyState <> 4 Then
 Response.Write "无法连接采集源"
 getHttpPage = False
 Exit Function
 End If
 getHttpPage = BIN2STR(Http.responseBody,Charset)
 Set Http = Nothing
 If Err Then
 Response.Write "服务器获取文件内容出错,请刷新重试！"
 getHttpPage = Err.description
 Err.Clear
 End If
End function

7：asp以文本方式打开文件

' OpenFromFile(FilePath,Charset)
' 以文本方式打开文件
'
' #####################################################
'
' 该过程需要 Scripting.FileSystemObject 及 Adodb.Stream 组件支持
'
' FilePath 为包含路径在内的文件名
' Charset 为要显示的编码标准
'
' #####################################################
'
' a = OpenFromFile("Functions.ASP","GB2312")

Function OpenFromFile(FilePath,Charset)
    Dim FSO,File
    Set FSO = Server.CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(Server.MapPath(FilePath)) Then
        Set File = Server.CreateObject("Adodb.Stream")
        File.Type = 1
        File.Open
        File.LoadFromFile(Server.MapPath(FilePath))
        OpenFromFile = BIN2STR(File.Read,Charset)
        Set File = Nothing
    Else
        OpenFromFile = "File does not exists."
    End If
    Set FSO = Nothing
End Function

8：asp文件保存

' SaveToFile(FileName,Code,Charset,Path,DtNow)
' 文件保存
'
' #####################################################
'
' 该过程需要 Scripting.FileSystemObject 及 Adodb.Stream 组件支持
'
' FileName 为要保存的文件名
' Code 为要保存的内容
' Charset 为要保存的编码格式
' Path 为要保存的文件存放地址
' 如果该地址不存在则自动建立（自动建立的路径部分的字符串中不能包含 \ / : * ? " < > | 等非法文件名的特殊符号）
' 注：只能建立一级新路径
'
' DtNow 为子路径
' 如果路径不存在则自动建立（自动建立的路径部分的字符串中不能包含 \ / : * ? " < > | 等非法文件名的特殊符号）
' 如果是时间类型则按日期建立子路径
' 如果不是则直接按字符串建立路径
' 如果为空，则不建立子路径
' 注：只能建立一级新路径
'
' #####################################################
'
' Call SaveToFile("a.html","<html><head><title>this is a Example page</title></head></html>","UTF-8","","")
' Call SaveToFile("b.html","<html><head><title>这是一个中文页面</title></head></html>","GB2312","",Now())
' Call SaveToFile("b.html","<html><head><title>这是一个日文页面</title></head></html>","Shift-Jis","",Now())

Sub xSaveToFile(FileName,Code,Charset,Path,DtNow)
 On Error Resume Next
 Dim File,sPath,FSO
 Set FSO = Server.CreateObject("Scripting.FileSystemObject")
 sPath = Path
 If sPath = "" Then sPath = "."
 If Right(sPath,1) = "/" Or Right(sPath,1) = "\" Then sPath = Left(sPath,Len(sPath) - 1)
 If Not FSO.FolderExists(Server.MapPath(sPath)) Then
 FSO.CreateFolder(Server.MapPath(Path))
 End If
 If IsDate(DtNow) Then
 sPath = sPath & "/" & Int(DtNow)
 ElseIf DtNow <> "" Then
 sPath = sPath & "/" & DtNow
 End If
 If Right(sPath,1) = "/" Or Right(sPath,1) = "\" Then sPath = Left(sPath,Len(sPath) - 1)
 If Not FSO.FolderExists(Server.MapPath(sPath)) Then
 FSO.CreateFolder(Server.MapPath(sPath))
 End If
 Set FSO = Nothing
 If Err Then
 response.write sPath
 Response.Write "File save failed,please check the path."
 response.write Err.description
 Exit Sub
 End If
 Set File = Server.CreateObject("Adodb.Stream")
 File.Charset = Charset
 File.Mode = 3
 File.Open
 File.Type = 2
 File.Position = 0
 File.WriteText Code
 File.SaveToFile Server.MapPath(sPath & "/" & FileName), 2
 File.Close
 Set File = Nothing
End Sub

顶一下

上一篇：ASP常用代码段之六下一篇：ASP常用代码段之八

栏目导航

热点推荐

阅览排行

ASP常用代码段之七

相关文章列表

评论总数：0 条 [ 查看全部 ] 网友评论