{******************************************************************************************}
{* mpegAudioDuration: Extract play duration from MPEG-1 and MPEG-2 (MPEG-2.5) audio files *}
{******************************************************************************************}

unit mpegAudioDuration;

// To get the play duration of a .mp1, .mp2, or .mp3 file, just call the procedure "GetMpegAudioDuration"
// Input:  The name of the file, and the time unit ('s', 'm', 'h')
// Output: The play duration (as real number, and as formatted string), and a return code <> 0, if there was an error or other problem

interface

uses
  SysUtils;

type
  TBit = 0..1;
  TBits = array of TBit;

procedure GetMpegAudioDuration(Filename: string; TimeUnit: Char; out PlayDuration: Real; out SPlayDuration: string; out ErrCode: Integer);
function MpegAudioErrorMessage(ErrCode: Integer): string;

implementation

{ Bytes to bits transformation }

function GetBits(Bytes: TBytes): TBits;

// The function takes as input an array of byte values and for each element creates 8 elements of the TBits output array

var
  Pow2, I, J: Integer;
  Byt: Byte;
  Bits: TBits;

begin
  SetLength(Bits, 8 * Length(Bytes));                                          // 1 byte = 8 bits
  for J := 0 to Length(Bits) - 1 do
    Bits[J] := 0;
  J := 0;
  for I := 0 to Length(Bytes) do begin
    // For each byte, element of the input array
    Byt := Bytes[I]; Pow2 := 128;
    // Transform byte to 8 bits (pushed into TBits output array)
    repeat
      if Byt >= Pow2 then begin
        Bits[J] := 1;
        Byt -= Pow2;
      end;
      Inc(J);
      Pow2 := Pow2 div 2;
    until Pow2 = 0;
    Result := Bits;
  end;
end;

{ Read MPEG Audio frame header information (result as a TBits array) }

procedure GetMpegAudioFHBits(Filename: string; out HeaderBits: TBits; out ErrCode: Integer);

// Parse the MPEG Audio file to find frame header. Read the 4 header bytes, transform bytes to bits (stored in output TBits array)

var
  I: Integer;
  FileExt, BitStream: string;
  Found, EndRead: Boolean;
  FileBytes, BitStreamBytes, HeaderBytes: TBytes;
  FileBits: TBits;
  MpegFile: file of Byte;

begin
  SetLength(FileBytes, 2); SetLength(BitStreamBytes, 4); SetLength(HeaderBytes, 4);
  SetLength(FileBits, 16); SetLength(HeaderBits, 0);
  ErrCode := 0;
  // Proceed if file exists
  if FileExists(Filename) then begin
    FileExt := ExtractFileExt(Filename);
    // Accept MPEG audio files only
    if (FileExt = '.mp1') or (FileExt = '.mp2') or (FileExt = '.mp3') then begin
      Assign(MpegFile, Filename);
      {$I-}
      Reset(MpegFile);
      {$I+}
      // Proceed if file is readable
      if IOResult = 0 then begin
        // Consider files with size < 100 bytes as invalid MPEG audio files
        if FileSize(MpegFile) >= 100 then begin
          // Try to find the bitstream header (Info or Xing). If "Info" is found, it's sure that the file is constant
          // bitrate. Otherwise, variable bitrate is possible and bitrate and duration values may be incorrect. If
          // "Info" is not found, the procedure returns a negative error code (corresponding to a warning message text).
          for I := 0 to 3 do
            Read(MpegFile, BitStreamBytes[I]);
          Found := False; EndRead := False;
          while not EndRead and not Found do begin
            BitStream := '';
            for I := 0 to 3 do
              BitStream += Chr(BitStreamBytes[I]);
            if (BitStream = 'Info') or (BitStream = 'Xing') then
              Found := True
            else begin
              if FilePos(MpegFile) >= 8500 then                                // suppose that bitstream header is somewhere in first 8500 bytes
                EndRead := True
              else begin
                BitStreamBytes[0] := BitStreamBytes[1];
                BitStreamBytes[1] := BitStreamBytes[2];
                BitStreamBytes[2] := BitStreamBytes[3];
                Read(MpegFile, BitStreamBytes[3]);
                if EoF(MpegFile) then
                  EndRead := True;
              end;
            end;
          end;
          if not Found then
            BitStream := '';
          // Search for (first) frame header and if found, extract 32-bits information
          Seek(MpegFile, 0);                                                   // start at beginning of file
          Found := False; EndRead := False;
          Read(MpegFile, FileBytes[0]); Read(MpegFile, FileBytes[1]);
          while not EndRead and not Found do begin
            FileBits := GetBits(FileBytes);
            Found := True;
            // Check if begin of actual 2 bytes read is frame sync data: 11 bits, that must all be '1'
            for I := 0 to 10 do begin
              if FileBits[I] <> 1 then
                Found := False;                                                // if one of these bits is '0', these 2 bytes are not start of frame header
            end;
            // If frame header not found, continue reading the file byte by byte
            // Stop operation (suppose "no frame header found") if the 11 '1' bits have not been found in the first MB of the file
            if not Found then begin
              if FilePos(MpegFile) >= 100000 then
                EndRead := True
              else begin
                FileBytes[0] := FileBytes[1];
                Read(MpegFile, FileBytes[1]);
                if EoF(MpegFile) then
                  EndRead := True
              end;
            end;
          end;
          // If the sync bits, have been found (= first 2 bytes of header), read two further bytes to get the complete 32-bits header
          if Found then begin
            HeaderBytes[0] := FileBytes[0]; HeaderBytes[1] := FileBytes[1];
            if EoF(MpegFile) then
              ErrCode := 5
            else begin
              Read(MpegFile, HeaderBytes[2]);                                  // 3rd byte of frame header
              if EoF(MpegFile) then
                ErrCode := 5
              else begin
                Read(MpegFile, HeaderBytes[3]);                                // 4th byte of frame header
                SetLength(Headerbits, 32);
                HeaderBits := GetBits(HeaderBytes);                            // transform the 4 bytes to 32 bits (TBits value returned by the sub)
              end;
            end;
          end
          else begin
            // No frame header found
            ErrCode := 5;
          end;
        end
        else begin
          // File size < 100 bytes (-> Invalid MPEG file message)
          ErrCode := 4;
        end;
        Close(MpegFile);
      end
      else begin
        // Could not open the file for read
        ErrCode := 3;
      end;
    end
    else begin
      // File extension is different from .mp1, .mp2 and .mp3
      ErrCode := 2;
    end;
  end
  else begin
    // File does not exist
    ErrCode := 1;
  end;
  // If there is no error, check if the "Info" of the bitstream header has been found
  // If not return a negative error code (-> warning, that file may be VBR)
  if ErrCode = 0 then begin
    if BitStream = '' then
      ErrCode := -1
    else if Bitstream = 'Xing' then
      ErrCode := -2;
  end;
end;

{ Get MPEG Audio file's bitrate (in kbps) }

function MpegAudioBitrate(HeaderBits: TBits): Integer;

var
  V, L, B: Integer;
  Bitrate: Integer;

begin
  V := HeaderBits[11] * 2 + HeaderBits[12];
  L := HeaderBits[13] * 2 + HeaderBits[14];
  B := HeaderBits[16] * 8 + HeaderBits[17] * 4 + HeaderBits[18] * 2 + HeaderBits[19];
  if (V = 3) and (L = 3) then begin
    // Version 1, layer 1
    case B of
       0: Bitrate := 0;                                                        // free format
       1: Bitrate := 32;
       2: Bitrate := 64;
       3: Bitrate := 96;
       4: Bitrate := 128;
       5: Bitrate := 160;
       6: Bitrate := 192;
       7: Bitrate := 224;
       8: Bitrate := 256;
       9: Bitrate := 288;
      10: Bitrate := 320;
      11: Bitrate := 352;
      12: Bitrate := 384;
      13: Bitrate := 416;
      14: Bitrate := 448;
      15: Bitrate := -1;                                                       // bad (unallowed value)
    end;
  end
  else if (V = 3) and (L = 2) then begin
    // Version 1, layer 2
    case B of
       0: Bitrate := 0;
       1: Bitrate := 32;
       2: Bitrate := 48;
       3: Bitrate := 56;
       4: Bitrate := 64;
       5: Bitrate := 80;
       6: Bitrate := 96;
       7: Bitrate := 112;
       8: Bitrate := 128;
       9: Bitrate := 160;
      10: Bitrate := 192;
      11: Bitrate := 224;
      12: Bitrate := 256;
      13: Bitrate := 320;
      14: Bitrate := 384;
      15: Bitrate := -1;
    end;
  end
  else if (V = 3) and (L = 1) then begin
    // Version 1, layer 3
    case B of
       0: Bitrate := 0;
       1: Bitrate := 32;
       2: Bitrate := 40;
       3: Bitrate := 48;
       4: Bitrate := 56;
       5: Bitrate := 64;
       6: Bitrate := 80;
       7: Bitrate := 96;
       8: Bitrate := 112;
       9: Bitrate := 128;
      10: Bitrate := 160;
      11: Bitrate := 192;
      12: Bitrate := 224;
      13: Bitrate := 256;
      14: Bitrate := 320;
      15: Bitrate := -1;
    end;
  end
  else if ((V = 2) or (V = 0)) and (L = 3) then begin
    // Version 2/2.5, layer 1
    case B of
       0: Bitrate := 0;
       1: Bitrate := 32;
       2: Bitrate := 48;
       3: Bitrate := 56;
       4: Bitrate := 64;
       5: Bitrate := 80;
       6: Bitrate := 96;
       7: Bitrate := 112;
       8: Bitrate := 128;
       9: Bitrate := 144;
      10: Bitrate := 160;
      11: Bitrate := 176;
      12: Bitrate := 192;
      13: Bitrate := 224;
      14: Bitrate := 256;
      15: Bitrate := -1;
    end;
  end
  else if ((V = 2) or (V = 0)) and ((L = 2) or (L = 1)) then begin
    // Version 2/2.5, layer 2 & 3
    case B of
       0: Bitrate := 0;
       1: Bitrate := 8;
       2: Bitrate := 16;
       3: Bitrate := 24;
       4: Bitrate := 32;
       5: Bitrate := 40;
       6: Bitrate := 48;
       7: Bitrate := 56;
       8: Bitrate := 64;
       9: Bitrate := 80;
      10: Bitrate := 96;
      11: Bitrate := 112;
      12: Bitrate := 128;
      13: Bitrate := 144;
      14: Bitrate := 160;
      15: Bitrate := -1;
    end;
  end;
  Result := Bitrate;
end;

{ Get MPEG Audio play duration (in seconds) }

procedure MpegAudioDuration(HeaderBits: TBits; FSize: LongInt; out Duration, ErrCode: Integer);

var
  Bitrate: Integer;

begin
  Duration := 0; ErrCode := 0;
  Bitrate := MpegAudioBitrate(HeaderBits);
  if Bitrate = 0 then
    ErrCode := 6
  else if Bitrate = -1 then
    ErrCode := 7                                                               // can't calculate duration for free format (0) or bad bitrate (-1)
  else
    Duration := Round(((FSize / 1000) * 8) / Bitrate);
end;

{ Determine MPEG audio file play duration) }

procedure GetMpegAudioDuration(Filename: string; TimeUnit: Char; out PlayDuration: Real; out SPlayDuration: string; out ErrCode: Integer);

var
  Duration, D, ErrCode2: Integer;
  FSize: LongInt;
  HH, MM, SS: string;
  HeaderBits: TBits;
  MpegFile: file of Byte;

begin
  PlayDuration := 0; SPlayDuration := ''; ErrCode := 0;
  // Read MPEG Audio frame header information
  GetMpegAudioFHBits(Filename, HeaderBits, ErrCode);
  // Proceed if a frame header has been found
  if ErrCode <= 0 then begin
    // Determine the file size
    Assign(MpegFile, Filename); Reset(MpegFile);                               // you must open the file, to use the FileSize function
    FSize := FileSize(MpegFile); Close(MpegFile);
    // Calculate play duration (in seconds)
    MpegAudioDuration(HeaderBits, FSize, Duration, ErrCode2);
    if ErrCode2 <> 0 then
      ErrCode := ErrCode2
    else begin
      // Transform play duration to unit wanted
      case TimeUnit of
        's': PlayDuration := Duration;
        'm': PlayDuration := Duration / 60;
        'h': PlayDuration := Duration / 3600;
      end;
      // Create 'HH:MM:SS' duration string
      if Duration >= 3600 then begin
        D := Duration div 3600; Duration := Duration mod 3600;
        HH := IntToStr(D);
        if D < 10 then
          HH := '0' + HH;
      end
      else
        HH := '00';
      if Duration >= 60 then begin
        D := Duration div 60; Duration := Duration mod 60;
        MM := IntToStr(D);
        if D < 10 then
          MM := '0' + MM;
      end
      else
        MM := '00';
      SS := IntToStr(Duration);
      if Duration < 10 then
        SS := '0' + SS;
      SPlayDuration := HH + ':' + MM + ':' + SS;
    end;
  end;
end;

{ Get mpegAudioFH error message (for given mpegAudioFH error code) }

function MpegAudioErrorMessage(ErrCode: Integer): string;

var
  ErrMess: string;

begin
  ErrMess := '';
  if ErrCode <> 0 then begin
    case ErrCode of
     -1: ErrMess := 'File may be VBR format (no header ID found)';
     -2: ErrMess := 'File is (probably) VBR format (file includes a Xing header ID)';
      0: ErrMess := 'Calculation successful';
      1: ErrMess := 'File not found';
      2: ErrMess := 'Invalid file type';
      3: ErrMess := 'File access denied';
      4: ErrMess := 'Invalid MPEG file';
      5: ErrMess := 'No frame header found';
      6: ErrMess := 'Free format bitrate';
      7: ErrMess := 'Invalid bitrate';
      else ErrMess := 'Unknown error';
    end;
  end;
  Result := ErrMess;
end;

end.