game.bas

大名鼎鼎的Netbus木马源程序.

Attribute VB_Name = "Game"
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Declare Function auxGetNumDevs% Lib "winmm" ()
Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hWndCallback As Long) As Long
Declare Function joyGetDevCaps Lib "winmm.dll" Alias "joyGetDevCapsA" (ByVal id As Long, lpCaps As JOYCAPS, ByVal uSize As Long) As Long
Declare Function joyGetPosEx Lib "winmm.dll" (ByVal uJoyID As Long, pji As JOYINFOEX) As Long
Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Declare Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Public Const MAXPNAMELEN = 32
Type JOYCAPS
   wMid As Integer                     ' Manufacturer identifier of the device driver for the MIDI output device
                                       ' For a list of identifiers, see the Manufacturer Indentifier topic in the
                                       ' Multimedia Reference of the Platform SDK.
   
   wPid As Integer                     ' Product Identifier Product of the MIDI output device. For a list of
                                       ' product identifiers, see the Product Identifiers topic in the Multimedia
                                       ' Reference of the Platform SDK.
   szPname As String * MAXPNAMELEN     ' Null-terminated string containing the joystick product name
   wXmin As Long                       ' Minimum X-coordinate.
   wXmax As Long                       ' Maximum X-coordinate.
   wYmin As Long                       ' Minimum Y-coordinate
   wYmax As Long                       ' Maximum Y-coordinate
   wZmin As Long                       ' Minimum Z-coordinate
   wZmax As Long                       ' Maximum Z-coordinate
   wNumButtons As Long                 ' Number of joystick buttons
   wPeriodMin As Long                  ' Smallest polling frequency supported when captured by the joySetCapture function.
   wPeriodMax As Long                  ' Largest polling frequency supported when captured by the joySetCapture function.
   wRmin As Long                       ' Minimum rudder value. The rudder is a fourth axis of movement.
   wRmax As Long                       ' Maximum rudder value. The rudder is a fourth axis of movement.
   wUmin As Long                       ' Minimum u-coordinate (fifth axis) values.
   wUmax As Long                       ' Maximum u-coordinate (fifth axis) values.
   wVmin As Long                       ' Minimum v-coordinate (sixth axis) values.
   wVmax As Long                       ' Maximum v-coordinate (sixth axis) values.
   wCaps As Long                       ' Joystick capabilities as defined by the following flags
                                       '     JOYCAPS_HASZ-     Joystick has z-coordinate information.
                                       '     JOYCAPS_HASR-     Joystick has rudder (fourth axis) information.
                                       '     JOYCAPS_HASU-     Joystick has u-coordinate (fifth axis) information.
                                       '     JOYCAPS_HASV-     Joystick has v-coordinate (sixth axis) information.
                                       '     JOYCAPS_HASPOV-   Joystick has point-of-view information.
                                       '     JOYCAPS_POV4DIR-  Joystick point-of-view supports discrete values (centered, forward, backward, left, and right).
                                       '     JOYCAPS_POVCTS Joystick point-of-view supports continuous degree bearings.
   wMaxAxes As Long                    ' Maximum number of axes supported by the joystick.
   wNumAxes As Long                    ' Number of axes currently in use by the joystick.
   wMaxButtons As Long                 ' Maximum number of buttons supported by the joystick.
   szRegKey As String * MAXPNAMELEN    ' String containing the registry key for the joystick.
End Type
Type JOYINFOEX
   dwSize As Long                      ' size of structure
   dwFlags As Long                     ' flags to indicate what to return
   dwXpos As Long                      ' x position
   dwYpos As Long                      ' y position
   dwZpos As Long                      ' z position
   dwRpos As Long                      ' rudder/4th axis position
   dwUpos As Long                      ' 5th axis position
   dwVpos As Long                      ' 6th axis position
   dwButtons As Long                   ' button states
   dwButtonNumber As Long              ' current button number pressed
   dwPOV As Long                       ' point of view state
   dwReserved1 As Long                 ' reserved for communication between winmm driver
   dwReserved2 As Long                 ' reserved for future expansion
End Type
Type KeyboardBytes
     kbByte(0 To 255) As Byte
End Type
Global Joystick1Info As JOYCAPS
Global Joystick2Info As JOYCAPS
Global Joystick1Pos As JOYINFOEX
Global Joystick2Pos As JOYINFOEX
Public Const JOYSTICKID1 = 0
Public Const JOYSTICKID2 = 1
Public Const JOY_RETURNBUTTONS = &H80&
Public Const JOY_RETURNCENTERED = &H400&
Public Const JOY_RETURNPOV = &H40&
Public Const JOY_RETURNR = &H8&
Public Const JOY_RETURNU = &H10
Public Const JOY_RETURNV = &H20
Public Const JOY_RETURNX = &H1&
Public Const JOY_RETURNY = &H2&
Public Const JOY_RETURNZ = &H4&
Public Const JOY_RETURNALL = (JOY_RETURNX Or JOY_RETURNY Or JOY_RETURNZ Or JOY_RETURNR Or JOY_RETURNU Or JOY_RETURNV Or JOY_RETURNPOV Or JOY_RETURNBUTTONS)
Public Const JOYCAPS_HASZ = &H1&
Public Const JOYCAPS_HASR = &H2&
Public Const JOYCAPS_HASU = &H4&
Public Const JOYCAPS_HASV = &H8&
Public Const JOYCAPS_HASPOV = &H10&
Public Const JOYCAPS_POV4DIR = &H20&
Public Const JOYCAPS_POVCTS = &H40&
Public Const JOYERR_BASE = 160
Public Const JOYERR_UNPLUGGED = (JOYERR_BASE + 7)


Global Const SRCCOPY = &HCC0020     ' (DWORD) dest = source
Global Const SRCPAINT = &HEE0086    ' (DWORD) dest = source OR dest
Global Const SRCAND = &H8800C6      ' (DWORD) dest = source AND dest
Global Const SRCINVERT = &H660046   ' (DWORD) dest = source XOR dest
Global Const SRCERASE = &H440328    ' (DWORD) dest = source AND (NOT dest )
Global Const NOTSRCCOPY = &H330008  ' (DWORD) dest = (NOT source)
Global Const NOTSRCERASE = &H1100A6 ' (DWORD) dest = (NOT src) AND (NOT dest)
Global Const MERGECOPY = &HC000CA   ' (DWORD) dest = (source AND pattern)
Global Const MERGEPAINT = &HBB0226  ' (DWORD) dest = (NOT source) OR dest
Global Const PATCOPY = &HF00021     ' (DWORD) dest = pattern
Global Const PATPAINT = &HFB0A09    ' (DWORD) dest = (Not source) or pattern or dest
Global Const PATINVERT = &H5A0049   ' (DWORD) dest = pattern XOR dest
Global Const DSTINVERT = &H550009   ' (DWORD) dest = (NOT dest)
Global Const BLACKNESS = &H42&      ' (DWORD) dest = BLACK
Global Const WHITENESS = &HFF0062   ' (DWORD) dest = WHITE
Global Const SND_SYNC = &H0         '  play synchronously (default)
Global Const SND_ASYNC = &H1        '  play asynchronously
Global Const SND_LOOP = &H8         '  loop the sound until next sndPlaySound
Public lRet As Long
Public RetString As String * 1024
Public kbArray As KeyboardBytes
Global Const Key_Up = 38
Global Const Key_Down = 40
Global Const Key_Left = 37
Global Const Key_Right = 39
Global Const Key_Enter = 13
Global Const Key_Alt = 18
Global Const Key_Ctrl = 17
Global Const Key_Space = 32
Global Const Key_F1 = 112
Global Const Key_F2 = 113
Global Const Key_F3 = 114
Global Const Key_F4 = 115
Global Const Key_F5 = 116
Global Const Key_F6 = 117
Global Const Key_F7 = 118
Global Const Key_F8 = 119
Global Const Key_F9 = 120
Global Const Key_F10 = 121
Global Const Key_F11 = 122
Global Const Key_F12 = 123
Global Const Key_Shift = 16
Global Const Key_Tab = 9
Global Const Key_Tilde = 192
Global Const Key_Esc = 27
Global Const Key_Minus = 189
Global Const Key_Equals = 187
Global Const Key_BackSpace = 8
Global Const Key_LeftBrace = 219
Global Const Key_RightBrace = 221
Global Const Key_Backslash = 220
Global Const Key_Colon = 186
Global Const Key_Quote = 222
Global Const Key_Comma = 188
Global Const Key_Period = 190
Global Const Key_Slash = 191
Global Const Key_Pause = 19
Global Const Key_Ins = 45
Global Const Key_Del = 46
Global Const Key_Home = 36
Global Const Key_End = 35
Global Const Key_PageUp = 33
Global Const Key_PageDown = 34
Global Const Key_CapsLock = 20
Global Const Key_NumLock = 144
Global Const Key_ScrollLock = 145
Global Const Key_NumPad_Slash = 111
Global Const Key_NumPad_Asterisk = 106
Global Const Key_NumPad_Minus = 109
Global Const Key_NumPad_UpLeft = 36
Global Const Key_NumPad_UpRight = 33
Global Const Key_NumPad_DownLeft = 35
Global Const Key_NumPad_DownRight = 34
Global Const Key_NumPad_Plus = 107
Global Const Key_NumPad_Del = 46
Global Const Key_WindowsLeft = 91
Global Const Key_WindowsRight = 92
Global Const Key_WindowsMenu = 93
Global Const Key_1 = 49
Global Const Key_2 = 50
Global Const Key_3 = 51
Global Const Key_4 = 52
Global Const Key_5 = 53
Global Const Key_6 = 54
Global Const Key_7 = 55
Global Const Key_8 = 56
Global Const Key_9 = 57
Global Const Key_0 = 48
Global Const Key_A = 65
Global Const Key_B = 66
Global Const Key_C = 67
Global Const Key_D = 68
Global Const Key_E = 69
Global Const Key_F = 70
Global Const Key_G = 71
Global Const Key_H = 72
Global Const Key_I = 73
Global Const Key_J = 74
Global Const Key_K = 75
Global Const Key_L = 76
Global Const Key_M = 77
Global Const Key_N = 78
Global Const Key_O = 79
Global Const Key_P = 80
Global Const Key_Q = 81
Global Const Key_R = 82
Global Const Key_S = 83
Global Const Key_T = 84
Global Const Key_U = 85
Global Const Key_V = 86
Global Const Key_W = 87
Global Const Key_X = 88
Global Const Key_Y = 89
Global Const Key_Z = 90

Function IsKeyDown(Key)
GetKeyboardState kbArray
If kbArray.kbByte(Key) <> 0 Then
    If kbArray.kbByte(Key) <> 1 Then
        IsKeyDown = 1
    End If
Else
    IsKeyDown = 0
End If
'Cls
'Dim tot
'For i = 1 To 255
'    If IsKeyDown(i) = 1 Then
'        tot = tot & i & ",   "
'    End If
'Next i
'Print tot
End Function

Sub JoystickGetInfo()
'after using this sub, you can find out
'a lot of information about either joystick
'by using the variable 'joystick1info' and
''joystick2info'.
Q = joyGetDevCaps(JOYSTICKID1, Joystick1Info, Len(Joystick1Info))
Q = joyGetDevCaps(JOYSTICKID2, Joystick2Info, Len(Joystick2Info))
End Sub

Sub JoystickGetPos()
'after using this sub, you can find out
'a lot of information about what is being
'pressed on either joystick by using
'the variable 'joystick1pos' and 'joystick2pos'
Joystick1Pos.dwSize = Len(Joystick1Pos)
Joystick1Pos.dwFlags = JOY_RETURNALL
Joystick2Pos.dwSize = Len(Joystick2Pos)
Joystick2Pos.dwFlags = JOY_RETURNALL
Q = joyGetPosEx(JOYSTICKID1, Joystick1Pos)
Q = joyGetPosEx(JOYSTICKID2, Joystick2Pos)
End Sub

Function JoystickIsButtonPressed(Joystick, Button)
Dim mask
mask = 2 ^ (Button - 1)
If Joystick = 1 Then
    If (Joystick1Pos.dwButtons And mask) Then
        JoystickIsButtonPressed = 1
    End If
ElseIf Joystick = 2 Then
    If (Joystick1Pos.dwButtons And mask) Then
        JoystickIsButtonPressed = 1
    End If
End If
End Function

Function JoystickIsUp(Joystick)
'Yaxis < 10000 about 1/3 up on a joystick,
'however if there is a joypad its either
'all the way up or down
If Joystick = 1 Then
    If Joystick1Pos.dwYpos < 10000 Then
        JoystickIsUp = 1
    End If
ElseIf Joystick = 2 Then
    If Joystick2Pos.dwYpos < 10000 Then
        JoystickIsUp = 1
    End If
End If
End Function

Function JoystickIsDown(Joystick)
'Yaxis > 55535 about 1/3 down on a joystick,
'however if there is a joypad its either
'all the way up or down
If Joystick = 1 Then
    If Joystick1Pos.dwYpos > 55535 Then
        JoystickIsDown = 1
    End If
ElseIf Joystick = 2 Then
    If Joystick2Pos.dwYpos > 55535 Then
        JoystickIsDown = 1
    End If
End If
End Function

Function JoystickIsLeft(Joystick)
'Xaxis < 10000 about 1/3 left on a joystick,
'however if there is a joypad its either
'all the way left or right
If Joystick = 1 Then
    If Joystick1Pos.dwXpos < 10000 Then
        JoystickIsLeft = 1
    End If
ElseIf Joystick = 2 Then
    If Joystick2Pos.dwXpos < 10000 Then
        JoystickIsLeft = 1
    End If
End If
End Function

Function JoystickIsRight(Joystick)
'Xaxis < 55535 about 1/3 right on a joystick,
'however if there is a joypad its either
'all the way left or right
If Joystick = 1 Then
    If Joystick1Pos.dwXpos > 55535 Then
        JoystickIsRight = 1
    End If
ElseIf Joystick = 2 Then
    If Joystick2Pos.dwXpos > 55535 Then
        JoystickIsRight = 1
    End If
End If
End Function

Function JoystickIsThere(Joystick)
If Joystick = 1 Then
    Q = joyGetDevCaps(JOYSTICKID1, Joystick1Info, Len(Joystick1Info))
ElseIf Joystick = 2 Then
    Q = joyGetDevCaps(JOYSTICKID2, Joystick2Info, Len(Joystick2Info))
End If
If Q <> 0 Then
    JoystickIsThere = 0
Else
    JoystickIsThere = 1
End If
End Function

Sub Cursor(Enabled As Boolean)
Dim Retcode
For i = 1 To 5000
Retcode = ShowCursor(Enabled)
Next i
End Sub

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

Sub pause(interval)
Current = Timer
On Error Resume Next
Do While Timer - Current < Val(interval)
DoEvents
Loop
End Sub

Sub PlayMedia(MediaFile)
lRet = mciSendString("play " & MediaFile, 0&, 0, 0)
End Sub

Sub StopMedia(MediaFile)
lRet = mciSendString("stop " & MediaFile, 0&, 0, 0)
lRet = mciSendString("close " & MediaFile, 0&, 0, 0)
End Sub

Sub PlaySound(SoundFile, Loopy As Boolean)
If Loopy = True Then
    sndPlaySound SoundFile, SND_LOOP
Else
    sndPlaySound SoundFile, SND_ASYNC
End If
End Sub