راهنمایی درباره "CreateProcessAsUser"

[hassan_reza]

همونطور که می دانید: سرویس در ویندوز ویستا به بعد در یک Session غیر از Session کاربر جاری اجرا شده و عملا تعامل با Desktop جاری مقدور نیست و برای اجرای یک برنامه (Process) می بایست از CreateProcessAsUser استفاده کرد.
حال دوستان راهنمایی بفرمایند برای تعامل با دسکتاپ جاری توسط یک سرویس در ویندوز 7!؟
باسپاس

[Mask]

شا نیاز به CreateProcessAsUser ندارید.
بلکه باید اسم دسکتاپ جاری رو بدست بیارید و با تابع CreateProcess برنامتون رو در دسکتاپ جاری اجرا کنید.
اگه در پستهای من جستجو کنید، یادمه پارسال برای این کار هم کد قرار دادم.

[hassan_reza]

پستهای شما را ملاحظه کردم. متأسفانه به نتیجه قطعی و نهایی نرسیده بودند.
آیا شما به همان شیوه هایی که در پست ها جناب آقای Mahan-1363 اشاره کرده بودند توانستید انجام دهید یا خیر؟
اگر بله لطفا نمونه کد قرار بدهید.
باسپاس

[hassan_reza]

کدی که بنده استفاده کردم و در ویندوز 7 جواب گرفتم:

unit uTools;

interface

uses
Windows, Messages, SysUtils, Classes, Controls,
WinSvc, Registry, ShlObj, TlHelp32;

type
TWtsConnectStateClass = (
WTSActive, // User logged on to WinStation
WTSConnected, // WinStation connected to client
WTSConnectQuery, // In the process of connecting to client
WTSShadow, // Shadowing another WinStation
WTSDisconnected, // WinStation logged on without client
WTSIdle, // Waiting for client to connect
WTSListen, // WinStation is listening for connection
WTSReset, // WinStation is being reset
WTSDown, // WinStation is down due to error
WTSInit); // WinStation in initialization

PWtsSessionInfoA = ^TWtsSessionInfoA;
TWtsSessionInfoA = record
SessionId: DWORD; // session id
pWinStationName: LPSTR; // name of WinStation this session is connected to
State: TWtsConnectStateClass; // connection state (see enum)
end;

const
WTS_CURRENT_SERVER_HANDLE = THandle(0);
WTSQueryUserToken : function(SessionId: Cardinal; var hToken: THandle): Boolean; stdcall = nil;
WTSEnumerateSessions : function(hServer: THandle; Reserved: DWord; Version: DWord; var pSessionInfo: PWtsSessionInfoA; var Count: DWord): Boolean; stdcall = nil;
WTSFreeMemory : procedure(pMemory: Pointer); stdcall = nil;
WTSSendMessage : function(hServer: THandle; SessionId: DWord; Title: PChar; TitleLength: DWord; Message: PChar; MessageLength: DWord; Style: DWord; Timeout: DWord; var Response: DWord; Wait: Boolean): Boolean; stdcall = nil;

function CreateProcessElevated(lpApplicationName: PChar; lpCommandLine: PChar;
lpCurrentDirectory: PChar; var ProcessInfo: TProcessInformation): Boolean;
function CreateUserProcess(lpApplicationName: PChar; lpCommandLine: PChar;
lpCurrentDirectory: PChar; var ProcessInfo: TProcessInformation): Boolean;

implementation

Function ProcessIDFromAppname32( appname: String ): DWORD;
{ Take only the application filename, not full path! }
Var
snapshot: THandle;
processEntry : TProcessEntry32;
Begin
Result := 0;
appName := UpperCase( appname );
snapshot := CreateToolhelp32Snapshot(
TH32CS_SNAPPROCESS,
0 );
If snapshot <> 0 Then
try
processEntry.dwSize := Sizeof( processEntry );
If Process32First( snapshot, processEntry ) Then
Repeat
If Pos(appname,
UpperCase(ExtractFilename(
StrPas(processEntry.szExeFile)))) > 0
Then Begin
Result:= processEntry.th32ProcessID;
Break;
End; { If }
Until not Process32Next( snapshot, processEntry );
finally
CloseHandle( snapshot );
End; { try }
End;



function GetShellProcName: String;
var
Reg : TRegistry;
begin
Reg := TRegistry.Create(KEY_READ);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKeyReadOnly('Software\Microsoft\Windows NT\CurrentVersion\WinLogon');
Result := Reg.ReadString('Shell');
finally
Reg.Free;
end;
end;


function GetShellHandle: THandle;
var
Pid : THandle;
ShellProcName : String;
begin
Result := 0;
ShellProcName := GetShellProcName;
if Length(ShellProcName) > 0 then
begin
Pid := ProcessIDFromAppname32(ShellProcName);
if Pid <> 0 then
Result := OpenProcess(PROCESS_ALL_ACCESS, False, Pid);
end;
end;

/////////////////////////////////////////////////////////////////////////////


function GetActiveWtsSession: Integer;
var
PSessionInfo : PWtsSessionInfoA;
Count : DWord;
P : PChar;
I : Integer;
begin
Result := -1;
if WtsEnumerateSessions(WTS_CURRENT_SERVER_HANDLE, 0, 1, PSessionInfo, Count) then
try
P := Pointer(PSessionInfo);
for I := 0 to Count -1 do
begin
if PWtsSessionInfoA(P)^.State = WTSActive then
begin
Result := PWtsSessionInfoA(P)^.SessionId;
Break;
end;
Inc(P, SizeOf(TWtsSessionInfoA));
end;
finally
WtsFreeMemory(PSessionInfo);
end;
end;



function IsWtsAvailable : Boolean;
begin
Result := Assigned(WTSQueryUserToken) and
Assigned(WTSEnumerateSessions) and
Assigned(WTSFreeMemory) and
Assigned(WTSSendMessage);
end;


/////////////////////////////////////////////////////////////////////////////

function CheckWTS:boolean;
var
ActiveSessionID : Integer;
begin
result:=false;
if IsWtsAvailable then // usually XP and Vista.
begin
ActiveSessionID := GetActiveWtsSession;
if ActiveSessionID < 0 then
begin
//ShowMessage('GetActiveWtsSession returned -1, no user logged on');
result:=true;
Exit;
end;
end;
end;

///////////////////////////////////////////////////////////////////////////////
function OpenShellProcessToken(ProcessName: String;
var hToken: THandle): Boolean;
var
hSnapshot,
hProcess: THandle;
Process: TProcessEntry32;
begin
Result := false;
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapshot <> 0) and (hSnapshot <> INVALID_HANDLE_VALUE) then
try
FillChar(Process, SizeOf(Process), #0);
Process.dwSize := SizeOf(Process);
if Process32First(hSnapshot, Process) then
repeat
if (AnsiLowerCase(Process.szExeFile) =
AnsiLowerCase(ProcessName)) then
begin
hProcess :=
OpenProcess(PROCESS_ALL_ACCESS, false, Process.th32ProcessID);
if (hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE) then
try
Result := OpenProcessToken(hProcess, TOKEN_ALL_ACCESS, hToken);
finally
CloseHandle(hProcess);
end;
Break;
end;
until (not Process32Next(hSnapshot, Process));
finally
CloseHandle(hSnapshot);
end;
end;

function CreateUserProcess(lpApplicationName: PChar; lpCommandLine: PChar;
lpCurrentDirectory: PChar; var ProcessInfo: TProcessInformation): Boolean;
var
WTSGetActiveConsoleSessionId: function: DWord; stdcall;
WTSQueryUserToken: function(SessionId: ULONG;
var phToken: THandle): BOOL; stdcall;
CreateEnvironmentBlock: function(lpEnvironment: PPointer; hToken: THandle;
bInherit: BOOL): BOOL; stdcall;
DestroyEnvironmentBlock: function(lpEnvironment: Pointer): BOOL; stdcall;
var
hUserToken : THandle;
ReturnLength,
Environment: Pointer;
StartupInfo: {$IFDEF UNICODE}TStartupInfoW{$ELSE}TStartupInfoA{$ENDIF};
begin
Result := false;
@CreateEnvironmentBlock :=
GetProcAddress(LoadLibrary('userenv.dll'), 'CreateEnvironmentBlock');
@DestroyEnvironmentBlock :=
GetProcAddress(LoadLibrary('userenv.dll'), 'DestroyEnvironmentBlock');
if (not Assigned(CreateEnvironmentBlock)) or
(not Assigned(DestroyEnvironmentBlock)) then Exit;
@WTSGetActiveConsoleSessionId :=
GetProcAddress(LoadLibrary('kernel32.dll'), 'WTSGetActiveConsoleSessionId');
@WTSQueryUserToken :=
GetProcAddress(LoadLibrary('wtsapi32.dll'), 'WTSQueryUserToken');
if (Assigned(WTSGetActiveConsoleSessionId) and
Assigned(WTSQueryUserToken)) then
begin
Result := WTSQueryUserToken(WTSGetActiveConsoleSessionId, hUserToken);
end else
begin
Result := OpenShellProcessToken(GetShellProcName, hUserToken);
end;
if Result then
try
if CreateEnvironmentBlock(@Environment, hUserToken, false) then
try
//FillChar(StartupInfo, SizeOf(StartupInfo), #0);
//StartupInfo.cb := SizeOf(StartupInfo);
ZeroMemory(@StartupInfo, sizeof(StartupInfo));
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.lpDesktop := 'winsta0\default';
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_SHOWDEFAULT;
Result := CreateProcessAsUser
(hUserToken,
lpApplicationName,
lpCommandLine,
nil,
nil,
false,
CREATE_NEW_CONSOLE or CREATE_DEFAULT_ERROR_MODE or CREATE_UNICODE_ENVIRONMENT,
Environment,
lpCurrentDirectory,
StartupInfo,
ProcessInfo);
finally
DestroyEnvironmentBlock(Environment);
end;
finally
CloseHandle(hUserToken);
end;
end;

function CreateProcessElevated(lpApplicationName: PChar; lpCommandLine: PChar;
lpCurrentDirectory: PChar; var ProcessInfo: TProcessInformation): Boolean;
var
WTSGetActiveConsoleSessionId: function: DWord; stdcall;
WTSQueryUserToken: function(SessionId: ULONG;
var phToken: THandle): BOOL; stdcall;
CreateEnvironmentBlock: function(lpEnvironment: Pointer; hToken: THandle;
bInherit: BOOL): BOOL; stdcall;
DestroyEnvironmentBlock: function(lpEnvironment: Pointer): BOOL; stdcall;
var
hUserToken,
hLinkedToken,
hElevatedToken: THandle;
ReturnLength,
ElevationType: DWord;
Environment: Pointer;
StartupInfo: TStartupInfo;
begin
Result := false;
@CreateEnvironmentBlock :=
GetProcAddress(LoadLibrary('userenv.dll'), 'CreateEnvironmentBlock');
@DestroyEnvironmentBlock :=
GetProcAddress(LoadLibrary('userenv.dll'), 'DestroyEnvironmentBlock');
if (not Assigned(CreateEnvironmentBlock)) or
(not Assigned(DestroyEnvironmentBlock)) then Exit;
@WTSGetActiveConsoleSessionId :=
GetProcAddress(LoadLibrary('kernel32.dll'), 'WTSGetActiveConsoleSessionId');
@WTSQueryUserToken :=
GetProcAddress(LoadLibrary('wtsapi32.dll'), 'WTSQueryUserToken');
if (Assigned(WTSGetActiveConsoleSessionId) and
Assigned(WTSQueryUserToken)) then
begin
Result := WTSQueryUserToken(WTSGetActiveConsoleSessionId, hUserToken);
end else
begin
Result := OpenShellProcessToken('explorer.exe', hUserToken);
end;
if Result then
try
if GetTokenInformation(hUserToken, TokenElevationType, @ElevationType,
SizeOf(ElevationType), ReturnLength) then
begin
if (ElevationType = 3) then
begin
if GetTokenInformation(hUserToken, TokenLinkedToken,
@hLinkedToken, SizeOf(hLinkedToken), ReturnLength) then
try
Result := DuplicateTokenEx(hLinkedToken, MAXIMUM_ALLOWED, nil,
SecurityImpersonation, TokenPrimary, hElevatedToken);
finally
CloseHandle(hLinkedToken);
end;
end else
begin
hElevatedToken := hUserToken;
end;
try
if CreateEnvironmentBlock(@Environment, hElevatedToken, false) then
try
FillChar(StartupInfo, SizeOf(StartupInfo), #0);
StartupInfo.cb := SizeOf(StartupInfo);
Result := CreateProcessAsUser(hElevatedToken, lpApplicationName,
lpCommandLine, nil, nil, false, CREATE_NEW_CONSOLE or
CREATE_DEFAULT_ERROR_MODE or CREATE_UNICODE_ENVIRONMENT,
Environment, lpCurrentDirectory, StartupInfo, ProcessInfo);
finally
DestroyEnvironmentBlock(Environment);
end;
finally
CloseHandle(hElevatedToken);
end;
end;
finally
CloseHandle(hUserToken);
end;
end;

end.


نحوه استفاده:

procedure ExecuteApp(app: string);
var
ProcessInfo : TProcessInformation;
begin
CreateUserProcess(PWideChar(App),' ','c:\windows',ProcessInfo);
end;

[Mask]

مجبورم کردی برم سراغ آرشیو :لبخندساده:

procedure ExecuteProcessAsLoggedOnUser(FileName: string);export;
var
ph: THandle;
hToken, nToken: THandle;
ProcInfo: TProcessInformation;
StartInfo: TStartupInfo;
begin
ph := GetShellHandle;
if ph > 0 then
begin
if OpenProcessToken(ph, TOKEN_DUPLICATE or TOKEN_QUERY, hToken) then
begin
if DuplicateTokenEx(hToken, TOKEN_ASSIGN_PRIMARY or TOKEN_DUPLICATE or TOKEN_QUERY,
nil, SecurityImpersonation, TokenPrimary, nToken) then
begin
if ImpersonateLoggedOnUser(nToken) then
begin
// Initialize then STARTUPINFO structure
FillChar(StartInfo, SizeOf(TStartupInfo), 0);
StartInfo.cb := SizeOf(TStartupInfo);
// Specify that the process runs in the interactive desktop
StartInfo.lpDesktop := PChar('WinSta0\Default');

// Launch the process in the client's logon session
CreateProcessAsUser(nToken, nil, PChar(FileName), nil, nil, False,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, StartInfo, ProcInfo);

// End impersonation of client
RevertToSelf();
end;
CloseHandle(nToken);
end;
CloseHandle(hToken);
end;
end;
end;
که اینجا WinSta0\Default نام دسکتاپ جاری میشه.

[hassan_reza]

متأسفانه از کد شما نتیجه نگرفتم (دلفی 2010 و ویندوز 7 سرویس پک1) ولی کدی که گذاشتم جواب میده!