Форум программистов [Powered by Invision Power Board]

Код


var
   pwUsername,pwDomain,pwPassword,pwCmdLine:PWidechar;
var
   StartupInfo:TStartupInfo;
   ProcessInfo:TProcessInformation;
begin
FillChar(StartupInfo,Sizeof(StartupInfo),#0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_SHOWDEFAULT;
GetMem(pwCmdLine,80 * sizeof(WideChar));
GetMem(pwUsername,80 * sizeof(WideChar));
GetMem(pwDomain,80 * sizeof(WideChar));
GetMem(pwPassword,80 * sizeof(WideChar));
StringToWideChar(CMD,pwCmdLine,80);
StringToWideChar(Lo,pwUsername,80);
StringToWideChar(DM,pwDomain,80);
StringToWideChar(PAS,pwPassword,80);
StartupInfo.lpDesktop:= Pchar(ST+'\'+DS);
StartupInfo.lpTitle:=pwUsername;
Log('CreateProcessWithLogon ...');
try
if not CreateProcessWithLogon(pwUsername,pwDomain,pwPassword,
      1,
      nil,
      pwCmdLine,                      { pointer to command line string }
      CREATE_NEW_CONSOLE,
      nil,                           { pointer to new environment block }
      nil,                           { pointer to current directory name }
      StartupInfo,                   { pointer to STARTUPINFO }
      ProcessInfo)
    then Log('error CreateProcessWithLogon: '+SysErrorMessage(GetLastError))
    else begin
                Log('CreateProcessWithLogon is Ok');
                if ToWait then WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
                if ToWait then Log('Object terminated');
         end;
except end;
if ProcessInfo.hThread <>null then CloseHandle(ProcessInfo.hThread );
if ProcessInfo.hProcess<>null then CloseHandle(ProcessInfo.hProcess);
FreeMem(pwPassword);
FreeMem(pwDomain);
FreeMem(pwUsername);
FreeMem(pwCmdLine);

Цитата(grofast @ 4.10.2010, 15:40)

Блин у меня на windows7 x64 +delphi 2011 не работает(

Если как обычное приложение все отлично если как сервис ни одно окно не показывается.
Хотя процесс запускается отлично.(

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls;

type
  TMenedgerZadanii = class(TService)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;


procedure MyCreateProcess(ConstCommandLine: string);
 function CreateProcessWithLogonW(const lpUsername: PWideChar;
  const lpDomain: PWideChar; const lpPassword: PWideChar;
  dwLogonFlags: DWORD; const lpApplicationName: PWideChar;
  lpCommandLine: PWideChar; dwCreationFlags: DWORD;
  lpEnvironment: Pointer; const lpCurrentDirectory: PWideChar;
  lpStartupInfo: PStartupInfo;
  lpProcessInfo: PProcessInformation): Boolean; stdcall;


  type
  TCreateProcessWithLogonW =
    function(const lpUsername: PWideChar;
    const lpDomain: PWideChar; const lpPassword: PWideChar;
    dwLogonFlags: DWORD; const lpApplicationName: PWideChar;
    lpCommandLine: PWideChar; dwCreationFlags: DWORD;
    lpEnvironment: Pointer; const lpCurrentDirectory: PWideChar;
    lpStartupInfo: PStartupInfo;
    lpProcessInfo: PProcessInformation): Boolean; stdcall;



  const
  DllName = 'advapi32.dll';


    LOGON_WITH_PROFILE = $00000001;
  LOGON_NETCREDENTIALS_ONLY = $00000002;
  LOGON_ZERO_PASSWORD_BUFFER = $80000000;




var
  MenedgerZadanii: TMenedgerZadanii;

   DllHandle: THandle;
  _CreateProcessWithLogonW: TCreateProcessWithLogonW;


implementation


{$R *.DFM}


procedure OpenTxt(Text:String);
 var
   F: Textfile;
 begin


   AssignFile(f,'D:\Служба.txt'); {Assigns the Filename}

   if Not FileExists('D:\Служба.txt') Then
   Begin
     ReWrite(f);
     CloseFile(f);
   End;

   AssignFile(f,'D:\Служба.txt'); {Assigns the Filename}
   //Reset(f);
   Append(f); {Opens the file for editing}
   Writeln(f,Text);
   Closefile(f); {Closes file F}
 end;




function InitLib: Boolean;
begin
  if DllHandle = 0 then
    if Win32Platform = VER_PLATFORM_WIN32_NT then
    begin
      DllHandle := LoadLibrary(DllName);
      if DllHandle <> 0 then
      begin
        _CreateProcessWithLogonW := GetProcAddress(DllHandle,
          'CreateProcessWithLogonW');
      end;
    end;
  Result := (DllHandle <> 0);
end;

function NotImplementedBool: Boolean;
begin
  SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
  Result := false;
end;



function CreateProcessWithLogonW(const lpUsername: PWideChar;
  const lpDomain: PWideChar; const lpPassword: PWideChar;
  dwLogonFlags: DWORD; const lpApplicationName: PWideChar;
  lpCommandLine: PWideChar; dwCreationFlags: DWORD;
  lpEnvironment: Pointer; const lpCurrentDirectory: PWideChar;
  lpStartupInfo: PStartupInfo;
  lpProcessInfo: PProcessInformation): Boolean; stdcall;
begin
  if InitLib and Assigned(_CreateProcessWithLogonW) then
    Result := _CreateProcessWithLogonW(lpUsername, lpDomain, lpPassword,
      dwLogonFlags, lpApplicationName, lpCommandLine, dwCreationFlags,
      lpEnvironment, lpCurrentDirectory, lpStartupInfo, lpProcessInfo)
  else
    Result := NotImplementedBool;
end;




 procedure MyCreateProcess(ConstCommandLine: string);
const
  UserName: WideString = 'programist';
  Password: WideString = '35673576';
  //ConstCommandLine : String = 'MONIC_S.EXE ';
  Title: WideString ='';
  Domain: WideString = '';
var
  MyStartupInfo: STARTUPINFO;
  ProcessInfo: PROCESS_INFORMATION;
  CommandLine: array[0..512] of WideChar;
begin
  FillChar(MyStartupInfo, SizeOf(MyStartupInfo), 0);
  MyStartupInfo.cb := SizeOf(MyStartupInfo);


  //MyStartupInfo.lpDesktop :=Nil;

  //MyStartupInfo.lpDesktop :=PChar('winsta0\Default');

  StringToWideChar(ConstCommandLine, CommandLine,
    Sizeof(CommandLine) div SizeOf(WideChar));
  MyStartupInfo.lpTitle := PWideChar(Title);


  OpenTxt('Дошли до креат процес');


  if not CreateProcessWithLogonW(PWideChar(UserName), PWideChar(Domain),
    PWideChar(Password), LOGON_WITH_PROFILE, nil,
    PWideChar(WideString(CommandLine)),CREATE_NEW_CONSOLE, nil, nil, @MyStartupInfo, @ProcessInfo) then
    OpenTxt(intToStr(GetLastError)+' '+SysErrorMessage(GetLastError))
  else
  begin
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end;


  OpenTxt('Окончание процедуры '+IntToStr(GetLastError))

end;



procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  MenedgerZadanii.Controller(CtrlCode);
end;

function TMenedgerZadanii.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;









procedure TMenedgerZadanii.ServiceStart(Sender: TService; var Started: Boolean);
begin
//MyCreateProcess('C:\windows\system32\cmd.exe');
 MyCreateProcess('C:\windows\explorer.exe');
end;

procedure TMenedgerZadanii.Timer1Timer(Sender: TObject);
begin

//MyCreateProcess('D:\w32dasm10\W32dsmv10\kWdsm.exe');

//MyCreateProcess('C:\windows\system32\cmd.exe');


end;

end.

Цитата(grofast @ 5.10.2010, 16:26

)

CreateProcessWithLogonW всегда возврашает true типа все удачно
gestlasterror возврашает 0.

Цитата(grofast @ 5.10.2010, 16:45

)

Если из под Ситемы запускаю то выводит в лог ошибку 5
Отказано в доступе.

Цитата(DaDe @ 3.10.2010, 15:07

)

запуск из под сервиса, под ОС Windows 7

Цитата(DaDe @ 5.10.2010, 19:14)

Цитата(grofast @ 5.10.2010, 16:26

)

CreateProcessWithLogonW всегда возврашает true типа все удачно
gestlasterror возврашает 0.

Судя по коду. Когда у тебя отображается результат gestlasterror, то CreateProcessWithLogonW не выполняется.

Цитата(grofast @ 5.10.2010, 16:45

)

Если из под Ситемы запускаю то выводит в лог ошибку 5
Отказано в доступе.

Из под System не получится, есть ограничения.

Код


//****************Если не удачно

  if not CreateProcessWithLogonW(PWideChar(UserName), PWideChar(Domain),
    PWideChar(Password), LOGON_WITH_PROFILE, nil,
    PWideChar(WideString(CommandLine)),CREATE_NEW_CONSOLE, nil, nil, @MyStartupInfo, @ProcessInfo) then
    OpenTxt(intToStr(GetLastError)+' '+SysErrorMessage(GetLastError))





  else     
  begin
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end;


  OpenTxt('Окончание процедуры '+IntToStr(GetLastError))  //*********************В любом случае вывести последнюю ошибку

Цитата(bems @ 5.10.2010, 19:57)

grofast, кнопка КОД справа вверху над формой ответа

Цитата(kami @ 6.10.2010, 01:30)

Цитата(DaDe @ 3.10.2010, 15:07

)

запуск из под сервиса, под ОС Windows 7

Нарыл у себя в закромах.
Писалось несколько лет назад, проверено сейчас под Vista - cmd.exe из сервиса запускается на активном десктопе "только так". В висте система разграничения учетных записей, afair, не отличается от семерки - так же в разных терминальных сессиях, соответственно - разные WinSta и Desktop. Смотреть метод Timer1Timer.
Функции когда-то писались под запуск вообще любого файла, у которого есть ассоциации в реестре.

Может быть, что-то (или большинство) лишнее - просьба удалить самим smile

Цитата(grofast @ 6.10.2010, 14:24

)

Если ни один пользователь не залогинен можно ли из под службы (system) запустить мою программу с правами пользователя?

Цитата(grofast @ 6.10.2010, 11:28

)

Спасибо огромное.

Цитата(kami @ 6.10.2010, 01:30

)

проверено сейчас под Vista - cmd.exe из сервиса запускается на активном десктопе "только так"

Цитата(DaDe @ 7.10.2010, 21:10

)

Получается от имени учетной записи, запустившей сервис.

Цитата(kami @ 8.10.2010, 22:03

)

Это как? LocalSystem|NetworkService|LocalService?
Тогда процесс был бы запущен на их десктопе, в 0 терминальной сессии и его окно не было бы видно...

Цитата(kami @ 6.10.2010, 01:30)

Нарыл у себя в закромах.
Писалось несколько лет назад, проверено сейчас под Vista - cmd.exe из сервиса запускается на активном десктопе "только так".

Цитата(seldir @ 12.11.2016, 18:59

)

хотя сама служба находится в системе в состоянии "выполняется".