各种编码批量转换 CodeChange.vbee Emeditor Macro 宏实现

'/*=========================================================================
' * Intro       因为Emeditor识别文本编码的能力比较强，所以用Emeditor打开我们想转换的文件，它都可以正常打开的，打开后我们再改变这个文件的编码，然后保存之
' * FileName    CodeChange.vbee
' * Author      yongfa365
' * Version     v1.0
' * WEB         http://www.yongfa365.com
' * Email       yongfa365[at]qq.com
' * FirstWrite  http://www.yongfa365.com/Item/CodeChange.vbee.html
' * LastModify  2007-10-06 02:42:01
' *==========================================================================*/

Set mainMenu=CreatePopupMenu
mainMenu.Add "功能：编码转换",0
mainMenu.Add "", 0, eeMenuSeparator 
mainMenu.Add "指定文件夹下所有文件存为指定编码文件",1
mainMenu.Add "", 0, eeMenuSeparator 
mainMenu.Add "当前文档存为gb2312",2
mainMenu.Add "当前文档存为utf-8",3
mainMenu.Add "当前文档存为指定编码文件",4
mainMenu.Add "", 0, eeMenuSeparator 
mainMenu.Add "所有文档存为指定编码文件",5
mainMenu.Add "所有文档存为gb2312",6
mainMenu.Add "所有文档存为utf-8",7
mainMenu.Add "", 0, eeMenuSeparator 
mainMenu.Add "程序说明",100
witchItem=mainMenu.Track
Select Case witchItem
    Case 1
        sPath = prompt("请输入要处理的文件所在的文件夹", "")
        If FolderExits(sPath) = False Then
            alert "输入的文件夹不存在，退出？"
            Quit
        End If
        bSubFolder = confirm("包括子文件夹？")
        sExt = prompt("只处理这些后缀的文件：(为空表示处理所有文件，各后缀以“|”隔开)", "html|htm|asp|php|php4")
        NewCode = prompt("文档编码转换为：(936-->gb2312,65001-->utf-8)", "65001")
        If IsNumeric(NewCode) Then
            Call FilesTree(sPath, bSubFolder)
            Set re = New RegExp
            re.Pattern = "([^|]+\.(" & sExt & "$))"
            re.IgnoreCase = True
            re.Global = True
            Set Matches = re.Execute(AllFiles)
            editor.NewFile
            For Each oMatch In Matches
                editor.OpenFile oMatch.SubMatches(0)
                SaveFile oMatch.SubMatches(0), NewCode
            Next
            Close
        Else
            alert "输入有误，必须输入数字，退出"
            Quit
        End If
    Case 2
        SaveFile document.FullName, 936
    Case 3
        SaveFile document.FullName, 65001
    Case 4
        NewCode = prompt("您要将当前文档编码转换为：(936-->gb2312,65001-->utf-8)", "936|65001")
        If IsNumeric(NewCode) Then
            SaveFile document.FullName, NewCode
        Else
            alert "输入有误，必须输入数字，退出"
            Quit
        End If
    Case 5
        NewCode = prompt("您要将所有文档编码转换为：(936-->gb2312,65001-->utf-8)", "936|65001")
        If IsNumeric(NewCode) Then
            AllDocNum = editor.Documents.Count
            Set NowFile = editor.ActiveDocument
            For i = 0 To AllDocNum
                editor.ExecuteCommandByID 5376 + i
                SaveFile document.FullName, NewCode
            Next
            NowFile.Activate()
        Else
            alert "输入有误，必须输入数字，退出"
            Quit
        End If
    Case 6
        AllDocNum = editor.Documents.Count
        Set NowFile = editor.ActiveDocument
        For i = 0 To AllDocNum
            editor.ExecuteCommandByID 5376 + i
            SaveFile document.FullName, 936
        Next
        NowFile.Activate()
    Case 7
        AllDocNum = editor.Documents.Count
        Set NowFile = editor.ActiveDocument
        For i = 0 To AllDocNum
            editor.ExecuteCommandByID 5376 + i
            SaveFile document.FullName, 65001
        Next
        NowFile.Activate()
    Case 100
        Msg= "柳永法制作,http://www.yongfa365.com"
        Msg=Msg & vbcrlf & "本宏在制作过程中有一块地方用了半天时间才发现问题："
        Msg=Msg & vbcrlf & "如果您的文档是英文与数字组合没有双字节文字，"
        Msg=Msg & vbcrlf & "并且文档是没有BOM的utf-8格式，那么再次打开这个文档时，"
        Msg=Msg & vbcrlf & "EmEditor还是会把这个文档编码认为是系统默认的文档，"
        Msg=Msg & vbcrlf & "如果是简体中文系统，显示的还是936 gb2312编码，"
        Msg=Msg & vbcrlf & "但他确实是utf-8的，只是这两种编码都可以正常打开这个文件。"


        alert(Msg)
End Select

Sub SaveFile(FileName, CodePage)
    editor.ExecuteCommandByID 4105 'Save As vbCrLf
    document.Encoding = CodePage 'Encoding gb2312-->936 utf-8-->65001 ...
    If CodePage = 65001 Or CodePage = 65005 Or CodePage = 65006 Then document.UnicodeSignature = False 'BOM
    document.Save FileName
End Sub

Function FolderExits(Folder)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(Folder) Then
        FolderExits = True
    Else
        FolderExits = False
    End If
End Function