PureBoard

Verfasst: **30.08.2006 16:01**

Kleiner Tip noch. Es ist einfacher, offline mit dem Apiviewer die Konstanten und sogar PB-Deklarationen zu finden.

http://www.activevb.de/rubriken/apiview ... iewer.html

Gruss Falko
[Edit]
Sorry, DD hatte es schon geschrieben
http://www.purebasic.fr/german/viewtopi ... cda#108199
[/Edit]

Verfasst: **30.08.2006 21:24**

Ich habe den 2. Post gelöscht da er genau der selbe war wie dieser. Ein Thread reicht doch um eine Antwort zuu bekommen denke ich

Verfasst: **07.10.2006 12:00**

habe jetzt auch mal ein Testwindow gebaut welches leider nicht auf dem vDesktop angezeigt wird sondern nur auf dem original Desktop, weiss einer warum?

Ich habe da mit meinem gefährlichen Halbwisse etwas zum Laufen gebracht. Es kann aber nicht schaden wenn einer von den Profis noch einmal einen kritischen Blick darauf wirft.

Code: Alles auswählen

#WINSTA_ALL  = #WINSTA_ACCESSCLIPBOARD | #WINSTA_ACCESSGLOBALATOMS | #WINSTA_CREATEDESKTOP | #WINSTA_ENUMDESKTOPS | #WINSTA_ENUMERATE | #WINSTA_EXITWINDOWS | #WINSTA_READATTRIBUTES | #WINSTA_READSCREEN | #WINSTA_WRITEATTRIBUTES | #DELETE | #READ_CONTROL | #WRITE_DAC | #WRITE_OWNER 
#DESKTOP_ALL = #DESKTOP_READOBJECTS | #DESKTOP_CREATEWINDOW | #DESKTOP_CREATEMENU | #DESKTOP_HOOKCONTROL | #DESKTOP_JOURNALRECORD | #DESKTOP_JOURNALPLAYBACK | #DESKTOP_ENUMERATE | #DESKTOP_WRITEOBJECTS | #DESKTOP_SWITCHDESKTOP | #STANDARD_RIGHTS_REQUIRED 


Global FontID1 
FontID1 = LoadFont(1, "Arial", 22, #PB_Font_Bold) 

;Show an error 
Procedure Abort(s.s) 
  MessageRequester("", "Error: "+s.s) 
  Debug "Error: "+s.s
  End 
EndProcedure 

;Check a result and ev. abort 
Procedure Chk(a.l, s.s) 

  ;If a is false, abort. 
  ;If a is false and s contains an error message, show it before abort. 
  If Not(a) 
    If s.s 
      Abort(s.s) 
    Else 
      End 
    EndIf 
  EndIf 
EndProcedure 

hWinSta = OpenWindowStation_("WinSta0", 0, #WINSTA_ALL) 
Chk( SetProcessWindowStation_(hWinSta) , "Failed to set window station") 

hDefaultDesk = OpenDesktop_("Default", #DF_ALLOWOTHERACCOUNTHOOK, 0, #DESKTOP_SWITCHDESKTOP) 
Chk(hDefaultDesk, "Failed to open default desktop") 

hDesk = CreateDesktop_("My Desktop 2", 0, 0, #DF_ALLOWOTHERACCOUNTHOOK, #DESKTOP_ALL, 0) 
Chk( hDesk, "Failed to create desktop") 

SetThreadDesktop_(hDesk)  ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Chk( SwitchDesktop_(hDesk), "Failed to switch desktop") 

If OpenWindow(1, 216, 0, 255, 165, "Test",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar ) 
  If CreateGadgetList(WindowID(1)) 
    TextGadget(1, 20, 70, 210, 30, "Test", #PB_Text_Center) 
    SetGadgetFont(1, FontID1) 
  EndIf 
EndIf 

 Repeat 
   Event = WaitWindowEvent() 
   WindowID = EventWindow() 
   GadgetID = EventGadget() 
   EventType = EventType() 
   If Event = #PB_Event_Gadget 
   EndIf 
 Until Event = #PB_Event_CloseWindow 

;Delay(2000) 

Chk( SwitchDesktop_(hDefaultDesk), "Failed to switch desktop") 
SetThreadDesktop_(hDefaultDesk)  ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

CloseDesktop_(hDesk) 
CloseDesktop_(hDefaultDesk) 
CloseWindowStation_(hWinSta)

Verfasst: **09.10.2006 20:45**

Hey, Klasse!!

von wegen gefährliches Halbwissen, klappt wircklich S U P E R !
vielen Dank!

Gruss Peter

Verfasst: **10.10.2006 13:48**

Danke für die Blumen!
Es freut mich wenn es hilft, aber ich habe daß mit dem Halbwissen nicht nur geschrieben um nach Komplimenten zu fischen. Es gibt sogenannte Seiteneffekte. Eine Aktion bewirkt mitunter mehrere Dinge. Wenn man sich seiner Sache nicht 100% sicher ist kann es leicht passieren, daß eine der unberücksichtigten Wirkungen irgendwann als Boomerang zurück kommt. Und dann gestaltet sich die Fehlersuche schwierig.

Verfasst: **10.10.2006 15:06**

Hallo nochmal,

habe nun mal versucht das Programm zu erweitern und wollte mal ein anderes Programm auf dem Winstation Desktop starten, geht aber nicht startet in diesem Programmbeispiel nur auf dem ursprünglichen Desktop, hat einer Idee woran das liegt?

Gruss Peter

Code: Alles auswählen

#WINSTA_ALL  = #WINSTA_ACCESSCLIPBOARD | #WINSTA_ACCESSGLOBALATOMS | #WINSTA_CREATEDESKTOP | #WINSTA_ENUMDESKTOPS | #WINSTA_ENUMERATE | #WINSTA_EXITWINDOWS | #WINSTA_READATTRIBUTES | #WINSTA_READSCREEN | #WINSTA_WRITEATTRIBUTES | #DELETE | #READ_CONTROL | #WRITE_DAC | #WRITE_OWNER 
#DESKTOP_ALL = #DESKTOP_READOBJECTS | #DESKTOP_CREATEWINDOW | #DESKTOP_CREATEMENU | #DESKTOP_HOOKCONTROL | #DESKTOP_JOURNALRECORD | #DESKTOP_JOURNALPLAYBACK | #DESKTOP_ENUMERATE | #DESKTOP_WRITEOBJECTS | #DESKTOP_SWITCHDESKTOP | #STANDARD_RIGHTS_REQUIRED 

Global FontID1 
FontID1 = LoadFont(1, "Arial", 22, #PB_Font_Bold) 

;Show an error 
Procedure Abort(s.s) 
  MessageRequester("", "Error: "+s.s) 
  Debug "Error: "+s.s 
  End 
EndProcedure 

;Check a result and ev. abort 
Procedure Chk(a.l, s.s) 
  
  ;If a is false, abort. 
  ;If a is false and s contains an error message, show it before abort. 
  If Not(a) 
    If s.s 
      Abort(s.s) 
    Else 
      End 
    EndIf 
  EndIf 
EndProcedure 

hWinSta = OpenWindowStation_("WinSta0", 0, #WINSTA_ALL) 
Chk( SetProcessWindowStation_(hWinSta) , "Failed to set window station") 

hDefaultDesk = OpenDesktop_("Default", #DF_ALLOWOTHERACCOUNTHOOK, 0, #DESKTOP_SWITCHDESKTOP) 
Chk(hDefaultDesk, "Failed to open default desktop") 

hDesk = CreateDesktop_("My Desktop 2", 0, 0, #DF_ALLOWOTHERACCOUNTHOOK, #DESKTOP_ALL, 0) 
Chk( hDesk, "Failed to create desktop") 

SetThreadDesktop_(hDesk)  ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

Chk( SwitchDesktop_(hDesk), "Failed to switch desktop") 


If OpenWindow(1, 216, 0, 255, 165, "Test",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar ) 
  If CreateGadgetList(WindowID(1)) 
    ButtonGadget(1, 20, 10, 210, 30, "Start Notepad")
    TextGadget(2, 20, 70, 210, 30, "Test", #PB_Text_Center) 
    SetGadgetFont(2, FontID1) 
  EndIf 
EndIf 

Repeat 
  Event = WaitWindowEvent() 
  WindowID = EventWindow() 
  GadgetID = EventGadget() 
  EventType = EventType() 
  If Event = #PB_Event_Gadget
    If GadgetID = 1
    run_prg = RunProgram("notepad.exe", "", "")
    EndIf
  EndIf
Until Event = #PB_Event_CloseWindow 


Chk( SwitchDesktop_(hDefaultDesk), "Failed to switch desktop") 
SetThreadDesktop_(hDefaultDesk)  ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

CloseDesktop_(hDesk) 
CloseDesktop_(hDefaultDesk) 
CloseWindowStation_(hWinSta)

Verfasst: **10.10.2006 16:29**

Hmm, scheint so das man nicht direkt mit Runprogram was erreicht sondern mit CreateProcess, habe auch ein VB Code Schnipsel gefunden der sich mit dem Thema beschäftigt kann den aber nicht komplett nach PB übersetzen weil mir hier die nötigen Kenntnisse in VB fehlen, wäre nett wenn Jemand mal drüber schaut, habe besondere Probleme der "Public Function GetDesktopName() As String", scheint so das hier erst der Desktopname des neuen Desktop ermittelt werden muss um CreateProcess dazu zu veranlassen das Programm auf dem neuen Desktop zu starten

Gruss Peter

Code: Alles auswählen

BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cDesktop"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit



Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessW" (ByVal lpApplicationName As Long, ByVal lpCommandLine As Long, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFOW, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetUserObjectInformation Lib "user32" Alias "GetUserObjectInformationW" (ByVal hObj As Long, ByVal nIndex As Long, pvInfo As Any, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Private Declare Function CreateDesktop Lib "user32" Alias "CreateDesktopW" (ByVal lpszDesktop As Long, ByVal lpszDevice As Long, pDevmode As Any, ByVal dwFlags As Long, ByVal dwDesiredAccess As Long, lpsa As Any) As Long
Private Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Declare Function GetThreadDesktop Lib "user32" (ByVal dwThread As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function OpenInputDesktop Lib "user32" (ByVal dwFlags As Long, ByVal fInherit As Boolean, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseDesktop Lib "user32.dll" (ByVal hDesktop As Long) As Long



Private Type PROCESS_INFORMATION
   hProcess As Long
   hThread As Long
   dwProcessId As Long
   dwThreadId As Long
End Type

Private Type STARTUPINFOW
   cbSize As Long
   lpReserved As Long
   lpDesktop As Long
   lpTitle As Long
   dwX As Long
   dwY As Long
   dwXSize As Long
   dwYSize As Long
   dwXCountChars As Long
   dwYCountChars As Long
   dwFillAttribute As Long
   dwFlags As Long
   wShowWindow As Integer
   cbReserved2 As Integer
   lpReserved2 As Long
   hStdInput As Long
   hStdOutput As Long
   hStdError As Long
End Type

Private Const UOI_FLAGS = 1
Private Const UOI_NAME = 2
Private Const UOI_TYPE = 3
Private Const UOI_USER_SID = 4
Private Const DESKTOP_SWITCHDESKTOP = &H100&
Private Const GENERIC_ALL = &H10000000
Private Const INFINITE As Long = &HFFFFFFFF

Private Const DESKTOP_READOBJECTS = &H1&





Public m_sDesktop As String
Public m_hDesktop As Long
Public m_hDesktopInputOld As Long
Public m_hDesktopThreadOld As Long

Public Sub Create(ByVal sDesktopName As String)
   m_hDesktopThreadOld = GetThreadDesktop(GetCurrentThreadId())
   m_hDesktopInputOld = OpenInputDesktop(0, False, DESKTOP_SWITCHDESKTOP)
   m_hDesktop = CreateDesktop(StrPtr(sDesktopName), ByVal 0&, ByVal 0&, 0, GENERIC_ALL, ByVal 0&)

   m_sDesktop = sDesktopName

   SetThreadDesktop m_hDesktop
   SwitchDesktop m_hDesktop
End Sub

Public Sub StartProcess(ByVal sPath As String)
    Dim tSi As STARTUPINFOW
    Dim tPi As PROCESS_INFORMATION
    Dim lR As Long
    Dim lErr As Long

   ' Must set the desktop to run on in the
   ' STARTUPINFO structure:
   tSi.cbSize = Len(tSi)
   tSi.lpTitle = StrPtr(m_sDesktop)
   tSi.lpDesktop = StrPtr(m_sDesktop)
   
   lR = CreateProcess( _
      StrPtr(sPath), ByVal 0&, ByVal 0&, ByVal 0&, _
      1, 0, ByVal 0&, ByVal 0&, tSi, tPi)
   
   If (lR = 0) Then
   
      lErr = Err.LastDllError
      ' Make sure we get back into the desktop
      ' that contains the application that is
      ' using this class:
      ClearUp
      ' Now show the error
      'ApiErrorHandler lErr, True
      
   Else
      
      ' Wait until the process has completed:
      ' WaitForSingleObject tPi.hProcess, INFINITE
      
      ' Done. Not sure if we need to close these
      ' handles, but it doesn't cause a problem
      CloseHandle tPi.hProcess
      CloseHandle tPi.hThread
           
      ' Once no more processes are running on
      ' the desktop it will automatically
      ' close.
           
   End If

End Sub


Public Function GetDesktopName() As String
Dim hDesktop As Long
Dim lR As Long
Dim lSize As Long
Dim sBuff As String
Dim iPos As Long
   
   hDesktop = OpenInputDesktop(0, False, DESKTOP_READOBJECTS)
   If Not (hDesktop = 0) Then
      lSize = (Len(m_sDesktop) + 1) * 2
      ReDim bBuff(0 To lSize - 1) As Byte
      lR = GetUserObjectInformation(hDesktop, UOI_NAME, bBuff(0), lSize, lSize)
      sBuff = bBuff
      iPos = InStr(sBuff, vbNullChar)
      If (iPos > 1) Then
         sBuff = Left(sBuff, iPos - 1)
      End If
      GetDesktopName = sBuff
      CloseHandle hDesktop
   End If
End Function





Public Sub ClearUp()
   SwitchDesktop m_hDesktopInputOld
   SetThreadDesktop m_hDesktopThreadOld
   CloseDesktop m_hDesktop
End Sub

Verfasst: **16.12.2021 13:53**

Hallo Peter, bist du bei dem Thema noch zu neuen Erkenntnissen gekommen?

PureBoard

Virtual Desktop

Re: Virtual Desktop