Subversion Repositories userdetect2

Rev

Rev 81 | Rev 85 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 81 Rev 82
Line 6... Line 6...
6 
{$LEGACYIFEND ON}
 6 
{$LEGACYIFEND ON}
7 
{$IFEND}
 7 
{$IFEND}
8 
 
 8 
 
9 
{$INCLUDE 'UserDetect2.inc'}
 9 
{$INCLUDE 'UserDetect2.inc'}
10 
 
 10 
 
11 
{$WARN UNSAFE_CODE OFF}
 - 
 
12 
{$WARN UNSAFE_TYPE OFF}
 - 
 
13 
 
 - 
 
14 
uses
 11 
uses
15 
  Windows, SysUtils, Dialogs, ShellAPI;
 12 
  Windows, SysUtils, Dialogs, ShellAPI, Classes;
16 
 
 13 
 
17 
const
 14 
const
18 
  EXITCODE_OK = 0;
 15 
  EXITCODE_OK = 0;
19 
  EXITCODE_TASK_NOTHING_MATCHES = 1;
 16 
  EXITCODE_TASK_NOTHING_MATCHES = 1;
20 
  EXITCODE_RUN_FAILURE = 2;
 17 
  EXITCODE_RUN_FAILURE = 2;
Line 22... Line 19...
22 
  EXITCODE_INI_NOT_FOUND = 11;
 19 
  EXITCODE_INI_NOT_FOUND = 11;
23 
  EXITCODE_RUNCMD_SYNTAX_ERROR = 12;
 20 
  EXITCODE_RUNCMD_SYNTAX_ERROR = 12;
24 
  EXITCODE_SYNTAX_ERROR = 13;
 21 
  EXITCODE_SYNTAX_ERROR = 13;
25 
 
 22 
 
26 
type
 23 
type
27 
  TArrayOfString = array of String;
 24 
  TArrayOfString = array of string;
28 
 
 25 
 
29 
  TIconFileIdx = record
 26 
  TIconFileIdx = record
30 
    FileName: string;
 27 
    FileName: string;
31 
    IconIndex: integer;
 28 
    IconIndex: integer;
32 
  end;
 29 
  end;
Line 34... Line 31...
34 
const
 31 
const
35 
  // Prefixes for UD2_RunCmd()
 32 
  // Prefixes for UD2_RunCmd()
36 
  UD2_RUN_IN_OWN_DIRECTORY_PREFIX = '$RIOD$';
 33 
  UD2_RUN_IN_OWN_DIRECTORY_PREFIX = '$RIOD$';
37 
  UD2_RUN_AS_ADMIN                = '$ADMIN$';
 34 
  UD2_RUN_AS_ADMIN                = '$ADMIN$';
38 
 
 35 
 
39 
function SplitString(const aSeparator, aString: String; aMax: Integer = 0): TArrayOfString;
 36 
function SplitString(const aSeparator, aString: string; aMax: Integer = 0): TArrayOfString;
40 
function BetterInterpreteBool(str: String): boolean;
 37 
function BetterInterpreteBool(str: string): boolean;
41 
function GetOwnCmdName: string;
 38 
function GetOwnCmdName: string;
42 
function ExpandEnvStr(const szInput: string): string;
 39 
function ExpandEnvStr(const szInput: string): string;
43 
procedure UD2_RunCMD(cmdLine: string; WindowMode: integer=SW_NORMAL);
 40 
procedure UD2_RunCMD(cmdLine: string; WindowMode: integer=SW_NORMAL);
44 
function SplitIconString(IconString: string): TIconFileIdx;
 41 
function SplitIconString(IconString: string): TIconFileIdx;
45 
// function GetHTML(AUrl: string): string;
 42 
// function GetHTML(AUrl: string): string;
46 
procedure VTS_CheckUpdates(VTSID, CurVer: string);
 43 
procedure VTS_CheckUpdates(VTSID, CurVer: string);
47 
function FormatOSError(ec: DWORD): string;
 44 
function FormatOSError(ec: DWORD): string;
48 
function CheckBoolParam(idx: integer; name: string): boolean;
 45 
function CheckBoolParam(idx: integer; name: string): boolean;
- 
 
 46 
function IndexOf_CS(aStrings: TStrings; aToken: String): Integer;
- 
 
 47 
function UD2_GetThreadErrorMode: DWORD;
- 
 
 48 
function UD2_SetThreadErrorMode(dwNewMode: DWORD; lpOldMode: LPDWORD): BOOL;
49 
 
 49 
 
50 
implementation
 50 
implementation
51 
 
 51 
 
52 
uses
 52 
uses
53 
  WinInet, Forms;
 53 
  WinInet, Forms;
54 
 
 54 
 
55 
function SplitString(const aSeparator, aString: String; aMax: Integer = 0): TArrayOfString;
 55 
function SplitString(const aSeparator, aString: string; aMax: Integer = 0): TArrayOfString;
56 
// http://stackoverflow.com/a/2626991/3544341
 56 
// http://stackoverflow.com/a/2626991/3544341
57 
var
 57 
var
58 
  i, strt, cnt: Integer;
 58 
  i, strt, cnt: Integer;
59 
  sepLen: Integer;
 59 
  sepLen: Integer;
60 
 
 60 
 
Line 118... Line 118...
118 
  AddString(Length(aString));
 118 
  AddString(Length(aString));
119 
 
 119 
 
120 
  SetLength(result, cnt);
 120 
  SetLength(result, cnt);
121 
end;
 121 
end;
122 
 
 122 
 
123 
function BetterInterpreteBool(str: String): boolean;
 123 
function BetterInterpreteBool(str: string): boolean;
124 
resourcestring
 124 
resourcestring
125 
  LNG_CANNOT_INTERPRETE_BOOL = 'Cannot determinate the boolean value of "%s"';
 125 
  LNG_CANNOT_INTERPRETE_BOOL = 'Cannot determinate the boolean value of "%s"';
126 
begin
 126 
begin
127 
  str := LowerCase(str);
 127 
  str := LowerCase(str);
128 
  if (str = 'yes') or (str = 'true') or (str = '1') then
 128 
  if (str = 'yes') or (str = 'true') or (str = '1') then
Line 399... Line 399...
399 
  begin
 399 
  begin
400 
    if status <> CurVer then
 400 
    if status <> CurVer then
401 
    begin
 401 
    begin
402 
      if MessageDlg(LNG_NEW_VERSION, mtConfirmation, mbYesNoCancel, 0) = ID_YES then
 402 
      if MessageDlg(LNG_NEW_VERSION, mtConfirmation, mbYesNoCancel, 0) = ID_YES then
403 
      begin
 403 
      begin
404 
        shellexecute(application.handle, 'open', pchar('http://www.viathinksoft.de/update/?id=@'+VTSID), '', '', sw_normal);
 404 
        shellexecute(application.handle, 'open', pchar('http://www.viathinksoft.de/update/?id=@'+VTSID), '', '', SW_Normal);
405 
      end;
 405 
      end;
406 
    end
 406 
    end
407 
    else
 407 
    else
408 
    begin
 408 
    begin
409 
      MessageDlg(LNG_NO_UPDATE, mtInformation, [mbOk], 0);
 409 
      MessageDlg(LNG_NO_UPDATE, mtInformation, [mbOk], 0);
Line 415... Line 415...
415 
begin
 415 
begin
416 
  Result := ('/'+LowerCase(name) = LowerCase(ParamStr(idx))) or
 416 
  Result := ('/'+LowerCase(name) = LowerCase(ParamStr(idx))) or
417 
            ('-'+LowerCase(name) = LowerCase(ParamStr(idx)));
 417 
            ('-'+LowerCase(name) = LowerCase(ParamStr(idx)));
418 
end;
 418 
end;
419 
 
 419 
 
- 
 
 420 
// function GetThreadErrorMode: DWORD; stdcall; external kernel32 name 'GetThreadErrorMode';
- 
 
 421 
function UD2_GetThreadErrorMode: DWORD;
- 
 
 422 
type
- 
 
 423 
  TFuncGetThreadErrorMode = function: DWORD; stdcall;
- 
 
 424 
var
- 
 
 425 
  dllHandle: Cardinal;
- 
 
 426 
  fGetThreadErrorMode: TFuncGetThreadErrorMode;
- 
 
 427 
begin
- 
 
 428 
  dllHandle := LoadLibrary(kernel32);
- 
 
 429 
  if dllHandle = 0 then
- 
 
 430 
  begin
- 
 
 431 
    result := 0;
- 
 
 432 
    Exit;
- 
 
 433 
  end;
- 
 
 434 
  try
- 
 
 435 
    @fGetThreadErrorMode := GetProcAddress(dllHandle, 'GetThreadErrorMode');
- 
 
 436 
    if not Assigned(fGetThreadErrorMode) then
- 
 
 437 
    begin
- 
 
 438 
      result := 0; // Windows Vista and prior
- 
 
 439 
      Exit;
- 
 
 440 
    end;
- 
 
 441 
    result := fGetThreadErrorMode();
- 
 
 442 
  finally
- 
 
 443 
    FreeLibrary(dllHandle);
- 
 
 444 
  end;
- 
 
 445 
end;
- 
 
 446 
 
- 
 
 447 
// function SetThreadErrorMode(dwNewMode: DWORD; lpOldMode: LPDWORD): BOOL; stdcall; external kernel32 name 'SetThreadErrorMode';
- 
 
 448 
function UD2_SetThreadErrorMode(dwNewMode: DWORD; lpOldMode: LPDWORD): BOOL;
- 
 
 449 
type
- 
 
 450 
  TFuncSetThreadErrorMode = function(dwNewMode: DWORD; lpOldMode: LPDWORD): BOOL; stdcall;
- 
 
 451 
var
- 
 
 452 
  dllHandle: Cardinal;
- 
 
 453 
  fSetThreadErrorMode: TFuncSetThreadErrorMode;
- 
 
 454 
begin
- 
 
 455 
  dllHandle := LoadLibrary(kernel32);
- 
 
 456 
  if dllHandle = 0 then
- 
 
 457 
  begin
- 
 
 458 
    result := FALSE;
- 
 
 459 
    if Assigned(lpOldMode) then lpOldMode^ := UD2_GetThreadErrorMode;
- 
 
 460 
    Exit;
- 
 
 461 
  end;
- 
 
 462 
  try
- 
 
 463 
    @fSetThreadErrorMode := GetProcAddress(dllHandle, 'SetThreadErrorMode');
- 
 
 464 
    if not Assigned(fSetThreadErrorMode) then
- 
 
 465 
    begin
- 
 
 466 
      result := FALSE; // Windows Vista and prior
- 
 
 467 
      if Assigned(lpOldMode) then lpOldMode^ := UD2_GetThreadErrorMode;
- 
 
 468 
      Exit;
- 
 
 469 
    end;
- 
 
 470 
    result := fSetThreadErrorMode(dwNewMode, lpOldMode);
- 
 
 471 
  finally
- 
 
 472 
    FreeLibrary(dllHandle);
- 
 
 473 
  end;
- 
 
 474 
end;
- 
 
 475 
 
- 
 
 476 
function IndexOf_CS(aStrings: TStrings; aToken: String): Integer;
- 
 
 477 
// Source: http://www.delphipraxis.net/888928-post15.html
- 
 
 478 
var
- 
 
 479 
  i : Integer;
- 
 
 480 
begin
- 
 
 481 
  Result := -1;
- 
 
 482 
  for i := 0 to aStrings.Count do
- 
 
 483 
    if aStrings[i]=aToken then begin
- 
 
 484 
      Result := i;
- 
 
 485 
      Break;
- 
 
 486 
    end;
- 
 
 487 
end;
- 
 
 488 
 
420 
end.
 489 
end.