Einzelnen Beitrag anzeigen

QuickAndDirty

Registriert seit: 13. Jan 2004
Ort: Hamm(Westf)
1.930 Beiträge
 
Delphi 12 Athens
 
#8

AW: Kommandozeile aus Programm

  Alt 23. Jul 2020, 13:18
Ich Benutze diese Funktion zum Installieren von Diensten
Die Funktion wartet darauf das die Anwendung zurückkehrt.
Wenn du das nicht willst musste das ausbauen.
Die bedingte Compilierung je nach Framework evtl auch ausbauen.
Delphi-Quellcode:
Procedure TKannDiensteKram.SetInstalledAsService(aValue : Boolean);
Begin
  if aValue <> GetInstalledAsService then
  Begin
    if aValue then
    Begin
      ExecAndWait(ServiceExe, '/install /silent', 60000, SW_SHOWNORMAL, true);
    end
    else
    Begin
      ExecAndWait(ServiceExe, '/uninstall /silent', 60000, SW_SHOWNORMAL, true);
    End;
  End;
End;

function TKannDiensteKram.ExecAndWait(Filename, Params: string; TimeOut:int64=-1 ; WindowState: word = SW_SHOWNORMAL; elevated:Boolean = false): boolean;
var
  ShExecInfo: SHELLEXECUTEINFO;
  started,h_res : Cardinal;
  const
  SEE_MASK_NOASYNC= $100;
begin
  Result := false;
  if Filename = 'then
    exit;
  if not FileExists(FileName) then
  Begin
    {$IFDEF FrameWork_VCL}
    ShowMessage('Datei nicht existent!');
    {$ENDIF}
    {$IFDEF FrameWork_FMX}
    TDialogService.ShowMessage('Datei nicht existent!');
    {$ENDIF}
    Exit;
  End;
  ZeroMemory(@ShExecInfo, SizeOf(ShExecInfo));
  ShExecInfo.Wnd := 0;
  ShExecInfo.cbSize := sizeof(SHELLEXECUTEINFO);
  ShExecInfo.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_NOASYNC;
  if elevated then
    ShExecInfo.lpVerb := 'runas'
  else
    ShExecInfo.lpVerb := 'open'; //'run as' statt 'open' ist für Systeme ab Vista evtl. besser
  ShExecInfo.lpFile := PChar(Filename);
  ShExecInfo.lpParameters := PChar(Params);
  ShExecInfo.lpDirectory := PChar(ExtractFileDir(Filename));
  ShExecInfo.nShow := WindowState;
  Result := ShellExecuteEx(@ShExecInfo);
  if Result then
  begin
    started := Gettickcount;
    repeat
      h_res := MsgWaitForMultipleObjects(1, ShExecInfo.hProcess, False, TimeOut, QS_ALLINPUT);
      if h_res <> WAIT_OBJECT_0 then
        Application.ProcessMessages;
    until (h_res = WAIT_OBJECT_0) or ( (Timeout >-1) and ( Started + TimeOut < GetTickCount )) ;
    if (timeout > -1) then
      Result := not( Started + TimeOut < GetTickCount );
    CloseHandle(ShExecInfo.hProcess);
  end
  else
    {$IFDEF FrameWork_VCL}
    Showmessage('Fehler beim Installieren des Dienstes:' + Filename +
                 #13#10'System Fehler: ' + SysErrorMessage(GetLastError));
    {$ENDIF}
    {$IFDEF FrameWork_FMX}
    TDialogService.Showmessage('Fehler beim Installieren des Dienstes:' + Filename +
                 #13#10'System Fehler: ' + SysErrorMessage(GetLastError));
    {$ENDIF}

End;
Andreas
Monads? Wtf are Monads?
  Mit Zitat antworten Zitat