freepascal.ru

Наваял, для своих нужд, небольшой класс для работы с MPD (Music Player Daemon).
Мож пригодится кому. Для его работы нужны компоненты 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: Класс был чуток подправлен.

B4rr4cuda
Спасибо!
Это мне точно пригодится