mmcdinfo.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]               =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/index.html               =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 22.12.98 - 12:07:52 $                                        =}
{========================================================================}
unit MMCDInfo;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Messages,
    Classes,
    Graphics,
    Controls,
    ExtCtrls,
    Forms,
    Dialogs,
{$IFNDEF DELPHI2}
    MMBigIni,
{$ELSE}
    Inifiles,
{$ENDIF}
    MMSystem,
    MPlayer,
    MMObj,
    MMUtils;

type
  TMMCDInfoStr   = String[100];
  PMMCDInfoOrder = ^TMMCDInfoOrder;
  TMMCDInfoOrder = array[0..0] of Byte;

  {-- TMMCDInfo ----------------------------------------------------------}
  TMMCDInfo = class(TMMNonVisualComponent)
  private
    FInterval   : integer;
    FEnabled    : Boolean;
    FDoorOpen   : Boolean;
    FNotReady   : Boolean;
    FIniFileName: TFileName;

    FDisc_ID    : String;
    FEntryType  : Byte;
    FArtist     : TMMCDInfoStr;
    FTitle      : TMMCDInfoStr;
    FNumTracks  : Byte;
    FTracks     : TStringList;
    FOrder      : PMMCDInfoOrder;
    FNumPlay    : Byte;

    FNumdevs    : integer;	     { Num. of cd devices on system   }
    FProductName: String;

    {$IFNDEF DELPHI2}
    FIniFile    : TBigIniFile;
    {$ELSE}
    FIniFile    : TIniFile;
    {$ENDIF}
    FPlayer     : TMediaPlayer;
    FTimer      : TTimer;

    { Events }
    FOnTimer    : TNotifyEvent;
    FOnDoorOpen : TNotifyEvent;
    FOnDoorClose: TNotifyEvent;
    FOnReady    : TNotifyEvent;

    procedure SetProductName(Name: String);
    procedure SetInterval(aValue: integer);
    procedure SetEnabled(aValue: Boolean);
    procedure SetIniFileName(aValue: TFileName);
    procedure SetArtist(aValue: TMMCDInfoStr);
    function  GetArtist: TMMCDInfoStr;
    procedure SetTitle(aValue: TMMCDInfoStr);
    function  GetTitle: TMMCDInfoStr;
    procedure SetTracks(aValue: TStrings);
    function  GetTracks: TStrings;
    procedure SetNumPlay(aValue: Byte);
    function  GetNumPlay: Byte;
    procedure SetPlayOrder(aPosition: Byte; aValue: Byte);
    function  GetPlayOrder(aPosition: Byte): Byte;
    procedure SetDiskID(aValue: string);
    procedure GenerateDiscID;
    procedure CreateNewDisc;
    procedure ParseIniFile;
    function  HasDiskInserted: Boolean;
    procedure TimerExpired(Sender: TObject);

  protected
    procedure Ready; dynamic;
    procedure DoorOpen; dynamic;
    procedure DoorClose; dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  public
    constructor Create(AOwner:TComponent); override;
    destructor  Destroy; override;

    procedure SaveInfo;
    property  DiscID: string read FDisc_ID write SetDiskID;
    property  Artist: TMMCDInfoStr read GetArtist write SetArtist;
    property  Title: TMMCDInfoStr read GetTitle write SetTitle;
    property  Tracks: TStrings read GetTracks write SetTracks;
    property  NumTracks: Byte read FNumTracks;
    property  NumPlay: Byte read GetNumPlay write SetNumPlay;
    property  PlayOrder[Position: Byte]: Byte read GetPlayOrder write SetPlayOrder;

    property  Numdevs: integer read FNumdevs;

  published
    { Events }
    property OnTimer    : TNotifyEvent read FOnTimer write FOnTimer;
    property OnReady    : TNotifyEvent read FOnReady write FOnReady;
    property OnDoorOpen : TNotifyEvent read FOnDoorOpen write FOnDoorOpen;
    property OnDoorClose: TNotifyEvent read FOnDoorClose write FOnDoorClose;

    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: integer read FInterval write SetInterval default 500;
    property Player: TMediaPlayer read FPlayer write FPlayer;
    property IniFile: TFileName read FIniFileName write SetIniFileName;
    property ProductName: String read FProductName write SetProductName stored False;
end;

function MSFToFrames(MSF: Longint): Longint;
function TMSF2Second(aTMSF: Longint): Longint;
function MSF2Second(aMSF: Longint): Longint;

implementation

uses MMString;

const
  INI_ARTIST    = 'artist';
  INI_ENTRYTYPE = 'EntryType';
  INI_TITLE     = 'title';
  INI_NUMTRACKS = 'numtracks';
  INI_ORDER     = 'order';
  INI_NUMPLAY   = 'numplay';

{-------------------------------------------------------------------------}
function MSFToFrames(MSF: Longint): Longint;
begin
     Result := MCI_MSF_FRAME(MSF);
     Result := Result + 75 * MCI_MSF_SECOND(MSF);
     Result := Result + 75 * 60 * MCI_MSF_MINUTE(MSF);
end;

{-------------------------------------------------------------------------}
function TMSF2Second(aTMSF: Longint): Longint;
begin
     Result := MCI_TMSF_Minute(aTMSF)*60+MCI_TMSF_Second(aTMSF);
end;

{-------------------------------------------------------------------------}
function MSF2Second(aMSF: Longint): Longint;
begin
     Result := MCI_MSF_Minute(aMSF)*60+MCI_MSF_Second(aMSF);
end;

{-- TMMCDInfo ------------------------------------------------------------}
constructor TMMCDInfo.Create(AOwner: TComponent);
var
   Buf: array[0..MAX_PATH] of Char;
begin
     inherited Create(AOwner);

     FInterval := 500;
     FEnabled := True;
     FNotReady := True;
     FDoorOpen := False;

     FIniFileName := '';
     FOrder := Nil;
     FIniFile := Nil;
     FTimer := Nil;
     FPlayer := Nil;
     FDisc_ID := LoadResStr(IDS_CDNODISC);

     GetWindowsDirectory(Buf, sizeOf(Buf)-1);
     IniFile := CheckPath(StrPas(Buf),True)+'cdplayer.ini';

     (*FNumDevs := CDAudioGetNumDevs;
     FProductName := CDAudioGetINSTALLName(1);*)

     if Not (csDesigning in ComponentState) then
     begin
          FTracks := TStringList.Create;
          FTimer := TTimer.Create(Self);
          FTimer.OnTimer := TimerExpired;
          FTimer.Interval := FInterval;
          FTimer.Enabled := FEnabled;
     end;

     ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
     if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMCDInfo ------------------------------------------------------------}
destructor TMMCDInfo.Destroy;
begin
     if Not (csDesigning in ComponentState) then
     begin
          if (FOrder <> Nil) then GlobalFreePtr(FOrder);
          FTimer.Free;
          FTracks.Free;
          FIniFile.Free;
     end;
     inherited destroy;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.Notification(AComponent: TComponent; Operation: TOperation);
begin
   inherited Notification(AComponent, Operation);
   if (Operation = opRemove) and (AComponent = FPlayer) then
      FPlayer := Nil;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.SetProductName(Name: String);
begin
     { Dummy };
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.Ready;
begin
     FNotReady := False;
     if assigned(FOnReady) then FOnReady(Self);
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.DoorOpen;
begin
     FDoorOpen := True;
     FNotReady := True;
     if assigned(FOnDoorOpen) then FOnDoorOpen(Self);
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.DoorClose;
begin
     FDoorOpen := False;
     if assigned(FOnDoorClose) then FOnDoorClose(Self);
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.TimerExpired(Sender: TObject);
Var
   aMode: TMPModes;

begin
   if assigned(FPlayer) And (FPlayer.DeviceID <> 0) then
   begin
      aMode := FPlayer.Mode;

      if (aMode = mpOpen) AND (Not FDoorOpen) then DoorOpen
      else if (aMode <> mpOpen) AND (FDoorOpen) then DoorClose;

      if FNotReady then
      begin
         if HasDiskInserted then
         begin
            GenerateDiscID;       { calc the disc id }
            ParseIniFile;         { search the disc  }
            Ready;
         end
         else
         begin
            FDisc_ID := LoadResStr(IDS_CDNODISC);
         end;
      end;
   end;

   if assigned(FOnTimer) then FOnTimer(Self);
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.SetInterval(aValue: integer);
begin
     if (aValue <> FInterval) then
     begin
          FInterval := aValue;
          if Not (csDesigning in ComponentState) then
             FTimer.Interval := FInterval;
     end;

   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.SetEnabled(aValue: Boolean);
begin
     if (aValue <> FEnabled) then
     begin
          FEnabled := aValue;
          if Not (csDesigning in ComponentState) then
             FTimer.Enabled := FEnabled;
     end;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.SetIniFileName(aValue: TFileName);
Var
   aBuf: array[0..MAX_PATH] of Char;
   aName,aPath: string;
begin
     aName := ExtractFileName(aValue);
     aPath := ExtractFilePath(aValue);
     if (aValue <> FIniFileName) and (aName <> '') then
     begin
          if (aPath = '') then
          begin
             GetWindowsDirectory(aBuf,sizeOf(aBuf)-1);