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

   end;
 const
   // Prefixes for UD2_RunCmd()
   UD2_RUN_IN_OWN_DIRECTORY_PREFIX = '$RIOD$';
+  UD2_RUN_AS_ADMIN                = '$ADMIN$';
 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(cmdLine: string; WindowMode: integer);
+procedure UD2_RunCMD(cmdLine: string; WindowMode: integer=SW_NORMAL);
 function SplitIconString(IconString: string): TIconFileIdx;
 // function GetHTML(AUrl: string): string;
 procedure VTS_CheckUpdates(VTSID, CurVer: string);
 function FormatOSError(ec: DWORD): string;
     result.FileName  := ExpandEnvStr(copy(IconString, 0, p-1));
     result.IconIndex := StrToInt(Copy(IconString, p+1, Length(IconString)-p));
   end;
 end;
-procedure UD2_RunCMD(cmdLine: string; WindowMode: integer);
+procedure UD2_RunCMD(cmdLine: string; WindowMode: integer=SW_NORMAL);
 // 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)
       cmdFile := Copy(cmdLine, 1, p-1);
       cmdArgs := Copy(cmdLine, p+1, Length(cmdLine)-p);
     end;
   end;
-  if Copy(cmdLine, 1, Length(UD2_RUN_IN_OWN_DIRECTORY_PREFIX)) = UD2_RUN_IN_OWN_DIRECTORY_PREFIX then
+  if Pos(UD2_RUN_IN_OWN_DIRECTORY_PREFIX, cmdLine) >= 1 then
   begin
+    cmdLine := StringReplace(cmdLine, UD2_RUN_IN_OWN_DIRECTORY_PREFIX, '', [rfReplaceAll]);
     cmdLine := Copy(cmdLine, 1+Length(UD2_RUN_IN_OWN_DIRECTORY_PREFIX), Length(cmdLine)-Length(UD2_RUN_IN_OWN_DIRECTORY_PREFIX));
     cmdFile := ExtractFileName(cmdLine);
     cmdDir  := ExtractFilePath(cmdLine);
   end
     cmdFile := cmdLine;
     cmdDir := '';
   end;
   ZeroMemory(@sei, SizeOf(sei));
+  if Pos(UD2_RUN_AS_ADMIN, cmdLine) >= 1 then
+  begin
+    cmdLine := StringReplace(cmdLine, UD2_RUN_AS_ADMIN, '', [rfReplaceAll]);
+    sei.lpVerb := 'runas';
+  end;
   sei.cbSize       := SizeOf(sei);
   sei.lpFile       := PChar(cmdFile);
   {$IFNDEF PREFER_SHELLEXECUTEEX_MESSAGES}
   sei.fMask        := SEE_MASK_FLAG_NO_UI;
   {$ENDIF}
   {$ENDIF}
 end;
 function GetHTML(AUrl: string): string;
 // http://www.delphipraxis.net/post43515.html
+// Modificated by ViaThinkSoft
 var
   databuffer : array[0..4095] of char;
   ResStr : string;
   hSession, hfile: hInternet;
   dwindex,dwcodelen,dwread,dwNumber: cardinal;
   res    : pchar;
   Str    : pchar;
 begin
-  ResStr:='';
+  ResStr := '';
-  if system.pos('http://',lowercase(AUrl))=0 then
+  if system.pos('http://',lowercase(AUrl)) = 0 then
+  begin
      AUrl:='http://'+AUrl;
+  end;
-  // Hinzugefügt
+  // [ViaThinkSoft] Added
   Application.ProcessMessages;
   hSession:=InternetOpen('InetURL:/1.0',
                          INTERNET_OPEN_TYPE_PRECONFIG,
                          nil,
                          nil,
 );
   if assigned(hsession) then
   begin
-    // Hinzugefügt
+    // [ViaThinkSoft] Added
-    application.ProcessMessages;
+    Application.ProcessMessages;
-    hfile:=InternetOpenUrl(
+    hfile := InternetOpenUrl(hsession,
-           hsession,
-           pchar(AUrl),
+                             pchar(AUrl),
-           nil,
+                             nil,
 ,
-           INTERNET_FLAG_RELOAD,
+                             INTERNET_FLAG_RELOAD,
 );
-    dwIndex  := 0;
+    dwIndex   := 0;
     dwCodeLen := 10;
-    // Hinzugefügt
+    // [ViaThinkSoft] Added
-    application.ProcessMessages;
+    Application.ProcessMessages;
     HttpQueryInfo(hfile,
                   HTTP_QUERY_STATUS_CODE,
                   @dwcode,
                   dwcodeLen,
                               @databuffer,
                               dwNumber,
                               DwRead)) do
       begin
-        // Hinzugefügt
+        // [ViaThinkSoft] Added
-        application.ProcessMessages;
+        Application.ProcessMessages;
         if dwRead =0 then
           break;
         databuffer[dwread]:=#0;
         Str := pchar(@databuffer);
   *)
   LNG_DOWNLOAD_ERR = 'An error occurred while searching for updates. Please check your internet connection and firewall.';
   LNG_NEW_VERSION = 'A new version is available. Do you want to download it now?';
   LNG_NO_UPDATE = 'You already have the newest program version.';
 var
-  temp: string;
+  status: string;
 begin
-  temp := GetHTML('http://www.viathinksoft.de/update/?id='+VTSID);
+  status := GetHTML('http://www.viathinksoft.de/update/?id='+VTSID);
-  if Copy(temp, 0, 7) = 'Status:' then
+  if Copy(status, 0, 7) = 'Status:' then
   begin
     MessageDlg(LNG_DOWNLOAD_ERR, mtError, [mbOK], 0);
   end
   else
   begin
-    if GetHTML('http://www.viathinksoft.de/update/?id='+VTSID) <> CurVer then
+    if status <> CurVer then
     begin
       if MessageDlg(LNG_NEW_VERSION, mtConfirmation, mbYesNoCancel, 0) = ID_YES then
       begin
-        shellexecute(application.handle, 'open', pchar('http://www.viathinksoft.de/update/?id=@spacemission'), '', '', sw_normal);
+        shellexecute(application.handle, 'open', pchar('http://www.viathinksoft.de/update/?id=@'+VTSID), '', '', sw_normal);
       end;
     end
     else
     begin
       MessageDlg(LNG_NO_UPDATE, mtInformation, [mbOk], 0);

Subversion Repositories userdetect2

userdetect2/trunk/UserDetect2/UD2_Utils.pas – Rev 73 → 79