Recherche de fichiers par type d extension

Télécharger le projet
Commenter

Description

Alors voila, ce code permet de lister tous les fichiers d'une extension choisie ( txt, mp3 .. )

Dans un repertoire précis ainsi que dans tous ces sous-repertoires.

Ceux ci peuvent ensuite etre lancés directement .

Ce prog m est utile dans une situation precise:

" Mais bon dieu .. sur quel album est cette satané chanson ! .. hop ! une recherche et la chanson est listee

Source / Exemple : 


Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'Tableau des resultats de recherche, je sais, c est degueulasse ..
' Mais c est ca qui est bon !!!! :D
Dim table(1000000, 2) As String

Public Enum eREDIRECTION
eREDIRECT_FICHIER
eREDIRECT_TABLEAU
End Enum

'Fonction de listage des fichiers

Public Sub SCANNER_LE_DISQUE2(ByVal LE_REP_DE_DEPART As String, _
ByVal LA_REDIRECTION As eREDIRECTION, _
Optional ByVal LES_MASQUES As String = vbNullString, _
Optional ByRef LE_TABL_DE_SORTIE As Variant, _
Optional ByVal LE_NO_DE_FICHIER As Long = 1)

On Error Resume Next 'Obligatoire pour ne pas être emmerdé par les fichier systèmes (jusqu'à autre solution...)

Dim i, N As Long
Dim LE_COMPTEUR As Long
Dim LE_NOM_FICHIER As String
Dim LE_TABL_DE_REP_FILS() As String
Dim LE_SPLIT_EXT() As String 'Va permettre de récupérer l'extension d'un fichier

LE_COMPTEUR = 0
LES_MASQUES = UCase(LES_MASQUES)

LE_NOM_FICHIER = Dir(LE_REP_DE_DEPART, vbReadOnly) 'Fichiers sans attribut + Fichiers en lecture seule ...

Do While LE_NOM_FICHIER <> ""
LE_SPLIT_EXT = Split(UCase(LE_NOM_FICHIER), ".")

LE_COMPTEUR = LE_COMPTEUR + 1: If (LE_COMPTEUR Mod 10) = 0 Then DoEvents
If InStr(1, LES_MASQUES, ";" & LE_SPLIT_EXT(UBound(LE_SPLIT_EXT)) & ";") = 0 Then
Select Case LA_REDIRECTION
Case eREDIRECT_FICHIER: Print #LE_NO_DE_FICHIER, LE_REP_DE_DEPART & LE_NOM_FICHIER
Case eREDIRECT_TABLEAU:
ReDim Preserve LE_TABL_DE_SORTIE(1 To 2, UBound(LE_TABL_DE_SORTIE, 2) + 1) As String

LE_TABL_DE_SORTIE(1, UBound(LE_TABL_DE_SORTIE, 2)) = LE_REP_DE_DEPART
LE_TABL_DE_SORTIE(2, UBound(LE_TABL_DE_SORTIE, 2)) = LE_NOM_FICHIER
End Select
End If

LE_NOM_FICHIER = Dir 'Fichier Suivant

Loop

'Cherche ts les répertoires "fils"
LE_NOM_FICHIER = Dir(LE_REP_DE_DEPART, vbDirectory) 'Fichiers sans attribut + répertoires ...

Do While LE_NOM_FICHIER <> ""

LE_COMPTEUR = LE_COMPTEUR + 1: If (LE_COMPTEUR Mod 10) = 0 Then DoEvents

If LE_NOM_FICHIER <> "." And LE_NOM_FICHIER <> ".." Then
'On regarde si le fichier est un répertoire. Si tel est le cas, on mémorise son nom
'afin de scruter les sous répertoire de celui-ci par la suite...
If (GetAttr(LE_REP_DE_DEPART & LE_NOM_FICHIER) And vbDirectory) = vbDirectory Then 'ATTENTION : Les fic systèmes nous foutent en erreur !
N = N + 1
ReDim Preserve LE_TABL_DE_REP_FILS(N) As String
'Mémorise le nom du répertoire
LE_TABL_DE_REP_FILS(N) = LE_REP_DE_DEPART & LE_NOM_FICHIER
End If
End If

LE_NOM_FICHIER = Dir 'Fichier suivant dans la liste extraite par LE_NOM_FICHIER = Dir(CurrentPath, vbDirectory)

Loop

'Recense ts les fichiers des répertoires mémorisés => Va nous donner : 1. Une liste de fichiers
' 2. Une autre liste de sous-répertoire (éventuellement)
For i = 1 To N

SCANNER_LE_DISQUE2 LE_TABL_DE_REP_FILS(i) & "\\", LA_REDIRECTION, LES_MASQUES, LE_TABL_DE_SORTIE, LE_NO_DE_FICHIER
Next i
End Sub

Private Sub Form_Load()

'Voila pour les jolis dessins
Timer1.Enabled = False
Picture1.Visible = False
Picture2.Visible = False

On Error Resume Next

'Lecture du fichier ini
Open ".\listeur.ini" For Input As #1
Line Input #1, variable
If variable = "" Then
Text1.Text = "mp3"
Else
Text1.Text = variable
End If
Line Input #1, variable
If variable = "" Then
Text2.Text = "C:"
Else
Text2.Text = variable
End If
Close #1
End Sub

Private Sub Command1_Click()

Dim Dossier As String
Dim Extension As String
Dim tmp As String
Dim A() As String
Dim J
List1.Clear
Label2.Caption = ""
Label3.Caption = ""

Picture1.Visible = True

'On fait clignoter la ptite boule
Timer1.Enabled = True

ReDim A(1 To 2, 0) As String 'A faire avant d'appeler SCANNER_LE_DISQUE sous peine d'erreur !

'On reformate le chemin comme il faut
Dossier = Text2.Text
Dossier = Replace(Dossier, "\\", "\")
Dossier = Replace(Dossier, "\", "\\")
Dossier = Replace(Dossier, "//", "/")
Dossier = Replace(Dossier, "/", "\\")
Dossier = Dossier & "\"
total = 0

Extension = Text1.Text

SCANNER_LE_DISQUE2 Dossier, eREDIRECT_TABLEAU, , A, 1

i = 0

For J = LBound(A, 2) + 1 To UBound(A, 2)

A(1, J) = Replace(A(1, J), Dossier, "")

tmp = Right$(A(2, J), Len(Extension) + 1)

'Pour chaque resultat, si l extension correspond a celle choisie

If "." & Extension = tmp Then

'On rajoute le nom du fichier dans la liste
tt = Dossier & A(1, J) & A(2, J)
tt = Replace(tt, "\\", "\")
List1.AddItem A(2, J)
List1.Refresh
total = total + 1
Label3.Caption = total & " objets trouvés"

While table(i, 1) <> ""
i = i + 1
Wend

'et on remplit le tableau de cette facon : Nom fichier || Chemin
table(i, 1) = A(2, J)
table(i, 2) = Dossier & A(1, J)

End If

Next J

Timer1.Enabled = False
Picture1.Visible = False
Picture2.Visible = False

End Sub

'Ecriture dans lini
Private Sub Command2_Click()
Open ".\listeur.ini" For Output As #2
Debug.Print Text2.Text
Print #2, Text1.Text
Print #2, Text2.Text
Close #2
End Sub

'Oui bon ca va .. c facile de se moquer
Private Sub Command3_Click()
Call MsgBox("FileLister v 1.0 par Babeuf ", vbInformation, "A propos")

End Sub

'Affiche le repertoire du fichier quand on le selectionne dans la liste
Private Sub List1_Click()

On Error Resume Next
i = 0
While table(i, 1) <> List1
i = i + 1
Wend
Label2.Caption = table(i, 2)
Label2.Caption = Replace(Label2.Caption, "\\", "\")
tst = Left(Label2.Caption, 1)
If tst = "\" Then
Label2.Caption = "\" & Label2.Caption
End If
End Sub

'Ouvre le fichier avec le programme  qui va bien

Private Sub List1_DblClick()

On Error Resume Next
i = 0
While table(i, 1) <> List1
i = i + 1
Wend
ShellExecute Me.hwnd, vbNullString, table(i, 2) & table(i, 1), "", vbNullString, 1
End Sub

'Ouvre le repertoire du fichier

Private Sub Label2_DblClick()
On Error Resume Next
ShellExecute Me.hwnd, vbNullString, Label2.Caption, "", vbNullString, 1
End Sub

'Lancer une recherche quand on valide avec la touche Entree
Private Sub Text1_KeyPress(KeyCode As Integer)
If KeyCode = 13 Then
Call Command1_Click
End If
End Sub

'Pareil
Private Sub Text2_KeyPress(KeyCode As Integer)
If KeyCode = 13 Then
Call Command1_Click
End If
End Sub

'Le timer qui fait clignoter la ptite boule pendant une recherche
Private Sub Timer1_Timer()
If Picture1.Visible = True Then
Picture1.Visible = False
Picture2.Visible = True
Else
Picture2.Visible = False
Picture1.Visible = True
End If
End Sub

Conclusion :


je sais, cette source n' a rien de vraiment revolutionnaire ( manquerait plus que ca .. ) , on peut meme dire qu elle est programmée tres salement ( bien que je prefere nettement le terme d'artistiquement :p ) .

Mais bon .. je suis ce qu on peut appeler un ultra debutant en vb, et je n ai aucune rigueur
( et oui ... habituellement je fais du php :D ) .. mais bon, ce code source peut tout de meme apprendre de trois bricoles aux debutants, comme l ecriture et la lecture de fichiers etc ...

Et puis , j ai tellement vu de types se faire descendre leurs sources en flamme que moi aussi a mon tour j ai eu envie de mettre la tete dans le pilori et d essuyer des projectiles légumineux.

donc, j attend pleins de commentaires, de bugs, d'améliorations possibles ( et utiles ), d'invitations Dysneyland et de réductions chez Ikea . merci
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.