[VBS - RESOLU] Recherche recursive de fichiers avec caracteres généric

Recherche recursive de fichiers avec caracteres généric [VBS - RESOLU] - VB/VBA/VBS - Programmation

Marsh Posté le 22-11-2005 à 11:15:58    

Bonjour
 
Ce que je souhaiterais faire c'est :
rechercher des fichiers as*.url ou *. url (par exemple) dans toute l'arborescence de "C:\Documents and settings" .
 
J'avoue ne pas reussir a faire ce script donc si quelqu'un y arrive je suis preneur.
 
L'ideal serait de retourner la liste dans un "tableau" ou quelque chose de ce genre. Toute proposition est bienvenue.
 
J'en ai besoin pour trouver tout ces fichiers afin de modifier leur contenu (remplacement de chaine), mais modifier ca j'y arrive.  
 
Merci de votre aide.
 
OS : W2K SP4 sans .NET


Message édité par orlith le 22-11-2005 à 17:05:08
Reply

Marsh Posté le 22-11-2005 à 11:15:58   

Reply

Marsh Posté le 22-11-2005 à 17:05:44    

Pour ceux que ca interesse voici ce que j'ai fait en modifiant un code trouvé sur le net.
 
' 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

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed