| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Запус процесса от имени другого пользователя [D6, D7, Win2k, WinXP]

Doomin ©   (2003-11-25 15:55:00) 

Есть программа на Дельфи, которая использует базу. Клиент хочет, чтобы оператор не мог унести базу на диске. Система Windows XP. Для реализации решил использовать имперсонацию на основе функции CreateProcessWithLogonW. Почитал MSDN, написал модуль:


unit ProcessWithLogon;

interface

uses Windows, SysUtils;

const
LOGON_WITH_PROFILE = $1;
LOGON_NETCREDENTIALS_ONLY = $2;

function CreateProcessWithLogonW(
UserName,
Domain,
Password: PChar;
dwLogonFlags: DWORD;
lpApplicationName,
lpCommandLine: PChar;
dwCreationFlags: DWORD;
lpEnvironment: Pointer;
lpCurrentDirectory: PChar;
const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;

function StrToPChar(const InStr: String): PAnsiChar;

function StartProcessWithLogon(
const strUsername, //

---

Doomin   (2003-11-25 17:54:00) [1]

Спасибо большое! Заработало!

---

Игорь Шевченко   (2003-11-25 16:21:00) [2]

unit main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TfMain = class(TForm)
Button: TButton;
procedure ButtonClick(Sender: TObject);
end;

var
fMain: TfMain;

implementation
uses
HSAdvApi;

{$R *.dfm}

procedure TfMain.ButtonClick(Sender: TObject);
begin
MyCreateProcess();
end;

procedure TfMain.MyCreateProcess;
const
UserName : WideString = "TESTUSER";
Password : WideString = "testuser";
ConstCommandLine : String = "CMD.EXE";
Title : WideString = "Test process";
Domain : WideString = "WORKGROUP";
var
MyStartupInfo : STARTUPINFO;
ProcessInfo : PROCESS_INFORMATION;
CommandLine : array[0..512] of WideChar;
begin
FillChar(MyStartupInfo, SizeOf(MyStartupInfo), 0);
MyStartupInfo.cb := SizeOf(MyStartupInfo);
StringToWideChar(ConstCommandLine, CommandLine,
Sizeof(CommandLine) div SizeOf(WideChar));
MyStartupInfo.lpTitle := PWideChar(Title);
if not CreateProcessWithLogonW (PWideChar(UserName), PWideChar(Domain),
PWideChar(Password), LOGON_WITH_PROFILE, nil,
CommandLine, 0, nil, nil, @MyStartupInfo, @ProcessInfo) then
RaiseLastWin32Error()
else begin
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
end;
end;

end.


Все дело в WideChar

---

Наверх