‘******************************************************************* ‘作用:transfer转换文件编码格式 ‘参数含义:incode为传入的文件编码 outcode转换后的文件编码 ‘进行判断文件类型是否是ansi类型,如果不是,提供选择是否需要自动更新文件 ‘******************************************************************* Function read(path) ‘将Byte()数组转成String字符串 Dim ado, a(), i, n Set ado = CreateObject("ADODB.Stream") ado.Type = 1 : ado.Open ado.LoadFromFile path n = ado.Size - 1 ReDim a(n) For i = 0 To n a(i) = ChrW(AscB(ado.Read(1))) Next read = Join(a, "") End Function Function is_valid_utf8(ByRef input) ‘ByRef以提高效率 Dim s, re Set re = New Regexp s = "[\xC0-\xDF]([^\x80-\xBF]|$)" s = s & "|[\xE0-\xEF].{0,1}([^\x80-\xBF]|$)" s = s & "|[\xF0-\xF7].{0,2}([^\x80-\xBF]|$)" s = s & "|[\xF8-\xFB].{0,3}([^\x80-\xBF]|$)" s = s & "|[\xFC-\xFD].{0,4}([^\x80-\xBF]|$)" s = s & "|[\xFE-\xFE].{0,5}([^\x80-\xBF]|$)" s = s & "|[\x00-\x7F][\x80-\xBF]" s = s & "|[\xC0-\xDF].[\x80-\xBF]" s = s & "|[\xE0-\xEF]..[\x80-\xBF]" s = s & "|[\xF0-\xF7]...[\x80-\xBF]" s = s & "|[\xF8-\xFB]....[\x80-\xBF]" s = s & "|[\xFC-\xFD].....[\x80-\xBF]" s = s & "|[\xFE-\xFE]......[\x80-\xBF]" s = s & "|^[\x80-\xBF]" re.Pattern = s is_valid_utf8 = (Not re.Test(input)) End Function Function CheckCode(Sourcefile) ‘WScript.echo "Checking: " & Sourcefile Dim stream set stream = CreateObject("Adodb.Stream") stream.Type = 1 ‘adTypeBinary stream.Mode = 3 ‘adModeReadWrite stream.Open stream.Position = 0 stream.LoadFromFile Sourcefile Bin = stream.read(2) s = read(Sourcefile) ‘读取文件 if is_valid_utf8(s)=-1 then‘判断是否UTF-8 Codes = "utf-8" msgbox Sourcefile&"文件为"&Codes&"非ansi请注意修改" ‘&HEF 239 &HBB 187 &HFF 255 &HFE 254 elseif AscB(MidB(Bin, 1, 1)) = &HEF and _ AscB(MidB(Bin, 2, 1)) = &HBB Then Codes = "utf-8" msgbox Sourcefile&"文件为"&Codes&"非ansi请注意修改" elseif AscB(MidB(Bin, 1, 1)) = &HFF and _ AscB(MidB(Bin, 2, 1)) = &HFE Then Codes = "unicode" msgbox Sourcefile&"文件为"&Codes&"非ansi请注意修改" elseif AscB(MidB(Bin, 1, 1)) = &HFE and _ AscB(MidB(Bin, 2, 1)) = &HFF Then Codes = "unicode big endian" msgbox Sourcefile&"文件为"&Codes&"非ansi请注意修改" Codes = "unicode" else Codes = "gb2312" end if stream.Close set stream = Nothing CheckCode = Codes end Function ‘******************************************************************* ‘作用:transfer转换文件编码格式 ‘参数含义:incode为传入的文件编码 outcode转换后的文件编码 ‘******************************************************************* Function transfer(inFile,incode,outcode,outfile) Set instream = CreateObject("Adodb.Stream") Set outstream = CreateObject("Adodb.Stream") ‘Open input file instream.Type = 2 ‘adTypeText instream.Mode = 3 ‘adModeReadWrite instream.Charset = inCode instream.Open instream.LoadFromFile inFile ‘Read input file content = instream.ReadText ‘Close input file instream.Close Set instream = Nothing ‘Open output file outstream.Type = 2 ‘adTypeText outstream.Mode = 3 ‘adModeReadWrite outstream.Charset = outCode outstream.Open ‘Write to output file outstream.WriteText content outstream.SaveToFile outFile, 2 ‘adSaveCreateOverWrite outstream.flush ‘Close output file outstream.Close Set outstream = Nothing end Function ‘******************************************************************* ‘作用:GetDirectory获取当前目录 ‘参数含义: ‘******************************************************************* Function GetDirectory() Dim WshShell Set WshShell=CreateObject("WScript.Shell") GetDirectory = WshShell.CurrentDirectory Set WshShell = nothing End Function ‘******************************************************************* ‘******************************************************************* ‘作用:rrubstr取字符串istr中的sign字符串后面的子字符串;从字符串尾部搜索的位置 ‘参数含义: ‘******************************************************************* Function rsubstr (istr, sign) Dim fnum,substr fnum = instrRev (istr,sign) + Len(sign) - 1 substr = Right (istr,Len(istr)-fnum) rsubstr = substr End Function ‘******************************************************************* ‘作用: ‘参数含义: ‘******************************************************************* Function Main() ‘创建新文件 Set nfso = CreateObject("Scripting.FileSystemObject") ‘遍历一个文件夹下的所有文件 Set oFso = CreateObject("Scripting.FileSystemObject") fold = GetDirectory()&"\" Set oFolder = oFso.GetFolder(fold) Dim inFile isExist = 0 isTransfer = 0 isCount = 0 Set oFiles = oFolder.Files ‘对每个文件进行处理 For Each oFile In oFiles inFile = oFile.path if rsubstr(inFile,".") <> "vbs" then isCount = isCount +1 incode = CheckCode (infile) outcode ="gb2312" if incode <> outcode then choice = Msgbox(inFile & " is not ansi,请注意!" & vbCrlf & _ " Do you want to transfer it?", vbQuestion + vbYesNo, _ "Output file has been existed") if choice = vbYES then transfer inFile,incode,outcode,inFile ‘msgbox inFile &"格式转换成功!" isTransfer = isTransfer +1 end if isExist = isExist+1 end if end if Next set nfso = nothing set ntf = nothing set oFolder = nothing set oFiles = nothing msgbox "共检查文件:"&isCount&",发现格式不对文件:"&isExist&",共转换成功文件:"&isTransfer End Function Main