Rev 95 | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
68 | daniel-mar | 1 | unit UD2_Utils; |
2 | |||
3 | interface |
||
4 | |||
5 | {$IF CompilerVersion >= 25.0} |
||
6 | {$LEGACYIFEND ON} |
||
7 | {$IFEND} |
||
8 | |||
70 | daniel-mar | 9 | {$INCLUDE 'UserDetect2.inc'} |
10 | |||
68 | daniel-mar | 11 | uses |
85 | daniel-mar | 12 | Windows, SysUtils, Dialogs, ShellAPI, Classes, UD2_Parsing; |
68 | daniel-mar | 13 | |
73 | daniel-mar | 14 | const |
15 | EXITCODE_OK = 0; |
||
16 | EXITCODE_TASK_NOTHING_MATCHES = 1; |
||
17 | EXITCODE_RUN_FAILURE = 2; |
||
18 | EXITCODE_TASK_NOT_EXISTS = 10; |
||
19 | EXITCODE_INI_NOT_FOUND = 11; |
||
20 | EXITCODE_RUNCMD_SYNTAX_ERROR = 12; |
||
81 | daniel-mar | 21 | EXITCODE_SYNTAX_ERROR = 13; |
73 | daniel-mar | 22 | |
68 | daniel-mar | 23 | type |
82 | daniel-mar | 24 | TArrayOfString = array of string; |
68 | daniel-mar | 25 | |
26 | TIconFileIdx = record |
||
27 | FileName: string; |
||
28 | IconIndex: integer; |
||
29 | end; |
||
30 | |||
82 | daniel-mar | 31 | function SplitString(const aSeparator, aString: string; aMax: Integer = 0): TArrayOfString; |
86 | daniel-mar | 32 | function MergeString(ary: TArrayOfString; glue: string): string; |
82 | daniel-mar | 33 | function BetterInterpreteBool(str: string): boolean; |
68 | daniel-mar | 34 | function GetOwnCmdName: string; |
35 | function ExpandEnvStr(const szInput: string): string; |
||
85 | daniel-mar | 36 | procedure UD2_RunCMD(cmd: TUD2Command); |
68 | daniel-mar | 37 | function SplitIconString(IconString: string): TIconFileIdx; |
38 | // function GetHTML(AUrl: string): string; |
||
39 | procedure VTS_CheckUpdates(VTSID, CurVer: string); |
||
71 | daniel-mar | 40 | function FormatOSError(ec: DWORD): string; |
81 | daniel-mar | 41 | function CheckBoolParam(idx: integer; name: string): boolean; |
87 | daniel-mar | 42 | function IndexOf_CS(aStrings: TStrings; aToken: string): Integer; |
82 | daniel-mar | 43 | function UD2_GetThreadErrorMode: DWORD; |
44 | function UD2_SetThreadErrorMode(dwNewMode: DWORD; lpOldMode: LPDWORD): BOOL; |
||
95 | daniel-mar | 45 | function GetFileVersion(const FileName: string=''): string; |
68 | daniel-mar | 46 | |
47 | implementation |
||
48 | |||
49 | uses |
||
100 | daniel-mar | 50 | wininet, Forms; |
68 | daniel-mar | 51 | |
82 | daniel-mar | 52 | function SplitString(const aSeparator, aString: string; aMax: Integer = 0): TArrayOfString; |
100 | daniel-mar | 53 | // https://stackoverflow.com/a/2626991/3544341 |
68 | daniel-mar | 54 | var |
55 | i, strt, cnt: Integer; |
||
56 | sepLen: Integer; |
||
57 | |||
58 | procedure AddString(aEnd: Integer = -1); |
||
59 | var |
||
60 | endPos: Integer; |
||
61 | begin |
||
62 | if (aEnd = -1) then |
||
63 | endPos := i |
||
64 | else |
||
65 | endPos := aEnd + 1; |
||
66 | |||
67 | if (strt < endPos) then |
||
68 | result[cnt] := Copy(aString, strt, endPos - strt) |
||
69 | else |
||
70 | result[cnt] := ''; |
||
71 | |||
72 | Inc(cnt); |
||
73 | end; |
||
74 | |||
75 | begin |
||
76 | if (aString = '') or (aMax < 0) then |
||
77 | begin |
||
78 | SetLength(result, 0); |
||
79 | EXIT; |
||
80 | end; |
||
81 | |||
82 | if (aSeparator = '') then |
||
83 | begin |
||
84 | SetLength(result, 1); |
||
85 | result[0] := aString; |
||
86 | EXIT; |
||
87 | end; |
||
88 | |||
89 | sepLen := Length(aSeparator); |
||
90 | SetLength(result, (Length(aString) div sepLen) + 1); |
||
91 | |||
92 | i := 1; |
||
93 | strt := i; |
||
94 | cnt := 0; |
||
95 | while (i <= (Length(aString)- sepLen + 1)) do |
||
96 | begin |
||
97 | if (aString[i] = aSeparator[1]) then |
||
98 | if (Copy(aString, i, sepLen) = aSeparator) then |
||
99 | begin |
||
100 | AddString; |
||
101 | |||
102 | if (cnt = aMax) then |
||
103 | begin |
||
104 | SetLength(result, cnt); |
||
105 | EXIT; |
||
106 | end; |
||
107 | |||
108 | Inc(i, sepLen - 1); |
||
109 | strt := i + 1; |
||
110 | end; |
||
111 | |||
112 | Inc(i); |
||
113 | end; |
||
114 | |||
115 | AddString(Length(aString)); |
||
116 | |||
117 | SetLength(result, cnt); |
||
118 | end; |
||
119 | |||
82 | daniel-mar | 120 | function BetterInterpreteBool(str: string): boolean; |
68 | daniel-mar | 121 | resourcestring |
122 | LNG_CANNOT_INTERPRETE_BOOL = 'Cannot determinate the boolean value of "%s"'; |
||
123 | begin |
||
124 | str := LowerCase(str); |
||
125 | if (str = 'yes') or (str = 'true') or (str = '1') then |
||
126 | result := true |
||
127 | else if (str = 'no') or (str = 'false') or (str = '0') then |
||
128 | result := false |
||
129 | else |
||
130 | raise EConvertError.CreateFmt(LNG_CANNOT_INTERPRETE_BOOL, [str]); |
||
131 | end; |
||
132 | |||
133 | function GetOwnCmdName: string; |
||
134 | begin |
||
135 | result := ParamStr(0); |
||
136 | result := ExtractFileName(result); |
||
137 | result := ChangeFileExt(result, ''); |
||
138 | result := UpperCase(result); |
||
139 | end; |
||
140 | |||
141 | function ExpandEnvStr(const szInput: string): string; |
||
100 | daniel-mar | 142 | // https://stackoverflow.com/a/2833147/3544341 |
68 | daniel-mar | 143 | const |
144 | MAXSIZE = 32768; |
||
145 | begin |
||
146 | SetLength(Result, MAXSIZE); |
||
147 | SetLength(Result, ExpandEnvironmentStrings(pchar(szInput), |
||
148 | @Result[1],length(Result))); |
||
149 | end; |
||
150 | |||
71 | daniel-mar | 151 | function FormatOSError(ec: DWORD): string; |
68 | daniel-mar | 152 | resourcestring |
153 | LNG_UNKNOWN_ERROR = 'Operating system error %d'; |
||
71 | daniel-mar | 154 | begin |
155 | result := SysErrorMessage(ec); |
||
156 | |||
157 | // Some errors have no error message, e.g. error 193 (BAD_EXE_FORMAT) in the German version of Windows 10 |
||
158 | if result = '' then result := Format(LNG_UNKNOWN_ERROR, [ec]); |
||
159 | end; |
||
160 | |||
73 | daniel-mar | 161 | function CheckLastOSCall(AThrowException: boolean): boolean; |
68 | daniel-mar | 162 | var |
163 | LastError: Cardinal; |
||
164 | begin |
||
165 | LastError := GetLastError; |
||
73 | daniel-mar | 166 | result := LastError = 0; |
167 | if not result then |
||
68 | daniel-mar | 168 | begin |
169 | if AThrowException then |
||
170 | begin |
||
171 | RaiseLastOSError; |
||
172 | end |
||
173 | else |
||
174 | begin |
||
71 | daniel-mar | 175 | MessageDlg(FormatOSError(LastError), mtError, [mbOK], 0); |
68 | daniel-mar | 176 | end; |
177 | end; |
||
178 | end; |
||
179 | |||
180 | function SplitIconString(IconString: string): TIconFileIdx; |
||
181 | var |
||
182 | p: integer; |
||
183 | begin |
||
184 | p := Pos(',', IconString); |
||
185 | |||
186 | if p = 0 then |
||
187 | begin |
||
188 | result.FileName := IconString; |
||
189 | result.IconIndex := 0; |
||
190 | end |
||
191 | else |
||
192 | begin |
||
193 | result.FileName := ExpandEnvStr(copy(IconString, 0, p-1)); |
||
194 | result.IconIndex := StrToInt(Copy(IconString, p+1, Length(IconString)-p)); |
||
195 | end; |
||
196 | end; |
||
197 | |||
85 | daniel-mar | 198 | procedure UD2_RunCMD(cmd: TUD2Command); |
100 | daniel-mar | 199 | // Discussion: https://stackoverflow.com/questions/32802679/acceptable-replacement-for-winexec/32804669#32804669 |
200 | // Version 1: https://pastebin.com/xQjDmyVe |
||
68 | daniel-mar | 201 | // --> CreateProcess + ShellExecuteEx |
202 | // --> Problem: Run-In-Same-Directory functionality is not possible |
||
203 | // (requires manual command and argument separation) |
||
100 | daniel-mar | 204 | // Version 2: https://pastebin.com/YpUmF5rd |
68 | daniel-mar | 205 | // --> Splits command and arguments manually, and uses ShellExecute |
206 | // --> Problem: error handling wrong |
||
207 | // --> Problem: Run-In-Same-Directory functionality is not implemented |
||
208 | // Current version: |
||
209 | // --> Splits command and arguments manually, and uses ShellExecute |
||
210 | // --> Run-In-Same-Directory functionality is implemented |
||
211 | resourcestring |
||
212 | LNG_INVALID_SYNTAX = 'The command line has an invalid syntax'; |
||
213 | var |
||
214 | cmdFile, cmdArgs, cmdDir: string; |
||
215 | p: integer; |
||
216 | sei: TShellExecuteInfo; |
||
85 | daniel-mar | 217 | cmdLine: string; |
68 | daniel-mar | 218 | begin |
219 | // We need a function which does following: |
||
220 | // 1. Replace the Environment strings, e.g. %SystemRoot% |
||
221 | // 2. Runs EXE files with parameters (e.g. "cmd.exe /?") |
||
222 | // 3. Runs EXE files without path (e.g. "calc.exe") |
||
223 | // 4. Runs EXE files without extension (e.g. "calc") |
||
224 | // 5. Runs non-EXE files (e.g. "Letter.doc") |
||
225 | // 6. Commands with white spaces (e.g. "C:\Program Files\xyz.exe") must be enclosed in quotes. |
||
79 | daniel-mar | 226 | |
85 | daniel-mar | 227 | cmdLine := ExpandEnvStr(cmd.executable); |
68 | daniel-mar | 228 | |
229 | // Split command line from argument list |
||
230 | if Copy(cmdLine, 1, 1) = '"' then |
||
231 | begin |
||
232 | cmdLine := Copy(cmdLine, 2, Length(cmdLine)-1); |
||
233 | p := Pos('"', cmdLine); |
||
234 | if p = 0 then |
||
235 | begin |
||
236 | // No matching quotes |
||
237 | // CreateProcess() handles the whole command line as single file name ("abc -> "abc") |
||
238 | // ShellExecuteEx() does not accept the command line |
||
73 | daniel-mar | 239 | ExitCode := EXITCODE_RUNCMD_SYNTAX_ERROR; |
68 | daniel-mar | 240 | MessageDlg(LNG_INVALID_SYNTAX, mtError, [mbOK], 0); |
241 | Exit; |
||
242 | end; |
||
243 | cmdFile := Copy(cmdLine, 1, p-1); |
||
244 | cmdArgs := Copy(cmdLine, p+2, Length(cmdLine)-p-1); |
||
245 | end |
||
246 | else |
||
247 | begin |
||
248 | p := Pos(' ', cmdLine); |
||
249 | if p = 0 then |
||
250 | begin |
||
251 | cmdFile := cmdLine; |
||
252 | cmdArgs := ''; |
||
253 | end |
||
254 | else |
||
255 | begin |
||
256 | cmdFile := Copy(cmdLine, 1, p-1); |
||
257 | cmdArgs := Copy(cmdLine, p+1, Length(cmdLine)-p); |
||
258 | end; |
||
259 | end; |
||
260 | |||
81 | daniel-mar | 261 | ZeroMemory(@sei, SizeOf(sei)); |
262 | |||
85 | daniel-mar | 263 | if cmd.runAsAdmin then |
81 | daniel-mar | 264 | begin |
265 | sei.lpVerb := 'runas'; |
||
266 | end; |
||
267 | |||
85 | daniel-mar | 268 | if cmd.runInOwnDirectory then |
68 | daniel-mar | 269 | begin |
270 | cmdFile := ExtractFileName(cmdLine); |
||
271 | cmdDir := ExtractFilePath(cmdLine); |
||
272 | end |
||
273 | else |
||
274 | begin |
||
275 | cmdFile := cmdLine; |
||
276 | cmdDir := ''; |
||
277 | end; |
||
278 | |||
279 | sei.cbSize := SizeOf(sei); |
||
280 | sei.lpFile := PChar(cmdFile); |
||
70 | daniel-mar | 281 | {$IFNDEF PREFER_SHELLEXECUTEEX_MESSAGES} |
282 | sei.fMask := SEE_MASK_FLAG_NO_UI; |
||
283 | {$ENDIF} |
||
68 | daniel-mar | 284 | if cmdArgs <> '' then sei.lpParameters := PChar(cmdArgs); |
285 | if cmdDir <> '' then sei.lpDirectory := PChar(cmdDir); |
||
85 | daniel-mar | 286 | sei.nShow := cmd.windowMode; |
68 | daniel-mar | 287 | if ShellExecuteEx(@sei) then Exit; |
70 | daniel-mar | 288 | {$IFNDEF PREFER_SHELLEXECUTEEX_MESSAGES} |
73 | daniel-mar | 289 | if not CheckLastOSCall(false) then ExitCode := EXITCODE_RUN_FAILURE; |
70 | daniel-mar | 290 | {$ENDIF} |
68 | daniel-mar | 291 | end; |
292 | |||
100 | daniel-mar | 293 | (* |
92 | daniel-mar | 294 | function GetHTML(const url: string): string; |
68 | daniel-mar | 295 | var |
92 | daniel-mar | 296 | idhttp :Tidhttp; |
68 | daniel-mar | 297 | begin |
92 | daniel-mar | 298 | idhttp := Tidhttp.Create(nil); |
299 | try |
||
300 | result := idhttp.Get(url); |
||
301 | finally |
||
302 | idhttp.Free; |
||
79 | daniel-mar | 303 | end; |
68 | daniel-mar | 304 | end; |
100 | daniel-mar | 305 | *) |
306 | // https://www.delphipraxis.net/post43515.html , fixed , works for Delphi 12 Athens |
||
307 | function GetHTML(AUrl: string): RawByteString; |
||
308 | var |
||
309 | databuffer : array[0..4095] of ansichar; // SIC! ansichar! |
||
310 | ResStr : ansistring; // SIC! ansistring |
||
311 | hSession, hfile: hInternet; |
||
312 | dwindex,dwcodelen,dwread,dwNumber: cardinal; |
||
313 | dwcode : array[1..20] of char; |
||
314 | res : pchar; |
||
315 | Str : pansichar; // SIC! pansichar |
||
316 | begin |
||
317 | ResStr:=''; |
||
318 | if (system.pos('http://',lowercase(AUrl))=0) and |
||
319 | (system.pos('https://',lowercase(AUrl))=0) then |
||
320 | AUrl:='http://'+AUrl; |
||
68 | daniel-mar | 321 | |
100 | daniel-mar | 322 | // Hinzugefügt |
323 | if Assigned(Application) then Application.ProcessMessages; |
||
324 | |||
325 | hSession:=InternetOpen('InetURL:/1.0', |
||
326 | INTERNET_OPEN_TYPE_PRECONFIG, |
||
327 | nil, |
||
328 | nil, |
||
329 | 0); |
||
330 | if assigned(hsession) then |
||
331 | begin |
||
332 | // Hinzugefügt |
||
333 | if Assigned(Application) then application.ProcessMessages; |
||
334 | |||
335 | hfile:=InternetOpenUrl( |
||
336 | hsession, |
||
337 | pchar(AUrl), |
||
338 | nil, |
||
339 | 0, |
||
340 | INTERNET_FLAG_RELOAD, |
||
341 | 0); |
||
342 | dwIndex := 0; |
||
343 | dwCodeLen := 10; |
||
344 | |||
345 | // Hinzugefügt |
||
346 | if Assigned(Application) then application.ProcessMessages; |
||
347 | |||
348 | HttpQueryInfo(hfile, |
||
349 | HTTP_QUERY_STATUS_CODE, |
||
350 | @dwcode, |
||
351 | dwcodeLen, |
||
352 | dwIndex); |
||
353 | res := pchar(@dwcode); |
||
354 | dwNumber := sizeof(databuffer)-1; |
||
355 | if (res ='200') or (res = '302') then |
||
356 | begin |
||
357 | while (InternetReadfile(hfile, |
||
358 | @databuffer, |
||
359 | dwNumber, |
||
360 | DwRead)) do |
||
361 | begin |
||
362 | |||
363 | // Hinzugefügt |
||
364 | if Assigned(Application) then application.ProcessMessages; |
||
365 | |||
366 | if dwRead =0 then |
||
367 | break; |
||
368 | databuffer[dwread]:=#0; |
||
369 | Str := pansichar(@databuffer); |
||
370 | resStr := resStr + Str; |
||
371 | end; |
||
372 | end |
||
373 | else |
||
374 | ResStr := 'Status:'+AnsiString(res); |
||
375 | if assigned(hfile) then |
||
376 | InternetCloseHandle(hfile); |
||
377 | end; |
||
378 | |||
379 | // Hinzugefügt |
||
380 | if Assigned(Application) then application.ProcessMessages; |
||
381 | |||
382 | InternetCloseHandle(hsession); |
||
383 | Result := resStr; |
||
384 | end; |
||
385 | |||
68 | daniel-mar | 386 | procedure VTS_CheckUpdates(VTSID, CurVer: string); |
387 | resourcestring |
||
388 | (* |
||
389 | LNG_DOWNLOAD_ERR = 'Ein Fehler ist aufgetreten. Wahrscheinlich ist keine Internetverbindung aufgebaut, oder der der ViaThinkSoft-Server temporär offline.'; |
||
390 | LNG_NEW_VERSION = 'Eine neue Programmversion ist vorhanden. Möchten Sie diese jetzt herunterladen?'; |
||
391 | LNG_NO_UPDATE = 'Es ist keine neue Programmversion vorhanden.'; |
||
392 | *) |
||
393 | LNG_DOWNLOAD_ERR = 'An error occurred while searching for updates. Please check your internet connection and firewall.'; |
||
394 | LNG_NEW_VERSION = 'A new version is available. Do you want to download it now?'; |
||
395 | LNG_NO_UPDATE = 'You already have the newest program version.'; |
||
396 | var |
||
100 | daniel-mar | 397 | status: RawByteString; |
68 | daniel-mar | 398 | begin |
100 | daniel-mar | 399 | status := GetHTML('https://www.viathinksoft.de/update/?id='+VTSID); |
79 | daniel-mar | 400 | if Copy(status, 0, 7) = 'Status:' then |
68 | daniel-mar | 401 | begin |
402 | MessageDlg(LNG_DOWNLOAD_ERR, mtError, [mbOK], 0); |
||
403 | end |
||
404 | else |
||
405 | begin |
||
100 | daniel-mar | 406 | if string(status) <> CurVer then |
68 | daniel-mar | 407 | begin |
408 | if MessageDlg(LNG_NEW_VERSION, mtConfirmation, mbYesNoCancel, 0) = ID_YES then |
||
409 | begin |
||
100 | daniel-mar | 410 | shellexecute(application.handle, 'open', pchar('https://www.viathinksoft.de/update/?id=@'+VTSID), '', '', SW_Normal); |
68 | daniel-mar | 411 | end; |
412 | end |
||
413 | else |
||
414 | begin |
||
415 | MessageDlg(LNG_NO_UPDATE, mtInformation, [mbOk], 0); |
||
416 | end; |
||
417 | end; |
||
418 | end; |
||
419 | |||
81 | daniel-mar | 420 | function CheckBoolParam(idx: integer; name: string): boolean; |
421 | begin |
||
422 | Result := ('/'+LowerCase(name) = LowerCase(ParamStr(idx))) or |
||
423 | ('-'+LowerCase(name) = LowerCase(ParamStr(idx))); |
||
424 | end; |
||
425 | |||
82 | daniel-mar | 426 | // function GetThreadErrorMode: DWORD; stdcall; external kernel32 name 'GetThreadErrorMode'; |
427 | function UD2_GetThreadErrorMode: DWORD; |
||
428 | type |
||
429 | TFuncGetThreadErrorMode = function: DWORD; stdcall; |
||
430 | var |
||
431 | dllHandle: Cardinal; |
||
432 | fGetThreadErrorMode: TFuncGetThreadErrorMode; |
||
433 | begin |
||
434 | dllHandle := LoadLibrary(kernel32); |
||
435 | if dllHandle = 0 then |
||
436 | begin |
||
437 | result := 0; |
||
438 | Exit; |
||
439 | end; |
||
440 | try |
||
441 | @fGetThreadErrorMode := GetProcAddress(dllHandle, 'GetThreadErrorMode'); |
||
442 | if not Assigned(fGetThreadErrorMode) then |
||
443 | begin |
||
444 | result := 0; // Windows Vista and prior |
||
445 | Exit; |
||
446 | end; |
||
447 | result := fGetThreadErrorMode(); |
||
448 | finally |
||
449 | FreeLibrary(dllHandle); |
||
450 | end; |
||
451 | end; |
||
452 | |||
453 | // function SetThreadErrorMode(dwNewMode: DWORD; lpOldMode: LPDWORD): BOOL; stdcall; external kernel32 name 'SetThreadErrorMode'; |
||
454 | function UD2_SetThreadErrorMode(dwNewMode: DWORD; lpOldMode: LPDWORD): BOOL; |
||
455 | type |
||
456 | TFuncSetThreadErrorMode = function(dwNewMode: DWORD; lpOldMode: LPDWORD): BOOL; stdcall; |
||
457 | var |
||
458 | dllHandle: Cardinal; |
||
459 | fSetThreadErrorMode: TFuncSetThreadErrorMode; |
||
460 | begin |
||
461 | dllHandle := LoadLibrary(kernel32); |
||
462 | if dllHandle = 0 then |
||
463 | begin |
||
464 | result := FALSE; |
||
465 | if Assigned(lpOldMode) then lpOldMode^ := UD2_GetThreadErrorMode; |
||
466 | Exit; |
||
467 | end; |
||
468 | try |
||
469 | @fSetThreadErrorMode := GetProcAddress(dllHandle, 'SetThreadErrorMode'); |
||
470 | if not Assigned(fSetThreadErrorMode) then |
||
471 | begin |
||
472 | result := FALSE; // Windows Vista and prior |
||
473 | if Assigned(lpOldMode) then lpOldMode^ := UD2_GetThreadErrorMode; |
||
474 | Exit; |
||
475 | end; |
||
476 | result := fSetThreadErrorMode(dwNewMode, lpOldMode); |
||
477 | finally |
||
478 | FreeLibrary(dllHandle); |
||
479 | end; |
||
480 | end; |
||
481 | |||
482 | function IndexOf_CS(aStrings: TStrings; aToken: String): Integer; |
||
483 | var |
||
85 | daniel-mar | 484 | i: Integer; |
82 | daniel-mar | 485 | begin |
486 | Result := -1; |
||
85 | daniel-mar | 487 | for i := 0 to aStrings.Count-1 do |
488 | begin |
||
489 | if aStrings[i] = aToken then |
||
490 | begin |
||
82 | daniel-mar | 491 | Result := i; |
492 | Break; |
||
493 | end; |
||
85 | daniel-mar | 494 | end; |
82 | daniel-mar | 495 | end; |
496 | |||
86 | daniel-mar | 497 | function MergeString(ary: TArrayOfString; glue: string): string; |
498 | var |
||
499 | i: integer; |
||
500 | begin |
||
501 | result := ''; |
||
502 | for i := Low(ary) to High(ary) do |
||
503 | begin |
||
504 | if result <> '' then result := result + glue; |
||
505 | result := result + ary[i]; |
||
506 | end; |
||
507 | end; |
||
508 | |||
95 | daniel-mar | 509 | function GetFileVersion(const FileName: string=''): string; |
510 | var |
||
511 | lpVerInfo: pointer; |
||
512 | rVerValue: PVSFixedFileInfo; |
||
513 | dwInfoSize: cardinal; |
||
514 | dwValueSize: cardinal; |
||
515 | dwDummy: cardinal; |
||
516 | lpstrPath: pchar; |
||
517 | a, b, c, d: word; |
||
518 | resourcestring |
||
519 | LNG_NO_VERSION = 'No version specification'; |
||
520 | begin |
||
521 | if Trim(FileName) = EmptyStr then |
||
522 | lpstrPath := pchar(ParamStr(0)) |
||
523 | else |
||
524 | lpstrPath := pchar(FileName); |
||
525 | |||
526 | dwInfoSize := GetFileVersionInfoSize(lpstrPath, dwDummy); |
||
527 | |||
528 | if dwInfoSize = 0 then |
||
529 | begin |
||
530 | Result := LNG_NO_VERSION; |
||
531 | Exit; |
||
532 | end; |
||
533 | |||
534 | GetMem(lpVerInfo, dwInfoSize); |
||
535 | try |
||
536 | GetFileVersionInfo(lpstrPath, 0, dwInfoSize, lpVerInfo); |
||
537 | VerQueryValue(lpVerInfo, '', pointer(rVerValue), dwValueSize); |
||
538 | |||
539 | with rVerValue^ do |
||
540 | begin |
||
541 | a := dwFileVersionMS shr 16; |
||
542 | b := dwFileVersionMS and $FFFF; |
||
543 | c := dwFileVersionLS shr 16; |
||
544 | d := dwFileVersionLS and $FFFF; |
||
545 | |||
546 | Result := IntToStr(a); |
||
547 | if (b <> 0) or (c <> 0) or (d <> 0) then Result := Result + '.' + IntToStr(b); |
||
548 | if (c <> 0) or (d <> 0) then Result := Result + '.' + IntToStr(c); |
||
549 | if (d <> 0) then Result := Result + '.' + IntToStr(d); |
||
550 | end; |
||
551 | finally |
||
552 | FreeMem(lpVerInfo, dwInfoSize); |
||
553 | end; |
||
554 | |||
555 | end; |
||
556 | |||
68 | daniel-mar | 557 | end. |