【QTP】vbs字符串处理函数

最近在弄QTP，其中需要一些关于字符串的函数，找到如下一篇，记录比较详细，由于也是转的他人，原作者不详，还是很感谢这些做了总结拿来共享的前辈。发在窝里也希望能帮到有需求的窝友们。
PS：冬至了，大家记得吃饺子哈

<%
'*************************************************
'函数名：gotTopic
'作用：截字符串，汉字一个算两个字符，英文算一个字符
'参数：str ----原字符串
' strlen ----截取长度
'返回值：截取后的字符串
'*************************************************
function gotTopic(str,strlen)
 if str="" then
 gotTopic=""
 exit function
 end if
 dim l,t,c, i
 str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")
 l=len(str)
 t=0
 for i=1 to l
 c=Abs(Asc(Mid(str,i,1)))
 if c>255 then
 t=t+2
 else
 t=t+1
 end if
 if t>=strlen then
 gotTopic=left(str,i) & "…"
 exit for
 else
 gotTopic=str
 end if
 next
 gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<")
end function

'********************************************
'函数名：IsValidEmail
'作用：检查Email地址合法性
'参数：email ----要检查的Email地址
'返回值：True ----Email地址合法
' False ----Email地址不合法
'********************************************
function IsValidEmail(email)
 dim names, name, i, c
 IsValidEmail = true
 names = Split(email, "@")
 if UBound(names) <> 1 then
 IsValidEmail = false
 exit function
 end if
 for each name in names
 if Len(name) <= 0 then
 IsValidEmail = false
 exit function
 end if
 for i = 1 to Len(name)
 c = Lcase(Mid(name, i, 1))
 if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
 IsValidEmail = false
 exit function
 end if
 next
 if Left(name, 1) = "." or Right(name, 1) = "." then
 IsValidEmail = false
 exit function
 end if
 next
 if InStr(names(1), ".") <= 0 then
 IsValidEmail = false
 exit function
 end if
 i = Len(names(1)) - InStrRev(names(1), ".")
 if i <> 2 and i <> 3 then
 IsValidEmail = false
 exit function
 end if
 if InStr(email, "..") > 0 then
 IsValidEmail = false
 end if
end function

'***************************************************
'函数名：IsObjInstalled
'作用：检查组件是否已经安装
'参数：strClassString ----组件名
'返回值：True ----已经安装
' False ----没有安装
'***************************************************
Function IsObjInstalled(strClassString)
 On Error Resume Next
 IsObjInstalled = False
 Err = 0
 Dim xTestObj
 Set xTestObj = Server.CreateObject(strClassString)
 If 0 = Err Then IsObjInstalled = True
 Set xTestObj = Nothing
 Err = 0
End Function

'**************************************************
'函数名：strLength
'作用：求字符串长度。汉字算两个字符，英文算一个字符。
'参数：str ----要求长度的字符串
'返回值：字符串长度
'**************************************************
function strLength(str)
 ON ERROR RESUME NEXT
 dim WINNT_CHINESE
 WINNT_CHINESE = (len("中国")=2)
 if WINNT_CHINESE then
 dim l,t,c
 dim i
 l=len(str)
 t=l
 for i=1 to l
 c=asc(mid(str,i,1))
 if c<0 then c=c+65536
 if c>255 then
 t=t+1
 end if
 next
 strLength=t
 else
 strLength=len(str)
 end if
 if err.number<>0 then err.clear
end function

'***************************************************
'函数名：isInteger
Rem 判断数字是否整形
'***************************************************
function isInteger(para)
 on error resume next
 dim str
 dim l,i
 if isNUll(para) then
 isInteger=false
 exit function
 end if
 str=cstr(para)
 if trim(str)="" then
 isInteger=false
 exit function
 end if
 l=len(str)
 for i=1 to l
 if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
 isInteger=false
 exit function
 end if
 next
 isInteger=true
 if err.number<>0 then err.clear
end function

'*******************************************
'函数名：HTMLEncode
Rem 过滤HTML代码
'*******************************************
function HTMLEncode(fString)
if not isnull(fString) then
 fString = replace(fString, ">", ">")
 fString = replace(fString, "<", "<")
 fString = replace(fString, "&#", "&#")
 fString = Replace(fString, CHR(32), " ")
 fString = Replace(fString, CHR(9), " ")
 fString = Replace(fString, CHR(34), """)
 fString = Replace(fString, CHR(39), "'")
 fString = Replace(fString, CHR(13), "")
 fString = Replace(fString, CHR(10) & CHR(10), " ")
 fString = Replace(fString, CHR(10), "
")
 HTMLEncode = fString
else
 HTMLEncode=fstring
end if
end function

'********************************************
'函数名：Createpass
'系统分配随机密码
'********************************************
Function Createpass()'系统分配随机密码
 Dim Ran,i,LengthNum
 LengthNum=16
 Createpass=""
 For i=1 To LengthNum
 Randomize
 Ran = CInt(Rnd * 2)
 Randomize
 If Ran = 0 Then
 Ran = CInt(Rnd * 25) + 97
 Createpass =Createpass& UCase(Chr(Ran))
 ElseIf Ran = 1 Then
 Ran = CInt(Rnd * 9)
 Createpass = Createpass & Ran
 ElseIf Ran = 2 Then
 Ran = CInt(Rnd * 25) + 97
 Createpass =Createpass& Chr(Ran)
 End If
 Next
End Function

'*********************************************
'函数名：Replacehtml
'去掉HTML标记
'*********************************************
Public Function Replacehtml(Textstr)
 Dim Str,re
 Str=Textstr
 Set re=new RegExp
 re.IgnoreCase =True
 re.Global=True
 re.Pattern="<(.[^>]*)>"
 Str=re.Replace(Str, "")
 Set Re=Nothing
 Replacehtml=Str
End Function

'*********************************************
'函数名：cutStr
'截取指定字符
'*********************************************
Function cutStr(str,strlen)
 '去掉所有HTML标记
 Dim re
 Set re=new RegExp
 re.IgnoreCase =True
 re.Global=True
 re.Pattern="<(.[^>]*)>"
 str=re.Replace(str,"")
 set re=Nothing
 Dim l,t,c,i
 l=Len(str)
 t=0
 For i=1 to l
 c=Abs(Asc(Mid(str,i,1)))
 If c>255 Then
 t=t+2
 Else
 t=t+1
 End If
 If t>=strlen Then
 cutStr=left(str,i)&"..."
 Exit For
 Else
 cutStr=str
 End If
 Next
 str = dvHTMLEncode(str)
 cutStr=Replace(cutStr,chr(10),"")
End Function

'*****************************************
‘剔除一个双引号"
key=replace(key,"""","")
------------
‘用 | 替换一个空格
key=replace(key," ","|")
-----------
‘两个空格替换为一个空格
'多个空格不能正常显示，只显示一个空格；但是字符串操作是正常的，该是几个就是几个。
key=replace(key," "," ")
-----------
'用 | 替换字符串中的一个空格和多个连续空格
do while instr(key," ")<>0
key=replace(key," "," ")
loop
key=replace(key," ","|")
-----------
%>
******************************************************
******************************************************
<%
function URLDecode(enStr)
dim deStr,strSpecial
dim c,i,v
deStr=""
strSpecial="!""#$%&'()*+,/:;<=>?@[\]^`{ |}~%"
for i=1 to len(enStr)
 c=Mid(enStr,i,1)
 if c="%" then
 v=eval("&h"+Mid(enStr,i+1,2))
 if inStr(strSpecial,chr(v))>0 then
 deStr=deStr&chr(v)
 i=i+2
 else
 v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
 deStr=deStr&chr(v)
 i=i+5
 end if
 else
 if c="+" then
 deStr=deStr&" "
 else
 deStr=deStr&c
 end if
 end if
next
URLDecode=deStr
end function
%>
－－－－－－－－－－－－－－－－－－－－－
<%
function U8Decode(enStr)
'输入一堆有%分隔的字符串，先分成数组，根据utf8规则来判断补齐规则
'输入:关 E5 85 B3 键 E9 94 AE 字 E5 AD 97
'输出:关 B9D8 键 BCFC 字 D7D6
dim c,i,i2,v,deStr,WeiS

for i=1 to len(enStr)
 c=Mid(enStr,i,1)
 if c="%" then
 v=c16to2(Mid(enStr,i+1,2))
 '判断第一次出现0的位置，
 '可能是1(单字节)，3(3-1字节)，4，5，6，7不可能是2和大于7
 '理论上到7，实际不会超过3。
 WeiS=instr(v,"0")
 v=right(v,len(v)-WeiS)'第一个去掉最左边的WeiS个
 i=i+3
 for i2=2 to WeiS-1
 c=c16to2(Mid(enStr,i+1,2))
 c=right(c,len(c)-2)'其余去掉最左边的两个
 v=v & c
 i=i+3
 next
 if len(c2to16(v)) =4 then
 deStr=deStr & chrw(c2to10(v))
 else
 deStr=deStr & chr(c2to10(v))
 end if
 i=i-1
 else
 if c="+" then
 deStr=deStr&" "
 else
 deStr=deStr&c
 end if
 end if
next
U8Decode = deStr
end function

function c16to2(x)
'这个函数是用来转换16进制到2进制的，可以是任何长度的，一般转换UTF-8的时候是两个长度，比如A9
'比如：输入“C2”，转化成“11000010”,其中1100是"c"是10进制的12（1100），那么2（10）不足4位要补齐成（0010）。
dim tempstr
dim i:i=0'临时的指针

for i=1 to len(trim(x))
tempstr= c10to2(cint(int("&h" & mid(x,i,1))))
do while len(tempstr)<4
 tempstr="0" & tempstr'如果不足4位那么补齐4位数
loop
c16to2=c16to2 & tempstr
next
end function

function c2to16(x)
'2进制到16进制的转换，每4个0或1转换成一个16进制字母，输入长度当然不可能不是4的倍数了

dim i:i=1'临时的指针
for i=1 to len(x) step 4
 c2to16=c2to16 & hex(c2to10(mid(x,i,4)))
next
end function

function c2to10(x)
'单纯的2进制到10进制的转换，不考虑转16进制所需要的4位前零补齐。
'因为这个函数很有用！以后也会用到，做过通讯和硬件的人应该知道。
'这里用字符串代表二进制
 c2to10=0
 if x="0" then exit function'如果是0的话直接得0就完事
 dim i:i=0'临时的指针
 for i= 0 to len(x) -1'否则利用8421码计算，这个从我最开始学计算机的时候就会，好怀念当初教我们的谢道建老先生啊！
 if mid(x,len(x)-i,1)="1" then c2to10=c2to10+2^(i)
 next
end function

function c10to2(x)
'10进制到2进制的转换
dim sign, result
result = ""
'符号
sign = sgn(x)
x = abs(x)
if x = 0 then
 c10to2 = 0
 exit function
end if
do until x = "0"
 result = result & (x mod 2)
 x = x \ 2
loop
result = strReverse(result)
if sign = -1 then
 c10to2 = "-" & result
else
 c10to2 = result
end if
end function
%>
*************************************************************
*************************************************************
<%
'汉字gb2312转换为UTF-8编码：

function chinese2unicode(Str)
dim i
dim Str_one
dim Str_unicode
for i=1 to len(Str)
 Str_one=Mid(Str,i,1)
 Str_unicode=Str_unicode&chr(38)
 Str_unicode=Str_unicode&chr(35)
 Str_unicode=Str_unicode&chr(120)
 Str_unicode=Str_unicode& Hex(ascw(Str_one))
 Str_unicode=Str_unicode&chr(59)
next
Response.Write Str_unicode
end function

'UTF-8 转换为 GB2312：

function UTF2GB(UTFStr)
 for Dig=1 to len(UTFStr)
 if mid(UTFStr,Dig,1)="%" then
 if len(UTFStr) >= Dig+8 then
 GBStr=GBStr & ConvChinese(mid(UTFStr,Dig,9))
 Dig=Dig+8
 else
 GBStr=GBStr & mid(UTFStr,Dig,1)
 end if
 else
 GBStr=GBStr & mid(UTFStr,Dig,1)
 end if
 next
 UTF2GB=GBStr
end function

function ConvChinese(x)
 A=split(mid(x,2),"%")
 i=0
 j=0

 for i=0 to ubound(A)
 A(i)=c16to2(A(i))
 next

 for i=0 to ubound(A)-1
 DigS=instr(A(i),"0")
 Unicode=""
 for j=1 to DigS-1
 if j=1 then
 A(i)=right(A(i),len(A(i))-DigS)
 Unicode=Unicode & A(i)
 else
 i=i+1
 A(i)=right(A(i),len(A(i))-2)
 Unicode=Unicode & A(i)
 end if
 next

 if len(c2to16(Unicode))=4 then
 ConvChinese=ConvChinese & chrw(int("&H" & c2to16(Unicode)))
 else
 ConvChinese=ConvChinese & chr(int("&H" & c2to16(Unicode)))
 end if
 next
end function

function c2to16(x)
 i=1
 for i=1 to len(x) step 4
 c2to16=c2to16 & hex(c2to10(mid(x,i,4)))
 next
end function

function c2to10(x)
 c2to10=0
 if x="0" then exit function
 i=0
 for i= 0 to len(x) -1
 if mid(x,len(x)-i,1)="1" then c2to10=c2to10+2^(i)
 next
end function

function c16to2(x)
 i=0
 for i=1 to len(trim(x))
 tempstr= c10to2(cint(int("&h" & mid(x,i,1))))
 do while len(tempstr)<4
 tempstr="0" & tempstr
 loop
 c16to2=c16to2 & tempstr
 next
end function

function c10to2(x)
 mysign=sgn(x)
 x=abs(x)
 DigS=1
 do
 if x<2^DigS then
 exit do
 else
 DigS=DigS+1
 end if
 loop
 tempnum=x

 i=0
 for i=DigS to 1 step-1
 if tempnum>=2^(i-1) then
 tempnum=tempnum-2^(i-1)
 c10to2=c10to2 & "1"
 else
 c10to2=c10to2 & "0"
 end if
 next
 if mysign=-1 then c10to2="-" & c10to2
end function
%>