Skip to main navigation Skip to main content Skip to page footer
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