Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 3406
  • Last Modified:

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 ...
0
pistacer
Asked:
pistacer
1 Solution
 
maharaCommented:
listening...
0
 
alanwhincupCommented:
listening & learning... :)
0
 
AttarSoftwareCommented:
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.
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
l8knightCommented:
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
0
 
pistacerAuthor Commented:
Adjusted points from 100 to 150
0
 
l8knightCommented:
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.
0
 
l8knightCommented:
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.
0
 
l8knightCommented:
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.
0
 
l8knightCommented:
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
0
 
l8knightCommented:
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
0
 
l8knightCommented:
Sorry, I didn't realise it was quite so big... but I started so I thought I had better finished. If you want to d'load the .zip file, let me know I will put it on my site for you to get.

regards

l8knight
0
 
pistacerAuthor Commented:
thanks, i will first check the sended units! if i can please you, put the zip on your page, i will download it!
0
 
pistacerAuthor Commented:
works perfectly! but i hawe some questions to add:
- can i destroy created desktop?
- i could not switch on log on desktop. why?
0
 
pistacerAuthor Commented:
works perfectly! but i hawe some questions to add:
- can i destroy created desktop?
- i could not switch on log on desktop. why?
0
 
pistacerAuthor Commented:
Comment accepted as answer
0
 
l8knightCommented:
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?
0
 
l8knightCommented:
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

0
 
l8knightCommented:
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
0
 
pistacerAuthor Commented:
l8knight, i will create any more question on this thema .... called default desktop
0

Featured Post

[Webinar On Demand] Database Backup and Recovery

Does your company store data on premises, off site, in the cloud, or a combination of these? If you answered “yes”, you need a data backup recovery plan that fits each and every platform. Watch now as as Percona teaches us how to build agile data backup recovery plan.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now