正規表現を使用してファイルパターンをコピーするVBScriptファイルです。ディレクトリ機能は、次のように書かれています。Christian d'Heureuse
私は詳細な解析を行いませんでした。したがって、ソースとデスティメーションのパターンに*が含まれている場合にのみスクリプトが機能します。
呼び出しは次のようになります。おそらく、私は何かが欠けてい
cscript myscript.vbs "C:\temp\filesToCopy_*.txt" "D:\temp\newName_*.txd"
' ___ _ _ ___
' | _ \__ _| |_| |_ ___ _ _ _ _/__|___ _ __ _ _
' | _/ _` | _| _/ -_) '_| ' \ (__/ _ \ '_ \ || |
' |_| \__,_|\__|\__\___|_| |_||_\___\___/ .__/\_, |
' |_| |__/
' Copy files using patterns
' any given String is split into three parts {part1}{*}{part3}
' the replacement String is used in the same pattern to replace the three parts
' (c) m.wallner-novak
'
' vbCopyFile
' Usage cscript vbCopyFile.vbs {Source} {Destination}
'
Option Explicit
Main
'''
' Main Procedure
'
Sub Main
dim SourcePattern
dim DestPattern
dim sFile
if Wscript.Arguments.count = 2 then
SourcePattern = WScript.arguments(0)
DestPattern = WScript.arguments(1)
Dim a
a = ListDir(SourcePattern)
If UBound(a) = -1 then
WScript.Echo "No files found with specified source path:"
WScript.Echo SourcePattern
Exit Sub
End If
Dim FileName
dim regEx
Set regEx = new regexp 'Create the RegExp object
dim sPattern
sPattern = SourcePattern
sPattern = replace(sPattern,"\","\\")
sPattern = replace(sPattern,".","\.")
sPattern = replace(sPattern,"*",")(.*)(")
sPattern = "(" & sPattern & ")"
dim part1
dim part3
dim pos1
pos1 = instr(DestPattern,"*")
if pos1>0 then
part1 = left(DestPattern,pos1-1)
part3 = mid(DestPattern,pos1+1,999)
end if
regEx.Pattern = sPattern
regEx.IgnoreCase = True
Dim Fso
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
on error resume next
For Each FileName In a
WScript.Echo "copying """ & FileName & """ to """ & regEx.Replace(FileName, part1 & "$2" & part3) & """"
Fso.CopyFile FileName, regEx.Replace(FileName, part1 & "$2" & part3)
if err.number <> 0 then
Wscript.echo "ERROR #" & err.number & vbcrlf & err.Description
exit sub
end if
Next
else
WScript.echo "Wrong number of arguments"
WScript.echo Wscript.ScriptName & " SourcePattern DestinationPattern"
WScript.echo "SourcePattern and DestinationPattern are {part1}{*}{part3}"
WScript.echo "Example: Hello*.exe Hello_World*_prefix.exe"
WScript.echo " will copy Hello123.exe to Hello_World123_prefix.exe"
end if
end sub
'''
' Test program for the ListDir function.
' Lists file names using wildcards.
'
' Author: Christian d'Heureuse (www.source-code.biz)
' License: GNU/LGPL (http://www.gnu.org/licenses/lgpl.html)
'
' Changes:
' 2006-01-19 Extended to handle the special case of filter masks
' ending with a ".". Thanks to Dave Casey for the hint.
Sub Main2
Dim Path
Select Case WScript.Arguments.Count
Case 0: Path = "*.*" ' list current directory
Case 1: Path = WScript.Arguments(0)
Case Else: WScript.Echo "Invalid number of arguments.": Exit Sub
End Select
Dim a: a = ListDir(Path)
If UBound(a) = -1 then
WScript.Echo "No files found."
Exit Sub
End If
Dim FileName
For Each FileName In a
WScript.Echo FileName
Next
End Sub
' Returns an array with the file names that match Path.
' The Path string may contain the wildcard characters "*"
' and "?" in the file name component. The same rules apply
' as with the MSDOS DIR command.
' If Path is a directory, the contents of this directory is listed.
' If Path is empty, the current directory is listed.
' Author: Christian d'Heureuse (www.source-code.biz)
Public Function ListDir (ByVal Path)
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
If Path = "" then Path = "*.*"
Dim Parent, Filter
if fso.FolderExists(Path) then ' Path is a directory
Parent = Path
Filter = "*"
Else
Parent = fso.GetParentFolderName(Path)
If Parent = "" Then If Right(Path,1) = ":" Then Parent = Path: Else Parent = "."
Filter = fso.GetFileName(Path)
If Filter = "" Then Filter = "*"
End If
ReDim a(10)
Dim n: n = 0
Dim Folder: Set Folder = fso.GetFolder(Parent)
Dim Files: Set Files = Folder.Files
Dim File
For Each File In Files
If CompareFileName(File.Name,Filter) Then
If n > UBound(a) Then ReDim Preserve a(n*2)
a(n) = File.Path
n = n + 1
End If
Next
ReDim Preserve a(n-1)
ListDir = a
End Function
Private Function CompareFileName (ByVal Name, ByVal Filter) ' (recursive)
CompareFileName = False
Dim np, fp: np = 1: fp = 1
Do
If fp > Len(Filter) Then CompareFileName = np > len(name): Exit Function
If Mid(Filter,fp) = ".*" Then ' special case: ".*" at end of filter
If np > Len(Name) Then CompareFileName = True: Exit Function
End If
If Mid(Filter,fp) = "." Then ' special case: "." at end of filter
CompareFileName = np > Len(Name): Exit Function
End If
Dim fc: fc = Mid(Filter,fp,1): fp = fp + 1
Select Case fc
Case "*"
CompareFileName = CompareFileName2(name,np,filter,fp)
Exit Function
Case "?"
If np <= Len(Name) And Mid(Name,np,1) <> "." Then np = np + 1
Case Else
If np > Len(Name) Then Exit Function
Dim nc: nc = Mid(Name,np,1): np = np + 1
If Strcomp(fc,nc,vbTextCompare)<>0 Then Exit Function
End Select
Loop
End Function
Private Function CompareFileName2 (ByVal Name, ByVal np0, ByVal Filter, ByVal fp0)
Dim fp: fp = fp0
Dim fc2
Do ' skip over "*" and "?" characters in filter
If fp > Len(Filter) Then CompareFileName2 = True: Exit Function
fc2 = Mid(Filter,fp,1): fp = fp + 1
If fc2 <> "*" And fc2 <> "?" Then Exit Do
Loop
If fc2 = "." Then
If Mid(Filter,fp) = "*" Then ' special case: ".*" at end of filter
CompareFileName2 = True: Exit Function
End If
If fp > Len(Filter) Then ' special case: "." at end of filter
CompareFileName2 = InStr(np0,Name,".") = 0: Exit Function
End If
End If
Dim np
For np = np0 To Len(Name)
Dim nc: nc = Mid(Name,np,1)
If StrComp(fc2,nc,vbTextCompare)=0 Then
If CompareFileName(Mid(Name,np+1),Mid(Filter,fp)) Then
CompareFileName2 = True: Exit Function
End If
End If
Next
CompareFileName2 = False
End Function
ていますが、シェル/バッチスクリプトでこれを行うにはしたくない理由があります？ – Costa