Manufacturing Information Solutions Forum Index Manufacturing Information Solutions
Your Place for Support and Discussions
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Rename Files Using Regular Expression Masks

 
Post new topic   Reply to topic    Manufacturing Information Solutions Forum Index -> VB Script
View previous topic :: View next topic  
Author Message
mistux
Site Admin


Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA

PostPosted: Mon Sep 18, 2006 8:29 am    Post subject: Rename Files Using Regular Expression Masks Reply with quote

Code:

' Regexp eXtended REName v.1.00 (C) 2000 0zz
' use rxren.msgs (below) to localize messages
'
option explicit
Const vbCompareText = 1

' messages
Dim CMSG_SCRNAME
Dim CMSG_USAGE
Dim CMSG_PROCESSING
Dim CMSG_INVALIDARG
Dim CMSG_INVALIDPAR
Dim CMSG_PARFOLDER

' parameters
Dim sFilenamePattern
Dim sReplacePattern
Dim sProcessFolder
Dim bOptionSubfolders
Dim bOptionRename

     If StrComp (Right(WScript.FullName, 11), "cscript.exe", 1) <> 0 Then
          WScript.Echo "Use cscript.exe to run this script"
          WScript.Quit
     End If

     loadMsgs "rxren.msgs", "loadDefaultMsgs"
     WScript.Echo CMSG_SCRNAME

     Dim fso, sPath

     If parseCmdLine() Then
          Set fso = CreateObject("Scripting.FileSystemObject")
          ProcessFolders fso, fso.GetFolder(sProcessFolder)
          Set fso = Nothing
     Else
          WScript.Echo CMSG_USAGE
     End If

WScript.Quit

'*****************
'*
'* Function parseCmdLine()
'*
'* Purpose: Parses the command line.
'* Input:
'*
'*****************
Private Function parseCmdLine()

     ON ERROR RESUME NEXT

     Dim strFlag
     Dim intState, iArg

     If Wscript.Arguments.Count > 0 Then
          strFlag = Wscript.arguments.Item(0)
     End If

     If IsEmpty(strFlag) Then
          parseCmdLine = False
          Exit Function
     End If

     'Check if the user is asking for help or is just confused
     If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h")_
          OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") _
          OR (strFlag="h") Then
          parseCmdLine = False
          Exit Function
     End If

     sFilenamePattern     = ""
     sReplacePattern          = ""
     sProcessFolder          = "."
     bOptionRename          = False
     bOptionSubfolders     = False

     'Retrieve the command line and set appropriate variables
     iArg = 0
     Do While iArg < Wscript.arguments.Count
          If "/" = Left(LCase(Wscript.arguments.Item(iArg)),1) Then
           Select Case Left(LCase(Wscript.arguments.Item(iArg)),2)
               Case "/s"
                    bOptionSubfolders = True
                    iArg = iArg + 1

               Case "/p"
                    bOptionRename = True
                    iArg = iArg + 1

               Case "/d"
                    If Not getArg(CMSG_PARFOLDER, sProcessFolder, iArg) Then
                         parseCmdLine = False
                         Exit Function
                    End If
                    iArg = iArg + 1

               Case Else 'We shouldn't get here
                    WScript.Echo prepareMsg (CMSG_INVALIDPAR, Array(Wscript.Arguments(iArg)))
                    Wscript.Quit

           End Select
          Else
               If sFilenamePattern = "" Then
                    sFilenamePattern = Wscript.Arguments(iArg)
               ElseIf sReplacePattern = "" Then
                    sReplacePattern = Wscript.Arguments(iArg)
               Else
                    WScript.Echo prepareMsg (CMSG_INVALIDPAR, Array(Wscript.Arguments(iArg)))
                    Wscript.Quit
               End If
               iArg = iArg + 1
          End If

     Loop '** iArg < Wscript.arguments.Count

        parseCmdLine = not (sFilenamePattern = "" or sReplacePattern = "")

End Function

'*****************
'*
'* Function getArg()
'*
'* Purpose: Helper to parseCmdLine()
'*
'* Usage:
'*
'* Case "/s"
'* getArg ("server name", strServer, iArg)
'*
'*****************
Private Function getArg (ByVal StrVarName, ByRef strVar, ByRef iArg)

     Dim bSucceed

     bSucceed = False

     If Len(Wscript.Arguments(iArg)) > 2 then
          If Mid(Wscript.Arguments(iArg),3,1) = ":" then
               If Len(Wscript.Arguments(iArg)) > 3 then
                    strVar = Right(Wscript.Arguments(iArg), _
                         Len(Wscript.Arguments(iArg)) - 3)
                    bSucceed = True
               End If
          Else
               strVar = Right(Wscript.Arguments(iArg), _
                    Len(Wscript.Arguments(iArg)) - 2)
               bSucceed = True
          End If
     End If

     If not bSucceed Then
          iArg = iArg + 1

          If iArg < Wscript.Arguments.Count Then
               strVar = Wscript.Arguments.Item(iArg)
               bSucceed = (Err.Number = 0) And (InStr(strVar, "/") = 0)
          End If

          If not bSucceed Then _
               Wscript.Echo prepareMsg (CMSG_INVALIDARG, Array(StrVarName))
     End If

     getArg = bSucceed
End Function

Sub ProcessFolders (fso, fld)
     Dim fc, file, sfldc, sfld, sNewName

     Set fc = fld.Files
     For Each file in fc
          If testPattern (file.Name, sFilenamePattern) Then
               sNewName = replacePattern (file.Name, sFilenamePattern, sReplacePattern)
               If file.Name <> sNewName Then
                    WScript.Echo Left(file.Name + String(30,"."),30) + " -> " + sNewName

                    If bOptionRename Then file.Name = sNewName
               End If
          End If
     Next

     Set fc = Nothing

     If bOptionSubfolders Then
          Set sfldc = fld.SubFolders
          For Each sfld in sfldc
               WScript.Echo prepareMsg (CMSG_PROCESSING, Array(sfld.Path))
               ProcessFolders fso, sfld
          Next
     End If

End Sub

' - good candidates to go to library script
Function testPattern(sBody, sPatt)
     Dim regEx
     Set regEx = New RegExp

     regEx.Global = True
     regEx.Pattern = sPatt
     regEx.IgnoreCase = True

     testPattern = regEx.Test(sBody)

     Set regEx = Nothing

End Function

Function replacePattern(str1, patrn, replStr)
     Dim regEx
     Set regEx = New RegExp
     regEx.Global = True
     regEx.Pattern = patrn
     regEx.IgnoreCase = True
     replacePattern = regEx.Replace(str1, replStr)
     Set regEx = Nothing
End Function

Sub loadMsgs(sMsgFile, sLoadDefaultMsgsSubName)
     On Error Resume Next

     Dim sScriptPath
     Dim fso, fm, sBody

     sScriptPath = WScript.ScriptFullName
     sScriptPath = Left (sScriptPath, Len(sScriptPath) - Len(WScript.ScriptName))

     Set fso = CreateObject("Scripting.FileSystemObject")
     Set fm = fso.OpenTextFile(sScriptPath + sMsgFile, 1)
     sBody = fm.ReadAll
     fm.Close
     Set fso = Nothing

     If Not IsEmpty(sBody) Then
          Execute sBody
     Else
          Execute sLoadDefaultMsgsSubName
     End If
End Sub

Function prepareMsg (sTemplate, sArgs())
     On Error Resume Next

     Dim sMessage, nToken
     Dim regEx, m, mm, nPtr

     Set regEx = New RegExp
     regEx.Global = True
     regEx.Pattern = "\^[0-9]"
     regEx.IgnoreCase = True

     nPtr = 0     ' pointer to last replaced token
     sMessage = ""
     Set mm = regEx.Execute (sTemplate)
     For Each m in mm
          nToken = CInt(Mid(m.Value,2,1))
          sMessage = sMessage _
               + Mid(sTemplate, nPtr+1, m.FirstIndex-nPtr) _
               + sArgs(nToken-1)
          nPtr = m.FirstIndex + m.Length
     Next

     sMessage = sMessage + Mid(sTemplate, nPtr + 1)

     Set regEx = Nothing
     prepareMsg = sMessage

End Function
'/- good candidates to go to library script

Sub loadDefaultMsgs()
     CMSG_SCRNAME = _
          "RXRen 1.0 (Regexp eXtended REName) (C) 2000 by 0zz"

     CMSG_PROCESSING     = "Processing ^1 folder..."

     CMSG_USAGE     = "USAGE: rxren.vbs [options] <filename pattern> <replace pattern>" _
          + vbCrLf _
          + vbCrLf + "<filename pattern> - regexp expression" _
          + vbCrLf + "<replace pattern> - -,,-" _
          + vbCrLf + "[options]" _
          + vbCrLf + vbTab + "/s - process subfolders" _
          + vbCrLf + vbTab + "/p - perform renaming of files (otherwise just display)" _
          + vbCrLf + vbTab + "/d <directory path> - folder to process" _
          + vbCrLf _
          + vbCrLf + "example usage:" _
          + vbCrLf + "Rename files *.apl, *.app to *.xxx (don't rename just display what to do)" _
          + vbCrLf + vbTab + "RXREN /s ""\.ap[lp]$"" xxx" _
          + vbCrLf + vbTab + " '$' matches end of name, '^' matches begin" _
          + vbCrLf _
          + vbCrLf + "Rename files K_<db>_<srv>*.sql to <srv> <db>.sql" _
          + vbCrLf + vbTab + "RXREN /s ""^(K_.*)_(.*)\.sql$"" ""$2 $1.sql""" _
          + vbCrLf

     CMSG_INVALIDARG     = "Invalid ^1" + vbCrLf + "Please check the input and try again"

     CMSG_INVALIDPAR     = "Invalid or misplaced parameter: ^1" + vbCrLf _
          + "Please check the input and try again," + vbCrLf _
          + "or invoke with '/?' for help with the syntax."

     CMSG_PARFOLDER = "Folder"
End Sub

'--------
' contents of rxren.msgs with russian messages
' store this file near main script
'--------
Back to top
View user's profile Send private message Send e-mail
Display posts from previous:   
Post new topic   Reply to topic    Manufacturing Information Solutions Forum Index -> VB Script All times are GMT - 5 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group