123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220 |
- {*
- * winamp.dpr -> Code for winamp.dll for DMDirc
- * DMDirc - Open Source IRC Client
- * Copyright (c) 2006-2011 Chris Smith, Shane Mc Cormack, Gregory Holmes
- *
- * Permission is hereby granted, free of charge, to any person obtaining a copy
- * of this software and associated documentation files (the "Software"), to deal
- * in the Software without restriction, including without limitation the rights
- * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
- * copies of the Software, and to permit persons to whom the Software is
- * furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
- * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
- * SOFTWARE.
- *}
-
- // References:
- // http://www.informit.com/articles/article.aspx?p=130494&seqNum=3
- // http://developer.apple.com/sdk/itunescomsdk.html
-
- library winamp;
- uses
- windows, messages, SysUtils, Classes, ComObj, ActiveX;
-
- var
- oldExitProc: Pointer;
-
- function getITunes(): Variant;
- begin
- if FindWindow('iTunes', nil) <> 0 then begin
- Result := CreateOLEObject('iTunes.Application');
- end
- else Raise Exception.Create('iTunes is not running');
- end;
-
- // Freepascal sucks.
- // In Delphi I could just do V.Foo to call function Foo, but FPC hasn't added
- // this functionality yet, so yay for horrible callOLEFunction(V, 'Foo'); to
- // do the exact same thing!
- function callOLEFunction(V: IDispatch; S: WideString): Variant;
- const
- GUID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';
- DEFAULT_PARAMS: TDispParams = ();
- var
- mres: HRESULT;
- invres: Variant;
- id: Integer;
- begin
- mres := V.GetIDsOfNames(GUID_NULL, @S, 1, locale_system_default, @id);
- olecheck(mres);
- mres := V.Invoke(id, GUID_NULL, locale_system_default, DISPATCH_PROPERTYGET, DEFAULT_PARAMS, @invres, nil, nil);
- olecheck(mres);
- Result := invres;
- end;
-
- function getPlayState(data: PChar):integer; stdcall;
- var
- V: Variant;
- B: array[0..255] of char;
- state: Integer;
- begin
- result := 1;
- try
- V := getITunes();
- state := callOLEFunction(V, 'PlayerState');
- if state = 0 then begin
- try
- callOLEFunction(V, 'PlayerPosition');
- B := 'Paused';
- except
- B := 'Stopped';
- end
- end
- else if state = 1 then B := 'Playing';
- result := 0;
- except
- on E : Exception do B:= 'Unable to find iTunes Application ('+E.ClassName+'/'+E.Message+')';
- end;
- StrCopy(data,B);
- end;
-
- function getArtist(data: PChar):integer; stdcall;
- var
- V: Variant;
- B: array[0..255] of char;
- begin
- result := 1;
- try
- V := getITunes();
- V := callOLEFunction(V, 'CurrentTrack');
- B := String(callOLEFunction(V, 'Artist'));
- result := 0;
- except
- on E : Exception do B:= 'Unable to find iTunes Application ('+E.ClassName+'/'+E.Message+')';
- end;
- StrCopy(data,B);
- end;
-
- function getTitle(data: PChar):integer; stdcall;
- var
- V: Variant;
- B: array[0..255] of char;
- kind: Integer;
- begin
- result := 1;
- try
- V := getITunes();
- V := callOLEFunction(V, 'CurrentTrack');
- kind := callOLEFunction(V, 'Kind');
- if kind = 3 then begin
- V := getITunes();
- B := String(callOLEFunction(V, 'CurrentStreamTitle'));
- end
- else begin
- B := String(callOLEFunction(V, 'Name'));
- end;
- result := 0;
- except
- on E : Exception do B:= 'Unable to find iTunes Application ('+E.ClassName+'/'+E.Message+')';
- end;
- StrCopy(data,B);
- end;
-
- function getAlbum(data: PChar):integer; stdcall;
- var
- V: Variant;
- B: array[0..255] of char;
- begin
- result := 1;
- try
- V := getITunes();
- V := callOLEFunction(V, 'CurrentTrack');
- B := String(callOLEFunction(V, 'Album'));
- result := 0;
- except
- on E : Exception do B:= 'Unable to find iTunes Application ('+E.ClassName+'/'+E.Message+')';
- end;
- StrCopy(data,B);
- end;
-
- function getLength(data: PChar):integer; stdcall;
- var
- V: Variant;
- B: array[0..255] of char;
- begin
- result := 1;
- try
- V := getITunes();
- V := callOLEFunction(V, 'CurrentTrack');
- B := String(callOLEFunction(V, 'Duration'));
- result := 0;
- except
- on E : Exception do B:= 'Unable to find iTunes Application ('+E.ClassName+'/'+E.Message+')';
- end;
- StrCopy(data,B);
- end;
-
- function getTime(data: PChar):integer; stdcall;
- var
- V: Variant;
- B: array[0..255] of char;
- begin
- result := 1;
- try
- V := getITunes();
- B := String(callOLEFunction(V, 'PlayerPosition'));
- result := 0;
- except
- on E : Exception do B:= 'Unable to find iTunes Application ('+E.ClassName+'/'+E.Message+')';
- end;
- StrCopy(data,B);
- end;
-
- function getFormat(data: PChar):integer; stdcall;
- var
- B: array[0..255] of char;
- begin
- Result := 0;
- B := 'Unknown';
- StrCopy(data,B);
- end;
-
- function getBitrate(data: PChar):integer; stdcall;
- var
- V: Variant;
- B: array[0..255] of char;
- begin
- result := 1;
- try
- V := getITunes();
- V := callOLEFunction(V, 'CurrentTrack');
- B := String(callOLEFunction(V, 'BitRate'));
- result := 0;
- except
- on E : Exception do B:= 'Unable to find iTunes Application ('+E.ClassName+'/'+E.Message+')';
- end;
- StrCopy(data,B);
- end;
-
- exports getPlayState, getArtist, getTitle, getAlbum, getLength, getTime, getFormat, getBitrate;
-
- procedure myExitProc;
- begin
- CoUnInitialize();
- ExitProc := oldExitProc;
- end;
-
- begin
- CoInitialize(nil);
- oldExitProc := ExitProc;
- ExitProc := @myExitProc;
- end.
|