servermod.bas

优秀的木马程序,自己看吧

Attribute VB_Name = "ServerMod"
'//////////////////////////////////////////////////////////
'// Module for Andromeda 1.0 Remote File Server for      //
'// Microsoft Win32 by Ryan and Andrew Lederman          //
'// www.induhviduals.com/andromeda                       //
'//////////////////////////////////////////////////////////

Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Const HKEY_LOCAL_MACHINE = &H80000002

Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long


Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long


Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Const MAX_PATH& = 260

Public sEnabled As Boolean
Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szexeFile As String * MAX_PATH
    End Type

Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Public filesOpen As Integer
Public strBuffer As String
Public PacketCount As Integer
Public EngineRunning As Boolean
Public SendPort(1 To 100)
Public intMax2 As Integer
Public fileNum As Long
Public FileSize1 As Long
Public fileName As String
Public StartSending  As Boolean
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpRetunedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uId As Long
    uFlags As Long
    uCallBackMessage As Long
    hIcon As Long
    szTip As String * 64
    End Type
    'constants required by Shell_NotifyIcon API call:
    Public Const NIM_ADD = &H0
    Public Const NIM_MODIFY = &H1
    Public Const NIM_DELETE = &H2
    Public Const NIF_MESSAGE = &H1
    Public Const NIF_ICON = &H2
    Public Const NIF_TIP = &H4
    Public Const WM_MOUSEMOVE = &H200

Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long


Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Public nid As NOTIFYICONDATA

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
   ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Public Const REG_NONE = (0)                         'No value type
Public Const REG_SZ = (1)                           'Unicode nul terminated string
Public Const REG_EXPAND_SZ = (2)                    'Unicode nul terminated string w/enviornment var
Public Const REG_BINARY = (3)                       'Free form binary
Public Const REG_DWORD = (4)                        '32-bit number
Public Const REG_DWORD_LITTLE_ENDIAN = (4)          '32-bit number (same as REG_DWORD)
Public Const REG_DWORD_BIG_ENDIAN = (5)             '32-bit number
Public Const REG_LINK = (6)                         'Symbolic Link (unicode)
Public Const REG_MULTI_SZ = (7)                     'Multiple Unicode strings
Public Const REG_RESOURCE_LIST = (8)                'Resource list in the resource map
Public Const REG_FULL_RESOURCE_DESCRIPTOR = (9)     'Resource list in the hardware description
Public Const REG_RESOURCE_REQUIREMENTS_LIST = (10)
Const READ_CONTROL = &H20000
Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Boolean
End Type
Type SECURITY_DESCRIPTOR
        Revision As Byte
        Sbz1 As Byte
        Control As Long
        Owner As Long
        Group As Long
End Type
Type ACL
        AclRevision As Byte
        Sbz1 As Byte
        AclSize As Integer
        AceCount As Integer
        Sbz2 As Integer
End Type
Declare Function RegReplaceKey Lib "advapi32.dll" Alias "RegReplaceKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpNewFile As String, ByVal lpOldFile As String) As Long
Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Declare Function RegSetKeySecurity Lib "advapi32.dll" (ByVal hKey As Long, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long
Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long

Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
   ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long

Declare Function RegUnLoadKey Lib "advapi32.dll" Alias "RegUnLoadKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
    "RegOpenKeyExA" (ByVal hKey As Long, _
    ByVal lpSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, phkResult As Long) As Long

Function CreateFolder(xFolder As String, Winsock As Winsock)
    'Creates a new folder. if function fails
    'returns False
    On Error GoTo failCreate
    MkDir xFolder
    sOutput "MKDIR '" & xFolder & "' from IP '" & Winsock.RemoteHostIP & "'"
    Winsock.SendData ("CREATED")
    Exit Function
failCreate:
    Winsock.SendData ("NOTCREATED")
End Function

Function DisplayLogFile(strWhichLog As String)
    'Opens the specified log file and displays to user
    Dim WhichFile As String
    With frmLog
    
    Select Case strWhichLog
        Case "Login":
            .Caption = "ndromeda - Log File (Logins)"
            WhichFile = App.Path + "\Log.txt"
            
        Case "FileTransfer":
            .Caption = "ndromeda - Log File (File Transfers)"
            WhichFile = App.Path + "\FTransfer.txt"
        Case "Output":
            .Caption = "ndromeda - Log File (Server Output)"
            WhichFile = App.Path + "\Output.txt"
    End Select
    
    If Exists(WhichFile) = False Then
        MsgBox "The Log file: " & vbCrLf & WhichFile & vbCrLf & "was not found. Andromeda will now create a new, empty log.", 16, "Error: File Not Found"
        i = FreeFile
        Open WhichFile For Output As #i
        Close #i
    End If
    
i = FreeFile
Open WhichFile For Input As #i
    Do While Not EOF(i): DoEvents
    
    Line Input #i, Record$
    
    Entire = Entire + Record$ + vbCrLf
    
    Loop
Close #i

.txtLogin.Text = Entire
.lblFileSize.Caption = FileLen(WhichFile) & " bytes"
.WhichLog.Text = strWhichLog
.Show , frmMain
End With

End Function

Sub EnableServer(WhichState As Boolean)
    'Takes a boolean, toggles server state depending on value passed
    'True = Enabled, False = Disabled
    Select Case WhichState
    
    Case True:
         frmMain.Server(0).Close
        frmMain.Server(0).LocalPort = 6969
         frmMain.Server(0).Listen
         Do While frmMain.Server(0).State <> sckListening
            DoEvents
            If frmMain.Server(0).State = sckError Then
                MsgBox "An error occurred while trying to initialize the listening socket.", 16, "Error": Exit Sub
            End If
        Loop
        sEnabled = True
        frmMain.TimerUptime.Enabled = True
        frmMain.Caption = "ndromeda RFS (Enabled)"
        sOutput "Server Enabled"
    Case False:
        frmMain.Server(0).Close
        Do While frmMain.Server(0).State <> sckClosed
            DoEvents
        Loop
        sEnabled = False
        frmMain.TimerUptime.Enabled = False
        frmMain.txtElapsed.Caption = "00:00:00"
        frmMain.Caption = "ndromeda RFS (Disabled)"
        sOutput "Server Disabled"
    End Select
    
End Sub

Function InvalidMessage() As String
    'Reads the Invalid Message file (\imessage.txt)
    'and returns the contents
    Dim fileNum As Integer
    fileNum = FreeFile
    If Exists(App.Path + "\imessage.txt") = False Then
        Open App.Path + "\imessage.txt" For Output As #fileNum
        Close #fileNum
        InvalidMessage = ""
    Exit Function
    End If
    
    Open App.Path + "\imessage.txt" For Input As #fileNum
        Do While Not EOF(fileNum): DoEvents
        
        Line Input #fileNum, Record$
        
        Entire = Entire + Record$ + vbCrLf
        Loop
    Close #fileNum
    InvalidMessage = Entire
End Function

Function IsValidSharedFolder(strFolder As String) As Boolean
    'Takes the path of a folder, and checks it against
    'the shared folder list. If it is found, returns TRUE, otherwise
    'returns FALSE
If Right(strFolder, 1) <> "\" Then strFolder = strFolder + "\"
For X = 1 To frmSharedFolders.lstDirectories.ListItems.Count
    Debug.Print frmSharedFolders.lstDirectories.ListItems(X).Text; strFolder
    If UCase(frmSharedFolders.lstDirectories.ListItems(X).Text) = UCase(strFolder) Then
        IsValidSharedFolder = True: Exit Function
    End If
    If UCase(Left(strFolder, Len(frmSharedFolders.lstDirectories.ListItems(X).Text))) = UCase(frmSharedFolders.lstDirectories.ListItems(X).Text) Then
        IsValidSharedFolder = True: Exit Function
    End If
Next X
    IsValidSharedFolder = False
End Function

Sub Main()
    'Entry point for application... depending on settings
    'will display either splash screen or main window
If GetSetting("Andromeda", "Settings", "SplashScreen", "1") = "1" Then
    frmSplash.Show
    start = Timer
    Do While Timer - start < 2.5: DoEvents: Loop
    frmSplash.Hide
    frmMain.Show
Else