title image


Smiley Tja, man müsste natürlich deinen Code "ein kleines wenig" erweitern...
um die Lösung für Fazez zun finden (zumindestens, wenn es sich um ein NT-System handelt):



Auf der Form "Form1" (auf der sich zusätzlich ein Timer "Timer1" befindet, um COM eine bessere Lebenschance zu geben):





Option Explicit



Private Sub Form_Load()

blUnload = False

HookOn Form1.hwnd

End Sub



Private Sub Form_Terminate()

HookOff Form1.hwnd

End Sub



Private Sub Timer1_Timer()

Call Endzeit_Eintragen

End Sub





In ein Modul:





Option Explicit



Public blUnload As Boolean

Public lp As Long



Private Type LUID

UsedPart As Long

IgnoredForNowHigh32BitPart As Long

End Type



Private Type TOKEN_PRIVILEGES

PrivilegeCount As Long

TheLuid As LUID

Attributes As Long

End Type



Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Declare Function OpenProcessToken Lib "advapi32" (ByVal _

ProcessHandle As Long, _

ByVal DesiredAccess As Long, TokenHandle As Long) As Long

Private Declare Function LookupPrivilegeValue Lib "advapi32" _

Alias "LookupPrivilegeValueA" _

(ByVal lpSystemName As String, ByVal lpName As String, lpLuid _

As LUID) As Long

Private Declare Function AdjustTokenPrivileges Lib "advapi32" _

(ByVal TokenHandle As Long, _

ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES _

, ByVal BufferLength As Long, _

PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long



Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)



Const EWX_LOGOFF = 0

Const EWX_SHUTDOWN = 1

Const EWX_REBOOT = 2

Const EWX_FORCE = 4

Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long





Private Const GWL_WNDPROC = (-4)

Private Const WM_QUERYENDSESSION = &H11

'

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _

ByVal hwnd As Long, _

ByVal nIndex As Long, _

ByVal dwNewLong As Long) As Long

'

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _

ByVal lpPrevWndFunc As Long, _

ByVal hwnd As Long, _

ByVal msg As Long, _

ByVal wParam As Long, _

ByVal lParam As Long) As Long

'

Private hOldWndProc As Long

'

Public Sub HookOn(ByVal hwnd As Long)



hOldWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)

End Sub

'

Public Sub HookOff(ByVal hwnd As Long)

SetWindowLong hwnd, GWL_WNDPROC, hOldWndProc

End Sub

'

Function WindowProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long



If wMsg = WM_QUERYENDSESSION And Not blUnload Then

lp = lParam

WindowProc = False

Form1.Timer1.Enabled = True

Exit Function

End If

WindowProc = CallWindowProc(hOldWndProc, hwnd, wMsg, wParam, ByVal lParam)

End Function



Public Sub Endzeit_Eintragen()

Dim x As Object

Dim w As Object

Dim ret As String



Set x = CreateObject("Excel.application")



Set w = x.workbooks.open("d:\irgendwas.xls")

w.sheets(1).cells(5, 1).Value = Now

w.Close savechanges:=True

Set w = Nothing

x.quit

Set x = Nothing

Form1.Timer1.Enabled = False

blUnload = True



Sleep 3000



AdjustToken



If lp = Val(0) Then

ret = ExitWindowsEx(EWX_SHUTDOWN, 0)

Else

ret = ExitWindowsEx(EWX_LOGOFF, 0)

End If





End Sub



Private Sub AdjustToken()

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 "", "SeShutdownPrivilege", tmpLuid



tkp.PrivilegeCount = 1

tkp.TheLuid = tmpLuid

tkp.Attributes = SE_PRIVILEGE_ENABLED



AdjustTokenPrivileges hdlTokenHandle, False, _

tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded



End Sub





Gruß aus Ostfriesland. Möge Tux mit Dir sein!

ff


Proggst du schon .net oder quälst du dich noch mit VB6?



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: