[文本处理] 如何用批处理将半角引号替换为全角引号

pan528

如何用DOS批处理的方式，将半角引号替换为全角引号。
思路上：先将回车替换为一个特殊的数字，再在半角引号前插入回车，然后根据单行替换为左引号，双行替换为右引号，去回车，最后再用回车符号替换特殊的数字……
但，怎样替换回车、用回车替换特殊符号等都搞不定，试了好多次，不得要领，请各位高手相助！先谢了！

材料：
更改后的效果：

pan528

回复 9# yu2n


感谢你的耐心回贴！
全角问题解决了，批量处理也没有问题，虽然目录不能自动追踪，但对效率影响不是太大。
再次感谢你的帮助！

yu2n

回复 8# pan528
1.  已更新代码。可自行修改 35 行代码：

str2= str2 & regEx_Replace("("")(.*)("")", objItem, "“$2”") & vbCrLf
复制代码

替换为

str2= str2 & regEx_Replace("("")(.*?)("")", objItem, "“$2”") & vbCrLf
复制代码

2. 本身不支持拖拽功能。是要记录最后一次打开位置的意思么？这个效果不太好。
将

  Set objFolder = CreateObject("Shell.Application").BrowseForFolder (&H0, strTips, &H0010 + &H0001)
复制代码

修改为

  Set objFolder = CreateObject("Shell.Application").BrowseForFolder (&H0, strTips, &H0010 + &H0001, "D:\")
复制代码

试试效果，那就只能选择这个位置了…

pan528

回复 7# yu2n

谢谢回贴！

但测试出了一点问题：
1、一列中有多组引号时，只处理两头的引号，中间没有处理。
2、拖拽目录时弹出选择目录的提示，能否，智能判断，自动找到目录？

yu2n

回复 6# pan528
批量处理文本和拖入文本？
建议直接做成浏览文件夹的形式，直接对文件夹里面所有的TXT类型文件处理。
选取多个拖放？好像Windows对拖放个数有限制，如果文件路径够长，估计一次处理不了多少文件。

VBS文件拖拽的个数限制（无法执行 – 参数列表过长）
http://demon.tw/programming/vbs-parameter-too-long.html

' VBS 批量替换TXT文件中的英文引号为成对中文引号 By Yu2n

' VBS 批量替换TXT文件中的英文引号为成对中文引号 By Yu2n
Call CommandMode("VBS 批量替换TXT文件中的英文引号为成对中文引号 By Yu2n")

Main
Sub Main()
  Dim strFolder, arrPath, strPath, nFileCount, i
  strFolder = BrowseForFolder("请选择要替换的 TXT 文件所在目录：")
  If strFolder = "" Then
    WScript.Echo vbCrLf & " --- 错误：没有选择文件夹。程序即将退出 ..." & vbCrLf
    Exit Sub
  End If
  arrPath = ScanFolder(strFolder)
  ' 统计个数，用于显示进度
  For Each strPath In arrPath
    If LCase(Right(strPath,4))=".txt" Then nFileCount = nFileCount + 1
  Next
  ' 执行替换
  Dim dtStart, objWord :  dtStart = Now()
  For Each strPath In arrPath
    If LCase(Right(strPath,4))=".txt" Then
      i = i + 1 :  WScript.Echo "[" & i & "/" & nFileCount & "]" & strPath
      Call DoReplace(strPath, strPath)    ' 执行替换
    End If
  Next
  WScript.Echo vbCrLf & " --- " & nFileCount & " 个文档完成替换，耗时 " _
    & DateDiff("s",dtStart,Now()) & " 秒。" & vbCrLf
End Sub

' 替换英文引号为中文引号（成对）
Sub DoReplace(ByVal file1, ByVal file2)
  Set fso = CreateObject("Scripting.filesystemobject")
  set oTxt = fso.OpenTextFile(file1, 1, False, -2)
  str1 = oTxt.ReadAll
  For Each objItem In Split(str1, vbCrLf)
    str2= str2 & regEx_Replace("("")(.*?)("")", objItem, "“$2”") & vbCrLf
  Next
  set oTxt = fso.OpenTextFile(file2, 2, True, -2)
  oTxt.Write str2
  oTxt.Close
End Sub

' 正则替换文本
Function regEx_Replace(ByVal sPattern, ByVal str, ByVal strReplace)
  With CreateObject("VBScript.RegExp")
    .Pattern=sPattern :  .IgnoreCase=True
    .Global=True      :  .MultiLine=True
    regEx_Replace = .Replace(str,strReplace)
  End With
End Function

' 浏览文件夹
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 strPath)
    Dim arr() : ReDim Preserve arr(-1)
    Call SCAN_FOLDER(arr, strPath) : ScanFolder = arr
End Function
Function SCAN_FOLDER(ByRef arr, ByVal folderSpec)
  On Error Resume Next
  Dim fso, objItems, objFile, objFolder
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set objItems = fso.GetFolder(folderSpec)
  If Right(folderSpec, 1) <> "\" Then folderSpec = folderSpec & "\"
  If (Not fso.FolderExists(folderSpec)) 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
    Call SCAN_FOLDER(arr, objFolder.Path)
  Next
  ReDim Preserve arr(UBound(arr) + 1)
  arr(UBound(arr)) = folderSpec
End Function

' 以命令提示符环境运行(保留参数)
Sub CommandMode(ByVal sTitle)
If (LCase(Right(WScript.FullName,11)) = "wscript.exe") Then
  Dim oArg, sArgs
  For Each oArg In WScript.Arguments
    sArgs = sArgs & " """ & oArg & """"
  Next
  CreateObject("WScript.Shell").Run( _
    "cmd /c Title " & sTitle & " & Cscript.exe //NoLogo """ & _
    WScript.ScriptFullName & """ " & sArgs & " & pause"), 1, False
    Wscript.Quit
End If
End Sub
复制代码

pan528

回复 4# yu2n


   vbs我还没有入门，如果要批量处理文本和拖入文本，代码应怎样改，请指点。谢谢！

pan528

回复 4# yu2n


    感谢回贴，已通过测试！

VBS只是DOS的表弟，虽然更高级一些，但不是纯DOS。

希望有DOS高手能用纯dos代码解决问题。

yu2n

VBS 算 DOS 么 ...

file1 = "C:\Users\Yu2n\Downloads\半角引号.txt"
file2 = "C:\Users\Yu2n\Downloads\半角引号1.txt"

Set fso = CreateObject("Scripting.filesystemobject")
set oTxt = fso.OpenTextFile(file1, 1, False, -2)
str1 = oTxt.ReadAll

For Each objItem In Split(str1, vbCrLf)
  str2= str2 & regEx_Replace("("")(.*)("")", objItem, "“$2”") & vbCrLf
Next

set oTxt = fso.OpenTextFile(file2, 2, True, -2)
oTxt.Write str2
oTxt.Close

Msgbox "Done!"

Function regEx_Replace(ByVal sPattern, ByVal str, ByVal strReplace)
  With CreateObject("VBScript.RegExp")
    .Pattern=sPattern :  .IgnoreCase=True
    .Global=True      :  .MultiLine=True
    regEx_Replace = .Replace(str,strReplace)
  End With
End Function
复制代码

pan528

回复 2# tmplinshi


谢谢回贴。已通过测试！

只是 fr 是第三方工具。如果能用 DOS 写就完美了！

tmplinshi

fr -rnnl:"***:\"(.*?)\"" -t:"“\1”" 半角引号.txt
复制代码

如果要替换目录下所有 txt，则文件名用 *.txt。
fr 下载地址: http://baiy.cn/utils/fr/index.htm