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