Open For Binary As .... [Résolu]

Messages postés
172
Date d'inscription
lundi 10 octobre 2005
Dernière intervention
16 mai 2011
- - Dernière réponse : jrivet
Messages postés
7401
Date d'inscription
mercredi 23 avril 2003
Dernière intervention
6 avril 2012
- 27 juin 2006 à 11:19
Bonjour,


J'utilise ce code pour récupérer tout le texte d'un fichier :


    Open FileName For Binary As #1

    TxtString = Space(LOF(1))

    Get #1, , TxtString

    Close #1


Mais j'aimerais savoir quel est le moyen de récupérer le texte A PARTIR d'un endroit défini du fichier jusqu'à la fin.

Par exemple à partir du moment où il trouve le texte "ICI".


Merci de m'aider si vous savez.....
Afficher la suite 

Votre réponse

12 réponses

Meilleure réponse
Messages postés
7401
Date d'inscription
mercredi 23 avril 2003
Dernière intervention
6 avril 2012
47
3
Merci
Salut,

C'est normal en fait car le moment ou tu recupere la position de "ICI" ta variable TxtString ne contient encore rien.

C'est pour cela que tu doit deja recupérer tout le contenu. et ensuite en extraire juste ce dont tu as besoin.

Essaie ceci pour voir (ATTENTION l'exemple ci dessous récupère aussi la chaine "ICI")

Dim TxtString As String 
Dim Ou As Integer 

Open FileName For Binary As #1 
TxtString =   Space (LOF(1)) 
Get #1, , TxtString 
Ou  = InStr(1, TxtString, "ICI") 
TxtString = Mid(TxtString, Ou) 
MsgBox "|" & TxtString & "|" 
Close #1 
 

<small> Coloration syntaxique automatique [AFCK]</small>
       

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
Mais Surtout: Règlement/FONT>

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 110 internautes nous ont dit merci ce mois-ci

Commenter la réponse de jrivet
Messages postés
7401
Date d'inscription
mercredi 23 avril 2003
Dernière intervention
6 avril 2012
47
0
Merci
Salut,
ATTENTION PAS TESTE
Soit tu fais
TxtString = Space(LOF(1) - NumOctetDepart)
Get #1, NumOctetDepart, TxtString

Mais de toute facon tu sera obligé de lire une premiere fois le fichiers pour savoir ou se trouve le texte "ICI"

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
Mais Surtout: Règlement/FONT>
Commenter la réponse de jrivet
Messages postés
172
Date d'inscription
lundi 10 octobre 2005
Dernière intervention
16 mai 2011
0
Merci
Merci pour cette réponse....mais.....

Je suis un peu newbie, donc je ne sais pas vraiment comment aller chercher le texte "ICI"....

J'ai cherché des heures sur le web un exemple complet, mais rien.........
Commenter la réponse de gribouillex
Messages postés
7401
Date d'inscription
mercredi 23 avril 2003
Dernière intervention
6 avril 2012
47
0
Merci
Salut,

Est ce que ta premiere methode récupère bien tout le texte.

Si oui.

Dim Ou as integer
Ou = Instr(1, TxtString, "ICI")
Ceci te retoune la position de la chaine de caractère "ICI" dans la variable Ou .
Si TxtString ne contient pas "ICI", elle te renvoie 0.

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
Mais Surtout: Règlement/FONT>
Commenter la réponse de jrivet
Messages postés
172
Date d'inscription
lundi 10 octobre 2005
Dernière intervention
16 mai 2011
0
Merci
Merci encore pour ton aide Julien....


Alors avec tes indications, j'ai écrit ça.... mais ça ne récupère rien.


Open FileName For Binary As #1

    Dim Ou As Integer

    TxtString = Space(LOF(1))

    Ou = InStr(1, TxtString, "ICI")

    TxtString = Space(LOF(1) - Ou)

    Get #1, Ou, TxtString

    Close #1


J'ai peut être mal écrit.....?!


Pour info Filename est un fichier MIDI avec deux pistes de texte. Le
premier code récupère la totalité du texte (qui part en traitement pour
affichage), et j'aimerais en faire de même avec la seconde piste qui
débute invariablement par un mot.
Commenter la réponse de gribouillex
Messages postés
172
Date d'inscription
lundi 10 octobre 2005
Dernière intervention
16 mai 2011
0
Merci
J'ai beaucoup de mal à intégrer ton code dans le mien.......(dont un extrait est joint plus bas....)

En fait, la msg box apparait (avec tous les caractères, même ceux qui
sont bizarre et, me semble t'il, pas jusqu'à la fin) et ensuite il ne
se passe rien...

plus de traitement de l'affichage de TxtString comme ca me le faisait avant

--------------------------------------


Sub ReadFile()


    'On Error Resume Next

    'Open FileName For Binary As #1

    'TxtString = Space(LOF(1))

    'Get #1, , TxtString

    'Close #1


    Dim Ou As Integer 
    Open FileName For Binary As #1 

    TxtString =  Space (LOF(1)) 
    Get #1, , TxtString 

    Ou  = InStr(1, TxtString, "ICI") 

    TxtString =   Mid (TxtString, Ou) 
    MsgBox "|" & TxtString & "|" 
    Close #1


    Dim isLyric As Boolean

    isLyric = False

    nrtracks = Val("&H" & Hex(Asc(Mid(TxtString, 11, 1))) & Hex(Asc(Mid(TxtString, 12, 1))))

       

    K = InStr(1, TxtString, Chr(&HFF) & Chr(&H51))

    If K <> 0 Then

        n1 = Hex(Asc(Mid(TxtString, K + 3, 1)))

        n2 = Hex(Asc(Mid(TxtString, K + 4, 1)))

        N3 = Hex(Asc(Mid(TxtString, K + 5, 1)))

        If Len(n1) 1 Then n1 "0" & n1

        If Len(n2) 1 Then n2 "0" & n2

        If Len(N3) 1 Then N3 "0" & N3

        T1 = Hex(Asc(Mid(TxtString, 13, 1)))

        T2 = Hex(Asc(Mid(TxtString, 14, 1)))

        If Len(T1) 1 Then T1 "0" & T1

        If Len(T2) 1 Then T2 "0" & T2

        Timebase = CDec("&H" & T1 & T2) / 4

        Bpm = Format(60000000 / CDec("&H" & n1 & n2 & N3), "0.00")

        ppqn = CDec("&H" & n1 & n2 & N3)

        Quarter = (ppqn / Timebase) / 4000

    End If

   

    IniTrack = 15

    For i = 1 To nrtracks

        B1 = Hex(Asc(Mid(TxtString, IniTrack + 4, 1)))

        B2 = Hex(Asc(Mid(TxtString, IniTrack + 5, 1)))

        B3 = Hex(Asc(Mid(TxtString, IniTrack + 6, 1)))

        B4 = Hex(Asc(Mid(TxtString, IniTrack + 7, 1)))

        If Len(B1) 1 Then B1 "0" & B1

        If Len(B2) 1 Then B2 "0" & B2

        If Len(B3) 1 Then B3 "0" & B3

        If Len(B4) 1 Then B4 "0" & B4

        TrackLenght = CLng("&H" & B1 & B2 & B3 & B4)

        Tempstring = Mid(TxtString, IniTrack + 8, TrackLenght)

        K = InStr(1, Tempstring,
Chr(&HFF) & Chr(&H3) & Chr(&H5) & Chr(&H57)
& Chr(&H6F) & Chr(&H72) & Chr(&H64) &
Chr(&H73))

        If K > 0 Then

            GetWords Tempstring

            isLyric = True

            GoTo L1

           

        Else

            K = 1

            isLyric = True

            For Y = 1 To 50

               
K = InStr(K, Tempstring, Chr(&HFF) & Chr(&H1))

                If K = 0 Then

                   
isLyric = False

                    Exit For

                End If

                K = K + 1

            Next

            If isLyric Then

                GetWords Tempstring

                GoTo L1

            End If

        End If

        IniTrack = IniTrack + TrackLenght + 8

    Next

   

    GetWords TxtString


'etc............................


--------------------------------------

et voici le module GetWords


Sub GetWords(ByVal MidString As String)


    On Error Resume Next

    Dim ndx As Long, K As Long, TimeTotal As Double, Pausa As Double, NewPhrase As Integer, Ts As Integer

    Dim Byte1 As Byte, Byte2 As Byte, Byte3 As Byte, Byte4 As Byte

    K 1: ndx 0: NewPhrase = 0

    Do

        NewText = ""

        K = InStr(K, MidString, Chr(&HFF))

        If K = 0 Then Exit Sub

        TextLenght = Asc(Mid(MidString, K + 2, 1))

        If Asc(Mid(MidString, K + 1, 1)) = &H1 Then

            If Mid(MidString, K + 3, 1) <> "@" Then

               
NewText = Mid(MidString, K + 3, TextLenght)

            End If

        End If

        Byte1 = Asc(Mid(MidString, (K + 3) + TextLenght, 1))

        Byte2 = Asc(Mid(MidString, (K + 4) + TextLenght, 1))

        Byte3 = Asc(Mid(MidString, (K + 5) + TextLenght, 1))

        Byte4 = Asc(Mid(MidString, (K + 6) + TextLenght, 1))

        TempValue = 0

        If Byte2 < &HFF Then

            If Byte3 < &HFF Then

                If Byte4 < &HFF Then

                   
TempValue = TempValue And &H7F

                   
TempValue = TempValue * &H80

                   
TempValue = TempValue Or (Byte1 And &H7F)

                   
TempValue = TempValue * &H80

                   
TempValue = TempValue Or (Byte2 And &H7F)

                   
TempValue = TempValue * &H80

                   
TempValue = TempValue Or (Byte3 And &H7F)

                   
TempValue = TempValue * &H80

                   
TempValue = TempValue Or (Byte4 And &H7F)

                   
Pausa = TempValue * Quarter

                Else

                   
TempValue = TempValue And &H7F

                   
TempValue = TempValue * &H80

                   
TempValue = TempValue Or (Byte1 And &H7F)

                   
TempValue = TempValue * &H80

                   
TempValue = TempValue Or (Byte2 And &H7F)

                   
TempValue = TempValue * &H80

                   
TempValue = TempValue Or (Byte3 And &H7F)

                   
Pausa = TempValue * Quarter

                End If

            Else

               
TempValue = (((Byte1 And &H7F) * &H80) Or (Byte2 And &H7F))

                Pausa = TempValue * Quarter

            End If

        Else

            Pausa = Byte1 * Quarter

        End If

        TimeTotal = TimeTotal + Pausa

        ndx = ndx + 1

       

        ReDim Preserve Lyr(ndx)

        Select Case Trim(NewText)

            Case "/", ""

                Ts = 0

                NewText = ""

                NewPhrase = NewPhrase + 1

                ReDim Preserve Phrase(NewPhrase)

                Lyr(ndx).TxtString = ""

                Lyr(ndx).TxtStringLen = 0

                Lyr(ndx).TextStart = Ts

                Lyr(ndx).TempoAtual = Pausa

                Lyr(ndx).TempoTotal = TimeTotal

                Lyr(ndx).FraseIndex = NewPhrase

                Phrase(NewPhrase) = ""

            Case Else

               
If Left(NewText, 1) "/" Or Left(NewText, 1) "" Then

                    Ts = 0

                   
NewText = LTrim(Right(NewText, Len(NewText) - 1))

                   
NewPhrase = NewPhrase + 1

                   
ReDim Preserve Phrase(NewPhrase)

                   
Lyr(ndx).TxtString = NewText

                   
Lyr(ndx).TxtStringLen = Len(NewText)

                   
Lyr(ndx).TextStart = Ts

                   
Lyr(ndx).TempoAtual = Pausa

                   
Lyr(ndx).TempoTotal = TimeTotal

                   
Lyr(ndx).FraseIndex = NewPhrase

                   
Phrase(NewPhrase) = NewText

                Else

                   
Lyr(ndx).TxtString = NewText

                   
Lyr(ndx).TxtStringLen = Len(NewText)

                   
Lyr(ndx).TextStart = Ts

                   
Lyr(ndx).TempoAtual = Pausa

                   
Lyr(ndx).TempoTotal = TimeTotal

                   
Lyr(ndx).FraseIndex = NewPhrase

                   
Phrase(NewPhrase) = Phrase(NewPhrase) & NewText

                End If

        End Select

        Ts = Ts + Len(NewText)

        K = K + 1

    Loop


End Sub
Commenter la réponse de gribouillex
Messages postés
7401
Date d'inscription
mercredi 23 avril 2003
Dernière intervention
6 avril 2012
47
0
Merci
Envoie moi en mail ton projet et ton fichier : [mailto:epsylon9@gmail.com epsylon9@gmail.com]

J'essaierai d'y jeter un coup d'oeil, en revanche pense a bien m'y expliquer ce que tu souhaite obtenir

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
Mais Surtout: Règlement/FONT>
Commenter la réponse de jrivet
Messages postés
172
Date d'inscription
lundi 10 octobre 2005
Dernière intervention
16 mai 2011
0
Merci
Ok, je viens de te l'envoyer...

Le projet est assez gros, il contient plusieurs autres problèmes que celui que nous venons d'évoquer.

Je t'ai donc tout mis, si tu as des solutions pour les autres problèmes ils sont bienvenus aussi......


 
Commenter la réponse de gribouillex
Messages postés
172
Date d'inscription
lundi 10 octobre 2005
Dernière intervention
16 mai 2011
0
Merci
   je ne parviens pas a vous envoyer de mail............
votre boîte supporte mal les fichiers zippés que j'envoie en attachement....
Commenter la réponse de gribouillex
Messages postés
7401
Date d'inscription
mercredi 23 avril 2003
Dernière intervention
6 avril 2012
47
0
Merci
Oui Gmail...

Renomme le en .zzz ca passera.

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
Mais Surtout: Règlement/FONT>
Commenter la réponse de jrivet
Messages postés
172
Date d'inscription
lundi 10 octobre 2005
Dernière intervention
16 mai 2011
0
Merci
Ca y'est !! A force de persévérence on y arrive. Ton bout de code est
absolument extra ! J'ai réussi à l'assembler à l'ensemble du programme.


MERCI JULIEN !
Commenter la réponse de gribouillex
Messages postés
7401
Date d'inscription
mercredi 23 avril 2003
Dernière intervention
6 avril 2012
47
0
Merci
Re,
Mais de rien le forum est fait pour cela.

Donc du coup même plus besoin d'envoyer le projet

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
Mais Surtout: Règlement/FONT>
Commenter la réponse de jrivet

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.