Attribute VB_Name = "Module1"
Private Declare Sub keybd_event Lib "user32" _
    (ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long)
Private Declare Function VkKeyScan Lib "user32" Alias "VkKeyScanA" ( _
   ByVal cChar As Byte) As Integer
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Function GetTickCount Lib "kernel32" () As Long
Option Explicit
'     'local variable(s) to hold property value(s)
Private mvarDestination As Long 'local copy


Private Const VK_SHIFT = &H10

Private Declare Function OemKeyScan Lib "user32" (ByVal wOemChar As Integer) As Long

Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long



Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long




Private Sub SendAKey(ByVal keys As String)

      Dim vk%
       Dim shiftscan%
       Dim scan%
       Dim oemchar$
       Dim dl&
       Dim shiftkey%
       '     ' Get the virtual key code for this character
       vk% = VkKeyScan(Asc(keys)) And &HFF
       '     ' See if shift key needs to be pressed
       shiftkey% = VkKeyScan(Asc(keys)) And 256
       oemchar$ = " " ' 2 character buffer
       '     ' Get the OEM character - preinitialize the buffer
       CharToOem Left$(keys, 1), oemchar$
       '     ' Get the scan code for this key
       scan% = OemKeyScan(Asc(oemchar$)) And &HFF
       '     ' Send the key down

         If shiftkey% = 256 Then
             '     'if shift key needs to be pressed
             shiftscan% = MapVirtualKey(VK_SHIFT, 0)
             '     'press down the shift key
             keybd_event VK_SHIFT, shiftscan%, 0, 0
          End If

      ' 'press key to be sent
       keybd_event vk%, scan%, 0, 0
       '     ' Send the key up

         If shiftkey% = 256 Then
             '     'keyup for shift key
             keybd_event VK_SHIFT, shiftscan%, KEYEVENTF_KEYUP, 0
          End If

      ' 'keyup for key sent
      keybd_event vk%, scan%, KEYEVENTF_KEYUP, 0
End Sub
Public Sub KeyDown(ByVal vKey As KeyCodeConstants)
   keybd_event vKey, 0, KEYEVENTF_EXTENDEDKEY, 0
End Sub

Public Sub KeyUp(ByVal vKey As KeyCodeConstants)
   keybd_event vKey, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
End Sub
Public Sub KeyPress(ByVal vKey As KeyCodeConstants)
   KeyUp vKey
   KeyDown vKey
End Sub

Public Sub Delay(time As Long) 'time is milliseconds
   
    Dim currentTime As Long
    
    currentTime = GetTickCount
    Do While (GetTickCount - currentTime < time) And (Not MiddleButton)
        DoEvents
    Loop
End Sub
Function MiddleButton() As Boolean
    MiddleButton = (GetAsyncKeyState(vbKeyMButton) And &H8000)
End Function
Function heal()
            
    KeyPress vbKeyEscape
    KeyPress vbKeyEscape
    KeyPress vbKeyEscape
    
    Delay (500)
    
  
    KeyUp vbKeyW
    KeyUp vbKeyA
    
    Delay (1000)
    
    SendKeys ("/heal")
    KeyPress vbKeyReturn
    
    Delay (60000) ' 1 minute
    
    SendKeys ("/heal")
    KeyPress vbKeyReturn
    
    KeyDown vbKeyW
    KeyDown vbKeyA

End Function
Public Sub main()

    
    Do 'loop forever
        
        'as soon as you press the middle mouse we start the program
        Do While (Not MiddleButton)
            DoEvents
        Loop
        
        'give a chance to let up on middle mouse button
        Do While (MiddleButton)
            DoEvents
        Loop
        
        'run in circles
'        KeyDown vbKeyW
        KeyDown vbKeyA
        
        
'        SendAKey ("W")
        
        'main loop
        Do While Not (MiddleButton)
        
            DoEvents
'
'        'f8
'            'KeyPress vbKeyF8
'            Delay (500)
'        'ctrl - 1 ' doesnt work
'        'just keep hammering on return instead
'            KeyPress vbKeyReturn
'            Delay (500)
'            KeyPress vbKeyReturn
'            Delay (500)
'            'at this point we should be attacking the nearest thing
'            'but sometimes we get people though so hit escape a bunch of times to clear them and try again
'            KeyPress vbKeyEscape
'            Delay (500)
'            KeyPress vbKeyEscape
'            Delay (500)
'            KeyPress vbKeyEscape
'            Delay (500)
'
'            'not too often
'            If (Rnd < 0.05) Then
'                heal
'            End If
'
'
'            'randomly rotate the camera (gets us out of trees)
'            If (Rnd < 0.1) Then
'
'                KeyDown (vbKeyRight)
'                KeyDown (vbKeyD)
'                Delay (2000) '2 seconds
'                KeyUp vbKeyRight
'                KeyUp vbKeyD
'
'            End If

        Loop
        
        'give a chance to let up on middle mouse button
        Do While (MiddleButton)
            DoEvents
        Loop
        
        KeyUp vbKeyW
        KeyUp vbKeyA
    Loop 'loop forever
End Sub