اجرای برنامه های کنترل پانل
* Control Panel
Shell "control.exe", vbMaximizedFocus
* Accessibility Options
Shell "rundll32.exe shell32.dll,Control_RunDLL access.cpl"
* Add/Remove Programs
Shell "rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl"
* Date/Time Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL timedate.cpl"
* Display Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL desk.cpl"
* Internet Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl"
* Joystick Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL Joy.cpl"
* Mouse Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL Main.cpl"
* Modem Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL modem.cpl"
* System Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl"
* Regional Settings
Shell "rundll32.exe shell32.dll,Control_RunDLL intl.cpl"
* Sound Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl"
بااين کد هر برنامه را که می خواهید قفل کنید
حتما تا به حال برنامه ای نظیر این ندیده اید.
این برنامه ، برنامه مورد نظر را بلافاصله بعد از اجرا می بندد.
شما فقط باید نام برنامه را وارد کنید. که من این برنامه بدبخت رو Windows Task Manager گذاشته ام.
ساخت برنامه را شروع می کنیم.
1)در ابتدا یک Textbox ، یک CommandButton و یک Timer به فرم اضافه کنید.
2)سپس کد زیر را وارد فرم خود کنید:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_CLOSE = &H10
Private Sub Command1_Click()
Timer1.Interval = 100
Timer1.Enabled = True
End Sub
Private Sub Form_Load()
Me.Caption = "حسن ايرانشاهي"
Timer1.Enabled = False
Text1 = "windows task manager"
End Sub
Private Sub Timer1_Timer()
Dim wnd As Long
wnd = FindWindow(vbNullString, Text1)
If wnd <> 0 Then
PostMessage wnd, WM_CLOSE, 0&, 0&
End If
End Sub
قرار دادن يک تصوير در گوشه منوهای ويژوال بيسيک
خوب حالا یه پروژه جدید بسازین و در ضمن یک تصویر Bitmap با اندازه Pixel 10*10 هم آماده کنید تا در این پروژه ازش استفاه کنید. خوب روی فرمتون دوبار کلیک کنید و کد زیر رو تو قسمت Declaration وارد کنید:
Option Explicit
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, _
ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, _
ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" _
(ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, _
ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
' Constant for SetMenuItemBitmaps
Private Const MF_BYPOSITION = &H400&
' Constants for LoadImage
Private Const IMAGE_BITMAP = &O0
Private Const LR_LOADFROMFILE = 16
Private Const LR_CREATEDIBSECTION = 8192
خوب تو این قسمت ما چهار تا تابع API تعریف کردیم که اینجا کارشونو به طور مختصر شرح میدم:
GetMenu: از این تابع برای بدست آوردن یک Handle (HWND) از کل منوی فرم استفاده میشه.
GetSubMenu: از این تابع برای بدست آوردن hwnd یکی از منوها (مثلا منوی File یا منوی Edit) استفاده میشه.
SerMenuItemBitmap: خوب این تابع نقش اصلی رو بازی میکنه و برای قرار دادن تصویر Bitmap در کنار نام زیر منو استفاده میشه.
LoadImage: از این تابع برای Load کردن تصویر Bitmap درون حافظه استفاده میکنیم.
خوب حالا یه Command Button به پروژتون اضافه کنید و کد زیر رو توش وارد کنید (رو دکمه دوبار کلیک کنید و کد رو Paste کنید):
Dim hMenu As Long
Dim hSubMenu As Long
Dim hMenuImg As Long
Dim sFileName As String
' Get the bitmap.
sFileName = App.Path & "\MenuImg.bmp"
hMenuImg = LoadImage(0, sFileName, IMAGE_BITMAP, 0, 0, _
LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
' Get the menu item handle.
hMenu = GetMenu(Me.hwnd)
hSubMenu = GetSubMenu(hMenu, 1)
' Set the "mnuTwo" bitmap to the one that is loaded in memory.
Call SetMenuItemBitmaps(hSubMenu, 0, MF_BYPOSITION, hMenuImg, 0)
خوب تو این قسمت اول سک متغیر برای hwnd کلی منو، یکی برای منو، و یک اشاره گر به تصویری که فراره تو حافظه Load شه و یک رشته برای مسیر فایل Bitmap تعریف کردیم. بعد مسیر فایل رو تعیین کردیم که من Bitmap خودمو تو مسیر پروژم (App.path) با نام MenuImg.bmp ذخیره کردم ولی شما میتونین اونو به مسیر فایل خودتون تغییر بدین. بعد توسط تابع LoadImage اونو Load کردیم. بعد از اون hwnd کلی منو و hwnd منوی شماره یک (مثلا اگه شما دو تا منو به ترتیب از چپ به راست File و Edit دارین شماره منوی File میشه 0 و شماره منوی Edit میشه 1 و بقیه هم به همین صورت) رو بدست آوردیم. در مرحله آخر تصویر Bitmap رو برای زیر منوی اول این منو set کردیم. (این هم از 0 شروع میشه یعنی شماره 0 به زیرمنوی اول اشاره میکنه). شما میتونین واسه بقیه منوها هم این کار رو بکنین فقط باید مسیر فایل و شماره منو و شماره زیر منو رو تغییر بدین.
به دست آوردن دایرکتوری های اصلی ویندوز
سلام.
اینم برای دوستای ویروسی :
به دست آوردن دایرکتوری ویندوز:
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
lpBuffer یک بافر و nSize اندازه بافر
Dim sBuf As String * 255
Dim lLen As Long
lLen = GetWindowsDirectory(sBuf, 255)
MsgBox Left(sBuf, lLen)
به دست آوردن دایرکتوری سیستم:
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
مثل قبلی
به دست آوردن دایرکتوری Temp:
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
nBufferLength طول بافر و lpBuffer هم یک بافر
Dim sBuf As String * 255
Dim lLen As Long
lLen = GetTempPath(255, sBuf)
MsgBox Left(sBuf, lLen)
البته این کارا رو با استفاده از FileSystemObject هم میشه انجام داد. برای این کار باید از متد GetSpecialFolder استفاده کنیم:
FileSystemObject.GetSpecialFolder(folderspec)
که folderspec دایرکتوری مورد نظر ما را مشخص می کند و مقادیر آن 0 برای دایرکتوری ویندوز، 1 برای دایرکتوری سیستم و 2 برای دایرکتوری موقت می باشد.
کد زیر دایرکتوری سیستم را به ما میدهد:
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
MsgBox oFSO.GetSpecialFolder(1)
