1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
' Test program for 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)
'Modified by Wilfrid Burel on the 22nd November 2005 in order to be recursive
' By default the function Listdir is Recursive. If you don't want the recursivity put something as second argument
' ex : cscript ListDir "D:\temp\*.exe" 0 will scan folder temp for exe files
' ex : cscript ListDir "D:\temp" will scan folder temp and subfolders for all files
Option Explicit
Dim a ' WB
Dim n: n = 0 ' WB
Dim Recursivity ' WB
Main
Sub Main
Dim Path
Select Case WScript.Arguments.Count
Case 0: Path = "*.*" ' list current directory
Case 1: Path = WScript.Arguments(0) ' WB
Case 2: Path = WScript.Arguments(0) : Recursivity = WScript.Arguments(1) ' WB
Case Else: WScript.Echo "Invalid number of arguments.": Exit Sub
End Select
Select Case Recursivity ' WB
Case "" : Recursivity=True ' WB
Case Else : Recursivity=False ' WB
End Select ' WB
ReDim a(10) ' WB
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 'Put here what you want to be done
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)
' Modified by Wilfrid Burel on the 22nd November 2005 in order to be recursive : modification commented and signed
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) quote by WB
Dim Folder: Set Folder = fso.GetFolder(Parent)
Dim Files: Set Files = Folder.Files
Dim File
'Implementation of recursivity WB
If Recursivity then
Dim SubFolder ' WB
If Folder.SubFolders.Count <> 0 Then 'WB
For Each SubFolder In Folder.SubFolders ' WB
ListDir(SubFolder&"\" & Filter) ' WB
Next ' WB
End If ' WB
End If
Set Files = Folder.Files
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
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
If fp > Len(Filter) Then CompareFileName2 = True: Exit Function
If Mid(Filter,fp) = ".*" Then ' special case: ".*" at end of filter
CompareFileName2 = True: Exit Function
End If
fc2 = Mid(Filter,fp,1): fp = fp + 1
If fc2 <> "*" And fc2 <> "?" Then Exit Do
Loop
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 |
Continuer apres une erreur
Répondre avec citation
te permet de trouver des liens comme :
Partager