[Back to SOUND SWAG index]  [Back to Main SWAG index]  [Original]

{ Copyright 1993 by Michael W. Armstrong.
                    2800 Skipwith Rd
                    Richmond, VA 23294

  Compuserve ID 72740, 1145
  This program is entered as Shareware.  If you find it useful, a small
  donation would be appreciated.  Feel free to incorporate the code into
  your own programs.
}

{  NOTE : The CD_Vars and CDUNIT_P are at the end of this code }


{$X+}
program CDPlay;

{$IfDef Windows}
{$C PRELOAD}
uses CD_Vars, CDUnit_P, WinCRT, WinProcs;
{$Else}
uses CD_Vars, CDUnit_P, CRT, Drivers;
{$EndIf}

Type
  TotPlayRec = Record
     Frames,
     Seconds,
     Minutes,
     Nada     : Byte;
  End;

Var
  GoodDisk : Boolean;
  SaveExit   : Pointer;
  OldMode    : Word;
  CurrentTrack,
  StartTrack,
  EndTrack   : Integer;
  TotPlay    : TotPlayRec;
  TrackInfo  : Array[1..99] of PAudioTrackInfo;

function LeadingZero(w: Word): String;
var s: String;
begin
  Str(w:0, s);
  LeadingZero := Copy('00', 1, 2 - Length(s)) + s;
end;


procedure DrawScreen;
Const TStr = '%03d:%02d';
      VStr = '%1d.%2d';
Var   FStr : PChar;
      NStr : String;
      Param: Array[1..2] of LongInt;
      Code : Integer;
begin
  WriteLn('CD ROM Audio Disk Player');
  WriteLn('Copyright 1992 by M. W. ARMSTRONG');
  Param[1] := MSCDEX_Version.Major;
  Param[2] := MSCDEX_Version.Minor;

{$IfDef Windows}
  wvsPrintf(FStr, VStr, Param);
{$Else}
  FormatStr(NStr, VStr, Param);
{$EndIf}

  WriteLn('MSCDEX Version ', NStr);
  Str(NumberOfCD, NStr);
  WriteLn('Number of CD ROM Drives is: '+Nstr);
  WriteLn('First CD Drive Letter is  : '+Chr(FirstCD+65));
  WriteLn('There are ' + LeadingZero(EndTrack - StartTrack + 1) + ' Tracks on this disk');
  Code := 1;
end;
{***********************************************************************}

{***********************************************************************}


procedure Setup;
Var
  LeadOut,
  StartP,
  TotalPlayTime    : LongInt;
  I     : Integer;
  A,B,C : LongInt;
  Track : Byte;
  EA    : Array[1..4] of Byte;
  SP,EP : LongInt;

Begin
  FillChar(AudioDiskInfo, SizeOf(AudioDiskInfo), #0);
  DeviceStatus;
  If Audio THEN
  Begin
    Audio_Disk_Info;
    TotalPlayTime := 0;
    LeadOut := AudioDiskInfo.LeadOutTrack;

    StartTrack := AudioDiskInfo.LowestTrack;
    EndTrack := AudioDiskInfo.HighestTrack;
    CurrentTrack := StartTrack;
    I := StartTrack-1;

    Repeat               { Checks if Audio Track or Data Track }
        Inc(I);
        Track := I;
        Audio_Track_Info(StartP, Track);
    Until (Track AND 64 = 0) OR (I = EndTrack);

    StartTrack := I;

    For I := StartTrack to EndTrack DO
      Begin
        Track := I;
        Audio_Track_Info(StartP, Track);
        New(TrackInfo[I]);
        FillChar(TrackInfo[I]^, SizeOf(TrackInfo[I]^), #0);
        TrackInfo[I]^.Track := I;
        TrackInfo[I]^.StartPoint := StartP;
        TrackInfo[I]^.TrackControl := Track;
      End;

    For I := StartTrack to EndTrack - 1 DO
        TrackInfo[I]^.EndPoint := TrackInfo[I+1]^.StartPoint;
    TrackInfo[EndTrack]^.EndPoint := LeadOut;

    For I := StartTrack to EndTrack DO
        Move(TrackInfo[I]^.EndPoint, TrackInfo[I]^.Frames, 4);

    TrackInfo[StartTrack]^.PlayMin := TrackInfo[StartTrack]^.Minutes;
    TrackInfo[StartTrack]^.PlaySec := TrackInfo[StartTrack]^.Seconds - 2;

    For I := StartTrack + 1 to EndTrack DO
      Begin
        EP := (TrackInfo[I]^.Minutes * 60) + TrackInfo[I]^.Seconds;
        SP := (TrackInfo[I-1]^.Minutes * 60) + TrackInfo[I-1]^.Seconds;
        EP := EP - SP;
        TrackInfo[I]^.PlayMin := EP DIV 60;
        TrackInfo[I]^.PlaySec := EP Mod 60;
      End;

    TotalPlayTime := AudioDiskInfo.LeadOutTrack - TrackInfo[StartTrack]^.StartPoint;
    Move(TotalPlayTime, TotPlay, 4);
  End;
end;

{***********************************************************************}


Begin
  Setup;
  If Audio THEN
  If Playing THEN
     StopAudio
  ELSE
     Begin
       StopAudio;
       Play_Audio(TrackInfo[StartTrack]^.StartPoint,
             TrackInfo[EndTrack]^.EndPoint);
       Audio_Status_Info;
       DrawScreen;
     End
  ELSE
      WriteLn('This is not an Audio CD');
  WriteLn('UPC Code is: ', UPC_Code);
end.

{ -----------------------------------   CUT HERE --------------------   }

Unit CD_Vars;

Interface

Type
  ListBuf    = Record
    UnitCode : Byte;
    UnitSeg,
    UnitOfs  : Word;
  end;
  VTOCArray  = Array[1..2048] of Byte;
  DriveByteArray = Array[1..128] of Byte;

  Req_Hdr    = Record
     Len     : Byte;
     SubUnit : Byte;
     Command : Byte;
     Status  : Word;
     Reserved: Array[1..8] of Byte;
  End;

Const
  Init       = 0;
  IoCtlInput = 3;
  InputFlush = 7;
  IOCtlOutput= 12;
  DevOpen    = 13;
  DevClose   = 14;
  ReadLong   = 128;
  ReadLongP  = 130;
  SeekCmd    = 131;
  PlayCD     = 132;
  StopPlay   = 133;
  ResumePlay = 136;

Type

  Audio_Play = Record
    APReq    : Req_Hdr;
    AddrMode : Byte;
    Start    : LongInt;
    NumSecs  : LongInt;
  end;

  IOControlBlock = Record
    IOReq_Hdr : Req_Hdr;
    MediaDesc : Byte;
    TransAddr : Pointer;
    NumBytes  : Word;
    StartSec  : Word;
    ReqVol    : Pointer;
    TransBlock: Array[1..130] OF Byte;
  End;

  ReadControl = Record
    IOReq_Hdr : Req_Hdr;
    AddrMode  : Byte;
    TransAddr : Pointer;
    NumSecs   : Word;
    StartSec  : LongInt;
    ReadMode  : Byte;
    IL_Size,
    IL_Skip   : Byte;
  End;

  AudioDiskInfoRec = Record
    LowestTrack    : Byte;
    HighestTrack   : Byte;
    LeadOutTrack   : LongInt;
  End;

  PAudioTrackInfo   = ^AudioTrackInfoRec;
  AudioTrackInfoRec = Record
    Track           : Integer;
    StartPoint      : LongInt;
    EndPoint        : LongInt;
    Frames,
    Seconds,
    Minutes,
    PlayMin,
    PlaySec,
    TrackControl    : Byte;
  end;

  MSCDEX_Ver_Rec = Record
    Major,
    Minor       : Integer;
  End;

  DirBufRec    = Record
     XAR_Len   : Byte;
     FileStart : LongInt;
     BlockSize : Integer;
     FileLen   : LongInt;
     DT        : Byte;
     Flags     : Byte;
     InterSize : Byte;
     InterSkip : Byte;
     VSSN      : Integer;
     NameLen   : Byte;
     NameArray : Array[1..38] of Char;
     FileVer   : Integer;
     SysUseLen : Byte;
     SysUseData: Array[1..220] of Byte;
     FileName  : String[38];
  end;

  Q_Channel_Rec = Record
    Control     : Byte;
    Track       : Byte;
    Index       : Byte;
    Minutes     : Byte;
    Seconds     : Byte;
    Frame       : Byte;
    Zero        : Byte;
    AMinutes    : Byte;
    ASeconds    : Byte;
    AFrame      : Byte;
  End;

Var
  AudioChannel   : Array[1..9] of Byte;
  RedBook,
  Audio,
  DoorOpen,
  DoorLocked,
  AudioManip,
  DiscInDrive    : Boolean;
  AudioDiskInfo  : AudioDiskInfoRec;
  DriverList     : Array[1..26] of ListBuf;
  NumberOfCD     : Integer;
  FirstCD        : Integer;
  UnitList       : Array[1..26] of Byte;
  MSCDEX_Version : MSCDEX_Ver_Rec;
  QChannelInfo   : Q_Channel_Rec;
  Busy,
  Playing,
  Paused         : Boolean;
  Last_Start,
  Last_End       : LongInt;
  DirBuf         : DirBufRec;

Implementation

Begin
  FillChar(DriverList, SizeOf(DriverList), #0);
  FillChar(UnitList, SizeOf(UnitList), #0);
  NumberOfCD  := 0;
  FirstCD  := 0;
  MSCDEX_Version.Major := 0;
  MSCDEX_Version.Minor := 0;
end.

{ -----------------------------------   CUT HERE --------------------   }

{$X+}

Unit CDUnit_P;

Interface

{Include the appropriate units.}

{$IfDef Windows}
{$C PRELOAD}
Uses Strings, WinCRT, WinDOS, WinProcs, SimRMI, CD_Vars;
{$EndIf}
{$IfDef DPMI}
Uses Strings, CRT, DOS, WinAPI, SimRMI, CD_Vars;
{$EndIf}
{$IfDef MSDOS}
Uses Strings, CRT, DOS, CD_Vars;
{$EndIf}

Var
  Drive   : Integer;  { Must set drive before all operations }
  SubUnit : Integer;

function File_Name(var Code : Integer) : String;

function Read_VTOC(var VTOC : VTOCArray;
                   var Index : Integer) : Boolean;

procedure CD_Check(var Code : Integer);

procedure Vol_Desc(Var Code : Integer;
                   var ErrCode : Integer);

procedure Get_Dir_Entry(PathName : String;
                        var Format, ErrCode : Integer);

procedure DeviceStatus;

procedure Audio_Channel_Info;

procedure Audio_Disk_Info;

procedure Audio_Track_Info(Var StartPoint : LongInt;
                           Var TrackControl : Byte);

procedure Audio_Status_Info;

procedure Q_Channel_Info;

procedure Lock(LockDrive : Boolean);

procedure Reset;

procedure Eject;

procedure CloseTray;

procedure Resume_Play;

procedure Pause_Audio;

procedure Play_Audio(StartSec, EndSec : LongInt);

function StopAudio : Boolean;

function Sector_Size(ReadMode : Byte) : Word;

function Volume_Size : LongInt;

function Media_Changed : Boolean;

function Head_Location(AddrMode : Byte) : LongInt;

procedure Read_Drive_Bytes(Var ReadBytes : DriveByteArray);

function UPC_Code : String;

Implementation

Const
  CarryFlag  = $0001;

Var
{$IfDef MSDOS}
  Regs       : Registers;
{$Else}
  Regs       :TRealModeRecord; { from SimRMI Unit }
{$EndIf}
  DOSOffset,
  DOSSegment,
  DOSSelector:Word;
  AllocateLong:Longint;
  IOBlock    : Pointer;


{$IfDef MSDOS}
{ standard DOS routines for segments and pointers }
function GetIOBlock(var Block : Pointer; Size : Word) : Boolean;
begin
  GetMem(Block, Size);
  DOSSegment := Seg(Block^);
  DOSOffset := Ofs(Block^);
  GetIOBlock := TRUE;
end;

function FreeIOBlock(var Block: Pointer) : Boolean;
begin
  FreeMem(Block, SizeOf(Block^));
  DOSSegment := 0;
  DOSSelector := 0;
  DOSOffset := 0;
  FreeIOBlock := TRUE;
end;

{$ELSE}

{ Get a block in DOS and set pointer values.  DOSSelector is used
  to access the block under protected mode.  DOSSegment accesses the
  block in real mode }

function GetIOBlock(var Block : Pointer; Size : Word) : Boolean;
begin
  AllocateLong:=GlobalDOSAlloc(Size); { enough extra room for string }
  If AllocateLong<>0 Then  {If allocation was successful...}
  Begin
     DOSSegment:=AllocateLong SHR 16;     {Get the real mode segment of the memory}
     DOSSelector:=AllocateLong AND $FFFF; {Get the protected mode selector of the memory}
     DOSOffset := 0;
     Block := Ptr(DOSSelector, 0);
     GetIOBlock := TRUE;
  End
  ELSE
     GetIOBlock := FALSE;
end;

{ Free the DOS block and dereference the pointer }

function FreeIOBlock(var Block: Pointer) : Boolean;
begin
  DOSSelector := GlobalDOSFree(DOSSelector);
  DOSSegment := 0;
  Block := NIL;
  FreeIOBlock := (DOSSelector = 0);
end;

{$EndIf}

procedure Clear_Regs;
begin
  FillChar(Regs, SizeOf(Regs), #0);
end;

procedure CD_Intr;
begin
  Regs.AH := $15;

{$IfDef MSDOS}
  Intr($2F, Regs);  { Call DOS normally }
{$Else}
  If NOT SimRealModeInt($2F,@Regs) Then    {Call DOS through the DPMI}
     Halt(100);
{$EndIf}
end;

procedure MSCDEX_Ver;
begin
  Clear_Regs;
  Regs.AL := $0C;
  Regs.BX := $0000;
  CD_Intr;
  MSCDEX_Version.Minor := 0;
  If Regs.BX = 0 Then
     MSCDEX_Version.Major := 1
  ELSE
     Begin
       MSCDEX_Version.Major := Regs.BH;
       MSCDEX_Version.Minor := Regs.BL;
     End;
end;

procedure Initialize;
begin
  NumberOfCD := 0;
  Clear_Regs;
  Regs.AL := $00;
  Regs.BX := $0000;
  CD_Intr;
  If Regs.BX <> 0 THEN
     Begin
       NumberOfCD := Regs.BX;
       FirstCD := Regs.CX;
       Clear_Regs;
       FillChar(DriverList, SizeOf(DriverList), #0);
       FillChar(UnitList, SizeOf(UnitList), #0);
       Regs.AL := $01;               { Get List of Driver Header Addresses }
       Regs.ES := Seg(DriverList);
       Regs.BX := Ofs(DriverList);
       CD_Intr;
       Clear_Regs;
       Regs.AL := $0D;               { Get List of CD-ROM Units }
       Regs.ES := Seg(UnitList);
       Regs.BX := Ofs(UnitList);
       CD_Intr;
       MSCDEX_Ver;
     End;
end;


function File_Name(var Code : Integer) : String;
Var
  FN : Pointer;
begin
  Clear_Regs;
  If NOT GetIOBlock(FN, 64) THEN
     Exit;
  FillChar(FN, SizeOf(FN), #0);
  Regs.AL := Code + 1;
{
       Copyright Filename     =  1
       Abstract Filename      =  2
       Bibliographic Filename =  3
}
  Regs.CX := Drive;
  Regs.ES := DOSSegment;
  Regs.BX := DOSOffset;
  CD_Intr;
  Code := Regs.AX;
  If (Regs.Flags AND CarryFlag) = 0 THEN
     File_Name := StrPas(FN)
  ELSE
     File_Name := '';
  FreeIOBlock(FN);
end;


function Read_VTOC(var VTOC : VTOCArray;
                   var Index : Integer) : Boolean;
{ On entry -
     Index = Vol Desc Number to read from 0 to ?
  On return
     Case Index of
            1    : Standard Volume Descriptor
            $FF  : Volume Descriptor Terminator
            0    : All others
}
var
  PVTOC : Pointer;

begin
  Clear_Regs;
  If NOT GetIOBlock(PVTOC, SizeOf(VTOCArray)) THEN
     Exit;
  FillChar(PVTOC^, SizeOf(PVTOC^), #0);
  Regs.AL := $05;
  Regs.CX := Drive;
  Regs.DX := Index;
  Regs.ES := DOSSegment;
  Regs.BX := DOSOffset;
  CD_Intr;
  Index := Regs.AX;
  Move(PVTOC^,VTOC, SizeOf(VTOC));
  If (Regs.Flags AND CarryFlag) = 0 THEN
     Read_VTOC := TRUE
  ELSE
     Read_VTOC := FALSE;
  FreeIOBlock(PVTOC);
end;

procedure CD_Check(var Code : Integer);
begin
  Clear_Regs;
  Regs.AL := $0B;
  Regs.BX := $0000;
  Regs.CX := Drive;
  CD_Intr;
  If Regs.BX <> $ADAD THEN
     Code := 2
  ELSE
     Begin
       If Regs.AX <> 0 THEN
          Code := 0
       ELSE
          Code := 1;
     End;
end;


procedure Vol_Desc(Var Code : Integer;
                   var ErrCode : Integer);

  function Get_Vol_Desc : Byte;
    begin
      Clear_Regs;
      Regs.CX := Drive;
      Regs.AL := $0E;
      Regs.BX := $0000;
      CD_Intr;
      Code := Regs.AX;
      If (Regs.Flags AND CarryFlag) <> 0 THEN
         ErrCode := $FF;
      Get_Vol_Desc := Regs.DH;
    end;

begin
  Clear_Regs;
  ErrCode := 0;
  If Code <> 0 THEN
     Begin
       Regs.DH := Code;
       Regs.DL := 0;
       Regs.BX := $0001;
       Regs.AL := $0E;
       Regs.CX := Drive;
       CD_Intr;
       Code := Regs.AX;
       If (Regs.Flags AND CarryFlag) <> 0 THEN
          ErrCode := $FF;
     End;
  If ErrCode = 0 THEN
     Code := Get_Vol_Desc;
end;

procedure Get_Dir_Entry(PathName : String;
                        var Format, ErrCode : Integer);
var
  PN : PChar;
  DB : Pointer;
begin
  FillChar(DirBuf, SizeOf(DirBuf), #0);
  PathName := PathName + #0;
  If NOT GetIOBlock(DB, SizeOf(DirBufRec) + 256) THEN
     Exit;
  PN := Ptr(DOSSelector, SizeOf(DirBufRec) + 1);
  Clear_Regs;
  Regs.AL := $0F;
  Regs.CL := Drive;
  Regs.CH := 1;
  Regs.ES := DOSSegment;
  Regs.BX := SizeOf(DirBufRec) + 1;
  Regs.SI := DOSSegment;
  Regs.DI := DOSOffset;
  CD_Intr;
  ErrCode := Regs.AX;
  If (Regs.Flags AND CarryFlag) = 0 THEN
  Begin
    Move(DB^, DirBuf, SizeOf(DirBuf));
    Move(DirBuf.NameArray[1], DirBuf.FileName[1], 38);
    DirBuf.FileName[0] := #12; { File names are only 8.3 }
    Format := Regs.AX
  End
  ELSE
    Format := $FF;
  FreeIOBlock(DB);
end;

function IO_Control(Command, NumberOfBytes, TransferBytes,
                     ReturnBytes, StartPoint : Byte;
                     var Bytes, TransferBlock): Byte;
var
  I : Word;
begin
  If NOT GetIOBlock(IOBlock, SizeOf(IOControlBlock)) THEN
     Exit;
  With IOControlBlock(IOBlock^) DO
  Begin
    I := Ofs(TransBlock[1]) - Ofs(IOReq_Hdr);
    NumBytes := NumberOfBytes;
    IOReq_Hdr.Len := 26;
    IOReq_Hdr.SubUnit := SubUnit;
    IOReq_Hdr.Status := 0;
    TransAddr := Ptr(DOSSegment, I); { 23 bytes into the IOBlock^ }
    IOReq_Hdr.Command := Command;
    Move(Bytes, TransBlock[1], TransferBytes);
    Clear_Regs;
    Regs.AL := $10;
    Regs.CX := Drive;
    Regs.ES := DOSSegment;
    Regs.BX := DOSOffset;
    CD_Intr;
    Busy := (IOReq_Hdr.Status AND 512) <> 0;
    If ((IOReq_Hdr.Status AND 32768) <> 0) THEN
       I := IOReq_Hdr.Status AND $FF
    ELSE
        I := 0;
    If ReturnBytes <> 0 THEN
       Move(TransBlock[StartPoint], TransferBlock, ReturnBytes);
  End;
  IO_Control := I;
  FreeIOBlock(IOBlock);
end;

procedure Audio_Channel_Info;
var
  Bytes : Byte;
begin
  Bytes := 4;
  IO_Control(IOCtlInput, 9, 1, 9, 1, Bytes, AudioChannel);
End;

procedure DeviceStatus;
var
  Bytes : Array[1..2] OF Byte;
  Status: Word;
begin
  Bytes[1] := 6;

  IO_Control(IOCtlInput, 5, 1, 2, 2, Bytes, Bytes);
  Move(Bytes, Status, 2);

  DoorOpen     := Status AND 1 <> 0;
  DoorLocked   := Status AND 2 = 0;
  Audio        := Status AND 16 <> 0;
  AudioManip   := Status AND 256 <> 0;
  DiscInDrive  := Status AND 2048 = 0;
  RedBook      := Status AND 1024 <> 0;
End;

procedure Audio_Disk_Info;
var Bytes : Byte;
begin
  Bytes := 10;
  IO_Control(IOCtlInput, 7, 1, 6, 2, Bytes, AudioDiskInfo);
  Playing := Busy;
end;

procedure Audio_Track_Info(Var StartPoint : LongInt;
                           Var TrackControl : Byte);
var
  Bytes : Array[1..5] Of BYTE;
begin
  Bytes[1] := 11;
  Bytes[2] := TrackControl;   { Track number }

  IO_Control(IOCtlInput, 7, 2, 5, 3, Bytes, Bytes);
  Move(Bytes[1], StartPoint, 4);
  TrackControl := Bytes[5];

  Playing := Busy;
end;

procedure Q_Channel_Info;
var
  Bytes : Byte;
begin
  Bytes := 12;
  IO_Control(IOCtlInput, 11, 1, 11, 2, Bytes, QChannelInfo);
end;

procedure Audio_Status_Info;
var
  Bytes : Array[1..11] Of Byte;
begin
  Bytes[1] := 15;
  IO_Control(IOCtlInput, 11, 1, 8, 2, Bytes, Bytes);
  Paused := (Word(Bytes[2]) AND 1) <> 0;
  Move(Bytes[4], Last_Start, 4);
  Move(Bytes[8], Last_End, 4);
  Playing := Busy;
end;

procedure Eject;
var
  Bytes : Byte;
begin
  Bytes := 0;
  IO_Control(IOCtlOutput, 1, 1, 0, 0, Bytes, Bytes);
end;

procedure Reset;
var Bytes : Byte;
begin
  Bytes := 2;
  IO_Control(IOCtlOutput, 1, 1, 0, 0, Bytes, Bytes);
  Busy := TRUE;
end;

procedure Lock(LockDrive : Boolean);
var
  Bytes : Array[1..2] Of Byte;
begin
  Bytes[1] := 1;
  If LockDrive THEN
     Bytes[2] := 1
  ELSE
     Bytes[2] := 0;
  IO_Control(IOCtlOutput, 2, 2, 0, 0, Bytes, Bytes);
end;

procedure CloseTray;
var Bytes : Byte;
begin
  Bytes := 5;
  IO_Control(IOCtlOutput, 1, 1, 0, 0, Bytes, Bytes);
end;

Var
  AudioPlay : Pointer;


function Play(StartLoc, NumSec : LongInt) : Boolean;
begin

  If NOT GetIOBlock(AudioPlay, SizeOf(Audio_Play)) THEN
     Exit;
  With Audio_Play(AudioPlay^) DO
  Begin
    APReq.Command := PlayCD;
    APReq.Len := 22;
    APReq.SubUnit := SubUnit;
    Start := StartLoc;
    NumSecs := NumSec;
    AddrMode := 1;
    Regs.AL := $10;
    Regs.CX := Drive;
    Regs.ES := DOSSegment;
    Regs.BX := DOSOffset;
    CD_Intr;
    Play := ((APReq.Status AND 32768) = 0);
  End;
  FreeIOBlock(AudioPlay);
end;

procedure Play_Audio(StartSec, EndSec : LongInt);
Var
  SP,
  EP     : LongInt;
  SArray : Array[1..4] Of Byte;
  EArray : Array[1..4] Of Byte;
begin
  Move(StartSec, SArray[1], 4);
  Move(EndSec, EArray[1], 4);
  SP := SArray[3];           { Must use longint or get negative result }
  SP := (SP*75*60) + (SArray[2]*75) + SArray[1];
  EP := EArray[3];
  EP := (EP*75*60) + (EArray[2]*75) + EArray[1];
  EP := EP-SP;

  Playing := Play(StartSec, EP);
  Audio_Status_Info;
end;

procedure Pause_Audio;
begin

  If Playing THEN
     Begin
       If NOT GetIOBlock(AudioPlay, SizeOf(Audio_Play)) THEN
          Exit;
       With Audio_Play(AudioPlay^) DO
       Begin
         APReq.Command := StopPlay;
         APReq.Len := 13;
         APReq.SubUnit := SubUnit;
       End;
       Regs.AL := $10;
       Regs.CX := Drive;
       Regs.ES := DOSSegment;
       Regs.BX := DOSOffset;
       CD_Intr;
       FreeIOBlock(AudioPlay);
     end;
  Audio_Status_Info;
  Playing := FALSE;
end;

procedure Resume_Play;
begin
  If NOT GetIOBlock(AudioPlay, SizeOf(Audio_Play)) THEN
     Exit;
  With Audio_Play(AudioPlay^) DO
  Begin
    APReq.Command := ResumePlay;
    APReq.Len := 13;
    APReq.SubUnit := SubUnit;
  End;
  Regs.AL := $10;
  Regs.CX := Drive;
  Regs.ES := DOSSegment;
  Regs.BX := DOSOffset;
  CD_Intr;
  Audio_Status_Info;
  FreeIOBlock(AudioPlay); { free DOS block anbd dereference pointer }
end;

function StopAudio : Boolean;
begin

  If NOT GetIOBlock(AudioPlay, SizeOf(Audio_Play)) THEN
     Exit;
  With Audio_Play(AudioPlay^) DO
  Begin
    APReq.Command := StopPlay;
    APReq.Len := 13;
    APReq.SubUnit := SubUnit;
    Regs.AL := $10;
    Regs.CX := Drive;
    Regs.ES := DOSSegment;
    Regs.BX := DOSOffset;
    CD_Intr;
    StopAudio := ((APReq.Status AND 32768) = 0);
  End;
  FreeIOBlock(AudioPlay);
end;

function Sector_Size(ReadMode : Byte) : Word;
Var
  SecSize : Word;
  Bytes   : Array[1..2] Of Byte;
begin
  Bytes[1] := 7;
  Bytes[2] := ReadMode;
  IO_Control(IOCtlInput, 4, 2, 2, 3, Bytes, SecSize);
  Sector_Size := SecSize;
End;

function Volume_Size : LongInt;
Var
  VolSize : LongInt;
  Bytes   : Byte;
begin
  Bytes := 8;
  IO_Control(IOCtlInput, 5, 1, 4, 2, Bytes, VolSize);
  Volume_Size := VolSize;
End;

function Media_Changed : Boolean;

{  1  :  Media not changed
   0  :  Don't Know
  -1  :  Media changed
}
var
  MedChng : Byte;
  Bytes : Byte;
begin
  Bytes := 9;
  IO_Control(IOCtlInput, 2, 1, 4, 2, Bytes, MedChng);
  Inc(MedChng);
  If MedChng IN [1,0] THEN
     Media_Changed := True
  ELSE
     Media_Changed := False;
End;

function Head_Location(AddrMode : Byte) : LongInt;
Var
  HeadLoc : Longint;
  Bytes : Array[1..2] Of Byte;
begin
  Bytes[1] := 1;
  Bytes[2] := AddrMode;
  IO_Control(IOCtlInput, 6, 2, 4, 3, Bytes, HeadLoc);
  Head_Location := HeadLoc;
End;

procedure Read_Drive_Bytes(Var ReadBytes : DriveByteArray);
var
  Bytes : Byte;
Begin
  Bytes := 5;
  IO_Control(IOCtlInput, 130, 1, 128, 3, Bytes, ReadBytes);
End;

function UPC_Code : String;
Var
  I, J, K : Integer;
  TempStr : String;
  Bytes : Array[1..11] Of Byte;
Begin
  TempStr := '';
  FillChar(Bytes, SizeOf(Bytes), #0);
  Bytes[1] := 14;
  If (IO_Control(IOCtlInput, 11, 1, 11, 1, Bytes, Bytes) <> 0) THEN
     TempStr := 'No UPC Code'
  ELSE
  Begin
    For I := 3 to 9 DO
      Begin
        J := (Bytes[I] AND $F0) SHR 4;
        K := Bytes[I] AND $0F;
        TempStr := TempStr + Chr(J + 48);
        TempStr := TempStr + Chr(K + 48);
      End;
    If Length(TempStr) > 13 THEN
        TempStr := Copy(TempSTr, 1, 13);
  End;
  UPC_Code := TempStr;
End;

{************************************************************}
{$IfDef MSDOS}
{$ELSE}
{$F+}
var
  ExitRoutine : Pointer;
procedure MyExit;
begin
  ExitProc := ExitRoutine;
  If DOSSelector <> 0 THEN
  Begin
     GlobalDOSFree(DOSSelector);
     WriteLn('DOS Selector not free');
  End
  ELSE
     WriteLn('DOS Selector free');
end;
{$EndIf}

Begin
  NumberOfCD := 0;
  FirstCD := 0;
  FillChar(MSCDEX_Version, SizeOf(MSCDEX_Version), #0);
  Initialize;
  Drive := FirstCD;
  SubUnit := 0;
{$IfDef MSDOS}
{$ELSE}
  ExitRoutine := ExitProc;
  ExitProc := @MyExit;
{$EndIf}
End.

[Back to SOUND SWAG index]  [Back to Main SWAG index]  [Original]