⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mmcdinfo.pas

📁 一套及时通讯的原码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
             aPath := CheckPath(StrPas(aBuf),True);
          end;
          FIniFileName := aPath+aName;
          if Not (csDesigning in ComponentState) then
          begin
             FIniFile.Free;
             {$IFNDEF DELPHI2}
             FIniFile := TBigIniFile.Create(FIniFileName);
             {$ELSE}
             FIniFile := TIniFile.Create(FIniFileName);
             {$ENDIF}
             CreateNewDisc;
          end;
     end;

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

{-- TMMCDInfo ------------------------------------------------------------}
function TMMCDInfo.HasDiskInserted: Boolean;
const
{$IFNDEF WIN32}
     { MCI extensions for CD audio devices }
     { flags for the dwItem field of the MCI_STATUS_PARMS parameter block }
     MCI_CDA_STATUS_TYPE_TRACK = $00004001;
     { flags for the dwReturn field of MCI_STATUS_PARMS parameter block }
     { MCI_STATUS command, (dwItem == MCI_CDA_STATUS_TYPE_TRACK) }
     MCI_CDA_TRACK_AUDIO = (MCI_CD_OFFSET + 0);
     MCI_CDA_TRACK_OTHER = (MCI_CD_OFFSET + 1);
{$ELSE}
     { flags for the dwItem field of the MCI_STATUS_PARMS parameter block }
     { BUGBUG: Borland has it not right declared !!! :-(                     }
     MCI_CDA_STATUS_TYPE_TRACK = $00004001;
{$ENDIF}

Var
  StatusParm: TMCI_Status_Parms;
  Flags     : LongInt;

begin
     Result := False;
     if assigned(FPlayer) And (FPlayer.DeviceID <> 0) then
     begin
          Flags := MCI_STATUS_ITEM;
          FillChar(StatusParm, SizeOf(TMCI_Status_Parms), 0);
          StatusParm.dwItem := MCI_STATUS_MEDIA_PRESENT;
          mciSendCommand(FPlayer.DeviceID, MCI_STATUS, Flags, Longint(@StatusParm));
          Result := (StatusParm.dwReturn > 0);

          if Result then
          {$IFNDEF WIN32}
          if _Win9x_ or _WinNT3_ or _WinNT4_ then
          {$ENDIF}
          begin
               Flags := MCI_STATUS_ITEM  OR MCI_Track;
               FillChar(StatusParm, SizeOf(TMCI_Status_Parms), 0);
               StatusParm.dwItem := MCI_CDA_STATUS_TYPE_TRACK;
               StatusParm.dwTrack := 1;
               mciSendCommand(FPlayer.DeviceID, MCI_STATUS, Flags, Longint(@StatusParm));
               Result := (StatusParm.dwReturn = MCI_CDA_TRACK_AUDIO);
          end;
     end;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.GenerateDiscID;
Var
   i        : integer;
   oldTime  : TMPTimeFormats;
   TrackPos : Longint;
   Result   : Longint;

begin
    { Result is our ID number }
    Result := 0;
    if assigned(FPlayer) And (FPlayer.DeviceID <> 0) then
    begin
        { save the current TimeFormat }
        oldTime := FPlayer.TimeFormat;

        { Set the time format to MSF. }
        FPlayer.TimeFormat := tfMSF;

        { here's the beef. }
        for i := 1 to FPlayer.Tracks do
        begin
            { get the starting position of each track. }
            TrackPos := FPlayer.TrackPosition[i];

  	    { Several macros used in an unorthodox method, }
            { to generate a quasi-random number            }
            inc(Result, MCI_MAKE_MSF(MCI_MSF_FRAME(TrackPos),
                                     MCI_MSF_SECOND(TrackPos),
                                     MCI_MSF_MINUTE(TrackPos)));
        end;

        { If the number of tracks is less than three, }
        { you need to add the disc length in frames   }
        if (FPlayer.Tracks < 3) then inc(Result, MSFToFrames(FPlayer.Length));

        { restore the old TimeFormat }
        FPlayer.TimeFormat := oldTime;

        { convert to hex string }
        FDisc_ID := Format('%x', [Result]);
    end;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.SetDiskID(aValue: string);
begin
   if (aValue <> '') then
   begin
      if (aValue <> FDisc_ID) then
      begin
         FDisc_ID := aValue;
         ParseIniFile;         { search the disc  }
      end;
   end
   else
   begin
      FDisc_ID := LoadResStr(IDS_CDNODISC);
   end;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.CreateNewDisc;
var
   i: integer;
begin
    if assigned(FPlayer) And (FPlayer.DeviceID <> 0) then
    begin
         FEntryType := 1;
         FArtist    := LoadResStr(IDS_CDARTIST);
         FTitle     := LoadResStr(IDS_CDTITLE);
         FNumTracks := FPlayer.Tracks;
         NumPlay := FNumTracks;
         FTracks.Clear;

         for i := 0 to FNumTracks-1 do
         begin
              FTracks.Add(LoadResStr(IDS_CDTRACK) + ' ' + IntToStr(i+1));
              FOrder^[i] := i;
         end;
     end
     else if (FTracks <> nil) then
     begin
        FEntryType := 1;
        FArtist    := LoadResStr(IDS_CDARTIST);
        FTitle     := LoadResStr(IDS_CDTITLE);
        FNumTracks := 0;
        NumPlay    := 0;
        FTracks.Clear;
     end;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.ParseIniFile;
Var
   aStr: String;
   i: integer;

begin
     if assigned(FIniFile) then
     with FIniFile do
     begin
          CreateNewDisc;

          {$IFDEF WIN32}
          {$IFDEF TRIAL}
          {$DEFINE _HACK3}
          {$I MMHACK.INC}
          {$ENDIF}
          {$ENDIF}

          i := ReadInteger(FDisc_ID, INI_ENTRYTYPE, 1);
          { is the disc allready in list ? }
          if (i = 1) then
          begin
               FEntryType := i;
               FArtist := ReadString(FDisc_ID, INI_ARTIST, FArtist);
               FTitle  := ReadString(FDisc_ID, INI_TITLE, FTitle);

               FNumTracks := ReadInteger(FDisc_ID, INI_NUMTRACKS, FNumTracks);
               for i := 0 to FNumTracks-1 do
               begin
                  if (i < FTracks.Count) then
                      aStr := FTracks[i]
                  else
                      aStr := LoadResStr(IDS_CDTRACK) + ' ' + IntToStr(i+1);

                  aStr := ReadString(FDisc_ID, IntToStr(i), aStr);

                  if (i < FTracks.Count) then
                      FTracks[i] := aStr
                  else
                      Ftracks.Add(aStr);
               end;
               NumPlay := ReadInteger(FDisc_ID, INI_NUMPLAY, FNumPlay);
               aStr := ReadString(FDisc_ID, INI_ORDER, '');
               if aStr <> '' then
               begin
                  aStr := aStr + ' ';
                  for i := 0 to FNumPlay-1 do
                  begin
                       try
                          FOrder^[i] := StrToInt(Copy(aStr,1,Pos(' ',aStr)-1));
                          Delete(aStr, 1, Pos(' ',aStr));
                       except
                          On Exception do FOrder^[i] := i;
                       end;

                       if (FOrder^[i] < 0) or (FOrder^[i] > FNumTracks) then
                          FOrder^[i] := i;
                  end;
               end;
          end;
     end;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.SaveInfo;
Var
   i: integer;
   SaveTracks: Boolean;
   aStr: String;

begin
     if assigned(FIniFile) And (FDisc_ID <> LoadResStr(IDS_CDNODISC)) then
     with FIniFile do
     begin
          EraseSection(FDisc_ID);

          WriteInteger(FDisc_ID, INI_ENTRYTYPE, FEntryType);
          WriteString(FDisc_ID, INI_ARTIST, FArtist);
          WriteString(FDisc_ID, INI_TITLE, FTitle);
          WriteInteger(FDisc_ID, INI_NUMTRACKS, FNumTracks);

          SaveTracks := False;
          for i := 0 to FNumTracks-1 do
              if FTracks[i] <> LoadResStr(IDS_CDTRACK) + ' ' + IntToStr(i+1) then
              begin
                   SaveTracks := True;
                   break;
              end;

          if SaveTracks then
               for i := 0 to FNumTracks-1 do
               begin
                   aStr := FTracks[i];
                   WriteString(FDisc_ID, IntToStr(i), aStr);
               end;

          aStr := '';
          for i := 0 to FNumPlay-1 do
              aStr := aStr + IntToStr(FOrder^[i]) + ' ';

          WriteString(FDisc_ID, INI_ORDER, aStr);
          WriteInteger(FDisc_ID, INI_NUMPLAY, FNumPlay);
     end;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.SetArtist(aValue: TMMCDInfoStr);
begin
     if (aValue <> FArtist) then
        FArtist := aValue;
end;

{-- TMMCDInfo ------------------------------------------------------------}
function TMMCDInfo.GetArtist: TMMCDInfoStr;
begin
     Result := FArtist;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.SetTitle(aValue: TMMCDInfoStr);
begin
     if (aValue <> FTitle) then
        FTitle := aValue;
end;

{-- TMMCDInfo ------------------------------------------------------------}
function TMMCDInfo.GetTitle: TMMCDInfoStr;
begin
     Result := FTitle;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.SetTracks(aValue: TStrings);
begin
     if (aValue <> FTracks) then
     begin
          FTracks.assign(aValue);
     end;
end;

{-- TMMCDInfo ------------------------------------------------------------}
function TMMCDInfo.GetTracks: TStrings;
begin
     Result := FTracks;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.SetNumPlay(aValue: Byte);
begin
     if (aValue <> FNumPlay) then
     begin
          FNumPlay := aValue;
          if (FOrder <> Nil) then
          begin
             GLobalFreePtr(FOrder);
             FOrder := Nil;
          end;
          if (FNumPlay > 0) then
             FOrder := GlobalAllocPtr(GHND, FNumPlay * sizeOf(Byte));
     end;
end;

{-- TMMCDInfo ------------------------------------------------------------}
function TMMCDInfo.GetNumPlay: Byte;
begin
     Result := FNumPlay;
end;

{-- TMMCDInfo ------------------------------------------------------------}
procedure TMMCDInfo.SetPlayOrder(aPosition: Byte; aValue: Byte);
begin
     if (aValue <> FOrder^[aPosition]) and (aPosition < FNumPlay) then
        FOrder^[aPosition] := aValue;
end;

{-- TMMCDInfo ------------------------------------------------------------}
function TMMCDInfo.GetPlayOrder(aPosition: Byte): Byte;
begin
     Result := 0;
     if (FNumPlay > 0) And (aPosition < FNumPlay) then
        Result := FOrder^[aPosition];
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -