比较常用到的一些ASP函数

Function MIP()
ip=Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If ip = "" Then
ip = Request.ServerVariables("REMOTE_ADDR")
end if
MIP=ip
End Function

Function Setting()   '网站基本设置
set rsset=server.CreateObject("adodb.recordset")
rsset.open "select * from Setting",cn,1,3
for i=0 to rsset.fields.count-1
if i=0 then
Setting=rsset(i).value
else
Setting=Setting&"§"&rsset(i).value
end if
next
End Function

Function Msave()
Msave="true"
'防范未知IP访问及软件攻击
if MIP="127.0.0.1" then Exit Function
if (MIP="unknown" or MIP="") then
Msave="false"
Response.write "系统拒绝了你的来访IP不明访问请求，如有问题请与客服中心联系"
Response.end
end if
'SQL注入式攻击防范get及ID（not）代码
squery=lcase(Request.ServerVariables("QUERY_STRING"))
sURL=lcase(Request.ServerVariables("HTTP_HOST"))
allquery=squery+sURL
if InStr(allquery,"%27")<>0 or InStr(allquery,"'")<>0 or InStr(allquery,"%a1a1")<>0 or InStr(allquery,"　")<>0 or InStr(allquery,"%24")<>0 or InStr(allquery,"$")<>0 or InStr(allquery,"%3b")<>0 or InStr(allquery,";")<>0 or InStr(allquery,":")<>0 or InStr(allquery,"%%")<>0 or InStr(allquery,"%3c")<>0 or InStr(allquery,"<")<>0 or InStr(allquery,">")<>0 or InStr(allquery,"--")<>0 or InStr(allquery,"sp_")<>0 or InStr(allquery,"xp_")<>0 or InStr(allquery,"exec")<>0 or InStr(allquery,"/")<>0 or InStr(allquery,"dir")<>0 or InStr(allquery,"exe")<>0 or InStr(allquery,"select")<>0 or InStr(allquery,"delete")<>0 or InStr(allquery,"update")<>0 or InStr(allquery,"insert")<>0 or InStr(allquery,"cmd")<>0 or InStr(allquery,"*")<>0 or InStr(allquery,"^")<>0 or InStr(allquery,"(")<>0 or InStr(allquery,")")<>0 or InStr(allquery,"+")<>0 or InStr(allquery,"copy")<>0 or InStr(allquery,"format")<>0 or not(isnumeric(request("id"))) or not(isnumeric(request("classid"))) or not(isnumeric(request("page"))) then
Msave="false"
win=Request.ServerVariables("HTTP_USER_AGENT")
Tlocal=Split(Getlocation,"§")(2)  '攻击的页面
set rsip=server.CreateObject("adodb.recordset")
rsip.open "select count(id) as M_num from AttackLog where Attack_ip='"&MIP&"'",cn,1,3
if rsip("M_num")>0 then  '当同一IP非法访问多于2次时
cn.execute "Insert into AttackLog(Attack_local,Attack_ip,Attack_atime,whois) values('"&Tlocal&"','"&MIP&"','"&Gettime&"','"&whois&"')"
'反击开绐(调用了一个死循环)
Response.write "<mce:script language='JavaScript'><!--
"
Response.write "while (true)"
Response.write "alert('你的不法访问已达 "&rsip("M_num")+1&" 次，你的真实IP地址："&MIP&"，所用游览器："&win&"。你的IP及其它信息已被记录，系统已启动入侵自卫反击，由此造成的一切后果自负！！！')
// --></mce:script>"
Response.end
'反击结束
else
cn.execute "Insert into AttackLog(Attack_local,Attack_ip,Attack_atime,whois) values('"&Tlocal&"','"&MIP&"','"&Gettime&"','"&whois&"')"
Response.Write("<mce:script type="text/javascript"><!--
alert('错误提示：系统拒绝了你的不法访问，请确认你的访问的网址是否正确，如有问题请与网站客服中心联系！你的真实IP地址："&MIP&"，所用游览器："&win&"。如果你的不法访问达到二次系统将自动进入入侵自卫反击状态。由此造成的一切后果自负！');history.go(-1);
// --></mce:script>")
Response.End
end if
rs.close
end if
End Function

Function Getlocation()  '获取浏览器地址数组=来自哪一页§§不包含传值地址§§包含传值地址
FromURL=request.serverVariables("Http_REFERER")'来自哪一页
ScriptAddress=CStr(Request.ServerVariables("SCRIPT_NAME")) '当前文件地址,不包含传值
If (Request.QueryString <> "") Then
ScriptAddress = ScriptAddress & "?"
For Each M_item In Request.QueryString
If InStr(page,M_Item)=0 Then
M_ItemUrl = M_ItemUrl & M_Item &"="& Server.URLEncode(Request.QueryString(""&M_Item&"")) & "&"
End If
Next
end if
GetUrl = ScriptAddress&M_ItemUrl '当前文件地址,包含传值
if right(ScriptAddress,1)="?" then ScriptAddress=left(ScriptAddress,len(ScriptAddress)-1)
if right(GetUrl,1)="&" then GetUrl=left(GetUrl,len(GetUrl)-1)
Getlocation=replace(FromURL&"§"&ScriptAddress&"§"&GetUrl,"/","/")
End Function

Function G_Split(CounterValue,Counter_bits)
For i=1 To Counter_bits
G=Mid(CounterValue,i,1)
If G="" Then
G=0
ImgTag="<img src="images/"&G&".gif" mce_src="images/"&G&".gif" width='15' height='12' align='absmiddle'>"&ImgTag
Else
ImgTag=ImgTag&"<img src="images/"&G&".gif" mce_src="images/"&G&".gif" width='15' height='12' align='absmiddle'>"
End If
Next
G_Split=ImgTag
End Function

Function Gettime()'时间格式化
y=year(date)
tmonth=month(date)
tday=day(date)
thour=hour(time)
tminute=minute(time)
tsecond=second(time)
if len(tmonth)=1 then
tmonth="0"&tmonth
end if
if len(tday)=1 then
tday="0"&tday
end if
if len(thour)=1 then
thour="0"&thour
end if
if len(tminute)=1 then
tminute="0"&tminute
end if
if len(tsecond)=1 then
tsecond="0"&tsecond
end if
Gettime=y&"-"&tmonth&"-"&tday&" "&thour&":"&tminute&":"&tsecond
End Function

' ============================================
' 格式化时间(显示)
' 参数：n_Flag
' 1:"yyyy-mm-dd hh:mm:ss"
' 2:"yyyy-mm-dd"
' 3:"hh:mm:ss"
' 4:"yyyy年mm月dd日"
' 5:"yyyymmdd"
' ============================================
Function Format_Time(s_Time, n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
If len(m) = 1 Then m = "0" & m
d = cstr(day(s_Time))
If len(d) = 1 Then d = "0" & d
h = cstr(hour(s_Time))
If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1
' yyyy-mm-dd hh:mm:ss
Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 2
' yyyy-mm-dd
Format_Time = y & "-" & m & "-" & d
Case 3
' hh:mm:ss
Format_Time = h & ":" & mi & ":" & s
Case 4
' yyyy年mm月dd日
Format_Time = y & "年" & m & "月" & d & "日"
Case 5
' yyyymmdd
Format_Time = y & m & d
End Select
End Function

Function RE_Tongpei(Ostr,Fstr,Mstr,Lstr,Nstr) '通配符替换(原字符串,首字符串,通配字符串,末字符串,替换成的字符串)
if Mstr=0 then Mstr="/s*?"  '当通配字符串为0时替换所有
set re=new regexp
re.ignorecase=true
re.global=true
re.pattern=Fstr&"("&Mstr&")"&Lstr                '关键是括号中的通配正则表达式
RE_Tongpei=re.replace(Ostr,Nstr)
End Function
'邮件发送函数
Function SendEmail(fromemail,fromemailemailpwd,fromemailsmtp,fromemailusername,emailSubject,emailcontent,toemail)
Set  msg  =  Server.CreateObject("JMail.Message")
msg.silent  =  true
msg.Logging  =  true
msg.Charset  =  "gb2312"
msg.ContentType = "text/html" '邮件头设置， 默认为 "text/plain" ,发送HTML信息,改为 "text/html"
msg.MailServerUserName  =  fromemail  '发信人地址
msg.MailServerPassword  =  fromemailemailpwd     '发信人密码
msg.From  =  fromemail                '发信人地址
msg.FromName  =  fromemailusername          '发信人名称
msg.AddRecipient  toemail        '收信人地址
msg.Subject  =  emailSubject      '信件主题
msg.Body  =  emailcontent
msg.Send  fromemailsmtp                      'smtp
SendEmail=err.number
set msg=nothing
End Function

Function CreateFile(FileName)  '新建文件,并返回结果 建立成功为OK,否则为NO
dim FSO,F
set FSO = server.CreateObject("scripting.filesystemobject")
F = server.mappath(FileName)
if FSO.FileExists(F) then
CreateFile="NO"
else
FSO.CreateTextFile F,true
CreateFile="OK"
end if
set F = nothing
set FSO = nothing
End Function

Function DeleteFile(FileName)  '删除文件,并返回结果 删除成功为OK,否则为NO
dim FSO,F
set FSO = server.CreateObject("scripting.filesystemobject")
F=server.MapPath(FileName)
if FSO.FileExists(F) then
FSO.DeleteFile F,true
DeleteFile="OK"
else
DeleteFile="NO"
end if
set F = nothing
set FSO = nothing
End Function

Function CreateFolder(Foldername)  '新建文件夹,并返回结果 建立成功为OK,否则为NO
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
F=server.MapPath(Foldername)
if FSO.FolderExists(F) then
CreateFolder="NO"
else
FSO.CreateFolder(F)
CreateFolder="OK"
end if
set F = nothing
set FSO = nothing
End Function

Function DeleteFolder(Foldername)  '删除文件夹,并返回结果 删除成功为OK,否则为NO
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
F=server.MapPath(Foldername)
if FSO.FolderExists(F) then
FSO.DeleteFolder(F)
DeleteFolder="OK"
else
DeleteFolder="NO"
end if
set F = nothing
set FSO = nothing
End Function

Function WriteFile(FileName,Content) '后面加
dim FSO,F
set FSO = server.CreateObject("scripting.filesystemobject")
if FSO.FileExists(server.mappath(FileName)) then
set F = FSO.opentextfile(server.mappath(FileName),8,1)
F.write Content
F.close
WriteFile="OK"
else
WriteFile="NO"
end if
set F = nothing
set FSO = nothing
End Function

Function WriteLine(filename,lineNum,Linecontent)  '写某行
if linenum < 1 then exit function
dim fso,f,temparray,tempCnt
set fso = server.CreateObject("scripting.filesystemobject")
if not fso.fileExists(server.mappath(filename)) then exit function
set f = fso.opentextfile(server.mappath(filename),1)
if not f.AtEndofStream then
tempcnt = f.readall
f.close
temparray = split(tempcnt,chr(10))
if lineNum>ubound(temparray)+1 then
exit function
else
temparray(lineNum-1) = lineContent
end if
tempcnt = replace(join(temparray,chr(10)),chr(10)&chr(10),chr(10))
if right(tempcnt,1)=chr(10) then tempcnt=left(tempcnt,len(tempcnt)-1)
set f = fso.createtextfile(server.mappath(filename),true)
f.write tempcnt
end if
f.close
set f = nothing
End Function

Function WriteLine1(filename,lineNum,Linecontent)  '写某行
if linenum<1 then exit function
set fso = server.CreateObject("scripting.filesystemobject")
if not fso.fileExists(server.mappath(filename)) then exit function
set textfile = fso.opentextfile(server.mappath(filename),1)
i=1
NewFileCont=""
while not textfile.atendofstream
if i<>cint(linenum) then
NewFileCont=NewFileCont&textfile.readline&chr(10)
a=i
end if
i=i+1
wend
if right(NewFileCont,1)=chr(10) then NewFileCont=left(NewFileCont,len(NewFileCont)-1)
NewFileCont=NewFileCont&a
set f = fso.createtextfile(server.mappath(filename),true)
f.write NewFileCont
set f = nothing
End Function

Function DB_Engine(oldDB,bakDB,newDB)  '数据库压缩
F1=server.MapPath(oldFile)
F2=server.MapPath(bakDB)
F3=server.MapPath(newFile)
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
FSO.CopyFile F1, F2 , true
Set Engine = Server.CreateObject("JRO.JetEngine")
prov = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Engine.CompactDatabase prov & F1, prov & F3
set Engine = nothing
set FSO = nothing
End Function

Function Copy_File(oldFile,newFile)  '复制文件
F1=server.MapPath(oldFile)
F2=server.MapPath(newFile)
Set fs = Server.CreateObject("Scripting.FileSystemObject")
fs.CopyFile F1, F2
End Function
Function Move_File(oldFile,newFile)  '移动文件
F1=server.MapPath(oldFile)
F2=server.MapPath(newFile)
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
FSO.MoveFile F1, F2
set FSO = nothing
End Function

Function GetFMSG(FName)    '获取文件信息 成功=CreateDate(建立时间):LastModify(最后修改):FileSize(文件大小),否则=NO
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
F=server.MapPath(FName)
if FSO.FileExists(F) then
set MyFile=FSO.getfile(F)
CreateDate=MyFile.DateCreated
LastModify=MyFile.DateLastModified
FileSize=MyFile.Size
GetFMSG="CreateDate："&CreateDate&",LastModify："&LastModify&",FileSize："&FileSize
set MyFile = nothing
else
GetFMSG="NO"
end if
set F = nothing
set FSO = nothing
End Function

Function GetFolderFile(FolderName)   '获取某文件夹中的所有文件,并返回文件名数组
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
if right(left(FolderName,2),1)=":" then
F=FolderName
else
F=server.MapPath(FolderName)
end if
if FSO.FolderExists(F) then
Set GetFile = FSO.GetFolder(F)
for each item in GetFile.Files
FileName = FileName&"§§"&item.Name
next
set GetFile = nothing
end if
if left(FileName,2)="§§" then FileName=right(FileName,len(FileName)-2)
if right(FileName,2)="§§" then FileName=left(FileName,len(FileName)-2)
GetFolderFile = "GetFolderFile:"&FileName
set F = nothing
set FSO = nothing
End Function

Function GetFolderMSG(Folder_Name)    '获取文件夹信息 成功=CreateDate(建立时间):LastModify(最后修改):FileSize(文件大小),否则=NO
set FSO=server.createobject("Scripting.FileSystemObject")
F=server.mappath(Folder_Name)
set MyFolder=fso.getfolder(F)
CreateDate=MyFolder.DateCreated
LastModify=MyFolder.DateLastModified
FolderSize=MyFolder.size
GetFolderMSG="CreateDate："&CreateDate&",LastModify："&LastModify&",FileSize："&FolderSize
set F = nothing
set FSO = nothing
End Function

Function GetFolderFolder(FolderName)   '获取某文件夹中的所有文件夹,并返回文件夹名称数组
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
F=server.MapPath(FolderName)
set SearchFolder=Filesystem.GetFolder(F).SubFolders
for each FolderItem in SearchFolder
FolderName=FolderName&"§§"&FolderItem.Name
next
set SearchFolder = nothing
if left(FolderName,2)="§§" then FolderName=right(FolderName,len(FolderName)-2)
if right(FolderName,2)="§§" then FolderName=left(FolderName,len(FolderName)-2)
GetFolderFolder = "GetFolderFolder:"&FolderName
set F = nothing
set FSO = nothing
End Function

Function ReadTxt(filepath)         '读取单行文件
set fsa=server.createobject("scripting.filesystemobject")
set textfilea=fsa.opentextfile(server.mappath(filepath))
ReadTxt=textfilea.readline
textfilea.close
End Function

Function ReadFile(filepath)         '读取整个文件
set fs=server.createobject("scripting.filesystemobject")
set textfile=fs.opentextfile(server.mappath(filepath))
while not textfile.atendofstream
ReadFile=ReadFile&replace(textfile.readline,"    ","　　")&"<BR>"
wend
textfile.close
End Function

Function Tlen(str)    '中英文长度
'mlen要显示多少个英文字符,一个中文占两个英文字符位置
p_len=len(trim(str))
strlen=0
for xx=1 to p_len
if asc(mid(str,xx,1))<0 then
strlen=int(strlen) + 2  '字符长度加2
else
strlen=int(strlen) + 1  '字符长度加1
end if
next
Tlen=strlen
End Function

Function Slen(str,mlen)    '中英文控制显示长度
'mlen要显示多少个英文字符,一个中文占两个英文字符位置
p_len=len(trim(str))
for xx=1 to p_len
if asc(mid(str,xx,1))<0 then
strlen=int(strlen) + 2  '字符长度加2
if strlen>mlen then '当字符串长度超长时则退出
L="true"  '设置字符串超长标记
exit for
else '否则字符串继续相加
nstr=nstr+mid(str,xx,1)
end if
else
strlen=int(strlen) + 1  '字符长度加1
if strlen>mlen then '当字符串长度超长时则退出
L="true"  '设置字符串超长标记
exit for
else '否则字符串继续相加
nstr=nstr+mid(str,xx,1)
end if
end if
next
if L="true" then
response.write nstr&".."
else
response.write nstr
end if
End Function

Function GetStr(Nstr,Lstr,Sstr,Ostr) 'Nstr字符串 Lstr作为分隔的字符串 Sstr前通配字符串 Ostr后通配字符串
if Nstr="" or Lstr="" or Sstr="" or Ostr="" then exit Function
d_count=ubound(split(lcase(Nstr),Lstr,-1,1))     '得通配数量
Olen=0
for i=0 to d_count-1
start=NewLen(1,Nstr,Sstr)
over=NewLen(start,Nstr,Ostr)
Purl=mid(Nstr,start+len(Sstr),over-start-len(Sstr))
if left(Purl,4)<>"http" then
if left(Purl,2)<>".." then
if left(Purl,1)="/" then
Purl=".."&Purl
else
Purl="../"&Purl
end if
end if
end if
Nstr=right(Nstr,len(Nstr)-(over-1+len(Ostr))+Olen)
GetStr=GetStr&"§"&Purl
next
if left(GetStr,1)="§" then GetStr=right(GetStr,len(GetStr)-1)
End Function
Function NewLen(start,wstr,strng)
NewLen=Instr(start,lcase(wstr),lcase(strng))
if NewLen<=0 then NewLen=Len(wstr)
End Function

Function DelStr(Str)
If IsNull(Str) Or IsEmpty(Str) Then Exit Function
DelStr=Replace(Str,"'","")
DelStr=Replace(DelStr,"&","")
DelStr=Replace(DelStr,"%20","")
DelStr=Replace(DelStr,"<","")
DelStr=Replace(DelStr,">","")
DelStr=Replace(DelStr,"%","")
End Function

'********HTMLEncode函数：除了server.htmlencode的所有功能以外，还有转化回车和空格的功能，处理'及"，可以将textarea中输入的文本按照原样在html中显示***********************
Function HEncode(str)
If IsNull(Str) Or IsEmpty(Str) Then Exit Function
str = replace(str,"&","&")
str = replace(str,"<","<")
str = replace(str,">",">")
str = replace(str,"<%","＜%")
str = replace(str,"%>","%＞")
str = replace(str,chr(34),""")
str = replace(str,chr(32)," ",1)
str = replace(str,chr(3),"'")
str = replace(str,"'","’")
str = Replace(str,CHR(39),"'")
str = Replace(str,"IMG","img")
HEncode = str
End Function

'********HTMLDecode函数：就是HTMLEncode函数的反函数，将html中的字符按照原样在textarea中显示，在修改信息时很有用***********************
Function HDecode(str)
If IsNull(Str) Or IsEmpty(Str) Then Exit Function
str = replace(str,"&","&")
str = replace(str,">",">")
str = replace(str,"<","<")
str = replace(str,""",chr(34))
str = replace(str," ",chr(32),1)
str = replace(str,"'",chr(3))
str = Replace(str,"'",chr(39))
HDecode = str
End Function

Function RemoveHTML(str)  '去掉字符串中所有html内容
If IsNull(Str) Or IsEmpty(Str) Then Exit Function
Dim RegEx
Set RegEx=New RegExp
RegEx.Pattern="<[^>]*>"
RegEx.Global=True
RemoveHTML=RegEx.Replace(str,"")
End Function

'post过滤sql注入代防范及HTML防护开始
Function NOsql(str)
if isnull(str) then
str = ""
exit function
end if
str=trim(str)
str=replace(str,"&","&")  '&
str=replace(str,";",";")  '分号
str=replace(str,"'","'")  '单引号
str=replace(str,"""",""")  '双引号
str=replace(str,"chr(9)"," ") '空格
str=replace(str,"chr(10)","<br>") '回车
str=replace(str,"chr(13)","<br>") '回车
str=replace(str,"chr(32)"," ") '空格
str=replace(str,"chr(34)",""") '双引号
str=replace(str,"chr(39)","'") '单引号
str=Replace(str, "script", "script")'script
str=replace(str,"<","<")         '左<
str=replace(str,">",">")         '右>
str=replace(str,"(","(")         '左(
str=replace(str,")",")")         '右)
str=replace(str,"*","*")         '*
str=replace(str,"--","--")      'SQL注释符
NOsql=str
End Function

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

Function GetSysInfo()
On Error Resume Next
Dim WshShell,WshSysEnv
Set WshShell = Server.CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("SYSTEM")
okOS = Cstr(WshSysEnv("OS"))
okCPUS = Cstr(WshSysEnv("NUMBER_OF_PROCESSORS"))
okCPU = Cstr(WshSysEnv("PROCESSOR_IDENTIFIER"))
If IsNull(okCPUS) Then
okCPUS = Request.ServerVariables("NUMBER_OF_PROCESSORS")
ElseIf okCPUS="" Then
okCPUS = Request.ServerVariables("NUMBER_OF_PROCESSORS")
End If
If Request.ServerVariables("OS")="" Then okOS=okOS & "(可能是 Windows Server 2003)"
GetSysInfo=okCPUS&"§"&okOS
End Function

' ============================================
' 检测上页是否从本站提交
' 返回:True,False
' ============================================
Function IsSelfRefer()
Dim sHttp_Referer, sServer_Name
sHttp_Referer = CStr(Request.ServerVariables("HTTP_REFERER"))
sServer_Name = CStr(Request.ServerVariables("SERVER_NAME"))
If Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name Then
IsSelfRefer = True
Else
IsSelfRefer = False
End If
End Function

' ============================================
' 得到安全字符串,在查询中使用
' ============================================
Function Get_SafeStr(str)
Get_SafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")
End Function

' ============================================
' 取实际字符长度
' ============================================
Function Get_TrueLen(str)
Dim l, t, c, 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
Next
Get_TrueLen = t
End Function

' ============================================
' 判断是否安全字符串,在注册登录等特殊字段中使用
' ============================================
Function IsSafeStr(str)
Dim s_BadStr, n, i
s_BadStr = "' 　&<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32)
n = Len(s_BadStr)
IsSafeStr = True
For i = 1 To n
If Instr(str, Mid(s_BadStr, i, 1)) > 0 Then
IsSafeStr = False
Exit Function
End If
Next
End Function