SourceCode



; written in Purebasic 4.10
; Copyright 2008: raz@DIINGGENTLEMENTZ.COMputing
; this code is free, but its not free to copy ;)
; you are only allowed to copy/distribute this code, if the
; topmost commented header in the sources
; is intact and not modified nor moved in any way!
; distribution is only for uncomercial using allowed!


Structure POINTAPI
  x.l
  y.l
EndStructure 

Structure MSLLHOOKSTRUCT
    pt.POINTAPI
    mouseData.l
    flags.l
    time.l
    dwExtraInfo.l
EndStructure

#WHEEL_DELTA = 120
#DIK_K = $25
#DIK_L = $26

Global DIMouseWheel_Up = #DIK_K
Global DIMouseWheel_Down = #DIK_L

Declare HookProc(nCode.l, wParam.l, *lParam.MSLLHOOKSTRUCT)
Declare AssignKeys()
Declare SendKeySet(VK_Key.l)
Declare SendKeyRelease(VK_Key.l)
Declare CreateShellLink(PATH$, LINK$, Argument$, DESCRIPTION$, WorkingDirectory$, ShowCommand.l, HotKey.l, IconFile$, IconIndexInFile.l)
Declare WaitForProcess(ParentThreadID)
Global GameExe.s
Global hHook.l


If CountProgramParameters()
  Parameter.s = Trim(ProgramParameter())
  Output.s = Space(1024)
  Base64Decoder(@Parameter, Len(Parameter), @Output, Len(Output))
  Debug Output
  GameExe = Trim(StringField(Output, 1, "!"))
  Debug GameExe
  DIMouseWheel_Up = Val(Trim(StringField(Output, 2, "!")))
  Debug DIMouseWheel_Up
  DIMouseWheel_Down = Val(Trim(StringField(Output, 3, "!")))
  Debug DIMouseWheel_Down
EndIf

If GameExe = ""
  File.s = OpenFileRequester("RetroMouseWheel: Please choose Game Executable", GetEnvironmentVariable("PROGRAMFILES")+"\", "Game Executable (*.exe)|*.exe",0)
  GameExe = File
  If PathFileExists_(File)
    If OpenConsole()
      ConsoleTitle("RetroMouseWheel")
      EnableGraphicalConsole(1)
      PrintN("To assign the keys of your game with mousewheel up/down")
      PrintN("you have to follow the setup. To start setup press <enter>.")
      Input()
      ClearConsole()
      PrintN("At first we assign a key to mousewheel up. Press the key")
      PrintN("on your keyboard, that has the function ingame you want to")
      PrintN("assign to your 'mousewheel up'.")
      DIMouseWheel_Up = AssignKeys()
      keybuffer.s = Space(1024)
      GetKeyNameText_(DIMouseWheel_Up << 16, keybuffer, 1024) ; Tastencode in Bezeichnung auflösen
      PrintN("")
      PrintN("You pressed: " +Trim(keybuffer))
      PrintN(Trim(keybuffer) + " will be assigned to mousewheel up.")
      PrintN("Press <enter> to continue.")
      Input()
      ClearConsole()
      PrintN("Now we assign a key to mousewheel down. Press the key")
      PrintN("on your keyboard, that has the function ingame you want to")
      PrintN("assign to your 'mousewheel down'.")
      DIMouseWheel_Down = AssignKeys()
      keybuffer.s = Space(1024)
      GetKeyNameText_(DIMouseWheel_Down << 16, keybuffer, 1024) ; Tastencode in Bezeichnung auflösen
      PrintN("")
      PrintN("You pressed: " + Trim(keybuffer))
      PrintN(Trim(keybuffer) + " will be assigned to mousewheel down.")
      PrintN("Press <enter> to finish setup and start gaming with mousewheelsupport :)")
      Input()
      ClearConsole()
      ConsoleColor(12,0)
      ConsoleLocate(0,5)
      PrintN(LSet("Ok. Now you are ready to play your game ;)",80))
      PrintN(LSet("For easy starting the game next time, a link",80))
      PrintN(LSet("on your desktop has been generated. You have to",80))
      PrintN(LSet("start your game using this link to play with",80))
      PrintN(LSet("RetroMouseWheel.",80))
      ConsoleColor(14,0)
      PrintN(LSet("You never will have to configure anything to play this game.",80))
      Input()
    CloseConsole()
    Else
      MessageRequester("RetroMouseWheel Program Information", "cannot create a console!", #PB_MessageRequester_Ok)
      End
    EndIf
    GameExeString.s = GameExe + "!" + StrU(DIMouseWheel_Up,0) + "!" + StrU(DIMouseWheel_Down,0)
    Output = Space(1024)
    Base64Encoder(@GameExeString, Len(GameExeString), @Output, Len(Output))
    WorkingDirectory.s = GetPathPart(GameExe)
    Link.s = GetEnvironmentVariable("USERPROFILE")+"\Desktop\Play "+RemoveString(GetFilePart(GameExe), GetExtensionPart(GameExe))+" With RetroMouseWheel.lnk"
    CreateShellLink(ProgramFilename(),Link,Output,"Play RetroGames with RetroMouseWheel :)",WorkingDirectory,#SW_SHOWDEFAULT,0,GameExe,0)    
  Else
    End
  EndIf
EndIf


CreateThread(@WaitForProcess(), GetCurrentThreadId_())

hInstance.l = GetModuleHandle_(0)
hHook = SetWindowsHookEx_(#WH_MOUSE_LL, @HookProc(), hInstance, 0) ; Hook setzen und Adresse speichern

msg.MSG 
While GetMessage_(msg, 0, 0, 0);PeekMessage_(msg,0,0,0,1)
  TranslateMessage_(msg)
  DispatchMessage_(msg)
Wend

UnhookWindowsHookEx_(hHook) ; Hook auflösen. MUSS GESETZT WERDEN!!!


Procedure HookProc(nCode.l, wParam.l, *lParam.MSLLHOOKSTRUCT) ; Callback-Procedure for Windows
  If nCode = #HC_ACTION
      ;"The wParam and lParam parameters contain information about a mouse message."
      If wParam = #WM_MOUSEWHEEL
     
        If *lParam\mouseData = #WHEEL_DELTA
          Debug "MouseWheel has been clicked"
        ElseIf *lParam\mouseData > #WHEEL_DELTA ; MouseWheelUp
          SendKeySet(DIMouseWheel_Up)
          SendKeyRelease(DIMouseWheel_Up)
        ElseIf *lParam\mouseData < #WHEEL_DELTA ; MouseWheelDown
          SendKeySet(DIMouseWheel_Down)
          SendKeyRelease(DIMouseWheel_Down)
        EndIf
       
      EndIf
  EndIf
 
  ProcedureReturn CallNextHookEx_(hHook, nCode, wParam, *lParam.MSLLHOOKSTRUCT) ; Hook weiterlaufen lassen
EndProcedure

Procedure.l AssignKeys()
  Define.l quit = 0
  Repeat
    KeyPressed$ = Inkey()
    If RawKey() > 0
      scancode.l = MapVirtualKeyEx_(RawKey(), 0, GetKeyboardLayout_(0))
      quit = 1
    EndIf
    Delay(5)
  Until quit = 1
  ProcedureReturn scancode
  EndProcedure

Procedure SendKeySet(VK_Key.l) ; Taste drücken

  Protected inpset.INPUT
  inpset\type = #INPUT_KEYBOARD
  inpset\ki\wScan = VK_Key
 
  SendInput_(1, @inpset, SizeOf(INPUT))

EndProcedure

Procedure SendKeyRelease(VK_Key.l) ; Taste loslassen

  Protected inprelease.INPUT
  inprelease\type = #INPUT_KEYBOARD
  inprelease\ki\wScan = VK_Key
  inprelease\ki\dwFlags = #KEYEVENTF_KEYUP
 
  SendInput_(1, @inprelease, SizeOf(INPUT))

EndProcedure

Procedure CreateShellLink(PATH$, LINK$, Argument$, DESCRIPTION$, WorkingDirectory$, ShowCommand.l, HotKey.l, IconFile$, IconIndexInFile.l)
   CoInitialize_(0)
   If CoCreateInstance_(?CLSID_ShellLink,0,1,?IID_IShellLink,@psl.IShellLinkA) = 0
   Set_ShellLink_preferences:
      psl\SetPath(@PATH$)
      psl\SetArguments(@Argument$)
      psl\SetWorkingDirectory(@WorkingDirectory$)
      psl\SetDescription(@DESCRIPTION$)
      psl\SetShowCmd(ShowCommand)
      psl\SetHotkey(HotKey)
      psl\SetIconLocation(@IconFile$, IconIndexInFile)
     
     
   ShellLink_SAVE:
      If psl\QueryInterface(?IID_IPersistFile,@ppf.IPersistFile) = 0
        mem.s = Space(1000) ;AllocateMemory(1,1000)
        MultiByteToWideChar_(#CP_ACP, 0, LINK$, -1, mem, 1000)
        hres = ppf\Save(@mem,#True)
        result = 1
        ppf\Release()
      EndIf
      psl\Release()
   EndIf
   CoUninitialize_()
   ProcedureReturn result
   
   DataSection
     CLSID_ShellLink:
       Data.l $00021401
       Data.w $0000,$0000
       Data.b $C0,$00,$00,$00,$00,$00,$00,$46
     IID_IShellLink:
       Data.l $000214EE
       Data.w $0000,$0000
       Data.b $C0,$00,$00,$00,$00,$00,$00,$46
     IID_IPersistFile:
       Data.l $0000010B
       Data.w $0000,$0000
       Data.b $C0,$00,$00,$00,$00,$00,$00,$46
   EndDataSection

EndProcedure

Procedure WaitForProcess(ParentThreadID)
  uProc.PROCESS_INFORMATION
  uStart.STARTUPINFO
  With uStart
    \cb = SizeOf(uStart)
    \wShowWindow = 1
    \dwFlags = 1
  EndWith
 
  CreateProcess_(0, GameExe, 0, 0, 1, #NORMAL_PRIORITY_CLASS, 0, GetPathPart(GameExe), uStart, uProc) ; Zielanwendung (Spiel) starten
  WaitForSingleObject_(uProc\hProcess, #INFINITE) ; Warten, bis die Zielanwendung (das Spiel) beendet wurde
  CloseHandle_(uProc\hProcess) ; Process-Handle schliessen
  PostThreadMessage_(ParentThreadID, #WM_QUIT, 0, 0)  ; den ParentThread eine Quit-Nachricht schicken, um das Programm zu beenden
EndProcedure

End