Bonjour,
Au coup d’œil, une question me vient : les record tiennent-ils compte dans tous les cas (exe 32/64 bits, D7/Delphi actuel) de l'alignement sur 8 octets dont il me semble me souvenir des spécifications ?
Version imprimable
Bonjour,
Au coup d’œil, une question me vient : les record tiennent-ils compte dans tous les cas (exe 32/64 bits, D7/Delphi actuel) de l'alignement sur 8 octets dont il me semble me souvenir des spécifications ?
Le temps de chargement de bArray représente 90% du temps total, en limitant la taille de chargement à 1ko, avec le même code, le temps est divisé par 10 :D.
C'est sans doute moins bien que Cirec et Paul, mais le gain est instantané.Code:if Taille>1023 then Taille:=1023;
Belle journée,
j'aimerai bien mais je doute sérieusement, je dirai que tu t'y es pris après moi :D
pare contre dans les fichiers que j'ai utilisé pour les testes certain on l'info en début de fichier et d'autre à la fin ...
et sur un fichier de 2Go avec l'info en fin ça ne risque pas de prendre du temps ?
d'où mon changement de tactique avec un buffer + gros et une recherche en début et si pas trouvé en fin de fichier.
ce qui a rendu de code quasi instantané.
Ben si je dis pas de bêtises par défaut delphi aligne les records en {$Align8}
pour le mode 32Bits il n'y a pas de soucis ça fonctionneCitation:
Envoyé par Aide Delphi
n'ayant pas de fichier avec des données en 64Bits j'ai pas testé.
Ceci dit pour respecter le nombre d'octets à lire j'ajouterai certainement le packed
Bien que ce soit en contradiction avec l'alignement sur 8 octets.
Je suis un peu perdu là !
peut être que Paul pourrait nous éclairer ;)
Cordialement,
@+
Bonjour Cirec
merci pour ta solution
j'ai testé, mais StrMoov n'était pas déclaré j'ai déclaré : StrMoov : AnsiString;
GetMP4Duration me renvoie systématiquement -1 ?
A+
Charly
Bonjour Paul,
Merci, mais j'ai un problème avec ton code en D7 :
J'ai remplacé Exit(False ) par Result := False ; Exit ;
par contre avec
:Code:S.Seek(H.Size - SizeOf(H), TSeekOrigin.soCurrent); // sauter la section
j'ai une erreur : Type Object ou Class requis ?
A+
Charly
@Cirec : merci ça fonctionne très bien et c'est très rapide
@Galet : oui on peut limiter à 1ko, mais dans certains MP4, la balise mvhd est presque en fin de fichier
A+
Charly
@PaulToth
ton code fonctionne bien quand l'info est en début de fichier
mais déclenche une Erreur de lecture du flux quand elle se trouve vers la fin.
dans la bouclecomme les Chunk ne se suivent pas obligatoirementCode:
1
2
3
4
5 repeat H.Size := LSwap(H.Size); S.Seek(H.Size - SizeOf(H), soFromCurrent); // sauter la section S.ReadBuffer(H, SizeOf(H)); // lire la suivante until H.Tag = 'moov'; // jusqu'au "moov"
du coup au bout de 3 répétitions H.Size contient une valeur totalement farfelue !!!
Cordialement,
@+
je n'ai testé qu'avec un seul et unique MP4 :)
mais normalement, le MP4 contient des blocks TMP4Chunk, qui peuvent eux même contenir des TMP4Chunk
donc je lis le premier qui doit être un 'ftyp', et je le saute (on avance de H.Size - SizeOf(H))
quand je trouve un "moov", je lis à l'intérieur jusqu'à ce que je trouve un "mvhd"
ah mais peut-être que ton MP4 contient plusieurs "moov" sans "mvhd" avant celui qui n'en contienne un
du coup il faut dans la boucle tenir compte de la taille du "moov" pour sortir de la boucle si on arrive au bout
quelque chose comme ça :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67 function GetMP4Duration(const AFileName: string; var Duration: Int64): Boolean; type TMP4Chunk = packed record Size: Cardinal; Tag : array[0..3] of AnsiChar; end; TMP4Mvhd = packed record Ver: Byte; Flags: array[0..2] of Byte; case Boolean of True: ( Creation1, Modified1: UInt64; Timescale1: Cardinal; Duration1: UInt64; ); False: ( Creation2, Modified2: Cardinal; Timescale2: Cardinal; Duration2: Cardinal; ); end; var S: TFileStream; H: TMP4Chunk; M: TMP4Mvhd; L: Cardinal; begin Result := False; S := TfileStream.Create(AFileName, fmOpenRead or fmShareDenyNone); try S.ReadBuffer(H, SizeOf(H)); // lecture d'un entête MP4 if H.Tag <> 'ftyp' then // vérification du type Exit(False); repeat // on peut avoir à lire +sieurs "moov" while H.Tag <> 'moov' do begin H.Size := LSwap(H.Size); S.Seek(H.Size - SizeOf(H), TSeekOrigin.soCurrent); // sauter la section S.ReadBuffer(H, SizeOf(H)); // lire la suivante end; L := LSwap(H.Size) - SizeOf(H); S.ReadBuffer(H, SizeOf(H)); // lire dans "moov" while (L > 0) and (H.Tag <> 'mvhd') do // jusque "mvhd" begin H.Size := LSwap(H.Size); Dec(L, H.Size); S.Seek(H.Size - SizeOf(H), TSeekOrigin.soCurrent); S.ReadBuffer(H, SizeOf(H)); end; until H.Tag = 'mvhd'; S.ReadBuffer(M, SizeOf(M)); // lire son contenu if M.Ver = 1 then // en fonction de la version begin M.Duration2 := LLSwap(M.Duration2); // non testé ! M.Timescale1 := LSwap(M.Timescale1); Duration := M.Duration1 div M.Timescale1; end else begin M.Duration2 := LSwap(M.Duration2); M.Timescale2 := LSwap(M.Timescale2); Duration := M.Duration2 div M.Timescale2; // calculé la durée en secondes end; Result := True; finally S.Free; end; end;
re,
j'ai compris d'où venait le souci ...
c'est pas ton code directement mais en codant une ligne différemment tout fonctionne !!!
bizarrement avec Seek ça ne fonctionne pas correctement en D7Code:
1
2 //S.Seek(H.Size - SizeOf(H), soFromCurrent); // sauter la section S.Position := S.Position + (H.Size - SizeOf(H));
en pas à pas peu importe la valeur de H.Size - SizeOf(H)
il conservait sa valeur
et après 3 ou 4 passe seek fonctionne à nouveau mais la position est déjà erronée.
j'avais aussi un problème avec Seek dans mon code et je suis aussi passé pas Position !
étrange quand même.
Cordialement,
@+
Version D7 du code de Paul Toth, il fonctionne pour 117 MP4 lus sur 118 trouvé, une Erreur de lecture, je ne teste pas sur la machine qui compile donc code de débogage bien vilain
Si je retrouve ce que j'avais fait pour des fichiers H264 à l'époque ou je gérais des DVR Dahua.
Sans la sortie sur "Next H not moov aborted" il y a aurait une erreur
En soFromCurrent : "Read Next H not moov - EReadError "Stream read error" - 2010960942 -> 2010960942 / 1220300993"
En soCurrent : "Read Next H not moov - EReadError "Stream read error" - 4295850655 -> 4295850655 / 1220300993"
Peut-être ajouter une gestion de fin de fichier prématurée ou se protéger de valeurs incohérentes dans le fichier lui-même
soFromCurrent et soCurrent existet en D7, cela différencie la version 32 et 64 Bits
C'est pour cela que dans un cas, cela qu'en soFromCurrent gérant des Integer, cela donne un nombre en 2... et en soCurrent, cela prend en 4...
Tout ça parce que le Seek tente un déplacement négatif donc en arrière qui part totalement en vrille !
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201 unit MP4HeaderReader_MainForm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; Edit1: TEdit; Button2: TButton; Edit2: TEdit; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Déclarations privées } procedure ScanMP4(const ADirectory: TFileName); public { Déclarations publiques } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin ScanMP4(Edit1.Text); end; function GetMP4Duration(const AFileName: string; var Duration: Int64): Boolean; function LSwap(C: Cardinal): Cardinal; begin Result := Swap(C) shl 16 + Swap(C shr 16); end; function LLSwap(L: UInt64): UInt64; begin Result := LSwap(L) shl 32 + LSwap(L shr 32); end; type TMP4Chunk = packed record Size: Cardinal; Tag : array[0..3] of AnsiChar; end; TMP4Mvhd = packed record Ver: Byte; Flags: array[0..2] of Byte; case Boolean of True: ( Creation1, Modified1: UInt64; Timescale1: Cardinal; Duration1: UInt64; ); False: ( Creation2, Modified2: Cardinal; Timescale2: Cardinal; Duration2: Cardinal; ); end; procedure _ReadBuffer(AStream: TFileStream; var ABuffer; ASize: Int64; const AHint: string); var P: Int64; begin P := AStream.Position; try AStream.ReadBuffer(ABuffer, ASize); except on E: Exception do raise ExceptClass(E.classType).CreateFmt('Read %s - %s "%s" - %d -> %d / %d', [AHint, E.ClassName, E.Message, P, AStream.Position, AStream.Size]); end; end; var S: TFileStream; H: TMP4Chunk; M: TMP4Mvhd; L: Cardinal; begin Result := False; S := TfileStream.Create(AFileName, fmOpenRead or fmShareDenyNone); try _ReadBuffer(S, H, SizeOf(H), 'First H'); // lecture d'un entête MP4 if H.Tag <> 'ftyp' then // vérification du type Exit; repeat // on peut avoir à lire +sieurs "moov" while H.Tag <> 'moov' do begin H.Size := LSwap(H.Size); if H.Size < SizeOf(H) then raise Exception.Create('Next H not moov aborted'); S.Seek(H.Size - SizeOf(H), soCurrent); // sauter la section _ReadBuffer(S, H, SizeOf(H), 'Next H not moov'); // lire la suivante end; L := LSwap(H.Size) - SizeOf(H); _ReadBuffer(S, H, SizeOf(H), 'Current H moov'); // lire dans "moov" while (L > 0) and (H.Tag <> 'mvhd') do // jusque "mvhd" begin H.Size := LSwap(H.Size); if H.Size < SizeOf(H) then raise Exception.Create('Next H not mvhd aborted'); Dec(L, H.Size); S.Seek(H.Size - SizeOf(H), soCurrent); _ReadBuffer(S, H, SizeOf(H), 'Next H not mvhd'); end; until H.Tag = 'mvhd'; _ReadBuffer(S, M, SizeOf(M), 'Current M mvhd'); // lire son contenu if M.Ver = 1 then // en fonction de la version begin M.Duration2 := LLSwap(M.Duration2); // non testé ! M.Timescale1 := LSwap(M.Timescale1); Duration := M.Duration1 div M.Timescale1; end else begin M.Duration2 := LSwap(M.Duration2); M.Timescale2 := LSwap(M.Timescale2); Duration := M.Duration2 div M.Timescale2; // calculé la durée en secondes end; Result := True; finally S.Free; end; end; procedure TForm1.ScanMP4(const ADirectory: TFileName); var Dir: TFileName; Path, Filter, FileName: string; sr: TSearchRec; Duration: Int64; const faNormal = $00000080; begin Path := IncludeTrailingPathDelimiter(ADirectory); Filter := Path + '*.mp4'; // Les Fichiers ! if FindFirst(Filter, faNormal, sr) = 0 then begin try repeat FileName := Path + sr.Name; try if GetMP4Duration(FileName, Duration) then Memo1.Lines.Add(FileName + ' : ' + IntToStr(Duration)) else Memo1.Lines.Add(FileName + ' : Error') except on E: Exception do Memo1.Lines.Add(FileName + ' : ' + E.Message); end; until FindNext(sr) <> 0; finally FindClose(sr); end; end; // Les Dossiers ! Filter := Path + '*'; if FindFirst(Filter, faDirectory, sr) = 0 then begin try repeat if ((sr.Attr and faDirectory) = faDirectory) and (sr.Name <> '.') and (sr.Name <> '..') then begin Dir := Path + sr.Name; ScanMP4(Dir); end; until FindNext(sr) <> 0; finally FindClose(sr); end; end; end; procedure TForm1.Button2Click(Sender: TObject); var Duration: Int64; begin if GetMP4Duration(Edit2.Text, Duration) then Memo1.Lines.Add(Edit2.Text + ' : ' + IntToStr(Duration)) else Memo1.Lines.Add(Edit2.Text + ' : Error'); end; end.
pour le debugage sur le poste client je ne serais trop te recommander madExcept, cet outils m'a sauvé la mise plus d'une fois :)
tu peux même faire en sorte qu'il t'envoie l'erreur par mail (ce que je fais), le client n'y voit que du feu, mais à la maj suivante, l'erreur à disparu :D
Bonsoir,
pour ma part, les 2 codes me donnent satisfaction, celui de Paul Toth et celui de Cirec.
J'ai fait des tests approximatifs qui montrent qu'ils sont quasiment aussi rapide l'un que l'autre.
je n'ai pas eu de problème avec le code de Paul, sauf quand le fichier MP4 faisait 0 k !
Merci donc
A+
Charly
Bonjour à toutes et à tous,
Chapeau bas à Cirec et à Paul THOT.
Pour répondre à Charly910 j'avais testé une version sans fichier .bat qui utilise le lecteur sans le faire lire et qui donne aussi l'indication pour les mp4, mp3:
Rien à voir avec les solutions proposées qui fonctionnent sur D6 et Win10 64 bits.Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42 procedure TForm1.OuvrirClick(Sender: TObject); var FileName, res : string; h, min, sec : string[3]; begin op1.CleanupInstance; chappli := ExtractFilePath(Application.ExeName); ForceCurrentDirectory := True; SetCurrentDir (chappli); op1.Filter := 'Fichiers Musical (*.mp4;*.mp3;*.wma)|*.mp4;*.mp3;*.wma|Fichiers Mp4 (*.mp4)|*.mp4|Fichiers Mp3 (*.mp3)|*.mp3|Fichiers Wma (*.wma)|*.wma' ; if op1.Execute then begin Mp1.FileName := op1.filename; Mp1.Open; h := inttostr(mp1.Length div 3600000 );//initialisation des heures min := inttostr(mp1.Length div 60000);//initialisation des minutes sec := inttostr(mp1.Length div 1000 - 60*strtoint(min));//initialisation des secondes if strtoint(h) <10 then h := '0'+h; if strtoint(min)<10 then min := '0'+min; if strtoint(sec)<10 then sec := '0'+sec; Edit1.text := h+':'+min+':'+sec; end; end;
Cordialement,
cincap
Bonjour,
le problème est largement résolu avec des solutions très rapides.
Test avec un panel de 690 videos :
- environ 200 ms pour Cirec
- environ 150 ms pour Paul Toth et ShaiLeTroll
Je n'ai pas pu tester la solution de Cincap car j'ai un problème à l'ouverture du TMediaPlayer
En tout cas merci à Tous les 4
A+
Charly
@ Charly910, avec Win10 et certains pc dès fois il existe des bugs.
Par contre la version avec le fichier .bat que tu as testée permet de donner la durée pour les fichiers .mp4, .mp3, .wma et .wav.
Il suffirait à un expert de le convertir en Delphi puisque j'utilise "CreateOleObject('Shell.Application');".
Si il le faut je communique le .bat pour ne pas polluer le site.
@+,
cincap