|
flyboy612
新手上路
积分 15
发帖 6
注册 2007-1-3
状态 离线
|
『楼 主』:
[求助]批量全角转半角
以前收藏一个全角转半角的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 ]
|
|
 2007-6-24 21:23 |
|
|
jmz573515
银牌会员
积分 1212
发帖 464
注册 2006-12-13
状态 离线
|
『第
2 楼』:
'只对当前目录有效
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
|
|
|
2007-6-26 08:44 |
|
|
slore
铂金会员
积分 5212
发帖 2478
注册 2007-2-8
状态 离线
|
『第
3 楼』:
（）《》好象还少符号了……
￥还有省略号什么的……
|
|
|
2007-6-26 12:16 |
|
|
3742668
荣誉版主
积分 2013
发帖 718
注册 2006-2-18
状态 离线
|
『第
4 楼』:
也来一个，只做演示用，利用相同的思路可以写出比较完善的脚本。
同样只针对根目录，对子目录无效，不过稍做修改就可以支持子目录，以前有过多次讨论，为了简化脚本，这里就略过了。
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
|
|
|
2007-6-26 13:25 |
|
|
