//****************************************************************************** // XBMC USB Controller for Windows. // Copyright © 2011 Dilshan R Jayakody. // // This program is free software: you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 3 of the License, or // (at your option) any later version. // // This program is distributed in the hope that it will be useful, // but WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with this program. If not, see . //****************************************************************************** unit dmMain; interface uses SysUtils, Classes, ExtCtrls, JvComponentBase, JvHidControllerClass, superobject, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, uSystem, Windows, Messages, Forms, inifiles, JclStrings, AppEvnts, JvTrayIcon, Menus, shellapi; type TdMain = class(TDataModule) http_client: TIdHTTP; hid_controller: TJvHidDeviceController; event_capture: TTimer; XBMCU_update: TTimer; app_event: TApplicationEvents; tray_icon: TJvTrayIcon; try_menu: TPopupMenu; mnuLog: TMenuItem; mnuClose: TMenuItem; N1: TMenuItem; mnuAbout: TMenuItem; procedure hid_controllerDeviceChange(Sender: TObject); procedure hid_controllerRemoval(HidDev: TJvHidDevice); procedure hid_controllerArrival(HidDev: TJvHidDevice); procedure event_captureTimer(Sender: TObject); function PostDataToXBMC(indata : string) : string; procedure XBMCU_updateTimer(Sender: TObject); procedure http_clientConnected(Sender: TObject); procedure hid_controllerDeviceData(HidDev: TJvHidDevice; ReportID: Byte; const Data: Pointer; Size: Word); procedure ResetPlayerState(); function ConnectXBMC() : Boolean; procedure RenderInfoToLCD(); procedure ResetLCD(); function WriteUSB : Boolean; procedure ResetUSBDataBuffer(); procedure SetupSystemConfig(); procedure MapKeyTable(); procedure DataModuleCreate(Sender: TObject); procedure DataModuleDestroy(Sender: TObject); procedure GetKeyMapData(instr : string; var mode_ : integer; var data_ : integer); procedure app_eventException(Sender: TObject; E: Exception); procedure SetXBMCVolumeLevel(isUp : Boolean; step_ : integer = 1); procedure SetXBMCGoToHome(); procedure SetXBMCAudioMute(); procedure mnuCloseClick(Sender: TObject); procedure mnuLogClick(Sender: TObject); procedure try_menuPopup(Sender: TObject); procedure mnuAboutClick(Sender: TObject); private xbmc_ : TXBMCInfo; device_ : TUSBDeviceInfo; player_data_buffer, player_ : TPlayerData; device_online : Boolean; usb_write_buf: array [0..64] of Byte; controller_ : TJvHidDevice; keymap : TList; rotate_state : string; public procedure InitSystem(); end; var dMain: TdMain; implementation uses fmAbout; {$R *.dfm} procedure TdMain.GetKeyMapData(instr : string; var mode_ : integer; var data_ : integer); var pos : integer; begin for pos := 0 to keymap.Count - 1 do begin if(instr = PKeyInfo(keymap.Items[pos])^.ID) then begin mode_ := PKeyInfo(keymap.Items[pos])^.Mode; data_ := PKeyInfo(keymap.Items[pos])^.Data; break; end; end; end; procedure TdMain.MapKeyTable(); var config_ini : TIniFile; val_list: TStringList; pos : integer; key_ptr : PKeyInfo; val_ : string; begin config_ini := TIniFile.Create(Root+'\mcci.ini'); val_list := TStringList.Create; config_ini.ReadSection('keymap',val_list); keymap.Clear; for pos := 0 to val_list.Count - 1 do begin new(key_ptr); key_ptr^.ID := val_list.Strings[pos]; val_ := config_ini.ReadString('keymap',val_list.Strings[pos],'0,0'); key_ptr^.Mode := StrToIntDef(val_[1],0); key_ptr^.Data := StrToIntDef(trim(StrRight(val_,Length(val_)-2)),0); keymap.Add(key_ptr); end; freeandnil(val_list); end; function TdMain.PostDataToXBMC(indata : string) : string; var indata_container : TStringList; begin result := ''; indata_container := TStringList.Create; indata_container.Add(indata); try result := http_client.Post('http://'+xbmc_.address+'/jsonrpc', indata_container) except event_capture.Enabled := false; XBMCU_update.Enabled := true; end; freeandnil(indata_container); end; procedure TdMain.hid_controllerDeviceChange(Sender: TObject); begin if(not Assigned(controller_)) then begin while(hid_controller.CheckOut(controller_))do begin if((controller_.Attributes.VendorID = device_.VID) and (controller_.Attributes.ProductID = device_.PID))then begin controller_.NumInputBuffers := 128; controller_.NumOverlappedBuffers := 128; LogMsg('USB Controller Interface is checkout'); break; end; end; end; end; procedure TdMain.hid_controllerRemoval(HidDev: TJvHidDevice); begin if(device_online) then begin if(((HidDev.Attributes.VendorID = device_.VID) and (HidDev.Attributes.ProductID = device_.PID)) and device_online) then begin if(Assigned(controller_)) then hid_controller.CheckIn(controller_); device_online := false; LogMsg('USB Controller Interface is removed'); end; end; end; procedure TdMain.hid_controllerArrival(HidDev: TJvHidDevice); begin if((HidDev.Attributes.VendorID = device_.VID) and (HidDev.Attributes.ProductID = device_.PID)) then begin device_online := true; LogMsg('USB Controller Interface is detected'); end; end; procedure TdMain.event_captureTimer(Sender: TObject); var rx_data : string; json_data : ISuperObject; playlist_item : int64; player_str : string; begin try if(device_online and ConnectXBMC) then begin rx_data := PostDataToXBMC('{"jsonrpc": "2.0", "method": "Player.GetActivePlayers", "id": 1}'); if(rx_data <> '') then begin json_data := SO(rx_data); if((json_data.O['result'].O['audio'] <> nil)and(json_data.O['result'].O['video'] <> nil)and(json_data.O['result'].O['picture'] <> nil)) then begin if(json_data.O['result'].B['audio']) then player_.ActivePlayer := psAudio else if(json_data.O['result'].B['video']) then player_.ActivePlayer := psVideo else if(json_data.O['result'].B['picture']) then player_.ActivePlayer := psPicture else ResetPlayerState; if(player_.ActivePlayer = psPicture) then begin player_.Attrib1 := ''; player_.Title := ''; end else if((player_.ActivePlayer = psAudio) or (player_.ActivePlayer = psVideo)) then begin if(player_.ActivePlayer = psAudio) then player_str := '{"jsonrpc": "2.0", "method": "AudioPlaylist.GetItems", "params": { "fields": ["title", "artist"] }, "id": 1}' else player_str := '{"jsonrpc": "2.0", "method": "VideoPlaylist.GetItems", "params": { "fields": ["title"] }, "id": 1}'; rx_data := PostDataToXBMC(player_str); if(rx_data <> '') then begin json_data := SO(rx_data); if(json_data.O['result'].O['state'] <> nil) then begin player_.PlayMode := plPlay; if(json_data.O['result'].O['state'].B['paused']) then player_.PlayMode := plPause; playlist_item := StrToIntDef(json_data.O['result'].O['state'].S['current'],-1); player_.Attrib1 := ''; player_.Title := ''; if((playlist_item>-1) and (json_data.O['result'].O['items']<>nil)) then begin if(player_.ActivePlayer = psAudio) then begin player_.Title := trim(json_data.O['result'].A['items'].O[playlist_item].S['title']); player_.Attrib1 := trim(json_data.O['result'].A['items'].O[playlist_item].S['artist']); end else begin player_.Title := trim(json_data.O['result'].A['items'].O[playlist_item].S['label']); player_.Attrib1 := ''; end; end; end else begin player_.PlayMode := plStop; player_.Attrib1 := ''; player_.Title := ''; end; end else raise Exception.Create('Invalid return from Playlist.GetItems'); end; end else raise Exception.Create('Invalid JSON Player.GetActivePlayers result data'); end else raise Exception.Create('Invalid return from Player.GetActivePlayers'); end; except on ex_ : Exception do begin ResetPlayerState; LogMsg(ex_.Message, lgError); end; end; if(device_online) then begin if((player_data_buffer.ActivePlayer <> player_.ActivePlayer)or((player_data_buffer.PlayMode <> player_.PlayMode))or((player_data_buffer.Attrib1 <> player_.Attrib1))or((player_data_buffer.Title <> player_.Title))) then begin if(player_.ActivePlayer = psNone) then ResetLCD else RenderInfoToLCD; end; end; player_data_buffer := player_; end; procedure TdMain.XBMCU_updateTimer(Sender: TObject); begin XBMCU_update.Enabled := not ConnectXBMC; end; procedure TdMain.http_clientConnected(Sender: TObject); begin if(not event_capture.Enabled) then begin event_capture.Enabled := true; XBMCU_update.Enabled := false; end; end; procedure TdMain.hid_controllerDeviceData(HidDev: TJvHidDevice; ReportID: Byte; const Data: Pointer; Size: Word); var mode_, data_ : integer; xbmc_wnd: HWND; str_ : string; rotery_mode : byte; begin if((device_online and ConnectXBMC) and ((HidDev.Attributes.VendorID = device_.VID) and (HidDev.Attributes.ProductID = device_.PID))) then begin if ((Cardinal(PChar(Data)[0]) = 184) and (Cardinal(PChar(Data)[1]) = 1)) then begin str_ := inttostr(Cardinal(PChar(Data)[2]))+inttostr(Cardinal(PChar(Data)[3]))+inttostr(Cardinal(PChar(Data)[4])); xbmc_wnd := FindWindow('xbmc', nil); if((str_='110') or (str_='120') or (str_='200') or (str_='210') or (str_='220')) then begin rotery_mode := 0; if(rotate_state='110')and(str_='120')then begin rotery_mode := 1; rotate_state := ''; end else if(rotate_state='120')and(str_='110')then begin rotery_mode := 2; rotate_state := ''; end else rotate_state := str_; if(xbmc_wnd <> 0) then begin if(((player_.ActivePlayer = psAudio) or (player_.ActivePlayer = psVideo))) and (((player_.PlayMode = plPlay) or (player_.PlayMode = plPause))) then begin if(str_ = '200') then PostMessage(xbmc_wnd, WM_KEYDOWN, VK_SPACE, 0); if(rotery_mode>0) then SetXBMCVolumeLevel(rotery_mode=1); end else begin if(str_ = '200') then PostMessage(xbmc_wnd, WM_KEYDOWN, VK_RETURN, 0); if(rotery_mode=1) then PostMessage(xbmc_wnd, WM_KEYDOWN, VK_UP, 0); if(rotery_mode=2) then PostMessage(xbmc_wnd, WM_KEYDOWN, VK_DOWN, 0); end; if(str_ = '210') then SetXBMCGoToHome else if(str_ = '220') then PostMessage(xbmc_wnd, WM_KEYDOWN, VK_ESCAPE, 0); end; end else begin rotate_state := ''; GetKeyMapData(str_,mode_, data_); if(mode_ > 0) and (xbmc_wnd <> 0) then begin if(mode_ = 1) then PostMessage(xbmc_wnd, WM_KEYDOWN, data_, 0) else if(mode_ = 2) then PostMessage(xbmc_wnd, WM_CHAR, data_, 0) else if(mode_ = 3) then begin case(data_) of 1 : SetXBMCVolumeLevel(true); 2 : SetXBMCVolumeLevel(false); 3 : SetXBMCGoToHome; 4 : SetXBMCAudioMute; end; end; end; end; end; end; end; procedure TdMain.ResetPlayerState(); begin player_.Title := ''; player_.Attrib1 := ''; player_.playmode := plIdle; player_.ActivePlayer := psNone; end; procedure TdMain.SetupSystemConfig(); begin xbmc_ := GetXBMCConfigInfo; device_ := GetUSBDeviceInfo; end; procedure TdMain.ResetUSBDataBuffer(); var pos : integer; begin for pos := 1 to 63 do begin usb_write_buf[pos] := 0; end; usb_write_buf[0] := 0; usb_write_buf[1] := 1; end; function TdMain.WriteUSB : Boolean; var written_: cardinal; begin if(Assigned(controller_)) then begin result := controller_.WriteFile(usb_write_buf, 65, written_); if(not result) then LogMsg('USB write operation failed',lgError); end else begin LogMsg('Call to unassigned USB device',lgError); result := false; end; end; procedure TdMain.ResetLCD(); begin ResetUSBDataBuffer; usb_write_buf[2] := 60; usb_write_buf[3] := 60; WriteUSB; end; procedure TdMain.RenderInfoToLCD(); var out_str : string; pos : shortint; begin ResetUSBDataBuffer; case player_.ActivePlayer of psAudio : usb_write_buf[2] := 65; psVideo : usb_write_buf[2] := 66; psPicture : usb_write_buf[2] := 67; psNone : usb_write_buf[2] := 60; end; case player_.PlayMode of plStop : usb_write_buf[3] := 65; plPlay : usb_write_buf[3] := 66; plPause : usb_write_buf[3] := 67; end; out_str := player_.Title; if(Length(out_str + ' - '+ player_.Attrib1) <= 60) then out_str := out_str + ' - '+ player_.Attrib1; if(Length(out_str)>=60) then out_str := StrLeft(out_str,56) + '...'; if(trim(out_str) <> '-') then begin for pos := 0 to Length(out_str) do usb_write_buf[5+pos] := ord(out_str[pos+1]); end; WriteUSB; end; function TdMain.ConnectXBMC() : Boolean; begin try result := http_client.Connected; if(result = false) then begin http_client.Connect(); result := http_client.Connected; end; except result := false; end; end; procedure TdMain.InitSystem(); begin ClearLog; controller_ := nil; SetupSystemConfig; ResetPlayerState; MapKeyTable; device_online := false; http_client.Host := xbmc_.address; http_client.Port := StrToIntDef(xbmc_.port, 80); player_data_buffer := player_; XBMCU_update.Enabled := true; LogMsg('Application initiated successfully'); if(StartXBMC) then begin while(not Application.Terminated) do begin Sleep(1); Application.ProcessMessages; end; end else LogMsg('Unable to launch or find XBMC executable file'); XBMCU_update.Enabled := false; event_capture.Enabled := false; LogMsg('Application terminated'); end; procedure TdMain.DataModuleCreate(Sender: TObject); begin keymap := TList.Create; end; procedure TdMain.DataModuleDestroy(Sender: TObject); begin freeandnil(keymap); end; procedure TdMain.app_eventException(Sender: TObject; E: Exception); begin LogMsg('Fatal Error: '+E.Message, lgError); end; procedure TdMain.SetXBMCGoToHome(); begin PostDataToXBMC('{"jsonrpc": "2.0", "method": "Input.Home", "id": 1}') end; procedure TdMain.SetXBMCAudioMute(); begin PostDataToXBMC('{"jsonrpc": "2.0", "method": "XBMC.ToggleMute", "id": 1}') end; procedure TdMain.SetXBMCVolumeLevel(isUp : Boolean; step_ : integer = 1); var json_rpc : ISuperObject; xbmc_watch_state : Boolean; rx_ : string; vol_level : integer; begin xbmc_watch_state := event_capture.Enabled; event_capture.Enabled := false; try rx_ := trim(PostDataToXBMC('{"jsonrpc": "2.0", "method": "XBMC.GetVolume", "id": 1}')); if(rx_ <> '') then begin json_rpc := SO(rx_); vol_level := json_rpc.I['result']; if(isUp) then begin vol_level := vol_level + step_; if(vol_level > 100) then vol_level := 100; end else begin vol_level := vol_level - step_; if(vol_level < 0) then vol_level := 0; end; PostDataToXBMC('{"jsonrpc": "2.0", "method": "XBMC.SetVolume", "params": {"value" : '+inttostr(vol_level)+'}, "id": 1}'); end else raise Exception.Create('Invalid return from XBMC.GetVolume'); finally event_capture.Enabled := xbmc_watch_state; end; end; procedure TdMain.mnuCloseClick(Sender: TObject); begin event_capture.Enabled := false; XBMCU_update.Enabled := false; Application.Terminate; end; procedure TdMain.mnuLogClick(Sender: TObject); begin if FileExists(Root + '\mcci.log') then ShellExecute(0,'open',pchar(Root + '\mcci.log'),'','',1) end; procedure TdMain.try_menuPopup(Sender: TObject); begin mnuLog.Enabled := FileExists(Root + '\mcci.log'); end; procedure TdMain.mnuAboutClick(Sender: TObject); var fmAboutWin : TFrmAbout; begin fmAboutWin := TFrmAbout.Create(nil); fmAboutWin.ShowModal; freeandnil(fmAboutWin); end; end.