中国DOS联盟

以前收藏一个全角转半角的VBS脚本，但是不能批量操作，发上来，请高手修改下，使之能对整个目录下的文本文档进行操作。谢谢！要是同时能在Emeditor中调用就更好了。

-------------------------------------------------------------------------------------------------
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile("原文件.txt",1)
Set objOut = objFSO.CreateTextFile("目的文件OK.TXT",True)

Do Until objFile.AtEndOfStream
text = objFile.Read(1)
if text <> "" then
CALL convertstr(text)
end if
objOut.Write(strCharacters)
Loop

function convertstr(content)
Dim SBC,halfSBC,DBC,halfDBC,QJnum,BJnum

SBC = "ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ＇"
halfSBC = "ABCDEFGHIJKLMNOPQRSTUVWXYZ'"
DBC = "ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ"
halfDBC = "abcdefghijklmnopqrstuvwxyz"
QJnum="０１２３４５６７８９"
BJnum="0123456789"

Dim S(27),hS(27),D(26),hD(26),Qnum(27),Bnum(27)

for i = 1 to 27
S(i-1) = mid(SBC,i,1)
hS(i-1) = mid(halfSBC,i,1)

content = replace(content,S(i-1),hS(i-1))

D(i-1) = mid(DBC,i,1)
hD(i-1) = mid(halfDBC,i,1)

content = replace(content,D(i-1),hD(i-1))

Qnum(i-1) = mid(QJnum,i,1)
Bnum(i-1) = mid(BJnum,i,1)

content = replace(content,Qnum(i-1),Bnum(i-1))

next

content = replace(content,chr(13)&chr(10),"<br>")
content = replace(content,"　"," ")
contentstr = content

objOut.write ("")
objOut.write(contentstr)
end function
-------------------------------------------------------------------------------------------------

Last edited by bjsh on 2007-7-31 at 11:16 AM ]

'只对当前目录有效

QJ=Split("Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ Ｉ Ｊ Ｋ Ｌ Ｍ Ｎ Ｏ Ｐ Ｑ Ｒ Ｓ Ｔ Ｕ Ｖ Ｗ Ｘ Ｙ Ｚ ａ ｂ ｃ ｄ ｅ ｆ ｇ ｈ ｉ ｊ ｋ ｌ ｍ ｎ ｏ ｐ ｑ ｒ ｓ ｔ ｕ ｖ ｗ ｘ ｙ ｚ ０ １ ２ ３ ４ ５ ６ ７ ８ ９ ＇")
BJ=Split("A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 '")
set fso=createobject("scripting.filesystemobject")
if not fso.folderexists("替换后的文件") then fso.createfolder ("替换后的文件")
set folder=fso.getfolder(".")
for each file in folder.files
  if ucase(right(file,3))="TXT" then Myreplace(file)
next
msgbox "替换成功！请查看替换后的文件！",4096,"提示"

sub Myreplace(w)
set file=fso.opentextfile(w)
n=file.readall
file.close

l=ubound(qj)
for i=0 to l
  n=Replace(n,QJ(i),Bj(i))
next

set file=fso.createtextfile("替换后的文件\" & fso.getfilename(w))
file.write n
file.close
end sub

（）《》好象还少符号了……

￥还有省略号什么的……

也来一个，只做演示用，利用相同的思路可以写出比较完善的脚本。
同样只针对根目录，对子目录无效，不过稍做修改就可以支持子目录，以前有过多次讨论，为了简化脚本，这里就略过了。

    sFolder = "C:\Documents and Settings\xxx\桌面\c"

'**************************************************************************
'Main
Set oShell = CreateObject("Shell.Application")
Set oDir = oShell.NameSpace(sFolder)
    
    For Each itemFile In oDir.Items
        If itemFile.Size > 0 And itemFile.Type = "文本文档" Then 
            Convert itemFile.Path,itemFile.Path & ".new"  '可自行修改第二个参数
            strList = strList & itemFile.Path & vbCrLf
        End If
    Next
    
    WScript.Echo "转换完毕，被转换的文件列表如下:" & strList
Set oDir = Nothing
Set oShell = Nothing
'**************************************************************************

'转换过程
Sub Convert(strFile,strNewFile)

	Dim objFSo,objSrcFile,objDstFile
	Dim strTmp,intAsc
        Dim boolFlag
    
    '若原文件名与新文件名相同，则标志置位
    If LCase(strFile) = LCase(strNewFile) Then
        boolFlag = True
        strNewFile = strNewFile & ".tmp"
    Else
        boolFlag = False
    End If
    
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objSrcFile = objFSO.OpenTextFile(strFile,1)
        Set objDstFile = objFSO.OpenTextFile(strNewFile,2,True)
'************************************************************************
	'核心算法:
	'ASCII中可对应显示的字符从33-125分别对应的全角字符编码差值为-23680
	
	'注意:$(36)对应的全角,
	'在中文字符集中编码为￥(-23644),而在英文字符集中为＄(-24089)
	
	'另外对于^符号在全角中文字符集中会被两个...(半个省略号，编辑器
	'不支持,故用3个点代替),并没有做处理
	
	'由于中文字符集和英文字符集的差别，可能存在其他Bug，可以根据需要修改
'************************************************************************	
	    Do 
	        strTmp = objSrcFile.Read(1)
	        intAsc = Asc(strTmp)
	        If intAsc < -23554 And intAsc > -23648 Then
	            objDstFile.Write Chr(23680 + intAsc)
	        ElseIf intAsc = -24159 Then
	            objDstFile.Write " "
	        ElseIf intAsc = -24089 Then
	            objDstFile.Write "$"
	        Else
	            objDstFile.Write strTmp
	        End If
	    Loop Until objSrcFile.AtEndOfStream
	
	    objDstFile.Close
	    objSrcFile.Close
	    
	    '删除原文件，改新文件名为原文件名
	    If boolFlag Then
	        objFSo.DeleteFile strFile
	        objFSO.MoveFile strNewFile,strFile
	    End If
	    
	Set objSrcFile = Nothing
	Set objDstFile = Nothing
	Set objFSO = Nothing

End Sub