pascal
1unit ExifTool;
2
3interface
4
5uses
6 Classes, SysUtils, Vcl.Forms, Util, Windows;
7
8function ExecuteExifTool(const Command: WideString; Output, Errors: TStrings): TFunctionResult;
9
10implementation
11
12uses
13 MainForm, StatusForm;
14
15function ExecuteExifTool(const Command: WideString; Output, Errors: TStrings): TFunctionResult;
16var
17 Buffer: array[0..255] of Byte;
18 CreationFlags: DWORD;
19 NumberOfBytesRead: DWORD;
20 PipeErrorsRead: THandle;
21 PipeErrorsWrite: THandle;
22 PipeOutputRead: THandle;
23 PipeOutputWrite: THandle;
24 ProcessInfo: TProcessInformation;
25 SecurityAttr: TSecurityAttributes;
26 StartupInfo: TStartupInfo;
27 WaitResult: DWORD;
28 FileCounter: integer;
29 Line: String;
30 OutStream, ErrStream: TMemoryStream;
31 Success: BOOL;
32begin
33 FileCounter := 0;
34 FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
35 FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
36 SecurityAttr.nLength := SizeOf(TSecurityAttributes);
37 SecurityAttr.bInheritHandle := True;
38 SecurityAttr.lpSecurityDescriptor := nil;
39
40 CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);
41 CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0);
42
43 FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
44 StartupInfo.cb := SizeOf(TStartupInfo);
45 StartupInfo.hStdInput := 0;
46 StartupInfo.hStdOutput := PipeOutputWrite;
47 StartupInfo.hStdError := PipeErrorsWrite;
48 StartupInfo.wShowWindow := SW_HIDE;
49 StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
50
51 CreationFlags := CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS;
52
53 Success := CreateProcessW(
54 nil, PWideChar(Command), nil, nil, True,
55 CreationFlags, nil, nil, StartupInfo, ProcessInfo
56 );
57
58 if Success then
59 begin
60 Result := frOk;
61 CloseHandle(PipeOutputWrite);
62 CloseHandle(PipeErrorsWrite);
63
64 OutStream := TMemoryStream.Create;
65 ErrStream := TMemoryStream.Create;
66 try
67 repeat
68 WaitResult := WaitForSingleObject(ProcessInfo.hProcess, 100);
69
70 NumberOfBytesRead := 0;
71 if PeekNamedPipe(PipeOutputRead, nil, 0, nil, @NumberOfBytesRead, nil) and (NumberOfBytesRead > 0) then
72 begin
73 while ReadFile(PipeOutputRead, Buffer, Length(Buffer) - 1, NumberOfBytesRead, nil) and not frmStatus.Cancel do
74 begin
75 OutStream.Write(Buffer, NumberOfBytesRead);
76
77 for var i := 0 to NumberOfBytesRead - 1 do
78 begin
79 Line := Line + Char(Buffer[i]);
80 if Char(Buffer[i]) = #$0A then
81 begin
82 if Line.Contains('SourceFile') then
83 begin
84 Inc(FileCounter);
85 Line := UTF8ToString(RawByteString(Line));
86
87 frmStatus.FilesProcessed := FileCounter;
88
89 Line := Line.Remove(Line.Length - 4, 4).Remove(0, 17);
90 frmStatus.ProcessingFile := Line.Replace('/', '\');
91 frmMain.StatusBar.Panels[3].Text := FileCounter.ToString;
92 frmMain.StatusBar.Panels[9].Text := TruncateFileName(frmStatus.ProcessingFile, (frmMain.StatusBar.Panels[9].Width - 10) div 9);
93
94 Application.ProcessMessages;
95 end;
96 Line := '';
97 end;
98 end;
99 end;
100 end;
101
102 NumberOfBytesRead := 0;
103 if PeekNamedPipe(PipeErrorsRead, nil, 0, nil, @NumberOfBytesRead, nil) and (NumberOfBytesRead > 0) then
104 begin
105 while ReadFile(PipeErrorsRead, Buffer, Length(Buffer) - 1, NumberOfBytesRead, nil) do
106 begin
107 ErrStream.Write(Buffer, NumberOfBytesRead);
108 end;
109 end;
110
111 Application.ProcessMessages;
112 until (WaitResult <> WAIT_TIMEOUT) or frmStatus.Cancel;
113
114 if frmStatus.Cancel then
115 Result := frCancel
116 else
117 begin
118 frmStatus.FilesProcessed := FileCounter;
119 frmStatus.ProcessingFile := Line;
120 frmMain.StatusBar.Panels[3].Text := FileCounter.ToString;
121 frmMain.StatusBar.Panels[9].Text := TruncateFileName(Line, (frmMain.StatusBar.Panels[9].Width - 10) div 9);
122 end;
123
124 OutStream.Position := 0;
125 Output.LoadFromStream(OutStream);
126 ErrStream.Position := 0;
127 Errors.LoadFromStream(ErrStream);
128 finally
129 OutStream.Free;
130 ErrStream.Free;
131 end;
132
133 CloseHandle(ProcessInfo.hProcess);
134 CloseHandle(ProcessInfo.hThread);
135 CloseHandle(PipeOutputRead);
136 CloseHandle(PipeErrorsRead);
137 end
138 else
139 begin
140 CloseHandle(PipeOutputRead);
141 CloseHandle(PipeOutputWrite);
142 CloseHandle(PipeErrorsRead);
143 CloseHandle(PipeErrorsWrite);
144 Result := frError;
145 end;
146end;
147
148initialization
149
150finalization
151
152end.
153
154