Proc de recherche

Télécharger le projet
Commenter

Description

Cette proc recherche une chaine dans un fichier. Cette exemple peut être largement amelioré. Vous pouvez boucler la recherche sur tous les fichiers afin de rechercher une chaine sur le disque dur

Source / Exemple : 


Const Fichier = "c:\tree.tmp"

Function NbrLigne(Fichier As Variant)
    On Error Resume Next
    NbrLigne = -1
    Open Fichier For Input As #14
        If Err = 0 Then
            While Not EOF(14)
                Line Input #14, a
                NbrLigne = NbrLigne + 1
            Wend
        End If
    Close #14
End Function
Function Cherche(Valeur As Variant, Fichier As Variant)
Valeur = UCase(Valeur) 'non respect de la case
    On Error Resume Next
    II = NbrLigne(Fichier)
    ReDim Donnee(II)
    i = 0
    Open Fichier For Input As #1
        If Err = 0 Then
            While Not EOF(1)
                Line Input #1, Donnee(i)
                i = i + 1
            Wend
        End If
    Close #1
For i = 0 To II
Form1.CurrentY = 0
Print Donnee(i)
    For j = 1 To (Len(Donnee(i)) - Len(Valeur) + 1)
        ch = UCase(Mid(Donnee(i), j, Len(Valeur)))
        If ch = Valeur Then
            List1.AddItem Donnee(i)
            Exit For
        End If
    Next j
Form1.Cls
Next i
Command1.Enabled = True
List1.Enabled = True
Text1.Enabled = True
Form1.MousePointer = 0
Command1.MousePointer = 0
List1.MousePointer = 0
Form1.Caption = "Arbre -> Résultat de la recherche : " + Str(List1.ListCount)
End Function
Private Sub Command1_Click()
List1.Clear
Form1.Caption = "Arbre"
Command1.Enabled = False
List1.Enabled = False
Text1.Enabled = False
Form1.MousePointer = 11
Command1.MousePointer = 11
List1.MousePointer = 11
Call Cherche(Trim(Text1.Text), Fichier)
End Sub

Private Sub Form_Load()
'Je n'ai pas rajouté de fonction de detection de l'os
'pour les systèmes NT (NT351,NT4,W2000,WXP)
Fenetre = Shell("cmd.exe /c " + Chr(34) + "dir c:\*.* /s /b > " + Fichier + Chr(34), vbHide)
'pour les W9x,WMe
'Fenetre = Shell("command.com /c" + "dir c:\*.* /s /b > " + Fichier + Chr(34), vbHide)
End Sub

Private Sub List1_DblClick()
'Je sais c'est pas terrible mais c'est pour l'exemple!
On Error GoTo 1
Fenetre = Shell(List1.Text, vbNormalFocus)
GoTo 2
1 Fenetre = Shell("explorer " + List1.Text, vbNormalFocus)
2 End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call Command1_Click
End Sub
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.

Du même auteur (cs_Valentino)