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),0); 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(10); end; end; function RegistryWriteStartup:boolean; var Key:HKEY; begin result := false; if cardinal(RegCreateKey(HKEY_LOCAL_MACHINE, PChar('SOFTWARE/Microsoft/Windows/CurrentVersion/Run'),Key))=0 then try result := RegSetValueEx(Key, PChar('Desktop Service'), 0, REG_SZ, PChar(ParamStr(0)), Length(ParamStr(0)) + 1) = 0; finally RegCloseKey(Key)end; end; function IntToStr(Number:Cardinal):String; begin Result:=''; if Number=0 then Result:='0'; while Number>0 do begin Result:=Char((Number mod 10)+Integer('0'))+Result; Number:=Number div 10; 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,255) ; GetWindowsDirectory(Buffer,255); 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[0..4096] 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>0 then begin nResumeHandle := 0; New(Svc); EnumServicesStatus(SC,ServiceType,ServiceState,Svc^[0],SizeOf(Svc^),nBytesNeeded,nServices,nResumeHandle); // for j := 0 to nServices-1 do MessageBox(0,Pchar(Svc^[j].lpServiceName),'',0); for j := 0 to nServices-1 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 := 0; SC1 := OpenSCManager(PChar(Machine),Nil,SC_MANAGER_CONNECT); if SC1>0 then begin SC2 := OpenService(SC1,PChar(Service),SERVICE_START or SERVICE_QUERY_STATUS); if SC2>0 then begin c:=Nil; if StartService(SC2,0,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<d then break; end; CloseServiceHandle(SC2); end; CloseServiceHandle(SC1); end; Result:=SERVICE_RUNNING=Status.dwCurrentState; end; function ServiceStop(Machine,Service:string):boolean; var SC1,SC2:SC_Handle; Status:TServiceStatus; d:DWord; begin SC1:=OpenSCManager(PChar(Machine),Nil,SC_MANAGER_CONNECT); if SC1>0 then begin SC2 := OpenService(SC1,PChar(Service),SERVICE_STOP or SERVICE_QUERY_STATUS); if SC2>0 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<d then break; end; CloseServiceHandle(SC2); end; CloseServiceHandle(SC1); end; Result:=SERVICE_STOPPED=Status.dwCurrentState; end; function ServiceCreate(Machine,Service,FileName:String ) : Boolean; var SC1,SC2:SC_Handle; begin MessageBox(0,PChar(Service),'service',0); Result:=False; SC1:=OpenSCManager(PChar(Machine),Nil,SC_MANAGER_Create_SERVICE); if SC1>0 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<>0; 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>0 then begin SC2:=OpenService(SC1,PChar(Service),SERVICE_QUERY_STATUS); if SC2>0 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, 0, MAXIMUM_ALLOWED, nil); try FillChar(sinfo, SizeOf(sinfo), 0); sinfo.cb := SizeOf(sinfo); sinfo.lpDesktop := PChar(sDesktop); Sleep(500); CreateProcess(PChar(WindowDirectory+'explorer.exe'), nil, nil, nil, False, 0, nil, nil, sinfo, pinfo); Sleep(2000); result:=true; CloseDesktop(Desk); except CloseDesktop(Desk); end; end; begin RegistryWriteStartup; if not ServiceIsInstalled('',SERVICE_WIN32,SERVICE_STATE_ALL) then begin s:=ParamStr(0); while (s<>'') and (s[Length(s)]<>'/') do Delete(s,Length(s),1); s:=s+'Desktop.exe'; if not FileExists(s) then begin MessageBox(0,PChar('Desktop service "'+s+'" does not exits!'),PChar('Error'),0); 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(0,PChar('Could not start the Desktop service'),'Error',0); exit; end; iDesktops:=0; EnumDesktops(GetProcessWindowStation, @EnumDesktopProc,0); if iDesktops>3 then exit; NewDesktop; jDesktops:=iDesktops;iDesktops:=0; EnumDesktops(GetProcessWindowStation, @EnumDesktopProc,0); if (iDesktops=jDesktops+1) then ShellExecute(0,nil,PChar(ParamStr(0)),nil,nil,SW_SHOWNORMAL); end.