[原创] VBS 文件、文件夹名称批量繁简转换

yu2n

名称：VBS 文件、文件夹名称繁简转换
功能：将指定目录中所有的文件、文件夹名称做繁转简、简转繁处理。
环境：MS Office Word 2007 及以上
作者：Yu2n
开发语言：VBS
适用人群：
        1. 使用繁体系统，需要导入简体资料的。
        2. 多动症少女

Option Explicit

Main
'********************************************************************************
Sub Main()
'********************************************************************************

	Dim fso, TCSC
	Dim strFolder, arrPath, oPath, strPath, i
	Dim lngReturn
	Dim FF, FD, FN, FX, FNX, FN2, FF2
	
	'命令行模式
	Call CommandMode(WScript.ScriptName)
	
	'选择文件夹
	WScript.Echo "> 请选择文件夹位置："
	strFolder = BrowseForFolder("请选择文件夹位置：")
	If strFolder = "" Then Exit Sub
	WScript.Echo "# " & strFolder
	arrPath = ScanFolder(strFolder)
	
	'选择模式
	lngReturn = Msgbox("请选择模式：" & vbLf & vbLf & _
		"【是(Y)】简体转繁体" & vbLf & _
		"【否(N)】繁体转简体" & vbLf & _
		"【取 消】不进行转换", vbQuestion+vbYesNoCancel+vbDefaultButton3, WScript.ScriptName)
	If lngReturn = vbCancel Then Exit Sub
	
	'对文件名称进行转换
	On Error Resume Next
	Set fso = CreateObject("Scripting.FileSystemObject")	
	Set TCSC = New TCSCConverter
	For Each oPath In arrPath
		If fso.FileExists(CStr(oPath)) Then
			FF = fso.GetFile(CStr(oPath))
			FD = fso.GetFile(FF).ParentFolder
			FX = fso.GetExtensionName(FF)
			FNX = fso.GetFile(FF).Name 
			FN = Left(FNX,Len(FNX)-Len(FX))
			If lngReturn = vbYes Then
				FN2 = TCSC.SC2TC(FN)
			Else
				FN2 = TCSC.TC2SC(FN)
			End If
			If FN <> FN2 Then
				i = 1
				FF2 = FD & "\" & FN2 & FX
				Do While fso.FileExists(FF2)
					i = i + 1
					FF2 = FD & "\" & FN2 & i & FX
				Loop
				fso.GetFile(FF).Move FF2
				If Err.Number = 0 Then
					WScript.Echo Mid(FF2,Len(strFolder)+1)
				Else
					Err.Clear
					WScript.Echo FF & vbCrLf & "* 转换失败，请手动重命名"
				End If
			End If
		End If
	Next
	
	'对文件夹名称进行转换(由子目录到父目录)
	For Each oPath In arrPath
		If fso.FolderExists(CStr(oPath)) Then
			FF = fso.GetFolder(CStr(oPath))
			FD = fso.GetFolder(FF).ParentFolder
			FN = fso.GetFolder(FF).Name
			If lngReturn = vbYes Then
				FN2 = TCSC.SC2TC(FN)
			Else
				FN2 = TCSC.TC2SC(FN)
			End If
			FF2 = FD & "\" & FN2
			If FN <> FN2 Then
				i = 1
				Do While fso.FileExists(FF2)
					i = i + 1
					FF2 = FD & "\" & FN2 & i
				Loop
				fso.GetFolder(FF).Move FF2
				If Err.Number = 0 Then
					WScript.Echo Mid(FF2,Len(strFolder)+1)
				Else
					Err.Clear
					WScript.Echo FF & vbCrLf & "* 转换失败，请手动重命名"
				End If
			End If
		End If
	Next	
	
End Sub


'********************************************************************************
' 流览文件夹
'********************************************************************************
Function BrowseForFolder(ByVal strTips)
	Dim objFolder
	Set objFolder = CreateObject("Shell.Application").BrowseForFolder (&H0, strTips, &H0010 + &H0001)
	If (Not objFolder Is Nothing) Then BrowseForFolder = objFolder.Self.Path  'objFolder.Items().Item().Path
End Function


'********************************************************************************
' 获取文件夹所有文件、文件夹清单(数组)
'********************************************************************************
Function ScanFolder(ByVal strDir)
	If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
	Dim arr() : ReDim Preserve arr(0) : arr(0) = strDir
	Call SCAN_FOLDER(arr, strDir) : ScanFolder = ArraySort(arr) '倒序排列
End Function
'********************************************************************************
Function SCAN_FOLDER(ByRef arr, ByVal strDir)
'********************************************************************************
	On Error Resume Next
	Dim fso, objItems, objFile, objFolder
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set objItems = fso.GetFolder(strDir)
	If (Not fso.FolderExists(strDir)) Then Exit Function
	For Each objFile In objItems.Files
		ReDim Preserve arr(UBound(arr) + 1)
		arr(UBound(arr)) = objFile.Path
	Next
	For Each objFolder In objItems.subfolders
		ReDim Preserve arr(UBound(arr) + 1)
		arr(UBound(arr)) = objFolder.Path & "\"
		Call SCAN_FOLDER(arr, objFolder.Path & "\")
	Next
End Function
'********************************************************************************
Function ArraySort(ByVal arr)
'********************************************************************************
	Dim i, j, tmp
	For i=1 To UBound(arr)
		For j=i To 1 Step -1
			If CStr(arr(j))>CStr(arr(j-1)) Then
				tmp=arr(j) : arr(j)=arr(j-1) : arr(j-1)=tmp
			End If
		Next
	Next
	ArraySort = arr
End Function


'********************************************************************************
' 以命令提示符环境运行(保留参数)
'********************************************************************************
Sub CommandMode(ByVal sTitle)
	Dim sCommand, oArg, sArgs
	If InStr(1, WScript.FullName, "\cscript.exe", vbTextCompare) > 0 Then Exit Sub
	For Each oArg In WScript.Arguments: sArgs = sArgs & " " & """" & oArg & """": Next
	CreateObject("WScript.Shell").Run "%Comspec% /c title " & sTitle & " & cscript.exe" & _
		" //NoLogo """ & WScript.ScriptFullName & """" & sArgs & " & pause", 1, False
	WScript.Quit(0)
End Sub


'********************************************************************************
'繁简转换类（依赖Office Word）--在 demon 版本上修改： http://demon.tw/my-work/vbs-tcscconverter-class.html
'********************************************************************************
Class TCSCConverter
	Private Word, Doc
	Private Sub Class_Initialize()
		On Error Resume Next
		Const msoAutomationSecurityForceDisable = 3
		Set Word = CreateObject("Word.Application")
		If Not Err.Number = 0 Then
			Msgbox "错误：无法创建 Office VBA 物件，请安装 Office  ...", vbCritical, WScript.ScriptName
			WScript.Quit(999)
		End If
		If Not Word.Application.Version >= 12.0 Then
			Msgbox "警告：请使用 Office 2007 以上版本。", vbExclamation, WScript.ScriptName
		End If
		Word.Visible = False: Word.DisplayAlerts = False
		Word.AutomationSecurity = msoAutomationSecurityForceDisable
		Set Doc = Word.Documents.Add
		On Error Goto 0
	End Sub
	Private Sub Class_Terminate()
		Doc.Content = ""
		Doc.Close False
		Word.Quit
		Set Doc = Nothing
		Set Word = Nothing
	End Sub
	'Traditional Chinese To Simplified Chinese
	Public Function TC2SC(str)
		Doc.Content = str
		Doc.Content.TCSCConverter 1, True, True
		TC2SC = Replace(Doc.Content, vbCr, vbCrLf)
		TC2SC = Left(TC2SC, Len(TC2SC) - 2)
	End Function
	'Simplified Chinese To Traditional Chinese
	Public Function SC2TC(str)
		Doc.Content = str
		Doc.Content.TCSCConverter 0, True, True
		SC2TC = Replace(Doc.Content, vbCr, vbCrLf)
		SC2TC = Left(SC2TC, Len(SC2TC) - 2)
	End Function
End Class
复制代码

yu2n

更新：使用内建对照表，转码函数纯手打，VB6 可直接使用不乱码。解决部分繁体字在繁体系统下不显示的问题… 真是奇葩的BUG…

' 名称：VBS 文件、文件夹名称繁简转换(使用内建对照表)
' 功能：将指定目录中所有的文件、文件夹名称做繁转简、简繁转处理。
' 环境：WinXP/7/8/10
' 作者：Yu2n
' 开发语言：VBS
' 适用人群：
' 1. 使用繁体系统，需要导入简体资料的。



Option Explicit

Main
'********************************************************************************
Sub Main()
'********************************************************************************

	Dim fso
	Dim strFolder, arrPath, oPath, strPath, i
	Dim lngReturn
	Dim FF, FD, FN, FX, FNX, FN2, FF2
	
	'命令行模式
	Call CommandMode(WScript.ScriptName)
	
	'选择文件夹
	WScript.Echo "> 请选择文件夹位置："
	strFolder = BrowseForFolder("请选择文件夹位置：")
	If strFolder = "" Then Exit Sub
	WScript.Echo "# " & strFolder
	arrPath = ScanFolder(strFolder)
	
	'选择模式
	lngReturn = Msgbox("请选择模式：" & vbLf & vbLf & _
		"【是(Y)】简体转繁体" & vbLf & _
		"【否(N)】繁体转简体" & vbLf & _
		"【取 消】不进行转换", vbQuestion+vbYesNoCancel+vbDefaultButton3, WScript.ScriptName)
	If lngReturn = vbCancel Then Exit Sub
	
	'对文件名称进行转换
	On Error Resume Next
	Set fso = CreateObject("Scripting.FileSystemObject")	
	For Each oPath In arrPath
		If fso.FileExists(CStr(oPath)) Then
			FF = fso.GetFile(CStr(oPath))
			FD = fso.GetFile(FF).ParentFolder
			FX = fso.GetExtensionName(FF)
			FNX = fso.GetFile(FF).Name 
			FN = Left(FNX,Len(FNX)-Len(FX))
			If lngReturn = vbYes Then
				FN2 = tran(FN, "t")
			Else
				FN2 = tran(FN, "s")
			End If
			If FN <> FN2 Then
				i = 1
				FF2 = FD & "\" & FN2 & FX
				Do While fso.FileExists(FF2)
					i = i + 1
					FF2 = FD & "\" & FN2 & i & FX
				Loop
				fso.GetFile(FF).Move FF2
				If Err.Number = 0 Then
					WScript.Echo Mid(FF2,Len(strFolder)+1)
				Else
					Err.Clear
					WScript.Echo FF & vbCrLf & "* 转换失败，请手动重命名"
				End If
			End If
		End If
	Next
	
	'对文件夹名称进行转换(由子目录到父目录)
	For Each oPath In arrPath
		If fso.FolderExists(CStr(oPath)) Then
			FF = fso.GetFolder(CStr(oPath))
			FD = fso.GetFolder(FF).ParentFolder
			FN = fso.GetFolder(FF).Name
			If lngReturn = vbYes Then
				FN2 = TCSC.SC2TC(FN)
			Else
				FN2 = TCSC.TC2SC(FN)
			End If
			FF2 = FD & "\" & FN2
			If FN <> FN2 Then
				i = 1
				Do While fso.FileExists(FF2)
					i = i + 1
					FF2 = FD & "\" & FN2 & i
				Loop
				fso.GetFolder(FF).Move FF2
				If Err.Number = 0 Then
					WScript.Echo Mid(FF2,Len(strFolder)+1)
				Else
					Err.Clear
					WScript.Echo FF & vbCrLf & "* 转换失败，请手动重命名"
				End If
			End If
		End If
	Next	
	
End Sub


'********************************************************************************
' 流览文件夹
'********************************************************************************
Function BrowseForFolder(ByVal strTips)
	Dim objFolder
	Set objFolder = CreateObject("Shell.Application").BrowseForFolder (&H0, strTips, &H0010 + &H0001)
	If (Not objFolder Is Nothing) Then BrowseForFolder = objFolder.Self.Path  'objFolder.Items().Item().Path
End Function


'********************************************************************************
' 获取文件夹所有文件、文件夹清单(数组)
'********************************************************************************
Function ScanFolder(ByVal strDir)
	If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
	Dim arr() : ReDim Preserve arr(0) : arr(0) = strDir
	Call SCAN_FOLDER(arr, strDir) : ScanFolder = ArraySort(arr) '倒序排列
End Function
'********************************************************************************
Function SCAN_FOLDER(ByRef arr, ByVal strDir)
'********************************************************************************
	On Error Resume Next
	Dim fso, objItems, objFile, objFolder
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set objItems = fso.GetFolder(strDir)
	If (Not fso.FolderExists(strDir)) Then Exit Function
	For Each objFile In objItems.Files
		ReDim Preserve arr(UBound(arr) + 1)
		arr(UBound(arr)) = objFile.Path
	Next
	For Each objFolder In objItems.subfolders
		ReDim Preserve arr(UBound(arr) + 1)
		arr(UBound(arr)) = objFolder.Path & "\"
		Call SCAN_FOLDER(arr, objFolder.Path & "\")
	Next
End Function
'********************************************************************************
Function ArraySort(ByVal arr)
'********************************************************************************
	Dim i, j, tmp
	For i=1 To UBound(arr)
		For j=i To 1 Step -1
			If CStr(arr(j))>CStr(arr(j-1)) Then
				tmp=arr(j) : arr(j)=arr(j-1) : arr(j-1)=tmp
			End If
		Next
	Next
	ArraySort = arr
End Function


'********************************************************************************
'中文簡繁轉換 (BIG5: 19968~40860, GB: 19968~40863)
'********************************************************************************
'繁体簡体對照字表(Win7繁體系統可識別繁體字1342組(必轉字1222組+可轉可不轉120組), 繁體系統無法識別的繁體字29組, YY統計于2018.12.31)
Function tran(ByVal sText, ByVal zh_choose)
	Dim zh_t, zh_s
    zh_t = "\u4E09\u4E1F\u4E82\u4E9E\u4F86\u4F96\u4FB6\u4FE0\u5006\u5009\u500B\u5011\u502B\u5049\u5074\u5075\u5098\u5099\u50B3\u50B5\u50B7\u50BE\u50C5\u50D1\u50DE\u50E5\u5100\u5104\u5108\u5109\u511F\u5132\u5137\u514C\u5167\u5169\u518A\u51AA\u51CD\u51DC\u51F1\u5225\u522A\u5247\u525B\u525D\u526E\u5275\u5287\u5289\u528A\u528D\u5291\u52C1\u52D5\u52D9\u52DE\u52E2\u52F3\u52F5\u52F8\u52FB\u532F\u5340\u5354\u537B\u537B\u53AD\u53B2\u53C3\u53E2\u5433\u5442\u54E1\u554F\u5553\u555E\u555F\u559A\u55AA\u55AC\u55AE\u55B2\u55C6\u55CE\u55DA\u5614\u5617\u5629\u562F\u5653\u5674\u5687\u56A8\u56B4\u56C2\u56D1\u56EA\u570B\u570D\u5712\u5713\u5716\u5718\u57F7\u5805\u582F\u5831\u5834\u583F\u584A\u5862\u5875\u5879\u588A\u589C\u58AE\u58B3\u58BE\u58C7" & _
           "\u58D3\u58D8\u58DF\u58E9\u58EF\u58FA\u58FD\u5920\u5922\u593E\u5967\u596A\u596E\u599D\u5A1B\u5A41\u5A66\u5ABD\u5B0C\u5B30\u5B38\u5B6B\u5B78\u5B7F\u5BAE\u5BE2\u5BE6\u5BE9\u5BEB\u5BEC\u5BF5\u5BF6\u5C07\u5C08\u5C0B\u5C0D\u5C0E\u5C46\u5C5C\u5C62\u5C64\u5C6C\u5CA1\u5CF6\u5CFD\u5D17\u5D84\u5DBC\u5DCB\u5DD2\u5E25\u5E2B\u5E33\u5E36\u5E40\u5E5F\u5E63\u5E6B\u5EAB\u5EC1\u5EC2\u5EC4\u5EC8\u5EDA\u5EDF\u5EE2\u5EE3\u5EEC\u5EF3\u5F35\u5F37\u5F48\u5F4C\u5F4E\u5F59\u5F65\u5F91\u5F9E\u5FB9\u6065\u6085\u60B6\u60E1\u60F1\u611B\u614B\u6158\u615A\u6163\u616B\u616E\u6176\u6182\u618A\u6191\u619A\u61A4\u61AB\u61B2\u61B6\u61C7\u61C9\u61F2\u61F6\u61F8\u61FC\u61FE\u6200\u6230\u6232\u6236\u633E\u6383\u6384\u6399\u63C0\u63DA\u63DB\u63EE\u640D" & _
           "\u6416\u6417\u6436\u645F\u646F\u6473\u647B\u6488\u6490\u6493\u64A3\u64A5\u64AB\u64BB\u64BE\u64BF\u64C1\u64C4\u64C7\u64CA\u64CB\u64D4\u64E0\u64EC\u64EF\u64F0\u64F1\u64F2\u64F4\u64FA\u64FB\u6506\u650F\u6514\u6519\u651C\u651D\u6522\u6523\u6524\u652A\u652C\u6557\u6558\u6575\u6578\u6582\u6583\u65AC\u65B7\u6642\u6649\u665D\u6688\u6689\u66A2\u66AB\u66C4\u66C6\u66C9\u66E0\u66F8\u6703\u6771\u67F5\u689D\u68C4\u68D7\u68DF\u68E7\u694A\u6953\u696D\u69AE\u69CD\u69F3\u6A01\u6A02\u6A13\u6A19\u6A1E\u6A23\u6A39\u6A4B\u6A62\u6A6B\u6A94\u6AA2\u6AB8\u6ABB\u6AE5\u6AFB\u6B04\u6B0A\u6B16\u6B3D\u6B4E\u6B50\u6B61\u6B72\u6B78\u6B98\u6BB2\u6BBA\u6BBC\u6BC0\u6BC6\u6C08\u6C2B\u6C7A\u6C92\u6C96\u6CC1\u6D36\u6DBC\u6DDA\u6DE8\u6DEA\u6DF5\u6DFA" & _
           "\u6E19\u6E1B\u6E26\u6E2C\u6E3E\u6E4A\u6E6F\u6E9D\u6EAB\u6EC4\u6EC5\u6ECC\u6ECE\u6ED9\u6EEC\u6EEF\u6EF2\u6EFE\u6EFF\u6F01\u6F1A\u6F22\u6F23\u6F2C\u6F32\u6F38\u6F3F\u6F51\u6F5B\u6F64\u6F70\u6F80\u6F86\u6F87\u6F97\u6FA4\u6FC1\u6FC3\u6FD5\u6FDF\u6FE4\u6FEB\u6FF0\u6FF1\u6FFA\u6FFE\u7009\u7015\u701D\u703E\u7058\u705D\u7063\u7064\u707D\u70BA\u70CF\u70F4\u7121\u7149\u7152\u7159\u7165\u7169\u7192\u71B1\u71BE\u71C8\u71D2\u71D9\u71DF\u71E6\u71ED\u71F4\u71FC\u720D\u7210\u721B\u722D\u7232\u723A\u723E\u7246\u727D\u72A2\u72A7\u72C0\u72F9\u72FD\u7319\u7336\u7344\u7345\u734E\u7368\u7370\u7372\u7375\u7378\u737A\u737B\u73FE\u743A\u7463\u7464\u7469\u746A\u74B0\u74CA\u7522\u7523\u755D\u7562\u756B\u7576\u7587\u758A\u75D9\u760B\u760D" & _
           "\u7613\u7621\u7627\u7642\u765F\u766C\u7670\u7671\u767C\u769A\u76BA\u76DC\u76DE\u76E1\u76E3\u76E4\u76E7\u775C\u779E\u77DA\u77EF\u786F\u78A9\u78BC\u78DA\u790E\u7919\u7926\u792B\u792C\u797F\u798D\u79AA\u79AE\u79B1\u79BF\u7A05\u7A08\u7A31\u7A4D\u7A4E\u7A62\u7A69\u7AA9\u7AAE\u7AAF\u7ABA\u7AC4\u7AC5\u7ACA\u7AF6\u7B46\u7B4D\u7B8B\u7BC0\u7BE9\u7C0D\u7C21\u7C3D\u7C43\u7C4C\u7C60\u7C6E\u7CB5\u7CDE\u7CE7\u7CFE\u7D00\u7D04\u7D05\u7D09\u7D0B\u7D0D\u7D10\u7D14\u7D17\u7D19\u7D1A\u7D1B\u7D21\u7D30\u7D33\u7D39\u7D42\u7D44\u7D46\u7D50\u7D55\u7D5E\u7D61\u7D62\u7D66\u7D68\u7D71\u7D72\u7D79\u7D81\u7D8F\u7D93\u7D9C\u7DA0\u7DA2\u7DAD\u7DB1\u7DB4\u7DB8\u7DBA\u7DBB\u7DBD\u7DBE\u7DBF\u7DCA\u7DD2\u7DD8\u7DDA\u7DDD\u7DDE\u7DE0\u7DE3\u7DE8" & _
           "\u7DE9\u7DEC\u7DEF\u7DF4\u7E1B\u7E23\u7E27\u7E2B\u7E2E\u7E31\u7E37\u7E3D\u7E3E\u7E43\u7E54\u7E55\u7E5E\u7E61\u7E69\u7E6A\u7E73\u7E79\u7E7C\u7E7D\u7E8C\u7E8F\u7E93\u7E96\u7E9C\u7F3D\u7F4C\u7F70\u7F75\u7F77\u7F85\u7FA9\u7FD2\u7FF9\u805E\u806F\u8070\u8072\u8073\u8076\u8077\u807E\u8085\u8105\u8108\u812B\u8139\u814E\u8166\u816B\u8173\u8178\u819A\u81A0\u81A9\u81BD\u81BF\u81C9\u81CD\u81E5\u81E8\u8208\u8209\u820A\u8259\u8266\u8271\u8277\u8332\u834A\u8396\u83A2\u83EF\u840A\u8449\u8457\u8466\u8477\u84BC\u84CB\u84EE\u8523\u8525\u852D\u8569\u856A\u856D\u858A\u8594\u85A9\u85CD\u85DD\u85E5\u85F9\u8606\u8607\u860A\u8622\u862D\u863F\u8655\u865B\u865C\u865F\u8667\u86FB\u8755\u8766\u8778\u879E\u87A2\u87C4\u87EC\u87FB\u8805\u8831" & _
           "\u883B\u8846\u8853\u885B\u88DC\u88DD\u8932\u8956\u896A\u896F\u8972\u898B\u898F\u8993\u8996\u89AA\u89BA\u89BD\u89C0\u8A02\u8A03\u8A08\u8A0A\u8A0E\u8A13\u8A16\u8A18\u8A1B\u8A1D\u8A1F\u8A23\u8A2A\u8A2D\u8A31\u8A34\u8A3A\u8A50\u8A55\u8A5B\u8A5E\u8A60\u8A62\u8A63\u8A66\u8A69\u8A6B\u8A6D\u8A71\u8A72\u8A73\u8A85\u8A8D\u8A95\u8A98\u8A9E\u8AA0\u8AA1\u8AA3\u8AA4\u8AA6\u8AA8\u8AAA\u8AB0\u8AB2\u8AB9\u8ABC\u8ABF\u8AC4\u8AC7\u8ACB\u8AD2\u8AD6\u8ADC\u8AE7\u8AF1\u8AF7\u8AF8\u8AFA\u8AFE\u8B00\u8B02\u8B04\u8B05\u8B0A\u8B0E\u8B17\u8B19\u8B1B\u8B1D\u8B20\u8B2C\u8B39\u8B3E\u8B49\u8B4F\u8B58\u8B5A\u8B5C\u8B6F\u8B70\u8B74\u8B77\u8B7D\u8B80\u8B8A\u8B92\u8B93\u8B95\u8C48\u8C4E\u8C54\u8C6C\u8C93\u8C9D\u8C9E\u8CA0\u8CA1\u8CA2\u8CA7\u8CA8" & _
           "\u8CA9\u8CAA\u8CAB\u8CAC\u8CAF\u8CB3\u8CB4\u8CB6\u8CB7\u8CB8\u8CBB\u8CBC\u8CBF\u8CC0\u8CC2\u8CC3\u8CC4\u8CC7\u8CC8\u8CCA\u8CD2\u8CD3\u8CDC\u8CDE\u8CE0\u8CE2\u8CE3\u8CE4\u8CE6\u8CEA\u8CEC\u8CED\u8CF4\u8CFA\u8CFC\u8CFD\u8D05\u8D08\u8D0A\u8D0D\u8D0F\u8D13\u8D16\u8D1B\u8D99\u8DA8\u8E10\u8E64\u8E8A\u8E8D\u8EA5\u8EC0\u8ECA\u8ECB\u8ECC\u8ECD\u8ED2\u8EDF\u8EF8\u8F03\u8F09\u8F14\u8F15\u8F1B\u8F1D\u8F25\u8F29\u8F2A\u8F2F\u8F38\u8F3B\u8F3E\u8F3F\u8F44\u8F45\u8F49\u8F4D\u8F4E\u8F5F\u8FA6\u8FAD\u8FAE\u8FAF\u8FB2\u9019\u9023\u9032\u9035\u904B\u904E\u9055\u9059\u905C\u905E\u9060\u9072\u9077\u9078\u907A\u907C\u9081\u9084\u908A\u908F\u90F5\u9109\u9112\u9116\u9127\u912D\u9130\u9132\u919E\u91AB\u91AC\u91C0\u91C1\u91CB\u91D8\u91DD" & _
           "\u91E3\u91E9\u91FA\u9209\u920D\u920E\u9214\u9215\u921E\u9223\u9234\u923E\u9240\u9251\u9257\u925A\u925B\u9278\u927B\u9280\u9285\u9291\u9298\u929C\u92A5\u92B3\u92B7\u92B9\u92BB\u92C1\u92C5\u92C7\u92D2\u92E4\u92EA\u92F8\u92FC\u9304\u9310\u9318\u9320\u9322\u9326\u9328\u932B\u932F\u9333\u9341\u934B\u934D\u9358\u935A\u935B\u936C\u9375\u937A\u937E\u9382\u938A\u9396\u93A2\u93AC\u93AE\u93B3\u93C8\u93DF\u93E1\u93FD\u9410\u9418\u942E\u9433\u9435\u9444\u9452\u9470\u9472\u9477\u947C\u947D\u947F\u9577\u9580\u9583\u9589\u958B\u958F\u9591\u9593\u9594\u9598\u95A1\u95A3\u95A5\u95A8\u95A9\u95B1\u95B9\u95BB\u95CA\u95CC\u95D6\u95DC\u95E1\u965D\u9663\u9670\u9673\u9678\u967D\u968A\u968E\u9695\u969B\u96A8\u96AA\u96B1\u96B4\u96B8\u96D6" & _
           "\u96D9\u96DB\u96DC\u96DE\u96E3\u96FB\u9727\u9748\u975C\u978F\u97CB\u97CC\u97D3\u97FB\u97FF\u9801\u9802\u9803\u9805\u9806\u9808\u980C\u9810\u9811\u9812\u9813\u9817\u9818\u9824\u982D\u9830\u9838\u9839\u983B\u9846\u984C\u984D\u984F\u9854\u985B\u985E\u9867\u986B\u986F\u9871\u9874\u98A8\u98C4\u98DB\u98EF\u98F2\u98FC\u98FD\u98FE\u9903\u9905\u990A\u990C\u9912\u9913\u991E\u9921\u9928\u993E\u9945\u994B\u9951\u9952\u995E\u99AC\u99AD\u99AE\u99B1\u99B3\u99B4\u99C1\u99D0\u99D2\u99D5\u99DB\u99DD\u99ED\u99F1\u99FF\u9A01\u9A0E\u9A19\u9A30\u9A37\u9A3E\u9A45\u9A55\u9A57\u9A5F\u9A62\u9AD2\u9AEE\u9B27\u9B5A\u9B6F\u9B91\u9BAE\u9BC9\u9BE8\u9C13\u9C57\u9C77\u9CE5\u9CF3\u9CF4\u9D09\u9D15\u9D1B\u9D26\u9D28\u9D3B\u9D3F\u9D51\u9D5D\u9D6C" & _
           "\u9D72\u9DB4\u9DD7\u9DF9\u9E75\u9E7C\u9E7D\u9E97\u9EA5\u9EC3\u9EDE\u9F08\u9F4A\u9F4B\u9F52\u9F61\u9F67\u9F72\u9F8D\u9F90\u9F94\u9F9C" ' 必轉字 1222 組
    zh_s = "\u53C1\u4E22\u4E71\u4E9A\u6765\u4ED1\u4FA3\u4FA0\u4FE9\u4ED3\u4E2A\u4EEC\u4F26\u4F1F\u4FA7\u4FA6\u4F1E\u5907\u4F20\u503A\u4F24\u503E\u4EC5\u4FA8\u4F2A\u4FA5\u4EEA\u4EBF\u4FA9\u4FED\u507F\u50A8\u4FEA\u5151\u5185\u4E24\u518C\u5E42\u51BB\u51DB\u51EF\u522B\u5220\u5219\u521A\u5265\u5250\u521B\u5267\u5218\u523D\u5251\u5242\u52B2\u52A8\u52A1\u52B3\u52BF\u52CB\u52B1\u529D\u5300\u6C47\u533A\u534F\u5374\u90C4\u538C\u5389\u53C2\u4E1B\u5434\u5415\u5458\u95EE\u542F\u54D1\u542F\u5524\u4E27\u4E54\u5355\u54DF\u545B\u5417\u545C\u5455\u5C1D\u54D7\u5578\u5618\u55B7\u5413\u5499\u4E25\u56A3\u5631\u56F1\u56FD\u56F4\u56ED\u5706\u56FE\u56E2\u6267\u575A\u5C27\u62A5\u573A\u78B1\u5757\u575E\u5C18\u5811\u57AB\u5760\u5815\u575F\u57A6\u575B" & _
           "\u538B\u5792\u5784\u575D\u58EE\u58F6\u5BFF\u591F\u68A6\u5939\u5965\u593A\u594B\u5986\u5A31\u5A04\u5987\u5988\u5A07\u5A74\u5A76\u5B59\u5B66\u5B6A\u5BAB\u5BDD\u5B9E\u5BA1\u5199\u5BBD\u5BA0\u5B9D\u5C06\u4E13\u5BFB\u5BF9\u5BFC\u5C4A\u5C49\u5C61\u5C42\u5C5E\u5188\u5C9B\u5CE1\u5C97\u5D2D\u5C7F\u5CBF\u5CE6\u5E05\u5E08\u5E10\u5E26\u5E27\u5E1C\u5E01\u5E2E\u5E93\u5395\u53A2\u53A9\u53A6\u53A8\u5E99\u5E9F\u5E7F\u5E90\u5385\u5F20\u5F3A\u5F39\u5F25\u5F2F\u6C47\u5F66\u5F84\u4ECE\u5F7B\u803B\u60A6\u95F7\u6076\u607C\u7231\u6001\u60E8\u60ED\u60EF\u6002\u8651\u5E86\u5FE7\u60EB\u51ED\u60EE\u6124\u60AF\u5BAA\u5FC6\u6073\u5E94\u60E9\u61D2\u60AC\u60E7\u6151\u604B\u6218\u620F\u6237\u631F\u626B\u62A1\u6323\u62E3\u626C\u6362\u6325\u635F" & _
           "\u6447\u6363\u62A2\u6402\u631A\u62A0\u63BA\u635E\u6491\u6320\u63B8\u62E8\u629A\u631E\u631D\u6361\u62E5\u63B3\u62E9\u51FB\u6321\u62C5\u6324\u62DF\u6448\u62E7\u6401\u63B7\u6269\u6446\u64DE\u64B5\u62E2\u62E6\u6400\u643A\u6444\u6512\u631B\u644A\u6405\u63FD\u8D25\u53D9\u654C\u6570\u655B\u6BD9\u65A9\u65AD\u65F6\u664B\u663C\u6655\u6656\u7545\u6682\u6654\u5386\u6653\u65F7\u4E66\u4F1A\u4E1C\u6805\u6761\u5F03\u67A3\u680B\u6808\u6768\u67AB\u4E1A\u8363\u67AA\u6868\u6869\u4E50\u697C\u6807\u67A2\u6837\u6811\u6865\u692D\u6A2A\u6863\u68C0\u67E0\u69DB\u6A71\u6A31\u680F\u6743\u6984\u94A6\u53F9\u6B27\u6B22\u5C81\u5F52\u6B8B\u6B7C\u6740\u58F3\u6BC1\u6BB4\u6BE1\u6C22\u51B3\u6CA1\u51B2\u51B5\u6C79\u51C9\u6CEA\u51C0\u6CA6\u6E0A\u6D45" & _
           "\u6DA3\u51CF\u6DA1\u6D4B\u6D51\u51D1\u6C64\u6C9F\u6E29\u6CA7\u706D\u6DA4\u8365\u6C47\u6CAA\u6EDE\u6E17\u6EDA\u6EE1\u6E14\u6CA4\u6C49\u6D9F\u6E0D\u6DA8\u6E10\u6D46\u6CFC\u6F5C\u6DA6\u6E83\u6DA9\u6D47\u6D9D\u6DA7\u6CFD\u6D4A\u6D53\u6E7F\u6D4E\u6D9B\u6EE5\u6F4D\u6EE8\u6E85\u6EE4\u6CFB\u6FD2\u6CA5\u6F9C\u6EE9\u704F\u6E7E\u6EE6\u707E\u4E3A\u4E4C\u70C3\u65E0\u70BC\u709C\u70DF\u7115\u70E6\u8367\u70ED\u70BD\u706F\u70E7\u70EB\u8425\u707F\u70DB\u70E9\u70EC\u70C1\u7089\u70C2\u4E89\u4E3A\u7237\u5C14\u5899\u7275\u728A\u727A\u72B6\u72ED\u72C8\u72F0\u72B9\u72F1\u72EE\u5956\u72EC\u72DE\u83B7\u730E\u517D\u736D\u732E\u73B0\u73D0\u7410\u7476\u83B9\u739B\u73AF\u743C\u4EA7\u4EA7\u4EA9\u6BD5\u753B\u5F53\u7574\u53E0\u75C9\u75AF\u75A1" & _
           "\u75EA\u75AE\u759F\u7597\u762A\u7663\u75C8\u762B\u53D1\u7691\u76B1\u76D7\u76CF\u5C3D\u76D1\u76D8\u5362\u7741\u7792\u77A9\u77EB\u781A\u7855\u7801\u7816\u7840\u788D\u77FF\u783E\u77FE\u7984\u7978\u7985\u793C\u7977\u79C3\u7A0E\u79C6\u79F0\u79EF\u9896\u79FD\u7A33\u7A9D\u7A77\u7A91\u7AA5\u7A9C\u7A8D\u7A83\u7ADE\u7B14\u7B0B\u7B3A\u8282\u7B5B\u7BD3\u7B80\u7B7E\u7BEE\u7B79\u7B3C\u7BA9\u7CA4\u7CAA\u7CAE\u7EA0\u7EAA\u7EA6\u7EA2\u7EAB\u7EB9\u7EB3\u7EBD\u7EAF\u7EB1\u7EB8\u7EA7\u7EB7\u7EBA\u7EC6\u7EC5\u7ECD\u7EC8\u7EC4\u7ECA\u7ED3\u7EDD\u7EDE\u7EDC\u7EDA\u7ED9\u7ED2\u7EDF\u4E1D\u7EE2\u7ED1\u7EE5\u7ECF\u7EFC\u7EFF\u7EF8\u7EF4\u7EB2\u7F00\u7EB6\u7EEE\u7EFD\u7EF0\u7EEB\u7EF5\u7D27\u7EEA\u7F04\u7EBF\u7F09\u7F0E\u7F14\u7F18\u7F16" & _
           "\u7F13\u7F05\u7EAC\u7EC3\u7F1A\u53BF\u7EE6\u7F1D\u7F29\u7EB5\u7F15\u603B\u7EE9\u7EF7\u7EC7\u7F2E\u7ED5\u7EE3\u7EF3\u7ED8\u7F34\u7ECE\u7EE7\u7F24\u7EED\u7F20\u7F28\u7EA4\u7F06\u94B5\u7F42\u7F5A\u9A82\u7F62\u7F57\u4E49\u4E60\u7FD8\u95FB\u8054\u806A\u58F0\u8038\u8042\u804C\u804B\u8083\u80C1\u8109\u8131\u80C0\u80BE\u8111\u80BF\u811A\u80A0\u80A4\u80F6\u817B\u80C6\u8113\u8138\u8110\u5367\u4E34\u5174\u4E3E\u65E7\u8231\u8230\u8270\u8273\u5179\u8346\u830E\u835A\u534E\u83B1\u53F6\u7740\u82C7\u8364\u82CD\u76D6\u83B2\u848B\u8471\u836B\u8361\u829C\u8427\u84DF\u8537\u8428\u84DD\u827A\u836F\u853C\u82A6\u82CF\u8574\u830F\u5170\u841D\u5904\u865A\u864F\u53F7\u4E8F\u8715\u8680\u867E\u8717\u8682\u8424\u86F0\u8749\u8681\u8747\u86CA" & _
           "\u86EE\u4F17\u672F\u536B\u8865\u88C5\u88E4\u8884\u889C\u886C\u88AD\u89C1\u89C4\u89C5\u89C6\u4EB2\u89C9\u89C8\u89C2\u8BA2\u8BA3\u8BA1\u8BAF\u8BA8\u8BAD\u8BAB\u8BB0\u8BB9\u8BB6\u8BBC\u8BC0\u8BBF\u8BBE\u8BB8\u8BC9\u8BCA\u8BC8\u8BC4\u8BC5\u8BCD\u548F\u8BE2\u8BE3\u8BD5\u8BD7\u8BE7\u8BE1\u8BDD\u8BE5\u8BE6\u8BDB\u8BA4\u8BDE\u8BF1\u8BED\u8BDA\u8BEB\u8BEC\u8BEF\u8BF5\u8BF2\u8BF4\u8C01\u8BFE\u8BFD\u8C0A\u8C03\u8C06\u8C08\u8BF7\u8C05\u8BBA\u8C0D\u8C10\u8BB3\u8BBD\u8BF8\u8C1A\u8BFA\u8C0B\u8C13\u8A8A\u8BCC\u8C0E\u8C1C\u8C24\u8C26\u8BB2\u8C22\u8C23\u8C2C\u8C28\u8C29\u8BC1\u8BA5\u8BC6\u8C2D\u8C31\u8BD1\u8BAE\u8C34\u62A4\u8A89\u8BFB\u53D8\u8C17\u8BA9\u8C30\u5C82\u7AD6\u8273\u732A\u732B\u8D1D\u8D1E\u8D1F\u8D22\u8D21\u8D2B\u8D27" & _
           "\u8D29\u8D2A\u8D2F\u8D23\u8D2E\u8D30\u8D35\u8D2C\u4E70\u8D37\u8D39\u8D34\u8D38\u8D3A\u8D42\u8D41\u8D3F\u8D44\u8D3E\u8D3C\u8D4A\u5BBE\u8D50\u8D4F\u8D54\u8D24\u5356\u8D31\u8D4B\u8D28\u8D26\u8D4C\u8D56\u8D5A\u8D2D\u8D5B\u8D58\u8D60\u8D5E\u8D61\u8D62\u8D43\u8D4E\u8D63\u8D75\u8D8B\u8DF5\u8E2A\u8E0C\u8DC3\u8E7F\u8EAF\u8F66\u8F67\u8F68\u519B\u8F69\u8F6F\u8F74\u8F83\u8F7D\u8F85\u8F7B\u8F86\u8F89\u8F8A\u8F88\u8F6E\u8F91\u8F93\u8F90\u8F97\u8206\u8F96\u8F95\u8F6C\u8F99\u8F7F\u8F70\u529E\u8F9E\u8FAB\u8FA9\u519C\u8FD9\u8FDE\u8FDB\u8FBE\u8FD0\u8FC7\u8FDD\u9065\u900A\u9012\u8FDC\u8FDF\u8FC1\u9009\u9057\u8FBD\u8FC8\u8FD8\u8FB9\u903B\u90AE\u4E61\u90B9\u90E7\u9093\u90D1\u90BB\u90F8\u915D\u533B\u9171\u917F\u8845\u91CA\u9489\u9488" & _
           "\u9493\u9492\u948E\u94A0\u949D\u94A9\u949E\u94AE\u94A7\u9499\u94C3\u94C0\u94BE\u94C2\u94B3\u94C6\u94C5\u94F0\u94EC\u94F6\u94DC\u94E3\u94ED\u8854\u94F1\u9510\u9500\u9508\u9511\u94DD\u950C\u94A1\u950B\u9504\u94FA\u952F\u94A2\u5F55\u9525\u9524\u952D\u94B1\u9526\u951A\u9521\u9519\u9530\u9528\u9505\u9540\u94E1\u9496\u953B\u9539\u952E\u9517\u949F\u9541\u9551\u9501\u94A8\u9550\u9547\u954D\u94FE\u94F2\u955C\u9508\u9563\u949F\u9570\u956D\u94C1\u94F8\u9274\u94A5\u9576\u954A\u9523\u94BB\u51FF\u957F\u95E8\u95EA\u95ED\u5F00\u95F0\u95F2\u95F4\u95F5\u95F8\u9602\u9601\u9600\u95FA\u95FD\u9605\u9609\u960E\u9614\u9611\u95EF\u5173\u9610\u9655\u9635\u9634\u9648\u9646\u9633\u961F\u9636\u9668\u9645\u968F\u9669\u9690\u9647\u96B6\u867D" & _
           "\u53CC\u96CF\u6742\u9E21\u96BE\u7535\u96FE\u7075\u9759\u5DE9\u97E6\u97E7\u97E9\u97F5\u54CD\u9875\u9876\u9877\u9879\u987A\u987B\u9882\u9884\u987D\u9881\u987F\u9887\u9886\u9890\u5934\u988A\u9888\u9893\u9891\u9897\u9898\u989D\u989C\u989C\u98A0\u7C7B\u987E\u98A4\u663E\u9885\u98A7\u98CE\u98D8\u98DE\u996D\u996E\u9972\u9971\u9970\u997A\u997C\u517B\u9975\u9981\u997F\u996F\u9985\u9986\u998F\u9992\u9988\u9965\u9976\u998B\u9A6C\u9A6D\u51AF\u9A6E\u9A70\u9A6F\u9A73\u9A7B\u9A79\u9A7E\u9A76\u9A7C\u9A87\u9A86\u9A8F\u9A8B\u9A91\u9A97\u817E\u9A9A\u9AA1\u9A71\u9A84\u9A8C\u9AA4\u9A74\u810F\u53D1\u95F9\u9C7C\u9C81\u9C8D\u9C9C\u9CA4\u9CB8\u9CC3\u9CDE\u9CC4\u9E1F\u51E4\u9E23\u9E26\u9E35\u9E33\u9E2F\u9E2D\u9E3F\u9E3D\u9E43\u9E45\u9E4F" & _
           "\u9E4A\u9E64\u9E25\u9E70\u5364\u7877\u76D0\u4E3D\u9EA6\u9EC4\u70B9\u9CD6\u9F50\u658B\u9F7F\u9F84\u556E\u9F8B\u9F99\u5E9E\u9F9A\u9F9F"
    Const zh_t_p = "\u4E26\u5091\u50AD\u50F9\u512A\u5152\u5283\u5284\u52DD\u53C1\u53E0\u5678\u5857\u58DE\u5925\u5BE7\u5C4D\u5DBA\u5DBD\u5E79\u5E7E\u5EE0\u5F5C\u5F8C\u5FA9\u6046\u6190\u61F7\u6261\u6372\u647A\u649A\u64B2\u64DA\u64E1\u64FE\u65BC\u6607\u66EC\u68F2\u6975\u69CB\u6A38\u6A5F\u6AC3\u6C23\u6C4E\u6C59\u6DD2\u6DE9\u6E67\u6E96\u6F54\u6FB1\u6FD8\u7051\u746F\u7515\u752F\u7570\u7661\u7662\u77FD\u78BA\u7950\u79A6\u7A2D\u7A2E\u7AAA\u7AC8\u7BC4\u7BC9\u7C3E\u7C6C\u7C72\u7D2E\u7DB2\u7E6D\u7FA8\u7FFA\u8056\u807D\u81D8\u81EF\u81FA\u8207\u838A\u842C\u8514\u85A6\u860B\u87F2\u880D\u881F\u8836\u88CF\u88FD\u8907\u89F8\u8A87\u8C50\u8D95\u8E34\u904A\u9069\u919C\u9245\u96E2\u96F2\u9858\u9918\u9A5A\u9AD4\u9B06\u9B25\u9E79\u9EBC\u9EBD\u9EE8\u9EF4" ' 可轉可不轉 120 組
    Const zh_s_p = "\u5E76\u6770\u4F63\u4EF7\u4F18\u513F\u5212\u672D\u80DC\u4E09\u8FED\u5428\u6D82\u574F\u4F19\u5B81\u5C38\u5CAD\u5CB3\u5E72\u51E0\u5382\u5F5D\u540E\u590D\u6052\u601C\u6000\u6266\u5377\u6298\u637B\u6251\u636E\u62AC\u6270\u4E8E\u5347\u6652\u6816\u6781\u6784\u6734\u673A\u67DC\u6C14\u6CDB\u6C61\u51C4\u51CC\u6D8C\u51C6\u6D01\u6DC0\u6CDE\u6D12\u7405\u74EE\u5B81\u5F02\u75F4\u75D2\u7845\u786E\u4F51\u5FA1\u79F8\u79CD\u6D3C\u7076\u8303\u7B51\u5E18\u7BF1\u5401\u624E\u7F51\u8327\u7FA1\u7FF1\u5723\u542C\u814A\u768B\u53F0\u4E0E\u5E84\u4E07\u535C\u8350\u82F9\u866B\u874E\u8721\u8695\u91CC\u5236\u590D\u89E6\u5938\u4E30\u8D76\u8E0A\u6E38\u9002\u4E11\u5DE8\u79BB\u4E91\u613F\u4F59\u60CA\u4F53\u677E\u6597\u54B8\u4E48\u4E48\u515A\u9709"
    Const zh_t_u1 = "\u5088\u50DE\u5239\u53C1\u53E0\u5450\u5553\u5892\u5F5C\u629B\u64E1\u6ED9\u7232\u7523\u7A2D\u7AC8\u7E27\u7FFA\u81EF\u8846\u8FF9\u915E\u9176\u91FA\u920E\u9341\u9854\u9EBD\u9F08" ' 繁體系統(BIG) ANSI 無法識別的字 (29個)
    Const zh_s_u1 = "\u5088\u4F2A\u5239\u4E09\u8FED\u5450\u542F\u5892\u5F5D\u629B\u62AC\u6C47\u4E3A\u4EA7\u79F8\u7076\u7EE6\u7FF1\u768B\u4F17\u8FF9\u915E\u9176\u948E\u94A9\u9528\u989C\u4E48\u9CD6" ' 繁體系統(BIG) ANSI 無法識別的字 - 簡體對照 (29個)
    Const zh_t_u2 = "\u50F3\u507D\u524E\u53C2\u758A\u5436\u555F\uFF1F\u5F5D\u62CB\u62AC\u532F\u70BA\u7522\u79F8\u7076\u7D5B\u7FF1\u768B\u773E\u8DE1\uFF1F\uFF1F\uFF1F\u9264\uFF1F\u984F\u4E48\u9C49" ' 繁體系統(BIG) ANSI 無法識別的字 - 繁體字修正 (24個) https://hanzi.unihan.com.cn/
    Dim s1, s2, a, l, i, c, p
    If (zh_choose = "t") Then ' 必轉字1222組 + 29個無法識別的字
        s1 = zh_s & zh_t_u1
        s2 = zh_t & zh_t_u2
    ElseIf (zh_choose = "s") Then
        s1 = zh_t & zh_t_u1
        s2 = zh_s & zh_s_u1
    ElseIf (zh_choose = "tf") Then ' 必轉字1222組 + 可轉可不轉120組 + 29個無法識別的字  注意：此轉換會導致部分人名出現錯字，如:傑杰\餘余。
        s1 = zh_s & zh_s_p & zh_t_u1
        s2 = zh_t & zh_t_p & zh_t_u2
    ElseIf (zh_choose = "sf") Then
        s1 = zh_t & zh_t_p & zh_t_u1
        s2 = zh_s & zh_s_p & zh_s_u1
    Else
        tran = sText
    End If
    s1 = decodeUnicode(s1)
    s2 = decodeUnicode(s2)
    l = Len(sText)
    For i = 1 To l Step 1
        c = Mid(sText, i, 1)
        p = InStr(1, s1, c, vbTextCompare)
        If p > 0 Then
            a = a & Mid(s2, p, 1)
        Else
            a = a & c
        End If
    Next
    tran = a
End Function


'******************************************************************************
Function encodeUnicode(ByVal strTEXT)
'****************************************************************************** encodeUnicode("中國") = "\u4E2D\u570B"
 Dim i, c, s
 For i = 1 To Len(strTEXT) Step 1
     c = Hex(AscW(Mid(strTEXT, i, 1)))
     If Len(c) > 2 Then
        s = s & "\u" & c
     Else
        s = s & Mid(strTEXT, i, 1)
     End If
 Next
 encodeUnicode = s
End Function


'******************************************************************************
Function decodeUnicode(ByVal strTEXT)
'****************************************************************************** decodeUnicode("\u4E2D\u570B") = "中國"
 Dim i, c, s, a
 a = Split(strTEXT, "\u")
 s = a(0)
 For i = 1 To UBound(a) Step 1
     c = ChrW(CLng("&H" & Left(a(i), 4)))
     s = s & c & Mid(a(i), 5, Len(a(i)))
 Next
 decodeUnicode = s
End Function


'********************************************************************************
' 以命令提示符环境运行(保留参数)
'********************************************************************************
Sub CommandMode(ByVal sTitle)
	Dim sCommand, oArg, sArgs
	If InStr(1, WScript.FullName, "\cscript.exe", vbTextCompare) > 0 Then Exit Sub
	For Each oArg In WScript.Arguments: sArgs = sArgs & " " & """" & oArg & """": Next
	CreateObject("WScript.Shell").Run "%Comspec% /c title " & sTitle & " & cscript.exe" & _
		" //NoLogo """ & WScript.ScriptFullName & """" & sArgs & " & pause", 1, False
	WScript.Quit(0)
End Sub
复制代码

pcl_test

兼容处理名称带Unicode字符的文件和子文件夹、带点的文件夹或不带扩展名的文件同名问题

@echo off
rem 指定目录路径
set "folder=C:\Users\Administrator\Desktop\test"

rem 0为转换文件名，1为转换文件夹名，2为同时转换文件名和文件夹名
set f=2

rem 0为不包括子文件夹，1为包括子文件夹
set r=1

rem 2为繁转简，4为简转繁
set n=2

if not exist "%folder%" (echo;"%folder%" not found&goto end)
echo;"%f%"|>nul findstr "^\"[012]\"$"||(echo;参数错误&goto end)
echo;"%r%"|>nul findstr "^\"[01]\"$"||(echo;参数错误&goto end)
echo;"%n%"|>nul findstr "^\"[24]\"$"||(echo;参数错误&goto end)
set locale=[System.Globalization.Cultureinfo]::CurrentCulture.LCID
if "%folder:~-1%" equ "\" set "folder=%folder:~,-1%"
if "%r%" equ "1" (set r=-recurse) else set "r="
if "%f%" equ "0" (set "f=$_.PSIsContainer -eq $false") else (
    if "%f%" equ "1" (set "f=$_.PSIsContainer -eq $true") else set "f=1 -eq 1"
)

powershell -NoProfile -ExecutionPolicy bypass ^
    $cs='^
        using System;^
        using System.Runtime.InteropServices;^
        public static class ToConvert^
        {^
            [DllImport(\"kernel32\", CharSet = CharSet.Unicode, SetLastError = true)]^
            public static extern int LCMapString(int Locale, int dwMapFlags, string lpSrcStr, int cchSrc, string lpDestStr, int cchDest);^
        }';^
    Add-Type -TypeDefinition $cs;^
    dir -LiteralPath '%folder%' %r%^|?{%f%}^|sort {$_.FullName.Length} -des^|%%{^
        $scr=$_.Name;$len=$scr.Length;$des=' '*$len;^
        [ToConvert]::LCMapString(%locale%, 0x0%n%000000, $scr, $len, $des, $len)^|out-null;^
        if($scr -ne $des){^
            $fd=[IO.Directory]::GetParent($_.FullName).FullName+'\';^
            $newname=$fd+$des;^
            $n=0;^
            while(Test-Path -LiteralPath $newname)^
            {^
                $n++;^
                if($_.PSIsContainer){^
                    $newname=$fd+$des+'_'+$n;^
                }else{^
                    if($des -match '(.+)(\.[^^\.]+$)'){$tmp=$matches[1]+'_'+$n+$matches[2]}else{$tmp=$des+'_'+$n}^
                    $newname=$fd+$tmp;^
                }^
            }^
            mv -LiteralPath $_.FullName $newname;^
            if(Test-Path -LiteralPath $_.FullName){$ts='*转换失败，需手动重命名';}else{$ts=$newname.Split('\')[-1];}^
            write-host ($_.FullName.ToLower().replace('%folder%'.ToLower(),'')+' ==^> '+$ts);^
        }^
    }
:end
pause
复制代码