WebSVN – userdetect2 – Diff – /trunk/UserDetect2/UD2_Utils.pas



{$IFEND}
 
{$INCLUDE 'UserDetect2.inc'}
 
uses
  Windows, SysUtils, Dialogs, ShellAPI, Classes, UD2_Parsing;
 
const
  EXITCODE_OK = 0;
  EXITCODE_TASK_NOTHING_MATCHES = 1;
  EXITCODE_RUN_FAILURE = 2;

  TIconFileIdx = record
    FileName: string;
    IconIndex: integer;
  end;
 
 
 
 
 
 
function SplitString(const aSeparator, aString: string; aMax: Integer = 0): TArrayOfString;
function BetterInterpreteBool(str: string): boolean;
function GetOwnCmdName: string;
function ExpandEnvStr(const szInput: string): string;
procedure UD2_RunCMD(cmd: TUD2Command);
function SplitIconString(IconString: string): TIconFileIdx;
// function GetHTML(AUrl: string): string;
procedure VTS_CheckUpdates(VTSID, CurVer: string);
function FormatOSError(ec: DWORD): string;
function CheckBoolParam(idx: integer; name: string): boolean;

    result.FileName  := ExpandEnvStr(copy(IconString, 0, p-1));
    result.IconIndex := StrToInt(Copy(IconString, p+1, Length(IconString)-p));
  end;
end;
 
procedure UD2_RunCMD(cmd: TUD2Command);
// Discussion: http://stackoverflow.com/questions/32802679/acceptable-replacement-for-winexec/32804669#32804669
// Version 1: http://pastebin.com/xQjDmyVe
// --> CreateProcess + ShellExecuteEx
// --> Problem: Run-In-Same-Directory functionality is not possible
//              (requires manual command and argument separation)

  LNG_INVALID_SYNTAX = 'The command line has an invalid syntax';
var
  cmdFile, cmdArgs, cmdDir: string;
  p: integer;
  sei: TShellExecuteInfo;
  cmdLine: string;
begin
  // We need a function which does following:
  // 1. Replace the Environment strings, e.g. %SystemRoot%
  // 2. Runs EXE files with parameters (e.g. "cmd.exe /?")
  // 3. Runs EXE files without path (e.g. "calc.exe")
  // 4. Runs EXE files without extension (e.g. "calc")
  // 5. Runs non-EXE files (e.g. "Letter.doc")
  // 6. Commands with white spaces (e.g. "C:\Program Files\xyz.exe") must be enclosed in quotes.
 
  cmdLine := ExpandEnvStr(cmd.executable);
 
  // Split command line from argument list
  if Copy(cmdLine, 1, 1) = '"' then
  begin
    cmdLine := Copy(cmdLine, 2, Length(cmdLine)-1);

    end;
  end;
 
  ZeroMemory(@sei, SizeOf(sei));
 
  if cmd.runAsAdmin then
  begin
 
 
    sei.lpVerb := 'runas';
  end;
 
  if cmd.runInOwnDirectory then
  begin
 
 
    cmdFile := ExtractFileName(cmdLine);
    cmdDir  := ExtractFilePath(cmdLine);
  end
  else
  begin

  {$IFNDEF PREFER_SHELLEXECUTEEX_MESSAGES}
  sei.fMask        := SEE_MASK_FLAG_NO_UI;
  {$ENDIF}
  if cmdArgs <> '' then sei.lpParameters := PChar(cmdArgs);
  if cmdDir  <> '' then sei.lpDirectory  := PChar(cmdDir);
  sei.nShow        := cmd.windowMode;
  if ShellExecuteEx(@sei) then Exit;
  {$IFNDEF PREFER_SHELLEXECUTEEX_MESSAGES}
  if not CheckLastOSCall(false) then ExitCode := EXITCODE_RUN_FAILURE;
  {$ENDIF}
end;

    FreeLibrary(dllHandle);
  end;
end;
 
function IndexOf_CS(aStrings: TStrings; aToken: String): Integer;
 
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to aStrings.Count-1 do
  begin
    if aStrings[i] = aToken then
    begin
      Result := i;
      Break;
    end;
  end;
end;
 
end.

Rev 82	Rev 85
Line 7...	Line 7...
7	{$IFEND}	7	{$IFEND}
8		8
9	{$INCLUDE 'UserDetect2.inc'}	9	{$INCLUDE 'UserDetect2.inc'}
10		10
11	uses	11	uses
12	Windows, SysUtils, Dialogs, ShellAPI, Classes;	12	Windows, SysUtils, Dialogs, ShellAPI, Classes, UD2_Parsing;
13		13
14	const	14	const
15	EXITCODE_OK = 0;	15	EXITCODE_OK = 0;
16	EXITCODE_TASK_NOTHING_MATCHES = 1;	16	EXITCODE_TASK_NOTHING_MATCHES = 1;
17	EXITCODE_RUN_FAILURE = 2;	17	EXITCODE_RUN_FAILURE = 2;
Line 26...	Line 26...
26	TIconFileIdx = record	26	TIconFileIdx = record
27	FileName: string;	27	FileName: string;
28	IconIndex: integer;	28	IconIndex: integer;
29	end;	29	end;
30		30
31	const	-
32	// Prefixes for UD2_RunCmd()	-
33	UD2_RUN_IN_OWN_DIRECTORY_PREFIX = '$RIOD$';	-
34	UD2_RUN_AS_ADMIN = '$ADMIN$';	-
35		-
36	function SplitString(const aSeparator, aString: string; aMax: Integer = 0): TArrayOfString;	31	function SplitString(const aSeparator, aString: string; aMax: Integer = 0): TArrayOfString;
37	function BetterInterpreteBool(str: string): boolean;	32	function BetterInterpreteBool(str: string): boolean;
38	function GetOwnCmdName: string;	33	function GetOwnCmdName: string;
39	function ExpandEnvStr(const szInput: string): string;	34	function ExpandEnvStr(const szInput: string): string;
40	procedure UD2_RunCMD(cmdLine: string; WindowMode: integer=SW_NORMAL);	35	procedure UD2_RunCMD(cmd: TUD2Command);
41	function SplitIconString(IconString: string): TIconFileIdx;	36	function SplitIconString(IconString: string): TIconFileIdx;
42	// function GetHTML(AUrl: string): string;	37	// function GetHTML(AUrl: string): string;
43	procedure VTS_CheckUpdates(VTSID, CurVer: string);	38	procedure VTS_CheckUpdates(VTSID, CurVer: string);
44	function FormatOSError(ec: DWORD): string;	39	function FormatOSError(ec: DWORD): string;
45	function CheckBoolParam(idx: integer; name: string): boolean;	40	function CheckBoolParam(idx: integer; name: string): boolean;
Line 196...	Line 191...
196	result.FileName := ExpandEnvStr(copy(IconString, 0, p-1));	191	result.FileName := ExpandEnvStr(copy(IconString, 0, p-1));
197	result.IconIndex := StrToInt(Copy(IconString, p+1, Length(IconString)-p));	192	result.IconIndex := StrToInt(Copy(IconString, p+1, Length(IconString)-p));
198	end;	193	end;
199	end;	194	end;
200		195
201	procedure UD2_RunCMD(cmdLine: string; WindowMode: integer=SW_NORMAL);	196	procedure UD2_RunCMD(cmd: TUD2Command);
202	// Discussion: http://stackoverflow.com/questions/32802679/acceptable-replacement-for-winexec/32804669#32804669	197	// Discussion: http://stackoverflow.com/questions/32802679/acceptable-replacement-for-winexec/32804669#32804669
203	// Version 1: http://pastebin.com/xQjDmyVe	198	// Version 1: http://pastebin.com/xQjDmyVe
204	// --> CreateProcess + ShellExecuteEx	199	// --> CreateProcess + ShellExecuteEx
205	// --> Problem: Run-In-Same-Directory functionality is not possible	200	// --> Problem: Run-In-Same-Directory functionality is not possible
206	// (requires manual command and argument separation)	201	// (requires manual command and argument separation)
Line 215...	Line 210...
215	LNG_INVALID_SYNTAX = 'The command line has an invalid syntax';	210	LNG_INVALID_SYNTAX = 'The command line has an invalid syntax';
216	var	211	var
217	cmdFile, cmdArgs, cmdDir: string;	212	cmdFile, cmdArgs, cmdDir: string;
218	p: integer;	213	p: integer;
219	sei: TShellExecuteInfo;	214	sei: TShellExecuteInfo;
-		215	cmdLine: string;
220	begin	216	begin
221	// We need a function which does following:	217	// We need a function which does following:
222	// 1. Replace the Environment strings, e.g. %SystemRoot%	218	// 1. Replace the Environment strings, e.g. %SystemRoot%
223	// 2. Runs EXE files with parameters (e.g. "cmd.exe /?")	219	// 2. Runs EXE files with parameters (e.g. "cmd.exe /?")
224	// 3. Runs EXE files without path (e.g. "calc.exe")	220	// 3. Runs EXE files without path (e.g. "calc.exe")
225	// 4. Runs EXE files without extension (e.g. "calc")	221	// 4. Runs EXE files without extension (e.g. "calc")
226	// 5. Runs non-EXE files (e.g. "Letter.doc")	222	// 5. Runs non-EXE files (e.g. "Letter.doc")
227	// 6. Commands with white spaces (e.g. "C:\Program Files\xyz.exe") must be enclosed in quotes.	223	// 6. Commands with white spaces (e.g. "C:\Program Files\xyz.exe") must be enclosed in quotes.
228		224
229	cmdLine := ExpandEnvStr(cmdLine);	225	cmdLine := ExpandEnvStr(cmd.executable);
230		226
231	// Split command line from argument list	227	// Split command line from argument list
232	if Copy(cmdLine, 1, 1) = '"' then	228	if Copy(cmdLine, 1, 1) = '"' then
233	begin	229	begin
234	cmdLine := Copy(cmdLine, 2, Length(cmdLine)-1);	230	cmdLine := Copy(cmdLine, 2, Length(cmdLine)-1);
Line 260...	Line 256...
260	end;	256	end;
261	end;	257	end;
262		258
263	ZeroMemory(@sei, SizeOf(sei));	259	ZeroMemory(@sei, SizeOf(sei));
264		260
265	if Pos(UD2_RUN_AS_ADMIN, cmdLine) >= 1 then	261	if cmd.runAsAdmin then
266	begin	262	begin
267	cmdLine := StringReplace(cmdLine, UD2_RUN_AS_ADMIN, '', [rfReplaceAll]);	-
268		-
269	sei.lpVerb := 'runas';	263	sei.lpVerb := 'runas';
270	end;	264	end;
271		265
272	if Pos(UD2_RUN_IN_OWN_DIRECTORY_PREFIX, cmdLine) >= 1 then	266	if cmd.runInOwnDirectory then
273	begin	267	begin
274	cmdLine := StringReplace(cmdLine, UD2_RUN_IN_OWN_DIRECTORY_PREFIX, '', [rfReplaceAll]);	-
275		-
276	cmdFile := ExtractFileName(cmdLine);	268	cmdFile := ExtractFileName(cmdLine);
277	cmdDir := ExtractFilePath(cmdLine);	269	cmdDir := ExtractFilePath(cmdLine);
278	end	270	end
279	else	271	else
280	begin	272	begin
Line 287...	Line 279...
287	{$IFNDEF PREFER_SHELLEXECUTEEX_MESSAGES}	279	{$IFNDEF PREFER_SHELLEXECUTEEX_MESSAGES}
288	sei.fMask := SEE_MASK_FLAG_NO_UI;	280	sei.fMask := SEE_MASK_FLAG_NO_UI;
289	{$ENDIF}	281	{$ENDIF}
290	if cmdArgs <> '' then sei.lpParameters := PChar(cmdArgs);	282	if cmdArgs <> '' then sei.lpParameters := PChar(cmdArgs);
291	if cmdDir <> '' then sei.lpDirectory := PChar(cmdDir);	283	if cmdDir <> '' then sei.lpDirectory := PChar(cmdDir);
292	sei.nShow := WindowMode;	284	sei.nShow := cmd.windowMode;
293	if ShellExecuteEx(@sei) then Exit;	285	if ShellExecuteEx(@sei) then Exit;
294	{$IFNDEF PREFER_SHELLEXECUTEEX_MESSAGES}	286	{$IFNDEF PREFER_SHELLEXECUTEEX_MESSAGES}
295	if not CheckLastOSCall(false) then ExitCode := EXITCODE_RUN_FAILURE;	287	if not CheckLastOSCall(false) then ExitCode := EXITCODE_RUN_FAILURE;
296	{$ENDIF}	288	{$ENDIF}
297	end;	289	end;
Line 472...	Line 464...
472	FreeLibrary(dllHandle);	464	FreeLibrary(dllHandle);
473	end;	465	end;
474	end;	466	end;
475		467
476	function IndexOf_CS(aStrings: TStrings; aToken: String): Integer;	468	function IndexOf_CS(aStrings: TStrings; aToken: String): Integer;
477	// Source: http://www.delphipraxis.net/888928-post15.html	-
478	var	469	var
479	i : Integer;	470	i: Integer;
480	begin	471	begin
481	Result := -1;	472	Result := -1;
482	for i := 0 to aStrings.Count do	473	for i := 0 to aStrings.Count-1 do
-		474	begin
483	if aStrings[i]=aToken then begin	475	if aStrings[i] = aToken then
-		476	begin
484	Result := i;	477	Result := i;
485	Break;	478	Break;
486	end;	479	end;
487	end;	480	end;
-		481	end;
488		482
489	end.	483	end.

Subversion Repositories userdetect2

userdetect2/trunk/UserDetect2/UD2_Utils.pas – Rev 82 → 85