中国DOS联盟

Option Explicit
'声明全局变量/对象
Dim ie,wnd,id,curpath,fso,dlg,ext,reg,filelist
Dim matchcase,fcount,shell,shellapp,delims
Const ForReading = 1, ForWriting = 2

Set shell = CreateObject("wscript.shell")
Set fso = CreateObject("scripting.FileSystemObject")
Set dlg = CreateObject("UserAccounts.CommonDialog")
Set shellapp = CreateObject("shell.application")
Set reg = new regexp

reg.global = True
curpath = fso.GetFolder(shell.currentdirectory).shortpath

configure
While True
        wscript.sleep 1000
Wend

'配置脚本任务
Sub Configure
        Set ie = wscript.CreateObject("InternetExplorer.Application","ie_")
        '设置ie对象
        ie.Navigate curpath & "\replace.htm"
        ie.ToolBar = 0
        ie.StatusBar = 0
        ie.Width = 684
        ie.Height = 259
        ie.left=fix((ie.document.parentwindow.screen.availwidth-ie.width)/2)   '水平居中'
        ie.top=fix((ie.document.parentwindow.screen.availheight-ie.height)/2) '垂直居中'
        ie.Resizable = False
        ie.Visible = True
        Set wnd = ie.document.parentwindow
        Set id = ie.document.all

        '设置ie窗口事件处理函数
        id.addfolder.onclick = getref("addfolder")
        id.addfile.onclick = getref("addfile")
        id.savelist.onclick = getref("savelist")
        id.loadlist.onclick = getref("loadlist")
        id.reg1.onchange = getref("reg1_change")
        id.reg2.onchange = getref("reg2_change")
        id.startsearch.onclick = getref("startsearch")
        id.startreplace.onclick = getref("startreplace")
        id.help.onclick = getref("help")
        id.about.onclick = getref("about")
End Sub

'遍历所有选择的文件
Sub traverse(process)
        Dim files,file,i,ret,str,old
        If id.from.value="" Then
                Call MsgBox("请输入搜索内容！",VbCritical)
                Exit Sub
        End If
        If id.matchcase.checked Then
                matchcase = 0
        Else
                matchcase = 1
        End If
        reg.ignorecase = Not id.matchcase.checked
        reg.pattern = id.from.value
        fcount = 0
        files = Split(id.filelist.value,vbcrlf)
        For i=0 To UBound(files)
                If files(i)<>"" Then
                        Set file = fso.opentextfile(files(i),forreading)
                        '跳过空文件
                        If Not file.atendofstream Then
                                'str在调用process函数时可能会被修改
                                str = file.readall
                                old = str        '用于分析完后的比较
                                '调用参数中指定的回调函数，并根据情况决定是否结束
                                ret = process(fso.getabsolutepathname(files(i)),str)
                                file.close

                                If str<>old Then
                                        If ret=True Then
                                                Set file = fso.opentextfile(files(i),forwriting)
                                                file.write str
                                                file.close
                                        ElseIf MsgBox("是否保存当前文件？",vbyesno)=vbyes Then
                                                Set file = fso.opentextfile(files(i),forwriting)
                                                file.write str
                                                file.close
                                        End If
                                End If
                                If ret=False Then
                                        Exit Sub
                                End If

                        End If
                End If
        Next
        If fcount=0 Then
                Call MsgBox("抱歉，无法找到字符串“"& id.from.value & "”！",VbExclamation)
        Else
                Call MsgBox("共找到 " & fcount & " 处结果，搜索完毕！",VbInformation)
        End If
End Sub

'根据字符串和偏移量得到行值和坐标
Sub getposition(str,offset,length,x,y,line)
        Dim linestart,lineend,delta
        '得到行首位置
        linestart = InstrRev(str,vbcrlf,offset)
        delta = 2
        If linestart=0 Then
                linestart = InstrRev(str,vblf,offset)
                delta = 1
        End If
        If linestart=0 Then
                linestart = InstrRev(str,vbcr,offset)
                delta = 1
        End If
        If linestart=0 And delta=-2 Then
                linestart = 1
        Else
                linestart = linestart + delta
        End If

        '得到行尾位置
        lineend = InStr(offset+length,str,vbcrlf)
        If lineend=0 Then
                lineend = InStr(offset,str,vblf)
        End If
        If lineend=0 Then
                lineend = InStr(offset,str,vbcr)
        End If
        If lineend=0 Then
                lineend=Len(str)
        Else
                lineend = lineend
        End If
        If lineend-linestart<=0 Then
                lineend = linestart + 1
        End If
        '得到行值和坐标
        line = Mid(str,linestart,lineend-linestart)
        x = offset - linestart + 1
        y = UBound(Split(Left(str,linestart),vblf)) + 1
End Sub

'单击[开始查找]按钮
Sub startsearch()
        If id.regular.checked Then
                Call traverse(getref("regularsearch"))
        Else
                Call traverse(getref("normalsearch"))
        End If
End Sub

'正则搜索回调函数
Function regularsearch(file,str)
        Dim matches,match,ret,x,y,line
        If reg.test(str) Then
                Set matches = reg.execute(str)
                For Each match In matches
                        Call getposition(str,match.firstindex+1,match.length,x,y,line)
                        fcount = fcount + 1
                        ret = MsgBox("文件：" & file & vbcrlf & "位置：" & y & "行，" & x & "列" & vbcrlf _
                                        & "匹配：“" & match.value & "”" & vbcrlf & "行值：" & line,vbokcancel,"搜索")
                        If ret=vbcancel Then
                                regularsearch = False
                                Exit Function
                        End If
                Next
        End If
        regularsearch = True
End Function

'一般搜索回调函数
Function normalsearch(file,str)
        Dim offset,ret,line,x,y
        offset = 1
        While offset<>0
                offset = InStr(offset,str,id.from.value,matchcase)
                If offset<>0 Then
                        Call getposition(str,offset,Len(id.from.value),x,y,line)
                        If Not id.fullword.checked Or isfullword(str,offset) Then
                                fcount = fcount + 1
                                ret = MsgBox("文件：" & file & vbcrlf & "位置：" & y & "行，" & x & "列" & vbcrlf _
                                                & "匹配：“" & id.from.value & "”" &  vbcrlf & "内容：" & line,vbokcancel,"搜索")
                                If ret=vbcancel Then
                                        normalsearch = False
                                        Exit Function
                                End If
                        End If
                        offset = offset + 1
                End If
        Wend
        normalsearch = True
End Function

'单击[开始替换]按钮
Sub startreplace()
        If id.regular.checked Then
                Call traverse(getref("regularreplace"))
        Else
                Call traverse(getref("normalreplace"))
        End If
End Sub

'正则替换回调函数
Function regularreplace(file,str)
        Dim matches,match,ret,x,y,line,dest,i,submatch,delta
        delta = 0        '改动后的偏移量
        If reg.test(str) Then
                Set matches = reg.execute(str)
                For Each match In matches
                        Call getposition(str,match.firstindex+1+delta,match.length,x,y,line)
                        fcount = fcount + 1
                        '得到替换后的字符串
                        dest = id.To.value
                        dest = Replace(dest,"\t",vbtab)
                        dest = Replace(dest,"\n",vbcrlf)
                        dest = Replace(dest,"\0",match.value)
                        i = 1
                        For Each submatch In match.submatches
                                dest = Replace(dest,"\" & i,submatch)
                                i = i + 1
                        Next
                        '是否提示
                        If id.prompt.checked Then
                                ret = MsgBox("文件：" & file & vbcrlf & "位置：" & y & "行，" & x & "列" & delta & "," & match.firstindex & vbcrlf _
                                                & "行值：" & line & vbcrlf & "匹配：“" & match.value & "”" &  vbcrlf _
                                                & "替换：“" & dest & "”",vbyesnocancel,"替换")
                        Else
                                ret = vbyes
                        End If
                        '更改字符串
                        If ret=vbyes Then
                                str = Left(str,match.firstindex+delta) & dest & Mid(str,match.firstindex+1+match.length+delta)
                                delta = delta + Len(dest) - match.length
                        End If
                        If ret=vbcancel Then
                                regularreplace = False
                                Exit Function
                        End If
                Next
        End If
        regularreplace = True
End Function

'判断是否为整词
Function isfullword(str,offset)
        reg.pattern = "[^\u4e00-\u9fa5|\w]"        '不是汉字字母数字
        '不是文件中的第一个字符，并且前一个字符不是汉字，字母，数字
        If offset>1 Then
                If Not reg.test(Mid(str,offset-1,1)) Then
                        isfullword = False
                        Exit Function
                End If
        End If
        '不是文件中的最后一个字符，并且后一个字符不是汉字，字母，数字
        If offset+Len(id.from.value)<=Len(str) Then
                If Not reg.test(Mid(str,offset+Len(id.from.value),1)) Then
                        isfullword = False
                        Exit Function
                End If
        End If
        isfullword = True
End Function

'一般替换回调函数
Function normalreplace(file,str)
        Dim offset,ret,line,x,y
        offset = 1
        While offset<>0
                offset = InStr(offset,str,id.from.value,matchcase)
                If offset<>0 Then
                        Call getposition(str,offset,Len(id.from.value),x,y,line)
                        If Not id.fullword.checked Or isfullword(str,offset) Then
                                fcount = fcount + 1
                                '是否提示
                                If id.prompt.checked Then
                                        ret = MsgBox("文件：" & file & vbcrlf & "位置：" & y & "行，" & x & "列" & vbcrlf _
                                                        & "行值：" & line & vbcrlf & "匹配：“" & id.from.value & "”" &  vbcrlf _
                                                        & "替换：“" & id.To.value & "”",vbyesnocancel,"替换")
                                Else
                                        ret = vbyes
                                End If
                                '更改字符串
                                If ret=vbyes Then
                                        str = Left(str,offset-1) & id.To.value & Mid(str,offset+Len(id.from.value))
                                End If
                                If ret=vbcancel Then
                                        normalreplace = False
                                        Exit Function
                                End If
                        End If
                        offset = offset + Len(id.To.value)
                End If
        Wend
        normalreplace = True
End Function

'选择搜索的字符串[正则表达式]中的内容
Sub reg1_change()
        id.from.value = id.from.value & id.reg1.value
        Call id.from.focus()
        id.reg1.value = "正则表达式"
        id.regular.checked = True
End Sub

'选择替换为字符串[正则表达式]中的内容
Sub reg2_change()
        id.to.value = id.To.value & id.reg2.value
        Call id.to.focus()
        id.reg2.value = "正则表达式"
        id.regular.checked = True
End Sub

'单击[添加目录]
Sub addfolder()
        If InStr(id.ext.value,";")=0 Then
                MsgBox "请至少输入一个分号！",vbcritical
                Exit Sub
        End If
        If Right(id.ext.value,1)<>";" Then
                MsgBox "请在扩展名末尾添加分号！",vbcritical
                Exit Sub
        End If
        Dim temp,folder
        temp = showSelFolderDlg
        If temp="" Then Exit Sub
        Set folder = fso.getfolder(temp)
        ext = Split(id.ext.value,";")
        Call getfilesinfolder(folder)
End Sub

'获得指定目录下的文件，并根据[包含子目录]决定是否递归
Sub getfilesinfolder(folder)
        Dim i,file,subfolder
        For Each file In folder.files
                For i=0 To UBound(ext)-1
                        If ext(0)="*" Or fso.getextensionname(file.path)=ext(i) Then
                                id.filelist.value = id.filelist.value & file.shortpath & vbcrlf
                                Exit For
                        End If
                Next
        Next
        If id.subfolder.checked Then
                For Each subfolder In folder.subfolders
                        Call getfilesinfolder(subfolder)
                Next
        End If
End Sub

'单击[添加文件]
Sub addfile()
        id.filelist.value = id.filelist.value & showSelFilesDlg
End Sub

'显示选择目录对话框
Function showSelFolderDlg()
        Dim folder,folderitem
        Set folder = shellapp.browseforfolder(0,"选择目标文件夹",0)
        If Not folder Is Nothing Then
                Set folderitem = folder.items.item
                showSelFolderDlg =  folderitem.path
        End If
End Function

'显示选择多文件对话框
Function showSelFilesDlg()
        Dim intResult,i,temp
        dlg.Filter = "所有文件|*.*"
        dlg.Flags = &H0200
        intResult = dlg.ShowOpen
        If intResult <> 0 Then
                temp = Split(dlg.FileName," ")
                If UBound(temp) = 0 Then
                        showSelFilesDlg = temp(0) & vbcrlf
                Else
                         showSelFilesDlg = ""
                        For i=1 To UBound(temp)
                                 showSelFilesDlg = showSelFilesDlg & temp(0) & temp(i) & vbcrlf
                        Next
                End If
        End If
End Function

'单击[保存列表]
Sub savelist()
        Dim name,file
        name = showSelFileDlg()
        If name = "" Then Exit Sub
        Set file = fso.opentextfile(name,forwriting,true)
        file.write id.filelist.value
        file.close
End Sub

'单击[读取列表]
Sub loadlist()
        Dim name,file
        name = showSelFileDlg()
        If name = "" Then Exit Sub
        Set file = fso.opentextfile(name,forreading,false)
        id.filelist.value = file.readall
        file.close
End Sub

'显示选择单个文件对话框
Function showSelFileDlg()
        dlg.Filter = "所有文件|*.*"
        dlg.Flags = &H0000
       
        If dlg.ShowOpen() <> 0 Then
                showSelFileDlg = dlg.FileName
        Else
                showSelFileDlg = ""
        End If
End Function

'处理ie进程的退出事件
Sub ie_onquit
        Set dlg = Nothing
        Set shell = Nothing
        Set fso = Nothing
        Set shellapp = Nothing
        Set reg = Nothing
        wscript.disconnectobject ie
        Set ie = Nothing
        Call wscript.quit()
End Sub

'单击[帮助]
Sub help()
        Call shell.run(curpath & "\help.chm")
End Sub

'单击[关于]
Sub about()
        Call MsgBox("感谢您使用《字符串替换脚本v0.1》" & vbcrlf _
                                                & "如果您有什么建议或者问题可以联系" & vbcrlf _
                                                & "sonic_andy [sonic_andy@sina.com]",vbinformation,"关于")
End Sub