asked on

createdesktop, switchdesktop

how about an easy sample:

save any id of current desktop,
create a new desktop,
save any id of this new desktop,
and switching between them

i checked it so:
------------------------------------------------------------------------------------------------

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button3: TButton;
Label1: TLabel;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
odeskt, ndeskt:hdesk;
ninit:boolean;
coml:string;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
thr:longint;
begin
thr:= getcurrentthreadid;
label1.Caption:= inttostr(thr);
odeskt:= getthreaddesktop(thr);
label2.Caption:= inttostr(odeskt);
ninit:= false;
ndeskt:= 0;
if paramcount = 0
then coml:= inttostr(odeskt)
else begin
coml:= '';
odeskt:= strtoint(paramstr(1))
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
switchdesktop(odeskt);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
sab:_SECURITY_ATTRIBUTES;
pri:_PROCESS_INFORMATION;
sti:STARTUPINFO;
yes:boolean;
begin
if not(ninit)
then begin
sab.nLength:= sizeof(sab);
sab.lpSecurityDescriptor:= nil;
sab.bInheritHandle:= true;
ndeskt:= createdesktop(pchar('pokus'),
nil,
nil,
// DF_ALLOWOTHERACCOUNTHOOK,
0,
(DESKTOP_CREATEMENU
+ DESKTOP_CREATEWINDOW
+ DESKTOP_ENUMERATE
+ DESKTOP_HOOKCONTROL
+ DESKTOP_JOURNALPLAYBACK
+ DESKTOP_JOURNALRECORD
+ DESKTOP_READOBJECTS
+ DESKTOP_SWITCHDESKTOP
+ DESKTOP_WRITEOBJECTS),
@sab);
ninit:= (ndeskt <> 0);
if ninit
then begin
sti.cb:= sizeof(sti);
sti.lpReserved:= nil;
sti.lpDesktop:= pchar('pokus');
sti.lpTitle:= nil;
sti.dwX:= 0;
sti.dwY:= 0;
sti.dwXSize:= 0;
sti.dwYSize:= 0;
sti.dwXCountChars:= 0;
sti.dwYCountChars:= 0;
sti.dwFillAttribute:= FOREGROUND_BLUE;
sti.dwFlags:= 0;
sti.wShowWindow:= 0;
sti.cbReserved2:= 0;
sti.lpReserved2:= nil;
sti.hStdInput:= 0;
sti.hStdOutput:= 0;
sti.hStdError:= 0;
yes:= createprocess(pchar('C:\newdesk.exe'),
pchar(coml),
@sab,
@sab,
true,
(CREATE_SEPARATE_WOW_VDM),
nil,
nil,
sti,
pri);
switchdesktop(ndeskt);
end;
end
else switchdesktop(ndeskt);
end;

end.
----------------------------------------------------------------------------------------------

object Form1: TForm1
Left = 244
Top = 106
Width = 289
Height = 249
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 168
Top = 40
Width = 73
Height = 29
Caption = 'Label1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -23
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label2: TLabel
Left = 168
Top = 80
Width = 73
Height = 29
Caption = 'Label2'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -23
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Button1: TButton
Left = 24
Top = 80
Width = 105
Height = 25
Caption = 'new desktop'
TabOrder = 0
OnClick = Button1Click
end
object Button3: TButton
Left = 24
Top = 128
Width = 105
Height = 25
Caption = 'old desktop'
TabOrder = 1
OnClick = Button3Click
end
end
--------------------------------------------------------------------------------------

sure i made some error, but i cannot find it. it will create a desktop, the same application is started into it, but to switch back ...
...something is wrong out there ...

mahara

listening...

alanwhincup

listening & learning... :)

AttarSoftware

Hmmmm... I tried this myself, and on 2000 (as it doesn't work on 95/98), I could create a WindowStation (which the help says you need to create a Desktop), but the call to create a Desktop always fails...

So I guess I am listening too, to see how it is done...

Sorry to be of no help,

Tim.

l8knight

I seem to remember someone providing an example of doing this on the Borland Community web site. In the Code Central section I think. Bugger it, I'll go have a look and get back to you.

l8knight

pistacer

ASKER

Adjusted points from 100 to 150

l8knight

o.k. I found it this is the unit... I'll post the rest in next message.

l8knight

unit desktops;

interface

uses classes, Windows;

type
TDesktop = class
private
FDesktops: TStringList;
function GetDesktops: TStrings;
procedure AddDesktop(const Name: String);
public
function CreateDesktop(const Name: String): HDESK;
destructor Destroy; override;
procedure Refresh;
procedure SwitchToDesktop(const Name: String);
published
property Desktops: TStrings read GetDesktops;
end;

function Desktop: TDesktop;

implementation

uses SysUtils;

const
DESKTOP_ALL = DESKTOP_READOBJECTS or DESKTOP_CREATEWINDOW or
DESKTOP_CREATEMENU or DESKTOP_HOOKCONTROL or
DESKTOP_JOURNALRECORD or DESKTOP_JOURNALPLAYBACK or
DESKTOP_ENUMERATE or DESKTOP_WRITEOBJECTS or DESKTOP_SWITCHDESKTOP;

var
FDesktop: TDesktop;

function Desktop: TDesktop;
begin
if not Assigned(FDesktop) then
FDesktop := TDesktop.Create;
result := FDesktop;
end;

function EnumDesktopProc(Desktop: LPTSTR; Param: LParam): Boolean; stdcall;
begin
TDesktop(Param).AddDesktop(Desktop);
result := True;
end;

{ TDesktop }

procedure TDesktop.AddDesktop(const Name: String);
begin
FDesktops.Add(Name);
end;

function TDesktop.CreateDesktop(const Name: String): HDESK;
var
hndDesk: HDESK;
begin
hndDesk := Windows.CreateDesktop(pchar(Name), nil, nil, 0, DESKTOP_ALL, nil);
if hndDesk = 0 then
RaiseLastWin32Error;
Desktops.Insert(0, Name);
result := hndDesk;
end;

destructor TDesktop.Destroy;
begin
FDesktops.Free;
inherited;
end;

function TDesktop.GetDesktops: TStrings;
begin
if not Assigned(FDesktops) then
begin
FDesktops := TStringList.Create;
EnumDesktops(GetProcessWindowStation, @EnumDesktopProc, Integer(Self));
end;
result := FDesktops;
end;

procedure TDesktop.Refresh;
begin
FreeAndNil(FDesktops);
end;

procedure TDesktop.SwitchToDesktop(const Name: String);
var
hndDesk: HDESK;
begin
hndDesk := OpenDesktop(PChar(Name), DF_ALLOWOTHERACCOUNTHOOK, False, DESKTOP_ALL);
if hndDesk = 0 then RaiseLastWin32Error;
SwitchDesktop(hndDesk);
CloseDesktop(hndDesk);
end;

initialization

finalization
FDesktop.Free;
end.

l8knight

unit MainForm;

interface

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

type
TfrmDesktopSwitch = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Run1: TMenuItem;
Desktop1: TMenuItem;
Newdesktop1: TMenuItem;
Refresh1: TMenuItem;
ApplicationEvents1: TApplicationEvents;
procedure Newdesktop1Click(Sender: TObject);
procedure Run1Click(Sender: TObject);
procedure Refresh1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
procedure DesktopBtnClick(sender: TObject);
procedure FetchDesktops;
end;

var
frmDesktopSwitch: TfrmDesktopSwitch;

implementation

{$R *.DFM}

uses RunForm, desktops;

type
TButtonCrack = class(TButton);

procedure TfrmDesktopSwitch.DesktopBtnClick(sender: TObject);
begin
Desktop.SwitchToDesktop((Sender as TButton).Caption);
end;

procedure TfrmDesktopSwitch.FetchDesktops;
var
i: integer;
begin
for i := ComponentCount - 1 downto 0 do
if Components[i] is TButton then
Components[i].Free;
for i := 0 to Desktop.Desktops.Count - 1 do
with TButtonCrack(TButton.Create(self)) do
begin
Parent := self;
Caption := Desktop.Desktops[i];
Align := alLeft;
OnClick := DesktopBtnClick;
end;
end;

procedure TfrmDesktopSwitch.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
CanClose := True;
if Desktop.Desktops.Count > 2 then // user has probably created an additional desktop or two
CanClose := MessageDlg('Closing this app can make it difficult to switch to other desktops.'#13 +
'Make sure it''s possible to launch this app within the current desktop.'#13#13 +
'Are you sure you want to quit?', mtWarning, [mbYes, mbNo], 0) = mrYes;
end;

procedure TfrmDesktopSwitch.Newdesktop1Click(Sender: TObject);
var
s: string;
sinfo: TStartupInfo;
pinfo: TProcessInformation;
hndDesk: HDESK;
begin
if InputQuery('New desktop', 'Enter name', s) then
begin
hndDesk := Desktop.CreateDesktop(s);
try
FillChar(sinfo, SizeOf(sinfo), 0);
sinfo.cb := SizeOf(sinfo);
sinfo.lpDesktop := PChar(s);
CreateProcess(pchar(Application.ExeName), nil, nil, nil, False, 0, nil, nil, sinfo, pinfo);
Sleep(100);
FetchDesktops;
finally
CloseDesktop(hndDesk);
end;
end;
end;

procedure TfrmDesktopSwitch.Run1Click(Sender: TObject);
begin
with TfrmRun.Create(self) do
try
ShowModal;
finally
Free;
end;
end;

procedure TfrmDesktopSwitch.Refresh1Click(Sender: TObject);
begin
Desktop.Refresh;
FetchDesktops;
end;

end.

l8knight

unit RunForm;

interface

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

type
TfrmRun = class(TForm)
edtName: TEdit;
Label1: TLabel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
btnBrowse: TButton;
procedure BitBtn1Click(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmRun: TfrmRun;

implementation

{$R *.DFM}

uses shellapi;

procedure TfrmRun.BitBtn1Click(Sender: TObject);
begin
if ShellExecute(Handle, nil, PChar(edtName.Text), nil, nil, SW_SHOWNORMAL) <= 32 then
MessageDlg(SysErrorMessage(GetLastError), mtError, [mbOk], 0)
else
ModalResult := mrOK;
end;

procedure TfrmRun.btnBrowseClick(Sender: TObject);
begin
with TOpenDialog.Create(self) do
try
Filter := 'Programs|*.exe;*.bat;*.com|All files|*.*';
if Execute then
edtName.Text := FileName;
finally
Free;
end;
end;

end.

l8knight

object frmDesktopSwitch: TfrmDesktopSwitch
Left = 192
Top = 107
Width = 300
Height = 94
Caption = 'Desktop switcher (NT)'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnCloseQuery = FormCloseQuery
PixelsPerInch = 96
TextHeight = 13
object MainMenu1: TMainMenu
Left = 240
Top = 8
object File1: TMenuItem
Caption = '&File'
object Run1: TMenuItem
Caption = '&Run...'
OnClick = Run1Click
end
end
object Desktop1: TMenuItem
Caption = '&Desktop'
object Newdesktop1: TMenuItem
Caption = '&New desktop'
OnClick = Newdesktop1Click
end
object Refresh1: TMenuItem
Caption = '&Refresh'
ShortCut = 116
OnClick = Refresh1Click
end
end
end
object ApplicationEvents1: TApplicationEvents
OnActivate = Refresh1Click
Left = 200
Top = 8
end
end

l8knight

object frmRun: TfrmRun
Left = 192
Top = 107
BorderStyle = bsDialog
Caption = 'Run'
ClientHeight = 100
ClientWidth = 351
Color = clBtnFace
ParentFont = True
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 24
Width = 29
Height = 13
Caption = 'Open:'
end
object edtName: TEdit
Left = 64
Top = 24
Width = 257
Height = 21
TabOrder = 0
end
object BitBtn1: TBitBtn
Left = 184
Top = 64
Width = 75
Height = 25
Caption = 'OK'
Default = True
TabOrder = 1
OnClick = BitBtn1Click
Glyph.Data = {
DE010000424DDE01000000000000760000002800000024000000120000000100
0400000000006801000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
3333333333333333333333330000333333333333333333333333F33333333333
00003333344333333333333333388F3333333333000033334224333333333333
338338F3333333330000333422224333333333333833338F3333333300003342
222224333333333383333338F3333333000034222A22224333333338F338F333
8F33333300003222A3A2224333333338F3838F338F33333300003A2A333A2224
33333338F83338F338F33333000033A33333A222433333338333338F338F3333
0000333333333A222433333333333338F338F33300003333333333A222433333
333333338F338F33000033333333333A222433333333333338F338F300003333
33333333A222433333333333338F338F00003333333333333A22433333333333
3338F38F000033333333333333A223333333333333338F830000333333333333
333A333333333333333338330000333333333333333333333333333333333333
0000}
NumGlyphs = 2
end
object BitBtn2: TBitBtn
Left = 266
Top = 64
Width = 75
Height = 25
TabOrder = 2
Kind = bkCancel
end
object btnBrowse: TButton
Left = 320
Top = 24
Width = 21
Height = 21
Caption = '...'
TabOrder = 3
OnClick = btnBrowseClick
end
end

ASKER CERTIFIED SOLUTION

l8knight

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

pistacer

ASKER

thanks, i will first check the sended units! if i can please you, put the zip on your page, i will download it!

pistacer

ASKER

works perfectly! but i hawe some questions to add:
- can i destroy created desktop?
- i could not switch on log on desktop. why?

pistacer

ASKER

works perfectly! but i hawe some questions to add:
- can i destroy created desktop?
- i could not switch on log on desktop. why?

pistacer

ASKER

Comment accepted as answer

l8knight

you can destroy the desktop but it would be a bit more difficult... because any thread using that desktop's handle would need to be closed aswell. Which also includes the desktop switch program...catch 22.

l8knight

anyone else have any ideas?

l8knight

according to the Microsft Platform SDK you cannot switch to the Winlogon Desktop, this is what it says:

The SwitchDesktop function fails if the desktop belongs to an invisible window station. SwitchDesktop also fails when called from a process associated with a secured desktop, such as the "WinLogon" and "Screen-Saver" desktops.

regards

l8knight

l8knight

by the way, if you want a start menu & desktop shortcuts etc in your newly created desktop just run explorer from the desktop switcher program.

l8knight

pistacer

ASKER

l8knight, i will create any more question on this thema .... called default desktop