No hay respuestas en este tema

[sir.dev.a.lot]

[TRUCO DELPHI] Unidad para Archivos MP3.

delphi

Unit uMP3Object;
 
interface
 
Uses
  Classes;
 
Const
  fmReadOnly  = $00;
  fmWriteOnly = $01;  
  fmReadWrite = $02;
  fmDenyAll   = $10;  
  fmDenyWrite = $20;
  fmDenyRead  = $30;
  fmDenyNone  = $40;
  fmNoInherit = $70;                                
 
Type
  TMp3Object = Class(TComponent)
  private
    FMp3File          : String;
    FMp3FileShort     : String;
    FVersion          : Byte;
    FLayer            : Byte;
    FBitrate          : Byte;
    FSampfreq         : Byte;
    FMode             : Byte;
    FTagsongname      : String;
    FTagArtist        : String;
    FTagAlbum         : String;
    FTagYear          : String;
    FTagComment       : String;
    FTagGenre         : Integer;
    FTime             : Integer;
    FTimeString       : String;
    FSize             : Integer;
    FSizeString       : String;
    FmpegTypeString   : String;
    FlayerString      : String;
    FbitrateString    : String;
    FSampleRateString : String;
    FChannelModeString: String;
 
    procedure SetMp3File(Const Value :  String);
  public
    property Mp3File      : String read FMp3File write SetMp3File;
    property Mp3FileShort : String read FMp3FileShort;
    property Size         : String read FSizeString;
    property BitRate      : String read FBitRateString;
    property Time         : String read FTimeString;
  end;
 
implementation
 
Uses
  Forms,
  SysUtils;
 
Type
  TStoreObject = Class(TComponent)
  private
    FMp3FileShort : String;
    FSize         : String;
    FBitRate      : String;
    FTime         : String;
  public
    property Mp3FileShort : String read FMp3FileShort write FMp3FileShort;
    property Size         : String read FSize         write FSize;
    property BitRate      : String read FBitRate      write FBitRate;
    property Time         : String read FTime         write FTime;
  end;
 
  TBuffer = Class(TComponent)
  private
    FStoreList : TStringList;
  public
    constructor Create(aOwner: Tcomponent); override;
    destructor Destroy; override;
 
    function GetStoreObject(aFileName: String): TStoreObject;
    procedure SetStoreObject(aFileName: String; aStoreObject: TStoreObject);
  end;
 
Var
  theBuffer : TBuffer;
 
{ Mp3Object }
 
Const
  cBG=0;
  cMODE_NAMES   : Array[cBG+0..cBG+4] Of String[9]=('stereo','j-stereo','dual-ch','single-ch','multi-ch');
  cLAYER_NAMES  : Array[cBG+0..cBG+2] Of String[3]=('i', 'II', 'III');
  cVERSION_NAMES: Array[cBG+0..cBG+2] Of String[10]=('MPEG-1','MPEG-2 LSF','MPEG-2.5');
  cVERSION_NUMS : Array[cBG+0..cBG+2] Of String[3]=('1','2','2.5');
  cBITRATES     : Array [cBG+0..cBG+2] Of Array[cBG+0..cBG+2] Of Array[cBG+0..cBG+14] Of Word =
{Mpeg 1}    {Layer I}  (((0,32,64,96,128,160,192,224,256,288,320,352,384,416,448),
            {Layer II}   (0,32,48,56,64,80,96,112,128,160,192,224,256,320,384),
            {Layer III}  (0,32,40,48,56,64,80,96,112,128,160,192,224,256,320)),
 
{Mpeg-2 Lsf}{Layer I}   ((0,32,48,56,64,80,96,112,128,144,160,176,192,224,256),
            {Layer II}   (0, 8,16,24,32,40,48, 56, 64, 80, 96,112,128,144,160),
            {Layer III}  (0, 8,16,24,32,40,48, 56, 64, 80, 96,112,128,144,160)),
 
{Mpeg-2.5}  {Layer I}   ((0,32,48,56,64,80,96,112,128,144,160,176,192,224,256),
            {Layer II}   (0,8,16,24,32,40,48,56,64,80,96,112,128,144,160),
            {Layer III}  (0,8,16,24,32,40,48,56,64,80,96,112,128,144,160)));
  cSFREQ : Array[cBG+0..cBG+2] Of Array[cBG+0..cBG+3] Of Word =
{mpeg 1}    ((44100,48000,32000,0),
{Mpeg-2 Lsf} (22050,24000,16000,0),
{Mpeg-2.5}   (11025, 8000, 8000,0));
 
Type
  buf = Array[0..4] Of Byte;
  taginfo = record
    id      : Array[1.. 3] Of Char;
    Songname: Array[1..30] Of Char;
    Artist  : Array[1..30] Of Char;
    Album   : Array[1..30] Of Char;
    Year    : Array[1.. 4] Of Char;
    Comment : Array[1..30] Of Char;
    Genre   : Byte;
  end;
 
function IsBitSet(Var INByte: Byte; Bit2Test: Byte): Boolean;
begin
  If (Bit2Test in [0..7]) Then
    Result := ((INByte And (1 Shl Bit2Test)) <> 0)
  Else
    Result := False;
end;
 
function LeadingZero(w: Word): String;
Var
  s : String;
begin
  Str(w:0, s);
  If Length(s) = 1 Then
    s := '0' + s;
  LeadingZero := s;
end;
 
procedure TMp3Object.SetMp3File(Const Value: String);
Var
  buffer        : buf;
  tag           : taginfo;
  f             : File;
  z,
  Result        : Integer;
  diri          : TSearchRec;
  myStoreObject : TStoreObject;
begin
  FMp3File := Uppercase(Value);
  MyStoreObject := thebuffer.getStoreObject(FMp3File);
  If Assigned(MyStoreObject) Then
  begin
    FMp3FileShort := MyStoreObject.FMp3FileShort;
    FSizeString   := MyStoreObject.FSize;
    FbitrateString:= MyStoreObject.FBitRate;
    FTimeString   := MyStoreObject.FTime;
    Exit;
  end;
 
  If FindFirst(Value, faAnyFile, diri) <> 0 Then
    Abort;
  FMp3FileShort := Diri.Name;
 
  FSize := diri.Size;
  FSizeString := IntToStr(Diri.size);
  FileMode := fmReadonly + fmDenyNone;
  System.Assign(f, Value);
  System.Reset(f, 1);
 
  z := 0;
  Result := SizeOf(buffer);
  buffer[0] := 0;
 
  While (z < 20480)               And
        (buffer[0] <> 255)        And
        (Result = SizeOf(buffer)) Do
  begin
    Seek(f, z);
    Inc(z);
    System.BlockRead(f, buffer, SizeOf(buffer), Result);
  end;
 
  System.Seek(f, FileSize(f) - 128);
  System.BlockRead(f, tag, SizeOf(tag));
  System.Close(f);
  {$I+}
  If IOResult <> 0 Then;
  If buffer[0] <> 255 Then
  begin
    FTimeString :='';
    FmpegTypeString :='';
    FLayerString :='';
    FbitrateString :='';
    FSampleRateString :='';
    FChannelModeString :='';
  end
  Else
  begin
    Flayer := 0;
    If isbitset(buffer[1], 1) Then Flayer := 1;
    If isbitset(buffer[1], 2) Then Flayer := Flayer + 2;
    Flayer := 4 - Flayer;
    Fbitrate := 0;
    If isbitset(buffer[2], 4) Then Fbitrate := 1;
    If isbitset(buffer[2], 5) Then Fbitrate := Fbitrate + 2;
    If isbitset(buffer[2], 6) Then Fbitrate := Fbitrate + 4;
    If isbitset(buffer[2], 7) Then Fbitrate := Fbitrate + 8;
    Fsampfreq := 0;
    If isbitset(buffer[2], 2) Then Fsampfreq :=1;
    If isbitset(buffer[2], 3) Then Fsampfreq := Fsampfreq + 2;
    Fversion := 0;
    If isbitset(buffer[1], 2) Then Fversion := 1;
    If isbitset(buffer[1], 3) Then Fversion := Fversion + 2;
    Case Fversion Of
      2 : Fversion :=0;
      3 : Fversion :=1;
      0 : Fversion :=2;
     Else Fversion :=4; 
    end;
 
    Fmode :=0;
    If isbitset(buffer[3],6) Then
      Fmode := 1;
    If isbitset(buffer[3],7) Then
     Fmode := Fmode + 2;
    If cBITRATES[Fversion][Flayer - 1][Fbitrate] <> 0 Then
    begin
      Ftime := Fsize Div (cBITRATES[Fversion][Flayer - 1][Fbitrate]*125);
      FTimeString := IntToStr(Ftime Div 60) + ' : ' + leadingzero(Ftime Mod 60);
    end
    Else
      FTimeString :='';
 
    FmpegTypeString   := cVERSION_NAMES[Fversion];
    FlayerString      := cLAYER_NAMES[Flayer - 1];
    FbitrateString    := IntToStr(cBITRATES[Fversion][Flayer - 1][Fbitrate]);
    FSampleRateString := IntToStr(cSFREQ[Fversion][Fsampfreq]);
    FChannelModeString:= cMODE_NAMES[Fmode];
  end;
  If tag.id <> 'TAG' Then
  begin
    FTagsongname:= '';
    FTagArtist  := '';
    FTagAlbum   := '';
    FTagYear    := '';
    FTagComment := '';;
    FTaggenre   := 80;
  end
  Else
  begin
    FTagsongname:= TrimRight(tag.Songname);
    FTagArtist  := TrimRight(tag.Artist);
    FTagAlbum   := TrimRight(tag.Album);
    FTagYear    := TrimRight(tag.Year);
    FTagComment := TrimRight(tag.Comment);
    FTaggenre   := tag.genre;
    If Ftaggenre > 80 Then
      Ftaggenre := 80;
  end;
 
  myStoreObject :=TStoreObject.Create(TheBuffer);
  MyStoreObject.FMp3FileShort := FMp3FileShort;
  MyStoreObject.FSize := FSizeString;
  MyStoreObject.FBitRate := FbitrateString;
  MyStoreObject.FTime := FTimeString;
  thebuffer.SetStoreObject(FMp3File, MyStoreObject);
end;
 
{ TBuffer }
 
constructor TBuffer.Create(aOwner: Tcomponent);
begin
  inherited;
  //---
  FStoreList := TStringList.Create;
  FStoreList.Sorted := True;
end;
 
destructor TBuffer.Destroy;
Var
  i : Integer;
begin
  For i := 0 To (FStoreList.Count - 1) Do
    FStoreList.Objects[i].Free;
  FStoreList.Free;
  //---
  inherited;
end;
 
function TBuffer.GetStoreObject(aFileName: String): TStoreObject;
Var
  idx : Integer;
begin
  If FStoreList.Find(aFileName, idx) Then
    Result := TStoreObject(FStoreList.Objects[idx])
  Else
    Result := Nil;
end;
 
procedure TBuffer.SetStoreObject(aFileName: String; aStoreObject: TStoreObject);
begin
  FStoreList.AddObject(aFileName, aStoreObject);
end;
 
initialization
  TheBuffer := TBuffer.Create(Application);
finalization
  TheBuffer.Free;
end.

Saludos!