'Funktionen
Public Function LockDesktop()
'GrantPrivileges 'hoffentlich nicht benötigt
 
oldDT = GetThreadDesktop(GetCurrentThreadId())
oldDI = OpenInputDesktop(0, True, DESKTOP_SWITCHDESKTOP)
 
'neuer Desktop
D = CreateDesktop(StrPtr("MDeskKiosk"), ByVal 0&, ByVal 0&, 1, GENERIC_ALL, _
  ByVal 0&)
 
'Speichern, falls Neustart der Kompletten Anwendung nötig...
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE Settings SET SettingValue='" & oldDI & "' WHERE" & _
  "SettingName='KioskModeDefDeskH';"
DoCmd.RunSQL "UPDATE Settings SET SettingValue='" & oldDT & "' WHERE" & _
"SettingName='KioskModeDefThreadH';"
DoCmd.RunSQL "UPDATE Settings SET SettingValue='" & D & "' WHERE" & _
"SettingName='KioskModeNewDeskH';"
DoCmd.RunSQL "UPDATE Settings SET SettingValue='1' WHERE" & _
"SettingName='KioskMode';"
DoCmd.SetWarnings True
 
 
Dim tSi As STARTUPINFO
Dim tPi As PROCESS_INFORMATION
Dim lR As Long
Dim lErr As Long
Dim sec1 As SECURITY_ATTRIBUTES
Dim sec2 As SECURITY_ATTRIBUTES
sec1.nLength = Len(sec1)
sec2.nLength = Len(sec2)
tSi.cb = Len(tSi)
tSi.lpDesktop = StrPtr("MDeskKiosk")
tSi.dwFlags = STARTF_USESHOWWINDOW 'STARTF_USETITLE 'STARTF_USEDESKTOP 'soweit 
' ich es verstehe, muss für Desktop und Title keine Flag gesetzt werden...
tSi.wShowWindow = SW_NORMAL
tSi.lpTitle = StrPtr("MDeskKiosk")
 
Dim sName As String
Dim rt As String
 
'*****************
'Diese beiden Methoden funktionieren nicht: (keine Fehlermeldung, es passiert 
' einfach  NICHTS)
'öffne Batchfile
 
sName = Replace(CreateKioskBatFile, "\", "\\", 1, -1, vbBinaryCompare)
rt = Replace(Environ("comspec") , "\", "\\", 1, -1, vbBinaryCompare)
'MsgBox rt & " " & sName
lR& = CreateProcess(rt & vbNullString, "/c " & sName & vbNullString, sec1, _
  sec2, False, &H80, 0&, vbNullString, tSi, tPi)
 
'ODER:
'öffne tmpDatabase
 
sName = Replace(Chr$(34) & tmpKioskDB & Chr$(34), "\", "\\", 1, -1, _
  vbBinaryCompare)
rt = Replace(Chr$(34) & AccessRoot & Chr$(34) , "\", "\\", 1, -1, _
vbBinaryCompare)' & " " & tmpKioskDB & vbNullString
'MsgBox rt & " " & sName
lR& = CreateProcess(vbNullString, rt & vbNullString & sName & vbNullString, _
  sec1, sec2, False, &H80&, 
0&, vbNullString, tSi, tPi)
'*****************
 
 
 
SwitchDesktop D
'Application.Quit 'Wohl eher nicht...
 
If lR = 0 Then
lErr = err.LastDllError
SwitchDesktop oldDI
CloseDesktop D
MsgBox lErr & "  ", , "last dllerror"
Else
'MsgBox "lR: " & lR & ", tPi.hProcess: " & tPi.hProcess & " " & 
' err.LastDllError, , "Success!!!"
'WaitForSingleObject tPi.hProcess, INFINITE 'erst wenn alles klar, sonnst _
  hängen wir uns auf...
CloseHandle tPi.hProcess
CloseHandle tPi.hThread
 
End If
End Function
 
'Hoffentlich nicht benötigt:
Public Function GrantPrivileges()
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
 
hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), _
  hdlTokenHandle
LookupPrivilegeValue "", "SeDebugPrivilege", tmpLuid
tkp.PrivilegeCount = 1
tkp.TheLuid = tmpLuid
tkp.Attributes = SE_PRIVILEGE_ENABLED
AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), _
  tkpNewButIgnored, lBufferNeeded
End Function
 
Public Function UnLockDesktop() 'wird nach 5 sec von Form.Timer gerufen...
SwitchDesktop oldDI
End Function