Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Запуск программы с правами администратора(исх), не получаестя использовать пример! 
:(
    Опции темы
ivanfr
Дата 23.12.2009, 05:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 83
Регистрация: 1.4.2009

Репутация: нет
Всего: нет



Здравствуйте 

Нашёл исходник, который запускает программу о имени другого пользователя. 
В моем случае есть пароль и имя пользователя.
Прога компилируется без ошибок, как таковых.
Как мне заставить запусть мою программу, при условию что она будет находиться на рабочем столе. (тоесть все в одной папке), будет применяться на разных компах соответственно будут разные пользователи. Программа читает параметры из реестра, чтобы работала нужны права админа. 
Немогу понять куда, чего вводить?!

Как я понял в этом исходнике,  нужно вызвать функцию  помогите на примере, какой либо другой программы.

Исходник

Код

program RunAs;

{$APPTYPE CONSOLE}

uses
  SysUtils,Windows;

function CreateProcessWithLogon(lpUsername        :PWideChar;
                                lpDomain          :PWideChar;
                                lpPassword        :PWideChar;
                                dwLogonFlags      :DWORD;
                                lpApplicationName :PWideChar;
                                lpCommandLine     :PWideChar;
                                dwCreationFlags   :DWORD;
                                lpEnvironment     :Pointer;
                                lpCurrentDirectory:PWideChar;
                                var lpStartupInfo :TStartupInfo;
                                var lpProcessInfo :TProcessInformation):BOOL;stdcall;external 'advapi32' name 'CreateProcessWithLogonW';

function CreateEnvironmentBlock(var lpEnvironment:Pointer;hToken:THandle;bInherit:BOOL):BOOL;stdcall;external 'userenv';
function DestroyEnvironmentBlock(pEnvironment:Pointer):BOOL;stdcall;external 'userenv';

const
  LOGON_WITH_PROFILE=$00000001;

procedure Error(s:string);
begin
  raise Exception.Create(s);
end;

procedure OSError(s:string);
(*
  Raise the last system error with an additional prefix message
*)
begin
  raise Exception.Create(s+#13#10+SysErrorMessage(GetLastError));
end;

function FormatParam(s:string):string;
(*
  Enclose into quotes (if not already) the string if it contains white space and return it, otherwise return the string itself.
*)
var
  a:Integer;
  t:Boolean;
begin
  Result:=s;
  t:=False;
  for a:=Length(s) downto 1 do
    if s[a] in [' ',#32] then begin
      t:=True;
      Break;
    end;
  if t and not (s[1] in ['''','"']) then
    Result:='"'+s+'"';
end;

function RunProcessAs(Command:string;Parameters:array of string;Username,Password:string;Domain:string='';WorkingDirectory:string='';Wait:Boolean=False):Cardinal;
(*
  Execute the Command with the given Parameters, Username, Domain, Password and Working Directory. Parameters containing white spaces are
  automatically embraced into quotes before being sent to avoid having them splitted by the system. If either Domain or Working Directory
  are empty the current one will be used instead.

  If Wait is specified the function will wait till the command is completely executed and will return the exit code of the process,
  otherwise zero.

  Suitable Delphi exceptions will be thrown in case of API failure.
*)
var
  a:Integer;
  n:Cardinal;
  h:THandle;
  p:Pointer;
  PI:TProcessInformation;
  SI:TStartupInfo;
  t:array[0..MAX_PATH] of WideChar;
  wUser,wDomain,wPassword,wCommandLine,wCurrentDirectory:WideString;
begin
  ZeroMemory(@PI,SizeOf(PI));
  ZeroMemory(@SI,SizeOf(SI));
  SI.cb:=SizeOf(SI);
  if not LogonUser(PChar(Username),nil,PChar(Password),LOGON32_LOGON_INTERACTIVE,LOGON32_PROVIDER_DEFAULT,h) then
    OSError('Could not log user in');
  try
    if not CreateEnvironmentBlock(p,h,True) then
      OSError('Could not access user environment');
    try
      wUser:=Username;
      wPassword:=Password;
      wCommandLine:=Command;
      for a:=Low(Parameters) to High(Parameters) do
        wCommandLine:=wCommandLine+' '+FormatParam(Parameters[a]);
      if Domain='' then begin
        n:=SizeOf(t);
        if not GetComputerNameW(t,n) then
          OSError('Could not get computer name');
        wDomain:=t;
      end else
        wDomain:=Domain;
      if WorkingDirectory='' then
        wCurrentDirectory:=GetCurrentDir
      else
        wCurrentDirectory:=WorkingDirectory;
      if not CreateProcessWithLogon(PWideChar(wUser),PWideChar(wDomain),PWideChar(wPassword),LOGON_WITH_PROFILE,nil,PWideChar(wCommandLine),CREATE_UNICODE_ENVIRONMENT,p,PWideChar(wCurrentDirectory),SI,PI) then
        OSError('Could not create process');
      if Wait then begin
        WaitForSingleObject(PI.hProcess,INFINITE);
        if not GetExitCodeProcess(PI.hProcess,Result) then
          OSError('Could not get process exit code');
      end else
        Result:=0;
      CloseHandle(PI.hProcess);
      CloseHandle(PI.hThread);
    finally
      DestroyEnvironmentBlock(p);
    end;
  finally
    CloseHandle(h);
  end;
end;

function FindStr(s:string;t:array of string):Integer;
(*
  Return the (case-insensitive) index of s into the array t, otherwise -1
*)
var
  a:Integer;
begin
  Result:=-1;
  for a:=Low(t) to High(T) do
    if AnsiUpperCase(t[a])=AnsiUpperCase(s) then begin
      Result:=a;
      Exit;
    end;
end;

function WaitChar:Char;
(*
  Wait till a character is typed in the console, and return its value
*)
var
  h:THandle;
  n:Cardinal;
  r:TInputRecord;
begin
  h:=GetStdHandle(STD_INPUT_HANDLE);
  repeat
    ReadConsoleInput(h,r,1,n);
  until (n=1) and (r.EventType=KEY_EVENT) and (r.Event.KeyEvent.bKeyDown);
  Result:=r.Event.KeyEvent.AsciiChar;
end;

function ReadlnMasked(var s:string):Boolean;
(*
  Read a string from the console input with masked characters, till either ENTER or ESCAPE is given. Return True if that was ENTER.
*)
var
  c:Char;
const
  EndChars:set of char=[#10,#13,#27];
begin
  s:='';
  repeat
    c:=WaitChar;
    if not (c in EndChars) then begin
      s:=s+c;
      Write('*');
    end;
  until c in EndChars;
  Result:=c=#13;
  WriteLn;
end;

procedure Main;
(*
  Main program, parse and process arguments, print usage if no arguments, ask for username or password if not specified and launch the
  desired process 
*)
var
  a,b:Integer;
  t:array of string;
  Username,Password,Domain,WorkingDir:string;

  function ExtractNext:string;
  (*
    Extract the next command-line argument, in respect of the previous flag
  *)
  begin
    Inc(b);
    if b>ParamCount then
      raise Exception.Create('Missing argument after '+ParamStr(b-1));
    Result:=ParamStr(b);
  end;

  procedure Parse;
  (*
    Parse the command-line flags
  *)
  var
    t:Boolean;
  begin
    t:=True;
    while t and (b<=ParamCount) do begin
      case FindStr(ParamStr(b),['---U','---P','---D','---W']) of
        0:Username:=ExtractNext;
        1:Password:=ExtractNext;
        2:Domain:=ExtractNext;
        3:WorkingDir:=ExtractNext;
      else
        t:=False;
      end;
      if t then
        Inc(b);
    end;
    if b>ParamCount then
      raise Exception.Create('Missing command name');
  end;

begin
  if ParamCount=0 then begin
    WriteLn('Usage: ',ChangeFileExt(ExtractFileName(ParamStr(0)),''),' [---U Username] [---D Domain] [---P Password] [---W WorkingDirectory] Command [Params]');
    ExitCode:=0;
    Exit;
  end;
  b:=1;
  Username:='';
  Password:='';
  Domain:='';
  WorkingDir:='';
  Parse;
  if Username='' then begin
    Write('Username: ');
    ReadLn(Username);
  end;
  if Password='' then begin
    Write('Password for ',Username,': ');
    if not ReadLnMasked(Password) then
      Error('Aborted');
  end;
  SetLength(t,ParamCount-b);
  try
    for a:=b+1 to ParamCount do
      t[a-b-1]:=ParamStr(a);
    ExitCode:=RunProcessAs(ParamStr(b),t,Username,Password,Domain,WorkingDir);
  finally
    SetLength(t,0);
  end;
end;

begin
  ExitCode:=-1;
  try
    Main;
  except
    on e:Exception do begin
      WriteLn('Error: ',e.Message);
      WriteLn('(Press any key to continue)');
      WaitChar;
    end;
  end;
end.
  

Присоединённый файл ( Кол-во скачиваний: 23 )
Присоединённый файл  run_as.zip 4,66 Kb
PM MAIL   Вверх
ivanfr
Дата 24.12.2009, 05:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 83
Регистрация: 1.4.2009

Репутация: нет
Всего: нет



На данный момент я решил эту проблему с помощью программы AdmiLink.
создав ярлык для запускаемой программы с определенным пользователем админом и его паролем. 
То есть программа стартует на всех машинах с ограниченными правами, где есть пользователь администратор.
Так как обычный юзер не имеет прав админа, то ни чего не может сделать. Чтобы программа запускалась, нужна папка куда можно положить файлы. Я для этих целей использовал папку "общие документы". 
Теперь, если есть 10 машин с пользователями и на них есть учетная запись админа, например, "админ"  с паролем "8888",  но сами Юзеры не имеют прав администратора, наша программа будет работать с правами администратора  на этих 10 машинах.
Жду ваших комментариев  по исходному коду, хотелось бы знать как его можно использовать.... smile 

PM MAIL   Вверх
Keeper89
Дата 27.12.2009, 15:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58





--------------------
PM MAIL WWW   Вверх
Virtuals
Дата 5.1.2010, 12:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 476
Регистрация: 27.11.2006

Репутация: 4
Всего: 11



ivanfr
1 зачем тебе LogonUser? - CreateProcessWithLogon сам его делает ;) (кстати как и многое другое, тоесть загрузку профиля и переменных окружения)
2. используй для анализа ошибок OSError(SysErrorMessage(GetLastError) ) думаю информативней будет smile.

ЗЫ а служба то вообще запущена? ибо CreateProcessWithLogonW это всего лиш оболочка вызова службы seclogon ;)
PM MAIL ICQ   Вверх
ivanfr
Дата 11.1.2010, 09:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 83
Регистрация: 1.4.2009

Репутация: нет
Всего: нет



Данный код стартует приложение, но при этом выводит сообщение куда нужно ввести имя пользователя и пароль.
Вопрос в следующем можно ли все это сделать программно чтобы пользователь ни чего не видел.
Да, и ещё откуда он берет путь? как я опять же понял непосредственно тот путь, откуда запускается сам программа. 
Код

procedure RunFileAsAdmin(hWnd: HWND; aFile: string; aParameters: string);
var
  sei: TShellExecuteInfoA;
begin
  FillChar(sei, SizeOf(sei), 0);
  sei.cbSize := SizeOf(sei);
  sei.Wnd := hWnd;
  sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
  sei.lpVerb := 'runas';
  sei.lpFile := PAnsiChar(aFile); //this was PChar in D2007
  sei.lpParameters := PAnsiChar(aParameters); //this was PChar in D2007
  sei.nShow := SW_SHOWNORMAL;
  if not ShellExecuteEx(@sei) then
    RaiseLastOSError;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  RunFileAsAdmin(Handle, IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + 'Project1.exe', '');
end;


Это сообщение отредактировал(а) ivanfr - 11.1.2010, 09:08
PM MAIL   Вверх
ivanfr
Дата 14.1.2010, 09:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 83
Регистрация: 1.4.2009

Репутация: нет
Всего: нет



Нашёл еще одно решение с воей проблемы. Можно использовать утилиту  psexec от Марк Руссинович (Mark Russinovich) http://technet.microsoft.com/ru-ru/sysinte...897553.aspx#top
Копирует на удаленную машину вашу программу и запустить ее.

PM MAIL   Вверх
Virtuals
Дата 24.1.2010, 15:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 476
Регистрация: 27.11.2006

Репутация: 4
Всего: 11



ivanfr
на ленивец.
код рабочий
Код

Procedure CRPND(ST,DS,Lo,PAS,DM,CMD:String; ToWait:Boolean);STDCALL;
var
   pwHelp,pwUsername,pwDomain,pwPassword,pwCmdLine:PWidechar;
var
//   WorkDir:String;
   StartupInfo:TStartupInfo;
   ProcessInfo:TProcessInformation;
begin
//   GetDir(0,WorkDir);
//   StrPCopy(zCurDir,WorkDir);
   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));
 GetMem(pwHelp,80 * sizeof(WideChar));

StringToWideChar(ST+'\'+DS,pwHelp,80);
StringToWideChar(CMD,pwCmdLine,80);
StringToWideChar(Lo,pwUsername,80);
StringToWideChar(DM,pwDomain,80);
StringToWideChar(PAS,pwPassword,80);

StartupInfo.lpDesktop:= pwHelp;
StartupInfo.lpTitle:=pwUsername;
ERRLog('CreateProcessWithLogon ...');
try
if not CreateProcessWithLogonW(pwUsername,pwDomain,pwPassword,
      1,
      nil,
      pwCmdLine,                      { pointer to command line string }
      {CREATE_NEW_CONSOLE or}          { creation flags }
      NORMAL_PRIORITY_CLASS
      or CREATE_NEW_CONSOLE
      or PROFILE_USER
      or CREATE_NEW_PROCESS_GROUP,
      nil,                           { pointer to new environment block }
      nil,                           { pointer to current directory name }
      StartupInfo,                   { pointer to STARTUPINFO }
      ProcessInfo)
    then ERRLog('error CreateProcessWithLogon: '+SysErrorMessage(GetLastError))
    else begin
                ERRLog('CreateProcessWithLogon is Ok');
                if ToWait then WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
                if ToWait then ERRLog('Object terminated');
         end;
except end;
if ProcessInfo.hThread <>null then CloseHandle(ProcessInfo.hThread );
if ProcessInfo.hProcess<>null then CloseHandle(ProcessInfo.hProcess);

FreeMem(pwHelp);
FreeMem(pwPassword);
FreeMem(pwDomain);
FreeMem(pwUsername);
FreeMem(pwCmdLine);
end;


PM MAIL ICQ   Вверх
ivanfr
  Дата 29.1.2010, 09:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 83
Регистрация: 1.4.2009

Репутация: нет
Всего: нет



Блин, ну я ей уже воспользовался добавив, пользовотеля и пароль, путь  перед этой строкой 
ExitCode:=RunProcessAs(ParamStr(b),t,Username,Password,Domain,WorkingDir);
 У меня запускалось. Только вот проблема была в другом. Моя софтина должна была  кидать инфу на новел диски, а они блин из под пользователя админа не работаю так, как на новеловском сервере нет такого юзера... и соответсвтенно дисков тоже.. 
Но все равно спасибо может  пригодиться.
Но для начала нужно потестить что там вы мне за иходник привели.

Это сообщение отредактировал(а) ivanfr - 29.1.2010, 09:46
PM MAIL   Вверх
ivanfr
Дата 29.1.2010, 10:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 83
Регистрация: 1.4.2009

Репутация: нет
Всего: нет



Думаю нужно вот так: 
Код


StartupInfo.lpDesktop:=PChar(pwHelp);
StartupInfo.lpTitle:=PChar(pwUsername);

А еще матерится на строки 
Код

ERRLog('CreateProcessWithLogon ...'); // Ругается ниже ошибка Почему
try
if not CreateProcessWithLogonW(pwUsername,pwDomain,pwPassword,  //CreateProcessWithLogonW -  ругается почему
      1,
      nil,
      pwCmdLine,                      { pointer to command line string }
      {CREATE_NEW_CONSOLE or}          { creation flags }
      NORMAL_PRIORITY_CLASS
      or CREATE_NEW_CONSOLE
      or PROFILE_USER
      or CREATE_NEW_PROCESS_GROUP,
      nil,                           { pointer to new environment block }
      nil,                           { pointer to current directory name }
      StartupInfo,                   { pointer to STARTUPINFO }
      ProcessInfo)
    then ERRLog('error CreateProcessWithLogon: '+SysErrorMessage(GetLastError))
    else begin
                ERRLog('CreateProcessWithLogon is Ok');
                if ToWait then WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
                if ToWait then ERRLog('Object terminated');
         end;
except end;


/// 
[Pascal Error] Unit5.pas(52): E2003 Undeclared identifier: 'ERRLog'
[Pascal Error] Unit5.pas(54): E2003 Undeclared identifier: 'CreateProcessWithLogonW'
[Pascal Fatal Error] Project5.dpr(5): F2063 Could not compile used unit 'Unit5.pas'

Как испрвавить!?


Это сообщение отредактировал(а) ivanfr - 29.1.2010, 14:35
PM MAIL   Вверх
Rennigth
Дата 15.2.2010, 06:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 8
Всего: 76



Цитата(ivanfr @  29.1.2010,  10:33 Найти цитируемый пост)
[Pascal Error] Unit5.pas(52): E2003 Undeclared identifier: 'ERRLog'
[Pascal Error] Unit5.pas(54): E2003 Undeclared identifier: 'CreateProcessWithLogonW'


Код

function CreateProcessWithLogonW(
  lpUsername: LPCWSTR; lpDomain: LPCWSTR; lpPassword: LPCWSTR;
  dwLogonFlags: DWORD;
  lpApplicationName: LPCWSTR;
  var lpCommandLine: LPWSTR;
  dwCreationFlags: DWORD;
  lpEnvironment: Pointer;
  lpCurrentDirectory: LPCWSTR;
  lpStartupInfo: PStartupInfoW;
  var lpProcessInfo: PProcessInformation): BOOL; external 'Advapi32.dll';

http://msdn.microsoft.com/en-us/library/ms...28VS.85%29.aspx

ERRLog наверное своя какая-то функция.


--------------------
(* Honesta mors turpi vita potior *)
PM MAIL ICQ   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »


 




[ Время генерации скрипта: 0.1559 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.