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

gribouillex 172 Messages postés lundi 10 octobre 2005Date d'inscription 16 mai 2011 Dernière intervention - 26 juin 2006 à 14:42 - Dernière réponse : jrivet 7401 Messages postés mercredi 23 avril 2003Date d'inscription 6 avril 2012 Dernière intervention
- 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
jrivet 7401 Messages postés mercredi 23 avril 2003Date d'inscription 6 avril 2012 Dernière intervention - 26 juin 2006 à 15:33
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>

Merci jrivet 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 101 internautes ce mois-ci

Commenter la réponse de jrivet
jrivet 7401 Messages postés mercredi 23 avril 2003Date d'inscription 6 avril 2012 Dernière intervention - 26 juin 2006 à 14:48
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
gribouillex 172 Messages postés lundi 10 octobre 2005Date d'inscription 16 mai 2011 Dernière intervention - 26 juin 2006 à 15:02
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
jrivet 7401 Messages postés mercredi 23 avril 2003Date d'inscription 6 avril 2012 Dernière intervention - 26 juin 2006 à 15:10
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
gribouillex 172 Messages postés lundi 10 octobre 2005Date d'inscription 16 mai 2011 Dernière intervention - 26 juin 2006 à 15:25
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
gribouillex 172 Messages postés lundi 10 octobre 2005Date d'inscription 16 mai 2011 Dernière intervention - 26 juin 2006 à 16:44
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
jrivet 7401 Messages postés mercredi 23 avril 2003Date d'inscription 6 avril 2012 Dernière intervention - 26 juin 2006 à 16:52
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
gribouillex 172 Messages postés lundi 10 octobre 2005Date d'inscription 16 mai 2011 Dernière intervention - 26 juin 2006 à 17:19
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
gribouillex 172 Messages postés lundi 10 octobre 2005Date d'inscription 16 mai 2011 Dernière intervention - 26 juin 2006 à 22:51
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
jrivet 7401 Messages postés mercredi 23 avril 2003Date d'inscription 6 avril 2012 Dernière intervention - 27 juin 2006 à 08:40
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
gribouillex 172 Messages postés lundi 10 octobre 2005Date d'inscription 16 mai 2011 Dernière intervention - 27 juin 2006 à 11:09
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
jrivet 7401 Messages postés mercredi 23 avril 2003Date d'inscription 6 avril 2012 Dernière intervention - 27 juin 2006 à 11:19
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.