<% Const IsDeBug = 1 Class NewaspMain_Cls     Public membername, memberpass, membergrade, membergroup, memberid     Public memberclass, menbernickname, Cookies_Name, CheckPassword     Public SiteName, SiteUrl, MasterMail, keywords, Copyright     Public InstallDir, IndexName, IstopSite, StopReadme, IsCloseMail     Public SendMailType, MailFrom, MailServer, MailUserName, MailPassword, MailInformPass, ChkSameMail     Public CheckUserReg, AdminCheckReg, AddUserPoint, SendRegMessage, FullContQuery, ActionTime     Public IsRunTime, UploadClass, UploadFileSize, UploadFileType, ContentKeyword, PreviewSetting     Public StopApplyLink, FSO_ScriptName, InitTitleColor, StopBankPay     Public ChinaeBank, VersionID, Badwords, Badwordr, serialcode, passedcode     Public ChannelName, ChannelDir, StopChannel, ChannelType     Public modules, ChannelSkin, HtmlPath, HtmlForm, HtmlPrefix     Public IsCreateHtml, HtmlExtName, StopUpload, MaxFileSize, UpFileType     Public IsAuditing, AppearGrade, ModuleName, BindDomain, DomainName     Public PostGrade, LeastString, MaxString, PaginalNum, LeastHotHist, Channel_Setting     Public ChannelSetting,ChannelData,ChannelPath     Public ChannelModule,ChannelHtmlPath,ChannelHtmlForm,ChannelUseHtml,ChannelHtmlExt,ChannelPrefix     Public ThisEdition, CopyrightStr, Version, Values, startime     Public SqlQueryNum, GetUserip, CacheName, Reloadtime     Public ScriptName, Admin_Page, skinid, SkinPath, HtmlCss, HtmlTop, HtmlFoot, HtmlContent, sHtmlContent     Private Main_Style, Main_Setting, MainStyle, Html_Setting     Private LocalCacheName, Cache_Data     Private CacheChannel, CacheData     Private arrGroupSetting, blnGroupSetting, binUserLong     Private Sub Class_Initialize()         On Error Resume Next         Reloadtime = 28800         SqlQueryNum = 0         '--缓存名称         CacheName = "newasp"         Cookies_Name = "newasp_net"         binUserLong = False         blnGroupSetting = False         GetUserip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")         If Len(GetUserip) = 0 Then GetUserip = Request.ServerVariables("REMOTE_ADDR")         GetUserip = CheckStr(GetUserip)         membername = CheckStr(Request.Cookies(Cookies_Name)("username"))         memberpass = CheckStr(Request.Cookies(Cookies_Name)("password"))         menbernickname = CheckStr(Request.Cookies(Cookies_Name)("nickname"))         membergrade = ChkNumeric(Request.Cookies(Cookies_Name)("UserGrade"))         membergroup = CheckStr(Request.Cookies(Cookies_Name)("UserGroup"))         memberclass = ChkNumeric(Request.Cookies(Cookies_Name)("UserClass"))         memberid = ChkNumeric(Request.Cookies(Cookies_Name)("userid"))         CheckPassword = CheckStr(Request.Cookies(Cookies_Name)("CheckPassword"))         Dim tmpstr, i         tmpstr = Request.ServerVariables("PATH_INFO")         tmpstr = Split(tmpstr, "/")         i = UBound(tmpstr)         ScriptName = LCase(tmpstr(i))         Admin_Page = False         If InStr(ScriptName, "showerr") > 0 Or InStr(ScriptName, "login") > 0 Or InStr(ScriptName, "admin_") > 0 Then Admin_Page = True     End Sub     Private Sub Class_Terminate()         If IsObject(Conn) Then Conn.Close : Set Conn = Nothing     End Sub     '===================服务器缓存部分函数开始===================     Public Property Let Name(ByVal vNewValue)         LocalCacheName = LCase(vNewValue)         Cache_Data = Application(CacheName & "_" & LocalCacheName)     End Property     Public Property Let Value(ByVal vNewValue)         If LocalCacheName <> "" Then             ReDim Cache_Data(2)             Cache_Data(0) = vNewValue             Cache_Data(1) = Now()             Application.Lock             Application(CacheName & "_" & LocalCacheName) = Cache_Data             Application.UnLock         Else             Err.Raise vbObjectError + 1, "NewaspCacheServer", " please change the CacheName."         End If     End Property     Public Property Get Value()         If LocalCacheName <> "" Then             If IsArray(Cache_Data) Then                 Value = Cache_Data(0)             Else                 'Err.Raise vbObjectError + 1, "NewaspCacheServer", " The Cache_Data("&LocalCacheName&") Is Empty."             End If         Else             Err.Raise vbObjectError + 1, "NewaspCacheServer", " please change the CacheName."         End If     End Property     Public Function ObjIsEmpty()         ObjIsEmpty = True         If Not IsArray(Cache_Data) Then Exit Function         If Not IsDate(Cache_Data(1)) Then Exit Function         If DateDiff("s", CDate(Cache_Data(1)), Now()) < (60 * Reloadtime) Then ObjIsEmpty = False     End Function     Public Sub DelCahe(MyCaheName)         Application.Lock         Application.Contents.Remove (CacheName & "_" & MyCaheName)         Application.UnLock     End Sub     Public Sub DelCache(MyCaheName)         Application.Lock         Application.Contents.Remove ("mynewasp_" & MyCaheName)         Application.UnLock     End Sub     '===================服务器缓存部分函数结束===================     Public Function ChkBoolean(ByVal Values)         If TypeName(Values) = "Boolean" Or IsNumeric(Values) Or LCase(Values) = "false" Or LCase(Values) = "true" Then             ChkBoolean = CBool(Values)         Else             ChkBoolean = False         End If     End Function     Public Function CheckNumeric(ByVal CHECK_ID)         If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then             CHECK_ID = CCur(CHECK_ID)         Else             CHECK_ID = 0         End If         CheckNumeric = CHECK_ID     End Function     Public Function ChkNumeric(ByVal CHECK_ID)         If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then             CHECK_ID = CLng(CHECK_ID)             If CHECK_ID < 0 Then CHECK_ID = 0         Else             CHECK_ID = 0         End If         ChkNumeric = CHECK_ID     End Function     Public Function CheckStr(ByVal str)         If IsNull(str) Then             CheckStr = ""             Exit Function         End If         str = Replace(str, Chr(0), "")         CheckStr = Replace(str, "'", "''")     End Function     '================================================     '过程名：CheckNull     '作  用：是否有效值     '================================================     Public Function CheckNull(ByVal sValue)         On Error Resume Next         If IsNull(sValue) Then             CheckNull = False             Exit Function         End If         If Trim(sValue) <> "" And LCase(Trim(sValue)) <> "http://" Then             CheckNull = True         Else             CheckNull = False         End If     End Function     Public Function ChkNull(ByVal str)         On Error Resume Next         If IsNull(str) Then             ChkNull = ""             Exit Function         End If         If Trim(str) <> "" And LCase(Trim(str)) <> "http://" Then             ChkNull = Trim(str)         Else             ChkNull = ""         End If     End Function     '=============================================================     '函数名：ChkFormStr     '作  用：过滤表单字符     '参  数：str   ----原字符串     '返回值：过滤后的字符串     '=============================================================     Public Function ChkFormStr(ByVal str)         Dim fString         fString = str         If IsNull(fString) Then             ChkFormStr = ""             Exit Function         End If         fString = Replace(fString, "'", "'")         fString = Replace(fString, Chr(34), """)         fString = Replace(fString, Chr(13), "")         fString = Replace(fString, Chr(10), "")         fString = Replace(fString, Chr(9), "")         fString = Replace(fString, ">", ">")         fString = Replace(fString, "<", "<")         fString = Replace(fString, "%", "％")         ChkFormStr = Trim(JAPEncode(fString))     End Function     '=============================================================     '函数作用：过滤SQL非法字符     '=============================================================     Public Function CheckRequest(ByVal str,ByVal strLen)         On Error Resume Next         str = Trim(str)         str = Replace(str, Chr(0), "")         str = Replace(str, "'", "")         str = Replace(str, "%", "")         str = Replace(str, "^", "")         str = Replace(str, ";", "")         str = Replace(str, "*", "")         str = Replace(str, "<", "")         str = Replace(str, ">", "")         str = Replace(str, "|", "")         str = Replace(str, "and", "")         str = Replace(str, "chr", "")         If Len(str) > 0 And strLen > 0 Then             str = Left(str, strLen)         End If         CheckRequest = str     End Function     '-- 移除有害字符     Public Function RemoveBadCharacters(ByVal strTemp)         Dim re         On Error Resume Next         Set re = New RegExp         re.Pattern = "[^\s\w]"         re.Global = True         RemoveBadCharacters = re.Replace(strTemp, "")         Set re = Nothing     End Function     '-- 去掉HTML标记     Public Function RemoveHtml(ByVal Textstr)         Dim Str,re         Str = Textstr         On Error Resume Next         Set re = New RegExp         re.IgnoreCase = True         re.Global = True         re.Pattern = "<(.[^>]*)>"         Str = re.Replace(Str, "")         Set re = Nothing         RemoveHtml=Str     End Function     '-- 数据库连接     Public Function Execute(Command)         If Not IsObject(Conn) Then ConnectionDatabase                 If IsDeBug = 0 Then              On Error Resume Next             Set Execute = Conn.Execute(Command)             If Err Then                 err.Clear                 Set Conn = Nothing                 Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。<br /><li>"                 Response.Write Command                 Response.End             End If         Else             Set Execute = Conn.Execute(Command)         End If             SqlQueryNum = SqlQueryNum+1     End Function     Public Sub ReadConfig()         On Error Resume Next         Name = "Config"         If ObjIsEmpty() Then ReloadConfig         CacheData = Value         '第一次起用系统或者重启IIS的时候加载缓存         Name = "Date"         If ObjIsEmpty() Then             Value = Date         Else             If CStr(Value) <> CStr(Date) Then                 Name = "Config"                 Call ReloadConfig                 CacheData = Value             End If         End If         SiteName = CacheData(1, 0): SiteUrl = CacheData(2, 0): MasterMail = CacheData(3, 0): keywords = CacheData(4, 0): Copyright = CacheData(5, 0): InstallDir = CacheData(6, 0)         IndexName = CacheData(7, 0): IstopSite = CacheData(8, 0): StopReadme = CacheData(9, 0): IsCloseMail = CacheData(10, 0): SendMailType = CacheData(11, 0): MailFrom = CacheData(12, 0)         MailServer = CacheData(13, 0): MailUserName = CacheData(14, 0): MailPassword = CacheData(15, 0): CheckUserReg = CacheData(16, 0): AdminCheckReg = CacheData(17, 0): MailInformPass = CacheData(18, 0)         ChkSameMail = CacheData(19, 0): AddUserPoint = CacheData(20, 0): SendRegMessage = CacheData(21, 0): FullContQuery = CacheData(22, 0): ActionTime = CacheData(23, 0): IsRunTime = CacheData(24, 0)         UploadClass = CacheData(25, 0): UploadFileSize = CacheData(26, 0): UploadFileType = CacheData(27, 0): ContentKeyword = CacheData(28, 0): StopApplyLink = CacheData(29, 0): FSO_ScriptName = CacheData(30, 0)         InitTitleColor = CacheData(31, 0): StopBankPay = CacheData(32, 0): ChinaeBank = CacheData(33, 0): VersionID = CacheData(34, 0): Badwords = CacheData(35, 0): Badwordr = CacheData(36, 0)         serialcode = CacheData(37, 0): passedcode = CacheData(38, 0) : PreviewSetting = CacheData(39, 0)         ThisEdition = "免费版 (Free Edition)"         Version = "Powered by：<a href=""http://www.newasp.net"" target=""_blank""  class=""navmenu"">NewCloud SiteManageSystem Version 2.0.0 SP1</a>"         CopyrightStr = "<!--" & vbCrLf         CopyrightStr = CopyrightStr & "┌─────────────────NEWASP──┐" & vbCrLf         CopyrightStr = CopyrightStr & "│NewCloud SiteManageSystem Version 2.0.0 SP1 │" & vbCrLf         CopyrightStr = CopyrightStr & "│版权所有: 新云网络 (newasp.net)             │" & vbCrLf         CopyrightStr = CopyrightStr & "│官方主页: http://www.newasp.net             │" & vbCrLf         CopyrightStr = CopyrightStr & "│论坛地址: http://bbs.newasp.net             │" & vbCrLf         CopyrightStr = CopyrightStr & "│E-Mail:   webenvoy@163.com  QQ: 94022511    │" & vbCrLf         CopyrightStr = CopyrightStr & "└────────────────────.NET┘" & vbCrLf         CopyrightStr = CopyrightStr & "-->" & vbCrLf         If CInt(IstopSite) = 1 And Not Admin_Page Then Response.Redirect ("" & SiteUrl & InstallDir & "showerr.asp?action=stop")     End Sub     Public Sub ReloadConfig()         Dim SQL, Rs         On Error Resume Next         SQL = "SELECT * from [NC_Config] "         Set Rs = Execute(SQL)         Value = Rs.GetRows(1)         Set Rs = Nothing     End Sub     '=============================================================     '过程名：ReloadChannel     '作  用：再装频道设置     '参  数：ChannelID   ----频道ID     '=============================================================     Private Sub ReloadChannel(ChannelID)         Dim SQL, Rs         On Error Resume Next         SQL = "SELECT ChannelID,ChannelName,ChannelDir,StopChannel,ChannelType,modules,ModuleName,BindDomain,DomainName,ChannelSkin,HtmlPath,HtmlForm,IsCreateHtml,HtmlExtName,HtmlPrefix,StopUpload,MaxFileSize,UpFileType,IsAuditing,AppearGrade,PostGrade,LeastString,MaxString,PaginalNum,LeastHotHist,Channel_Setting from NC_Channel where ChannelType <= 1 And ChannelID = " & CLng(ChannelID)         Set Rs = Execute(SQL)         If Rs.BOF And Rs.EOF Then             Response.Write "错误的频道参数！"             Exit Sub         End If         Value = Rs.GetRows(1)         Set Rs = Nothing     End Sub     '=============================================================     '过程名：ReadChannel     '作  用：读取频道设置     '参  数：ChannelID   ----频道ID     '=============================================================     Public Sub ReadChannel(ChannelID)         On Error Resume Next         If Not IsNumeric(ChannelID) Then ChannelID = 1         ChannelID = Clng(ChannelID)         Name = "Channel" & ChannelID         If ObjIsEmpty() Then Call ReloadChannel(ChannelID)         CacheChannel = Value         If CLng(CacheChannel(0, 0)) <> ChannelID Then             Call ReloadChannel(ChannelID)             CacheChannel = Value         End If         ChannelName = CacheChannel(1, 0): ChannelDir = CacheChannel(2, 0): StopChannel = CacheChannel(3, 0): ChannelType = CacheChannel(4, 0): modules = CacheChannel(5, 0): ModuleName = CacheChannel(6, 0): BindDomain = CacheChannel(7, 0): DomainName = CacheChannel(8, 0): ChannelSkin = CacheChannel(9, 0): HtmlPath = CacheChannel(10, 0)         HtmlForm = CacheChannel(11, 0): IsCreateHtml = CacheChannel(12, 0): HtmlExtName = CacheChannel(13, 0): HtmlPrefix = CacheChannel(14, 0): StopUpload = CacheChannel(15, 0): MaxFileSize = CacheChannel(16, 0): UpFileType = CacheChannel(17, 0): IsAuditing = CacheChannel(18, 0): AppearGrade = CacheChannel(19, 0)         PostGrade = CacheChannel(20, 0): LeastString = CacheChannel(21, 0): MaxString = CacheChannel(22, 0): PaginalNum = CacheChannel(23, 0): LeastHotHist = CacheChannel(24, 0): Channel_Setting = CacheChannel(25, 0)         If CInt(StopChannel) = 1 And Not Admin_Page Then Response.Redirect (InstallDir & "showerr.asp?action=ChanStop")     End Sub     Public Sub LoadChannel(chanid)         On Error Resume Next         Dim Rs,SQL,tmpdata         chanid = CLng(chanid)         Name = "MyChannel" & chanid         If ObjIsEmpty() Then             SQL = "SELECT ChannelName,ChannelDir,ModuleName,HtmlPath,HtmlForm,IsCreateHtml,HtmlExtName,HtmlPrefix,StopUpload,LeastString,MaxString,LeastHotHist FROM NC_Channel WHERE ChannelType<=1 And ChannelID= " & Clng(chanid)             Set Rs = Execute(SQL)             tmpdata = Rs.GetString(, , "|||", "@@@", "")             tmpdata = Left(tmpdata, Len(tmpdata) - 3)             Set Rs = Nothing             Value = tmpdata         End If         ChannelData = Split(Value, "|||")         ChannelPath = InstallDir & ChannelData(1)         ChannelModule = ChannelData(2)         ChannelHtmlPath = ChannelData(3)         ChannelHtmlForm = ChannelData(4)         ChannelUseHtml = ChannelData(5)         ChannelHtmlExt = ChannelData(6)         ChannelPrefix = ChannelData(7)     End Sub     '=============================================================     '过程名：LoadTemplates     '作  用：载入模板     '参  数：Page_Mark   ----StyleID     '=============================================================     Public Sub LoadTemplates(ChannelID, pageid, StyleID)         Dim rstmp, TempSkinID         On Error Resume Next         ChannelID = CLng(ChannelID)         pageid = CInt(pageid)         Name = "DefaultSkinID"         If ObjIsEmpty() Then             Set rstmp = Execute("SELECT skinid from [NC_Template] where pageid = 0 And isDefault = 1")             Value = rstmp(0)             Set rstmp = Nothing         End If         TempSkinID = Value         If StyleID = 0 Or StyleID = "" Then             skinid = TempSkinID         Else             Set rstmp = Execute("SELECT skinid from [NC_Template] where pageid = 0 And skinid = " & StyleID)             If Not rstmp.EOF Then                 skinid = rstmp(0)             Else                 skinid = TempSkinID             End If             Set rstmp = Nothing         End If         skinid = CLng(skinid)         Name = "MainStyle" & skinid         If ObjIsEmpty() Then TemplatesMainCache (skinid)         Main_Style = Value         SkinPath = Main_Style(0, 0)         Main_Setting = Split(Main_Style(2, 0), "|||")         MainStyle = Main_Style(1, 0)         'MainStyle = Replace(MainStyle, "{$InstallDir}", ReadInstallDir(BindDomain))         MainStyle = Replace(MainStyle, "{$SkinPath}", SkinPath)         MainStyle = Split(MainStyle, "|||")         HtmlCss = MainStyle(0)         HtmlTop = MainStyle(1)         HtmlFoot = MainStyle(2)         If pageid <> 0 Then             Name = "Templates" & ChannelID & skinid & pageid             If ObjIsEmpty() Then                 TemplatesToCache ChannelID, pageid             End If             ByValue = Value         End If     End Sub     Private Sub TemplatesToCache(ChannelID, pageid)         On Error Resume Next         Dim Rs, SQL, rstmp         SQL = "SELECT skinid,page_content,page_setting FROM [NC_Template] WHERE ChannelID = " & ChannelID & " And skinid = " & skinid & " And pageid = " & pageid         Set Rs = Execute(SQL)         If Not Rs.EOF Then             Value = Rs.GetRows(1)         Else             Set rstmp = Execute("SELECT skinid,page_content,page_setting FROM [NC_Template] WHERE ChannelID = " & ChannelID & " And isDefault = 1 And pageid = " & pageid)             Value = rstmp.GetRows(1)             Set rstmp = Nothing         End If         Set Rs = Nothing     End Sub     Private Sub TemplatesMainCache(skinid)         On Error Resume Next         Dim Rs, SQL, rstmp         SQL = "SELECT TemplateDir,page_content,page_setting FROM [NC_Template] WHERE pageid = 0 And skinid = " & skinid & " And ChannelID = 0"         Set Rs = Execute(SQL)         If Not Rs.EOF Then             Value = Rs.GetRows(1)         Else             Set rstmp = Execute("SELECT TemplateDir,page_content,page_setting from [NC_Template] WHERE pageid = 0 And isDefault = 1 And ChannelID = 0")             Value = rstmp.GetRows(1)             Set rstmp = Nothing         End If         Set Rs = Nothing     End Sub     Public Property Let ByValue(ByVal vNewValue)         Dim tmpstr         tmpstr = vNewValue         Html_Setting = tmpstr(2, 0)         Html_Setting = Split(Html_Setting, "|||")         HtmlContent = tmpstr(1, 0)         If CInt(Html_Setting(0)) <> 0 Then             HtmlContent = HtmlTop & HtmlContent & HtmlFoot         End If         HtmlContent = Replace(HtmlContent, "{$Style_CSS}", HtmlCss)         HtmlContent = Replace(HtmlContent, "{$SkinPath}", SkinPath)         HtmlContent = Replace(HtmlContent, "{$Width}", Main_Setting(0))         HtmlContent = Replace(HtmlContent, "{$ChannelMenu}", ChannelMenu)         HtmlContent = Replace(HtmlContent, "{$WebSiteName}", SiteName)         HtmlContent = Replace(HtmlContent, "{$WebSiteUrl}", SiteUrl)         HtmlContent = Replace(HtmlContent, "{$MasterMail}", MasterMail)         HtmlContent = Replace(HtmlContent, "{$Keyword}", keywords)         HtmlContent = Replace(HtmlContent, "{$Copyright}", Copyright)         HtmlContent = Replace(HtmlContent, "{$IndexName}", IndexName)         HtmlContent = Replace(HtmlContent, "{$Version}", "")         HtmlContent = HtmlContent     End Property     Public Property Get ByValue()         ByValue = HtmlContent     End Property     Public Property Let HTMLValue(ByVal vNewValue)         Dim TempStr         TempStr = vNewValue         TempStr = Replace(TempStr, "{$Style_CSS}", HtmlCss)         TempStr = Replace(TempStr, "{$SkinPath}", SkinPath)         TempStr = Replace(TempStr, "{$Width}", Main_Setting(0))         TempStr = Replace(TempStr, "{$ChannelMenu}", ChannelMenu)         TempStr = Replace(TempStr, "{$WebSiteName}", SiteName)         TempStr = Replace(TempStr, "{$WebSiteUrl}", SiteUrl)         TempStr = Replace(TempStr, "{$MasterMail}", MasterMail)         TempStr = Replace(TempStr, "{$Keyword}", keywords)         TempStr = Replace(TempStr, "{$Copyright}", Copyright)         TempStr = Replace(TempStr, "{$IndexName}", IndexName)         TempStr = Replace(TempStr, "{$Version}", "")         sHtmlContent = TempStr     End Property     Public Property Get HTMLValue()         HTMLValue = sHtmlContent     End Property     Public Property Get HtmlSetting(n)         HtmlSetting = Html_Setting(n)     End Property     Public Property Get MainSetting(n)         MainSetting = Main_Setting(n)     End Property     '================================================     '过程名：GetSiteUrl     '作  用：取得带端口的URL     '================================================     Public Property Get GetSiteUrl()         If Request.ServerVariables("SERVER_PORT") = "80" Then             GetSiteUrl = "http://" & Request.ServerVariables("server_name")         Else             GetSiteUrl = "http://" & Request.ServerVariables("server_name") & ":" & Request.ServerVariables("SERVER_PORT")         End If     End Property     '================================================     '函数名：FormEncode     '作  用：过虑提交的表单数据     '参  数：str ----原字符串  n ----字符长度     '================================================     Public Function FormEncode(ByVal str, ByVal n)         If Not IsNull(str) And Trim(str) <> "" Then             str = Left(str, n)             str = Replace(str, ">", ">")             str = Replace(str, "<", "<")             str = Replace(str, ">", ">")             str = Replace(str, "<", "<")             str = Replace(str, "'", "'")             str = Replace(str, Chr(34), """)             str = Replace(str, "%", "％")             str = Replace(str, vbNewLine, "")             FormEncode = Trim(str)         Else             FormEncode = ""         End If     End Function     '================================================     '函数名：ChkKeyWord     '作  用：过滤关键字     '参  数：keyword ----关键字     '================================================     Public Function ChkKeyWord(ByVal keyword)         Dim FobWords, i         On Error Resume Next         FobWords = Array(91, 92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65339, 65340)         For i = 1 To UBound(FobWords, 1)             If InStr(keyword, ChrW(FobWords(i))) > 0 Then                 keyword = Replace(keyword, ChrW(FobWords(i)), "")             End If         Next         keyword = Left(keyword, 100)         FobWords = Array("~", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "+", "=", "`", "[", "]", "{", "}", ";", ":", """", "'", ",", "<", ">", ".", "/", "\", "?", "_")         For i = 0 To UBound(FobWords, 1)             If InStr(keyword, FobWords(i)) > 0 Then                 keyword = Replace(keyword, FobWords(i), "")             End If         Next         ChkKeyWord = keyword     End Function     '================================================     '函数名：JAPEncode     '作  用：日文片假名编码     '参  数：str ----原字符     '================================================     Public Function JAPEncode(ByVal str)         Dim FobWords, i         On Error Resume Next         If IsNull(str) Or Trim(str) = "" Then             JAPEncode = ""             Exit Function         End If         FobWords = Array(92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65340)         For i = 1 To UBound(FobWords, 1)             If InStr(str, ChrW(FobWords(i))) > 0 Then                 str = Replace(str, ChrW(FobWords(i)), "&#" & FobWords(i) & ";")             End If         Next         JAPEncode = str     End Function     '================================================     '函数名：JAPUncode     '作  用：日文片假名解码     '参  数：str ----原字符     '================================================     Public Function JAPUncode(ByVal str)         Dim FobWords, i         On Error Resume Next         If IsNull(str) Or Trim(str) = "" Then             JAPUncode = ""             Exit Function         End If         FobWords = Array(92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65340)         For i = 1 To UBound(FobWords, 1)             If InStr(str, "&#" & FobWords(i) & ";") > 0 Then                 str = Replace(str, "&#" & FobWords(i) & ";", ChrW(FobWords(i)))             End If         Next         str = Replace(str, Chr(0), "")         str = Replace(str, "'", "''")         JAPUncode = str     End Function     '=============================================================     '函数作用：带脏话过滤     '=============================================================     Public Function ChkBadWords(ByVal str)         If IsNull(str) Then Exit Function         Dim i, Bwords, Bwordr         Bwords = Split(Badwords, "|")         Bwordr = Split(Badwordr, "|")         For i = 0 To UBound(Bwords)             If i > UBound(Bwordr) Then                 str = Replace(str, Bwords(i), "*")             Else                 str = Replace(str, Bwords(i), Bwordr(i))             End If         Next         ChkBadWords = str     End Function     '=============================================================     '函数作用：过滤HTML代码，带脏话过滤     '=============================================================     Public Function HTMLEncode(ByVal fString)         If Not IsNull(fString) Then             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, " ", " ")             fString = Replace(fString, Chr(10), "<br /> ")             fString = ChkBadWords(fString)             HTMLEncode = fString         End If     End Function     '=============================================================     '函数作用：过滤HTML代码，不带脏话过滤     '=============================================================     Public Function HTMLEncodes(ByVal 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 = Replac