Extraire chaine dans un fichier avec comme parametre caractere debut et fin

bonjour a tous,
je suis debutant en vb et j'ai un petit probleme
Je souhaiterai extraire une chaine dans un fichier, de la maniere suivante :
avoir une fonction du style : extraire(NomDuFichier,ChaineDeDebut,ChaineDeFin)
Exemple :
si mon fichier contient "Salut, comment tu vas ?" et que j'appel extraire(NomDuFichier,"Salut, ", "tu vas"'), elle me retourne "comment"

J'avais trouvé celle ci
Function Extract(ByVal Fichier As String, ByVal Before As String, After As String, ByVal vBefore As String, vAfter As String) As String
On Error Resume Next
Dim trig, mutex, result, i, a$, istart, istop, value
 Open Fichier For Input As #1
 trig = False
 mutex = False
 For i = 1 To 2
 Do
  DoEvents
  Line Input #1, a$
  If InStr(a$, Before) And trig = False Then trig = True: mutex = True
  If trig Then result = result & a$
  If trig And Not mutex And InStr(a$, After) Then Exit Do
  mutex = False
 Loop Until EOF(1)
 Close #1
 
 If vBefore <> "" Then Before = vBefore
 If vAfter <> "" Then After = vAfter
 
 istart = InStr(result, Before) + Len(Before)
 istop = InStr(result, After)
 If istop < istart Then istop = InStr(istop + 1, result, After)
 value = Mid(result, istart, istop - istart)
 Next i
 Extract = value
 
End Function


Elle fonctionne bien, mais ne fonctionne pas toujours, ou n'est moi qui ne l'utilise pas comme il faut :

Extrait de mon fichier temp.tmp:
onClick="BlogThisTrack.start('http://www.radioblogclub.com/listen?u=.8yck5WdvN3Ln9Gbi5ybpRWYy9SbvNmLjlWbhNmYldnL3d3d/david%2520vendetta%2520-%2520break%25204%2520love%25202006.mp3.rbs');"></td><td valign="top"

Extrait du code qui ne fonctionne pas
Dim exten,titre

titre="david%2520vendetta%2520-%2520break%25204%2520love%25202006"
exten = Extract(App.Path & "\" & "temp.tmp", titre, "');" ,  "",  "")

Et exten reste vide :(

Que faire ?

Merci pour votre aide .

Bonjour,

Ce que je n'aime pas, c'est :
"Elle fonctionne bien, mais ne fonctionne pas toujours"
Cer qui me donne à penser que ce qui est en cause, n'est pas ta fonction (que j'aurais au demeurant écrite d'yne autre manière), mais le fichier lu lui-même.
Pour peu qu'il contienne un cractère NULL quelque part, la chaine extraite s'arrêtera à ce caractère !

Voilà, de toutes manières, ce que j'aurais écrit (en reprenant ton exemple) :

Private Sub Command1_Click()
  Dim toto As String ', titi As String
  toto = "Salut, comment tu vas ?" 'et que j'appel extraire(NomDuFichier,"Salut, ", "tu vas"'
  titi = extrayons(toto, "Salut,", "tu vas ?")
  MsgBox titi
End Sub

Private Function extrayons(texte As String, devant As String, derriere As String) As String
  extrayons = Mid(texte, InStr(texte, devant) + 1 + Len(devant))
  extrayons = Trim(Left(extrayons, InStr(extrayons, derriere) - 1))
End Function

vous allez vraiment réussir à décourager les membres à venir répondre sur le forum!

8 lignes à taper... aucun effort


Option Explicit

Private Sub Form_Load()
    MsgBox ExtractUnknownPartFile("C:\test3.txt", "http://www.", ".com")
    
    Dim titre As String
    titre = "david%2520vendetta%2520-%2520break%25204%2520love%25202006"
    MsgBox ExtractUnknownPartFile("C:\test3.txt", titre, "');")
    
    Unload Me
End Sub

Private Function ExtractUnknownPartFile(sPath, sLeft, sRight) As String
' on prend un bout ici....
'   http://www.codyx.org/snippet_lire-toutes-lignes-fichier-texte_22.aspx#67
' et là.....
'   http://www.codyx.org/snippet_remplacer-chaine-inconnue-placee-entre-deux-chaines-connues_303.aspx
' on mélange le tout et voilà...

    ExtractUnknownPartFile = vbNullString
    Dim FF As Integer, sBuffer As String, lPosL As Long, lPosR As Long
    
    FF = FreeFile
    On Error Resume Next
    Open sPath For Input As #FF
        sBuffer = Input(LOF(FF), #FF)
    Close #FF
    On Error GoTo 0

    If LenB(sBuffer) Then
        lPosL = InStr(1, sBuffer, sLeft)
        lPosR = InStr(lPosL + 1, sBuffer, sRight)
        If lPosL > 0 And lPosR > 0 Then ExtractUnknownPartFile = Mid$(sBuffer, lPosL + Len(sLeft), lPosR - lPosL - Len(sLeft))
    End If
End Function

++
PCPT   [AFCK]

---

Prenez un instant pour répondre à ce sondage svp

Merci beaucoup a vous, je vais tester tout ca !