xrezax
یک شنبه 27 شهریور 1390, 17:01 عصر
دوستان من بوسیله کد زیر برناممو در ویندوز xp سیستمی می کردم طوری که هر کس ببندش سیستم ریستارت می شد اما متاسفانه روی سون کار نمی ده. راهی هست سیستمی کنم در سون ؟؟؟؟ کجاشو تغییر بدم /؟؟
دوستان سورسی چیزی دارن ممنون میشم اینجا قرار بدن
اینم سورس کدهای من
یک ماژول می سازم و اینو توش قرار می دم
Option Explicit
Private Const ANYSIZE_ARRAY = 1
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Type LUID
LowPart As Long
HighPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (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 Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLUID As LUID) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Const SE_DEBUG_NAME As String = "SeDebugPrivilege"
Public Declare Function RtlSetProcessIsCritical Lib "ntdll.dll" (ByVal NewValue As Boolean, ByVal OldValue As Boolean, ByVal WinLogon As Boolean)
Public Function GetPrivilegs(ByVal privilegio As String) As Long
On Error Resume Next
Dim lpLUID As LUID
Dim lpToken As TOKEN_PRIVILEGES
Dim lpAntToken As TOKEN_PRIVILEGES
Dim hToken As Long
Dim hProcess As Long
Dim res As Long
hProcess = GetCurrentProcess()
res = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken)
If res = 0 Then
Exit Function
End If
res = LookupPrivilegeValue(vbNullString, privilegio, lpLUID)
If res = 0 Then
Exit Function
End If
With lpToken
.PrivilegeCount = 1
.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
.Privileges(0).pLuid = lpLUID
End With
res = AdjustTokenPrivileges(hToken, False, lpToken, Len(lpToken), lpAntToken, Len(lpAntToken))
If res = 0 Then
Exit Function
End If
GetPrivilegs = res
End Function
اینم توی لود برنامم می زارم
Private Sub Command1_Click()
GetPrivilegs SE_DEBUG_NAME
Call RtlSetProcessIsCritical(0, 0, 1)
End Sub
دوستان کمک کنن :ناراحت:
دوستان سورسی چیزی دارن ممنون میشم اینجا قرار بدن
اینم سورس کدهای من
یک ماژول می سازم و اینو توش قرار می دم
Option Explicit
Private Const ANYSIZE_ARRAY = 1
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Type LUID
LowPart As Long
HighPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (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 Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLUID As LUID) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Const SE_DEBUG_NAME As String = "SeDebugPrivilege"
Public Declare Function RtlSetProcessIsCritical Lib "ntdll.dll" (ByVal NewValue As Boolean, ByVal OldValue As Boolean, ByVal WinLogon As Boolean)
Public Function GetPrivilegs(ByVal privilegio As String) As Long
On Error Resume Next
Dim lpLUID As LUID
Dim lpToken As TOKEN_PRIVILEGES
Dim lpAntToken As TOKEN_PRIVILEGES
Dim hToken As Long
Dim hProcess As Long
Dim res As Long
hProcess = GetCurrentProcess()
res = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken)
If res = 0 Then
Exit Function
End If
res = LookupPrivilegeValue(vbNullString, privilegio, lpLUID)
If res = 0 Then
Exit Function
End If
With lpToken
.PrivilegeCount = 1
.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
.Privileges(0).pLuid = lpLUID
End With
res = AdjustTokenPrivileges(hToken, False, lpToken, Len(lpToken), lpAntToken, Len(lpAntToken))
If res = 0 Then
Exit Function
End If
GetPrivilegs = res
End Function
اینم توی لود برنامم می زارم
Private Sub Command1_Click()
GetPrivilegs SE_DEBUG_NAME
Call RtlSetProcessIsCritical(0, 0, 1)
End Sub
دوستان کمک کنن :ناراحت: