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
| function Swap32(Value: Longword): Longword;
type
TMapLongword = array[0..3] of Byte;
begin
TMapLongword(Result)[0] := TMapLongword(Value)[3];
TMapLongword(Result)[1] := TMapLongword(Value)[2];
TMapLongword(Result)[2] := TMapLongword(Value)[1];
TMapLongword(Result)[3] := TMapLongword(Value)[0];
end;
function ChercheAPP13IPTCTag(ATag: Byte; AStream: TMemoryStream): string;
var
Mot: Word;
FinApp13, Card: Cardinal;
APP13Found, SOSFound: Boolean;
Octet: Byte;
S: string;
i: integer;
begin
Result:='non trouvé';
APP13Found:=False;
SOSFound:=False;
AStream.Seek(0, soFromBeginning);
AStream.Read(Mot, 2);
Mot:=Swap(Mot);
if Mot<>$FFD8 then Exit; // pas JPEG
repeat
AStream.Read(Mot, 2);
Mot:=Swap(Mot);
case Mot of
$FFED: APP13Found:=True; // on a trouvé le marqueur APP13
$FFDA: SOSFound:=True; // on a atteint le début l'image
else begin
AStream.Read(Mot, 2);
Mot:=Swap(Mot);
AStream.Seek(Mot-2, soFromCurrent);
end;
end;
until APP13Found or SOSFound;
if APP13Found
then begin
AStream.Read(Mot, 2); // longueur APP13
Mot:=Swap(Mot);
FinApp13:=AStream.Position+Mot-2; // pour test ultérieur
// titre APP13
S:=EmptyStr;
repeat
AStream.Read(Octet, 1);
if Octet>0 then S:=S+Chr(Octet);
until Octet=0;
// signature données
AStream.Read(Card, 4);
Card:=Swap32(Card);
if Card<>$3842494D then Exit; // = '8BIM' : signature IRB (Image Resource Block)
// signature IPTC
AStream.Read(Mot, 2);
Mot:=Swap(Mot); // inutile !!!
if Mot<>$0404 then Exit; // bloc de données IPTC-NAA
// champ 'Name' (souvent NULL)
S:=EmptyStr;
AStream.Read(Octet, 1); // nombre de caractères de la chaîne (Pascal string)
if Octet=0
then AStream.Seek(1, soFromCurrent) // car alignement pair (rempli avec 1 zéro)
else begin
for i:=1 to Octet
do begin
AStream.Read(Octet, 1);
S:=S+Chr(Octet);
end;
if Odd(Length(S))
then AStream.Seek(1, soFromCurrent) // car alignement pair (rempli avec 1 zéro)
end;
// longueur données qui suivent
AStream.Read(Card, 4);
Card:=Swap32(Card);
if AStream.Position+Card<>FinApp13 then Exit; // discordance données de longueur
// parcours des tags
while AStream.Position<FinApp13
do begin
AStream.Read(Octet, 1);
if Octet<>$1C then Exit; // marqueur obligatoire
AStream.Read(Octet, 1);
if Octet<>$02 then Exit; // on filtre les enregistrements d'application n°2
// qui correspondent aux champs IPTC décrivant le document
AStream.Read(Octet, 1); // tag
AStream.Read(Mot, 2); // longueur de la donnée
Mot:=Swap(Mot);
i:=1 shl 15; // masque bit 15
if Mot and i = i then Exit; // champs de longueur > 32767 non gérés...
if Octet=ATag
then begin
S:=EmptyStr;
for i:=1 to Mot
do begin
AStream.Read(Octet, 1);
S:=S+Chr(Octet);
end;
Result:=S;
Break; // sort du while
end
else AStream.Seek(Mot, soFromCurrent)
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
Flux: TMemoryStream;
begin
if OpenPictureDialog1.Execute
then begin
Flux:=TMemoryStream.Create;
Flux.LoadFromFile(OpenPictureDialog1.FileName);
ShowMessage(ChercheAPP13IPTCTag(55, Flux)); // Date Created : YYYYMMDD : 8 caractères
ShowMessage(ChercheAPP13IPTCTag(60, Flux)); // Time Created : HHMMSS+/-HHMM : 11 caractères
Flux.Free;
end;
end; |
Répondre avec citation
Envoyé par mecyber25
A défaut de le coder, regarde au moins ce que te dit ton Windows lorsque tu la télécharges et que tu regardes la colonne/valeur Prise de vue.
Partager