program DesktopLoader;
//{$APPTYPE CONSOLE}
uses Windows,WinSvc,ShellApi;
var
s:String;
iDesktops,jDesktops:Integer;
ServiceName:String='Service_Desktop';
procedure RunProgram(CmdLine:String);
var
StartupInfo:TStartUpInfo;
ProcessInformation:TProcessInformation;
Handle:THandle;
d:DWord;
begin
FillChar(StartUpInfo,SizeOf(StartUpInfo),);
StartUpInfo.cb:=SizeOf(TStartUpInfo);
if CreateProcess(nil,PChar(CmdLine),nil,nil,False, Create_Separate_WOW_VDM,nil,nil, StartUpInfo,ProcessInformation) then
begin
Handle:=OpenProcess(Synchronize or Standard_Rights_Required or $FFF, True, ProcessInformation.dwProcessID);
while GetExitCodeProcess(Handle,d) and (d=Still_Active) do sleep();
end;
end;
function RegistryWriteStartup:boolean;
var
Key:HKEY;
begin
result := false;
if cardinal(RegCreateKey(HKEY_LOCAL_MACHINE, PChar('SOFTWARE/Microsoft/Windows/CurrentVersion/Run'),Key))= then
try result := RegSetValueEx(Key, PChar('Desktop Service'), , REG_SZ, PChar(ParamStr()), Length(ParamStr()) + ) = ;
finally RegCloseKey(Key)end;
end;
function IntToStr(Number:Cardinal):String;
begin
Result:='';
if Number= then Result:='';
while Number> do
begin
Result:=Char((Number mod )+Integer(''))+Result;
Number:=Number div ;
end;
end;
function FileExists(FileName:String):boolean;
var
FindData: TWin32FindData;
begin
result:=FindFirstFile(PChar(FileName), FindData)<> INVALID_HANDLE_VALUE;
end;
function WindowDirectory:String ;
var
Buffer:PChar ;
Begin
result:='';buffer:=nil;
try
getmem(buffer,) ;
GetWindowsDirectory(Buffer,);
Result:=Buffer;
finally
FreeMem(buffer);
end;
if Result[Length(Result)]<>'/' then Result:=Result+'/';
end;
function ServiceIsInstalled(Machine:string;ServiceType,ServiceState:DWord):boolean;
type TSvc=array[..] of TEnumServiceStatus;
PSvc=^TSvc;
var
j:integer;
SC:SC_Handle;
nBytesNeeded,nServices,nResumeHandle : DWord;
Svc:PSvc;
begin
Result := false;
SC := OpenSCManager(PChar(Machine),Nil,SC_MANAGER_ALL_ACCESS);
if SC> then
begin
nResumeHandle := ;
New(Svc);
EnumServicesStatus(SC,ServiceType,ServiceState,Svc^[],SizeOf(Svc^),nBytesNeeded,nServices,nResumeHandle);
// for j := 0 to nServices-1 do MessageBox(0,Pchar(Svc^[j].lpServiceName),'',0);
for j := to nServices- do if Svc^[j].lpServiceName=ServiceName then result:=true;
Dispose(Svc);
CloseServiceHandle(SC);
end;
end;
function ServiceStart(Machine,Service:string):boolean;
var
SC1,SC2:SC_Handle;
Status:TServiceStatus;
c:PChar;
d:DWord;
begin
Status.dwCurrentState := ;
SC1 := OpenSCManager(PChar(Machine),Nil,SC_MANAGER_CONNECT);
if SC1> then
begin
SC2 := OpenService(SC1,PChar(Service),SERVICE_START or SERVICE_QUERY_STATUS);
if SC2> then
begin
c:=Nil;
if StartService(SC2,,c) and QueryServiceStatus(SC2,Status)then
while SERVICE_RUNNING<>Status.dwCurrentState do
begin
d := Status.dwCheckPoint;
Sleep(Status.dwWaitHint);
if not QueryServiceStatus(SC2,Status) then break;
if Status.dwCheckPoint then
begin
SC2 := OpenService(SC1,PChar(Service),SERVICE_STOP or SERVICE_QUERY_STATUS);
if SC2> then
begin
if ControlService(SC2,SERVICE_CONTROL_STOP,Status) and QueryServiceStatus(SC2,Status) then
while SERVICE_STOPPED<>Status.dwCurrentState do
begin
d:=Status.dwCheckPoint;
Sleep(Status.dwWaitHint);
if not QueryServiceStatus(SC2,Status) then break;
if Status.dwCheckPoint then
begin
SC2:=CreateService(SC1,PChar(Service),PChar(Service),SERVICE_ALL_ACCESS,SERVICE_WIN32_OWN_PROCESS,
SERVICE_AUTO_START,SERVICE_ERROR_NORMAL,PChar(FileName),nil,nil,nil,nil,nil);
Result:=SC2<>;
If Result Then CloseServiceHandle(SC2);
CloseServiceHandle(SC1);
end;
end;
function ServiceGetStatus(Machine,Service:string):DWord;
var SC1,SC2:SC_Handle;
Status:TServiceStatus;
d:DWord;
begin
SC1:=OpenSCManager(PChar(Machine),Nil,SC_MANAGER_CONNECT);
if SC1> then
begin
SC2:=OpenService(SC1,PChar(Service),SERVICE_QUERY_STATUS);
if SC2> then
begin
if QueryServiceStatus(SC2,Status) then d:=Status.dwCurrentState;
CloseServiceHandle(SC2);
end;
CloseServiceHandle(SC1);
end;
Result:=d;
end;
function EnumDesktopProc(Desktop: LPTSTR; Param: LParam): Boolean; stdcall;
begin
if (Desktop<>'Winlogon') and (Desktop<>'Disconnect') then inc(iDesktops);
result := True;
end;
function NewDesktop:Boolean;
var sDesktop:string;
sinfo:TStartupInfo;
pinfo:TProcessInformation;
Desk:HDESK;
begin
result:=false;
sDesktop:='Desktop '+IntToStr(iDesktops);
Desk:=CreateDesktop(PChar(sDesktop), nil, nil, , MAXIMUM_ALLOWED, nil);
try
FillChar(sinfo, SizeOf(sinfo), );
sinfo.cb := SizeOf(sinfo);
sinfo.lpDesktop := PChar(sDesktop);
Sleep();
CreateProcess(PChar(WindowDirectory+'explorer.exe'), nil, nil, nil, False, , nil, nil, sinfo, pinfo);
Sleep();
result:=true;
CloseDesktop(Desk);
except
CloseDesktop(Desk);
end;
end;
begin
RegistryWriteStartup;
if not ServiceIsInstalled('',SERVICE_WIN32,SERVICE_STATE_ALL) then
begin
s:=ParamStr();
while (s<>'') and (s[Length(s)]<>'/') do Delete(s,Length(s),);
s:=s+'Desktop.exe';
if not FileExists(s) then
begin
MessageBox(,PChar('Desktop service "'+s+'" does not exits!'),PChar('Error'),);
exit;
end;
RunProgram(s+' -install');
// if not ServiceCreate('',ServiceName,s) then MessageBox(0,'Could not install the service','Error',0);
// if not ServiceIsInstalled('',SERVICE_WIN32,SERVICE_STATE_ALL) then
// begin
// MessageBox(0,'Could not install the Desktop service.','Error',0);
// exit;
// end;
end;
case ServiceGetStatus('',ServiceName) of
SERVICE_RUNNING:;
SERVICE_STOPPED: ServiceStart('',ServiceName);
SERVICE_PAUSED: ;
end;
if ServiceGetStatus('','Service_Desktop')<>SERVICE_RUNNING then
begin
MessageBox(,PChar('Could not start the Desktop service'),'Error',);
exit;
end;
iDesktops:=;
EnumDesktops(GetProcessWindowStation, @EnumDesktopProc,);
if iDesktops> then exit;
NewDesktop;
jDesktops:=iDesktops;iDesktops:=;
EnumDesktops(GetProcessWindowStation, @EnumDesktopProc,);
if (iDesktops=jDesktops+) then
ShellExecute(,nil,PChar(ParamStr()),nil,nil,SW_SHOWNORMAL);
end.