Мож пригодится кому. Для его работы нужны компоненты LNet.
- Код: Выделить всё
unit umpd;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,lNet,lNetComponents,ExtCtrls;
type
TCurrentStatus=record
AVolume:integer;
ARepeat:Boolean;
ARandom:Boolean;
APlayList:Longint;
APlayListLength:integer;
AXfade:integer;
AState:0..3;
ASong:integer;
ASongId:integer;
ATimeElapsed:integer;
ATimeTotal:integer;
ABitrate:integer;
AAudioSampleRate:integer;
AAudioBits:integer;
AAudioChanels:integer;
AUpDbJobId:integer;
AError:string;
AResult:string;
end;
TCurrentSong=record
AFile:string;
ATime:integer;
AAlbum:string;
ADate:string;
AArtist:string;
ATitle:string;
AGenre:string;
ATrack:integer;
APos:Integer;
AId:integer;
AResult:string;
end;
TUpdateInfoProc=procedure (const Status:TCurrentStatus);
TUpdateSongProc=procedure (const Song:TCurrentSong);
TGetInfoProc=procedure (Cmd,AResult:string; const ANames,AValues:TStrings);
{ TMpd }
TMpd = class
private
LClient:TLTCPComponent;
FTimer:TTimer;
FBackInfoProc:TUpdateInfoProc;
FBackSongProc:TUpdateSongProc;
FBackGetInfo:TGetInfoProc;
Fbuf:TStringList;
FLastCmd:TStringList;
FNames,FValues:TStrings;
//---------------------
procedure LClientReceive(aSocket: TLSocket);
procedure MpdOnTimer(Sender: TObject);
//---------------------
Function GetHost:string;
Function GetPort:Word;
Function GetInterval:Cardinal;
Function GetConnected:boolean;
procedure ParseInfo(str: string);
procedure ParseSong(str: string);
procedure ParseStatus(str: string);
//---------------------
procedure SetHost(AValue:string);
procedure SetPort(AValue:Word);
procedure SetInterval(AValue:Cardinal);
public
constructor Create;
destructor Destroy; override;
//---------------------
procedure ExecCmd(ACmd:string);
function Connect(AHost:String; APort:Word):boolean;
function Connect:boolean;
procedure Disconnect;
//---------------------
property Host:String read GetHost write SetHost;
property Port:Word read GetPort write SetPort;
property UpdateInterval:Cardinal read GetInterval write SetInterval;
property Connected:boolean read GetConnected;
property OnUpdateInfo:TUpdateInfoProc read FBackInfoProc write FBackInfoProc;
property OnUpdateSong:TUpdateSongProc read FBackSongProc write FBackSongProc;
Property OnGetInfo:TGetInfoProc read FBackGetInfo write FBackGetInfo;
property LastCmd:TStringList read FLastCmd;
end;
implementation
{ TMpd }
procedure TMpd.ParseInfo(str:string);
var st,s,ar:string; p,i:integer;
begin
if not assigned(FBackGetInfo) then exit;
st:=str;
FNames.Clear;
FValues.Clear;
Fbuf.Clear;
Fbuf.NameValueSeparator:=':';
i:=1;
while i<=length(st) do
begin
if st[i]=#10 then
begin
Fbuf.Add(s);
s:='';
end
else
s:=s+st[i];
i:=i+1;
end;
if (pos('OK',Fbuf[Fbuf.Count-1])>0) or (pos('ACK',Fbuf[Fbuf.Count-1])>0) then
p:=2 else p:=1;
if (Fbuf.Count>1) then
for i:=0 to Fbuf.Count-p do
begin
FNames.Add(Fbuf.Names[i]);
FValues.Add(copy(Fbuf.ValueFromIndex[i],2,length(Fbuf.ValueFromIndex[i])))
end;
if (pos('OK',Fbuf[Fbuf.Count-1])>0) or (pos('ACK',Fbuf[Fbuf.Count-1])>0) then
ar:=Fbuf[Fbuf.Count-1] else ar:='';
if (Fbuf.Count>0) and (Assigned(FBackGetInfo)) then
FBackGetInfo(LastCmd[LastCmd.Count-1],ar,FNames,FValues);
end;
procedure TMpd.ParseSong(str:string);
var st,s:string; p,i:integer; inf:TCurrentSong;
begin
if not assigned(FBackSongProc) then exit;
st:=str;
Fbuf.Clear;
Fbuf.NameValueSeparator:=':';
i:=1;
while i<=length(st) do
begin
if st[i]=#10 then
begin
Fbuf.Add(s);
s:='';
end
else
s:=s+st[i];
i:=i+1;
end;
p:=Fbuf.IndexOfName('file');
if p>-1 then
begin
Inf.AFile:=copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p]));
end
else Inf.AFile:='';
p:=Fbuf.IndexOfName('Time');
if p>-1 then
begin
if not TryStrToInt(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.ATime) then
Inf.ATime:=0;
end
else Inf.ATime:=0;
p:=Fbuf.IndexOfName('Artist');
if p>-1 then
begin
Inf.AArtist:=copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p]));
end
else Inf.AArtist:='';
p:=Fbuf.IndexOfName('Title');
if p>-1 then
begin
Inf.ATitle:=copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p]));
end
else Inf.ATitle:='';
p:=Fbuf.IndexOfName('Album');
if p>-1 then
begin
Inf.AAlbum:=copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p]));
end
else Inf.AAlbum:='';
p:=Fbuf.IndexOfName('Date');
if p>-1 then
begin
Inf.ADate:=copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p]));
end
else Inf.ADate:='';
p:=Fbuf.IndexOfName('Genre');
if p>-1 then
begin
Inf.AGenre:=copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p]));
end
else Inf.AGenre:='';
p:=Fbuf.IndexOfName('Pos');
if p>-1 then
begin
if not TryStrToInt(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.APos) then
Inf.APos:=0;
end
else Inf.APos:=0;
p:=Fbuf.IndexOfName('Id');
if p>-1 then
begin
if not TryStrToInt(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.AId) then
Inf.AId:=0;
end
else Inf.AId:=0;
p:=Fbuf.IndexOfName('Track');
if p>-1 then
begin
if not TryStrToInt(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.ATrack) then
Inf.ATrack:=0;
end
else Inf.ATrack:=0;
Inf.AResult:=Fbuf[Fbuf.Count-1];
if Assigned(FBackSongProc) then
FBackSongProc(Inf);
end;
//------------------------------------------------------
procedure TMpd.ParseStatus(str:string);
var st,s:string; p,i:integer; inf:TCurrentStatus;
begin
if not assigned(FBackInfoProc) then exit;
st:=str;
Fbuf.Clear;
Fbuf.NameValueSeparator:=':';
i:=1;
while i<=length(st) do
begin
if st[i]=#10 then
begin
Fbuf.Add(s);
s:='';
end
else
s:=s+st[i];
i:=i+1;
end;
p:=Fbuf.IndexOfName('volume');
if p>-1 then
begin
if not TryStrToInt(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.AVolume) then Inf.AVolume:=0;
end
else Inf.AVolume:=0;
p:=Fbuf.IndexOfName('repeat');
if p>-1 then
begin
if not TryStrToBool(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.ARepeat) then Inf.ARepeat:=false;
end
else Inf.ARepeat:=false;
p:=Fbuf.IndexOfName('random');
if p>-1 then
begin
if not TryStrToBool(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.ARandom) then Inf.ARandom:=false;
end
else Inf.ARandom:=false;
p:=Fbuf.IndexOfName('playlist');
if p>-1 then
begin
if not TryStrToInt(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.APlayList) then Inf.APlayList:=0;
end
else Inf.APlayList:=0;
p:=Fbuf.IndexOfName('playlistlength');
if p>-1 then
begin
if not TryStrToInt(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.APlayListLength) then Inf.APlayListLength:=0;
end
else Inf.APlayListLength:=0;
p:=Fbuf.IndexOfName('xfade');
if p>-1 then
begin
if not TryStrToInt(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.AXfade) then Inf.AXfade:=0;
end
else Inf.AXfade:=0;
p:=Fbuf.IndexOfName('state');
if p>-1 then
begin
if copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p]))='play' then Inf.AState:=1
else if copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p]))='stop' then Inf.AState:=2
else if copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p]))='pause' then Inf.AState:=3
else Inf.AXfade:=0;
end
else Inf.AState:=0;
p:=Fbuf.IndexOfName('song');
if p>-1 then
begin
if not TryStrToInt(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.ASong) then Inf.ASong:=0;
end
else Inf.ASong:=0;
p:=Fbuf.IndexOfName('songid');
if p>-1 then
begin
if not TryStrToInt(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.ASongId) then Inf.ASongId:=0;
end
else Inf.ASongId:=0;
p:=Fbuf.IndexOfName('time');
if p>-1 then
begin
s:=copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p]));
if not TryStrToInt( copy(s,1,pos(':',s)-1),Inf.ATimeElapsed) then Inf.ATimeElapsed:=0;
delete(s,1,pos(':',s));
if not TryStrToInt(s,Inf.ATimeTotal) then Inf.ATimeTotal:=0;
end
else
begin
Inf.ATimeTotal:=0;
Inf.ATimeElapsed:=0;
end;
p:=Fbuf.IndexOfName('bitrate');
if p>-1 then
begin
if not TryStrToInt(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.ABitrate) then Inf.ABitrate:=0;
end
else Inf.ABitrate:=0;
p:=Fbuf.IndexOfName('audio');
if p>-1 then
begin
s:=copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p]));
if not TryStrToInt( copy(s,1,pos(':',s)-1),Inf.AAudioSampleRate) then Inf.AAudioSampleRate:=0;
delete(s,1,pos(':',s));
if not TryStrToInt(copy(s,1,pos(':',s)-1),Inf.AAudioBits) then Inf.AAudioBits:=0;
delete(s,1,pos(':',s));
if not TryStrToInt(s,Inf.AAudioChanels) then Inf.AAudioChanels:=0;
end
else
begin
Inf.AAudioSampleRate:=0;
Inf.AAudioBits:=0;
Inf.AAudioChanels:=0;
end;
p:=Fbuf.IndexOfName('updating_db');
if p>-1 then
begin
if not TryStrToInt(copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p])),Inf.AUpDbJobId) then Inf.AUpDbJobId:=0;
end
else Inf.AUpDbJobId:=0;
p:=Fbuf.IndexOfName('error');
if (p>-1) and (p<Fbuf.Count-1) then
begin
Inf.AError:=copy(Fbuf.ValueFromIndex[p],2,length(Fbuf.ValueFromIndex[p]));
end;
Inf.AResult:=Fbuf[Fbuf.Count-1];
if Assigned(FBackInfoProc) then
FBackInfoProc(Inf);
end;
procedure TMpd.LClientReceive(aSocket: TLSocket);
var s:string; song:TCurrentSong;
begin
if aSocket.GetMessage(s)>0 then
begin
while FLastCmd.Count>0 do
begin
if (FLastCmd.Count>0) and (FLastCmd[FLastCmd.Count-1]='status+') then
begin
ParseStatus(s);
FLastCmd.Delete(FLastCmd.Count-1);
end else
if (FLastCmd.Count>0) and (FLastCmd[FLastCmd.Count-1]='currentsong+') then
begin
ParseSong(s);
FLastCmd.Delete(FLastCmd.Count-1);
end else
if (FLastCmd.Count>0) then
begin
ParseInfo(s);
FLastCmd.Delete(FLastCmd.Count-1);
end;
end;
LClient.IterReset;
end;
end;
procedure TMpd.MpdOnTimer(Sender: TObject);
begin
if not LClient.Connected then exit;
// запрос статуса и песни для проц FBackInfoProc и FBackSongProc;
if Assigned(LClient.Iterator) then
begin
FLastCmd.Add('status+');
LClient.SendMessage('status'+#13#10,LClient.Iterator);
FLastCmd.Add('currentsong+');
LClient.SendMessage('currentsong'+#13#10,LClient.Iterator);
end;
end;
function TMpd.GetHost: string;
begin
if not assigned(LClient) then exit;
Result:=LClient.Host;
end;
function TMpd.GetPort: Word;
begin
if not assigned(LClient) then exit;
Result:=LClient.Port;
end;
function TMpd.GetInterval: Cardinal;
begin
Result:=FTimer.Interval;
end;
function TMpd.GetConnected: boolean;
begin
Result:=LClient.Connected;
end;
procedure TMpd.SetHost(AValue: string);
begin
LClient.Host:=AValue;
end;
procedure TMpd.SetPort(AValue: Word);
begin
LClient.Port:=AValue;
end;
procedure TMpd.SetInterval(AValue: Cardinal);
begin
FTimer.Interval:=AValue;
end;
constructor TMpd.Create;
begin
LClient:=TLTCPComponent.Create(nil);
LClient.Host:='localhost';
LClient.Port:=6600;
LClient.OnReceive:=@LClientReceive;
FTimer:=TTimer.Create(nil);
FTimer.Interval:=1000;
FTimer.OnTimer:=@MpdOnTimer;
FBackInfoProc:=nil;
Fbuf:=TStringList.Create;
Fbuf.CaseSensitive:=true;
FLastCmd:=TStringList.Create;
FNames:=TStringList.Create;
FValues:=TStringList.Create;
end;
destructor TMpd.Destroy;
begin
if Assigned(LClient) then FreeAndNil(LClient);
if Assigned(FTimer) then FreeAndNil(FTimer);
if Assigned(Fbuf) then FreeAndNil(Fbuf);
if Assigned(FLastCmd) then FreeAndNil(FLastCmd);
if Assigned(FNames) then FreeAndNil(FNames);
if Assigned(FValues) then FreeAndNil(FValues);
inherited Destroy;
end;
procedure TMpd.ExecCmd(ACmd: string);
begin
if Assigned(LClient.Iterator) then
begin
FLastCmd.Add(ACmd);
LClient.SendMessage(ACmd+#13#10,LClient.Iterator);
end;
end;
function TMpd.Connect(AHost: String; APort: Word): boolean;
begin
LClient.Port:=APort;
LClient.Host:=AHost;
Result:=LClient.Connect;
FTimer.Enabled:=true;
end;
function TMpd.Connect: boolean;
begin
Result:=LClient.Connect;
FTimer.Enabled:=true;
end;
procedure TMpd.Disconnect;
begin
LClient.Disconnect;
FTimer.Enabled:=False;
end;
end.
Пример использования:
- Код: Выделить всё
...
var
Form1: TForm1;
Mpd:TMpd;
implementation
{ TForm1 }
procedure OnStatus(const Info:TCurrentStatus);
begin
form1.Label2.Caption:=inttostr(info.AVolume);
form1.Label3.Caption:=BoolToStr(info.ARepeat,true);
form1.Label4.Caption:=inttostr(info.ATimeElapsed)+' / '+inttostr(info.ATimeTotal);
form1.pb1.Max:=info.ATimeTotal;
form1.pb1.Position:=info.ATimeElapsed;
form1.Label5.Caption:=inttostr(info.AAudioSampleRate)+':'+inttostr(info.AAudioBits)+':'+inttostr(info.AAudioChanels);
form1.Label6.Caption:=inttostr(Info.ABitrate);
form1.Label7.Caption:=inttostr(Info.APlayListLength);
form1.Label8.Caption:=booltostr(Info.ARandom,true);
form1.Label9.Caption:=inttostr(Info.ASong);
form1.Label10.Caption:=inttostr(Info.ASongId);
case Info.AState of
0: form1.Label11.Caption:='Stop';
1: form1.Label11.Caption:='Play';
2: form1.Label11.Caption:='Stop';
3: form1.Label11.Caption:='Pause';
end;
Form1.Label12.Caption:='>'+info.AResult;
end;
procedure OnSong(const Song:TCurrentSong);
begin
form1.Label13.Caption:=Inttostr(Song.AId);
form1.Label14.Caption:=Inttostr(Song.ATrack);
form1.Label15.Caption:=Song.AArtist;
form1.Label16.Caption:=Song.ATitle;
form1.Label17.Caption:=Song.AGenre;
form1.Label18.Caption:=Song.ADate;
form1.Label19.Caption:=Song.AAlbum;
form1.Label20.Caption:=Song.AFile;
form1.Label21.Caption:=Inttostr(Song.APos);
form1.Label22.Caption:=Inttostr(Song.ATime);
end;
procedure OnGetInfo(cmd,AResult:string; const ANames,AValues:TStrings);
begin
form1.ListBox1.Clear;
form1.ListBox2.Clear;
form1.ListBox3.Clear;
form1.ListBox1.items.AddStrings(ANames);
form1.ListBox2.items.AddStrings(AValues);
form1.ListBox3.items.Add(Cmd);
form1.ListBox3.items.Add(AResult);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Mpd:=TMpd.Create;
mpd.OnUpdateInfo:=@OnStatus;
mpd.OnUpdateSong:=@OnSong;
mpd.OnGetInfo:=@OnGetInfo;
mpd.UpdateInterval:=600;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
mpd.Connect;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
mpd.ExecCmd('stats');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
mpd.ExecCmd(Edit2.text);
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
mpd.Disconnect;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
CheckBox1.Checked:=mpd.Connected;
end;
...
Edit: Класс был чуток подправлен.
