SCSI/ASPI

开发平台：
Delphi

UNIT1.PAS：源码内容
							unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  TASPIdev, TCdBasic, Menus, ExtCtrls, StdCtrls, Spin;
type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    MandatoryCmd: TMenuItem;
    OptionalCmd: TMenuItem;
    ModeCmd: TMenuItem;
    AudioCmd: TMenuItem;
    PlayAudio101: TMenuItem;
    HelpSubmenu: TMenuItem;
    TestReady1: TMenuItem;
    RequestSense1: TMenuItem;
    Inquiry1: TMenuItem;
    Reserve1: TMenuItem;
    Release1: TMenuItem;
    SelfTest1: TMenuItem;
    ReadCapacity1: TMenuItem;
    ReadCapacityPM1: TMenuItem;
    Read101: TMenuItem;
    RezeroUnit1: TMenuItem;
    StartStopUnit1: TMenuItem;
    Seek101: TMenuItem;
    PreFetch1: TMenuItem;
    SynchronizeCache1: TMenuItem;
    LockUnlockCache1: TMenuItem;
    ReadLong1: TMenuItem;
    ReadSubchannel1: TMenuItem;
    ReadToc1: TMenuItem;
    ReadHeaderLBA1: TMenuItem;
    ReadHeaderMSF1: TMenuItem;
    ModeSelectEX1: TMenuItem;
    ModeSenseHeader1: TMenuItem;
    ModeSenseRecover1: TMenuItem;
    ModeSenseRecoverEX1: TMenuItem;
    ModeSenseMediumEX1: TMenuItem;
    ModeSenseDevice1: TMenuItem;
    ModeSenseDeviceEX1: TMenuItem;
    ModeSenseAudio1: TMenuItem;
    ModeSenseAudioEX1: TMenuItem;
    ModeSelect1: TMenuItem;
    ModeSelectEX2: TMenuItem;
    PlayAudio121: TMenuItem;
    PlayAudioMSF1: TMenuItem;
    PlayAudioTI1: TMenuItem;
    PlayAudioR101: TMenuItem;
    PlayAudioR121: TMenuItem;
    PauseAudio1: TMenuItem;
    ResumeAudio1: TMenuItem;
    About1: TMenuItem;
    ASPI1: TMenuItem;
    TASPI1: TMenuItem;
    EnumDevices1: TMenuItem;
    Panel1: TPanel;
    ComboBox1: TComboBox;
    Memo1: TMemo;
    procedure About1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure TestReady1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Reserve1Click(Sender: TObject);
    procedure Release1Click(Sender: TObject);
    procedure RezeroUnit1Click(Sender: TObject);
    procedure PauseAudio1Click(Sender: TObject);
    procedure ResumeAudio1Click(Sender: TObject);
    procedure ModeSenseAudio1Click(Sender: TObject);
    procedure ModeSenseDevice1Click(Sender: TObject);
    procedure ModeSenseHeader1Click(Sender: TObject);
    procedure SelfTest1Click(Sender: TObject);
    procedure ReadCapacity1Click(Sender: TObject);
    procedure ReadCapacityPM1Click(Sender: TObject);
    procedure StartStopUnit1Click(Sender: TObject);
    procedure Seek101Click(Sender: TObject);
    procedure ReadSubchannel1Click(Sender: TObject);
    procedure ReadToc1Click(Sender: TObject);
    procedure PreFetch1Click(Sender: TObject);
    procedure LockUnlockCache1Click(Sender: TObject);
    procedure PlayAudio101Click(Sender: TObject);
    procedure PlayAudio121Click(Sender: TObject);
    procedure PlayAudioTI1Click(Sender: TObject);
    procedure PlayAudioMSF1Click(Sender: TObject);
    procedure ReadLong1Click(Sender: TObject);
    procedure Read101Click(Sender: TObject);
    procedure ModeSenseRecoverEX1Click(Sender: TObject);
    procedure ModeSenseMediumEX1Click(Sender: TObject);
    procedure ModeSenseDeviceEX1Click(Sender: TObject);
    procedure ModeSenseAudioEX1Click(Sender: TObject);
    procedure TASPI1Click(Sender: TObject);
    procedure EnumDevices1Click(Sender: TObject);
    procedure RequestSense1Click(Sender: TObject);
  private
    { Private declarations }
  public
    CdRom1 : TCdRom;
  end;
var
  Form1: TForm1;
  Log  : Text;    // We can treat 'Log' as text file opened for write
implementation
uses Unit2, Unit3, Unit4, Unit5, Unit6, Unit7, Unit8, Unit9,
     Unit10, Unit11, Unit12, Unit13, Unit14, Unit15, Unit16,
     Unit17, Unit18, Unit19, Unit20, Unit21;
{$R *.DFM}
//=============== LogMemo object functions ================
var
   LogDFile   : TextFile;  // Real disk file for logging
   LogDFileOk : BOOLEAN;   // TRUE if disk file was successfully opened
   LogFileBuf : string;
   LogFileMaxMemoLines : integer;  // Max number of lines that are stored
                                   // in Memo (for editing, remarks etc.)
procedure LogFileAddLine;
begin with Form1.Memo1 do begin
   Lines.BeginUpdate;
   while Lines.Count > LogFileMaxMemoLines do begin
      if LogDFileOk then
       try
         writeln(LogDFile, Lines[0]);
       except
         on EInOutError do begin
            LogDFileOk := FALSE;
            MessageDlg('Error while writing log file. Trying to close it.',
                    mtInformation, [mbOk], 0);
            CloseFile(LogDFile);
      end; end;
      Lines.Delete(0);
   end;
   Lines.EndUpdate;
   Lines.Add(LogFileBuf);
   LogFileBuf := '';
end; end;
function LogFileOut(var P : TTextRec) : integer;
var i : integer;
begin
   with P do begin
      for i := 0 to BufPos-1 do
       if Buffer[i] <> #10 then begin     // Skip all LFs
         if Buffer[i] = #13 then LogFileAddLine
                            else LogFileBuf := LogFileBuf + Buffer[i];
      end;
      BufPos  := 0;
   end;
   result  := 0;
end;
function LogFileFlush(var P : TTextRec) : integer;
begin
   result := 0;
end;
function LogFileClose(var P : TTextRec) : integer;
begin
   P.Mode := fmClosed;
   result := 0;
   if LogDFileOk then begin
      LogFileMaxMemoLines := 0;    // write the rest of log to disk
      LogFileAddLine;
      CloseFile(LogDFile);
end; end;
procedure LogFileAssignRewrite(const FName : string);
begin
   LogDFileOk := TRUE;
   try
      AssignFile(LogDFile, FName);
      Rewrite(LogDFile);
   except
      on EInOutError do begin
         LogDFileOk := FALSE;
         MessageDlg('Cannot open log file '+ FName +
                    '. Logging onto screen only.',
                    mtInformation, [mbOk], 0);
   end; end;
   with TTextRec(Log) do begin
      Handle  := 0;
      Mode    := fmOutput;
      BufSize := sizeof(Buffer);
      BufPos  := 0;
      BufEnd  := 0;
      BufPtr  := @Buffer;
      OpenFunc  := @LogFileFlush;  // do nothing, return Ok
      InOutFunc := @LogFileOut;
      FlushFunc := @LogFileFlush;
      CloseFunc := @LogFileClose;
      Name[0] := #0;
   end;
   LogFileMaxMemoLines := 128;
   LogFileBuf := '======= TCdRom Demo Program Log File =======';
   Form1.Memo1.Lines.Clear;
   LogFileAddLine;
end;
//=============== Some common functions ================
procedure Report(const st : string; Res : BOOLEAN);
var s : string;
begin
   writeln(Log, Copy(st,1,Length(st)-2)+');');
   if Res then write(Log, '     Executed successfully')
          else write(Log, '     Execution failed');
   with Form1.CdRom1 do begin
      write(Log, ', LastErr = ', SCSIerrorName[LastError]);
      if LastError = Err_SenseIllegalRequest then begin
           // detailed error analyse especially for this Demo
         if (Sense[15] AND $80) <> 0 then begin
            writeln(Log);
            write(Log, '     Detailed: Error in ');
            if (Sense[15] AND $80) <> 0
              then write(Log, 'command descriptor block, byte ')
              else write(Log, 'command data block, byte ');
            write(Log, GatherWORD(Sense[16], Sense[17]));
            if (Sense[15] AND 8) <> 0 then
               write(Log, ', bit ', (Sense[15] AND 7));
      end; end;
           // Here is ASC/ASCQ analyse
      if Sense[12] <> 0 then begin    // Additional Sense Code
         writeln(Log);
         write(Log, '     Detailed: ');
         case Sense[12] of
            $1A : s := 'Parameter list length error';
            $1B : s := 'Synchronous data transfer error';
            $20 : s := 'Invalid command operation code';
            $21 : s := 'Logical block address out of range';
            $24 : s := 'Invalid field in command descriptor block';
            $25 : s := 'Logical unit not supported';
            $26 : case Sense[13] of
              0 : s := 'Invalid field in parameter list';
              1 : s := 'Parameter not supported';
              2 : s := 'Parameter value invalid';
              3 : s := 'Threshold parameters not supported';
              end;
            $28 : s := 'Not ready (medium may have changed)';
            $29 : s := 'Power on, reset or bus device reset occured';
            $2A : case Sense[13] of
              0 : s := 'Parameters changed';
              1 : s := 'Mode parameters changed';
              2 : s := 'Log parameters changed';
              end;
            $2B : s := 'Cannot execute copy';
            $2C : s := 'Command sequence error';
            $2F : s := 'Commands cleared by another initiator';
            $30 : case Sense[13] of
              0 : s := 'Incompatible medium installed';
              1 : s := 'Cannot read medium - unknown format';
              2 : s := 'Cannot read medium - incompatible format';
              end;
            $37 : s := 'Rounded parameter';
            $39 : s := 'Saving parameters not supported';
            $3A : s := 'Medium not present';
            $3D : s := 'Invalid bits in identify message';
            $3E : s := 'Logical unit has not self-configured yet';
            $3F : case Sense[13] of
              0 : s := 'Target operation conditions have changed';
              1 : s := 'Microcode has been changed';
              2 : s := 'Changed operating definition';
              3 : s := 'Inquiry data has changed';
              end;
            $40 : s := Format('Diagnostic failure on component %2xh',
                              [Sense[13]]);
            $43 : s := 'Message error';
            $44 : s := 'Internal target failure';
            $45 : s := 'Select or reselect failure';
            $46 : s := 'Unsuccessfull soft reset';
            $47 : s := 'SCSI parity error';
            $48 : s := 'Initiator detected error message received';
            $49 : s := 'Invalid message error';
            $4A : s := 'Command phase error';
            $4B : s := 'Data phase error';
            $4C : s := 'Logical unit failed self-configuration';
            $4E : s := 'Overlapped commands attempted';
            $53 : case Sense[13] of
              0 : s := 'Media load or eject failed';
              2 : s := 'Meduim removal prevented';
              end;
            $57 : s := 'Unable to recover table-of-contents';
            $5A : case Sense[13] of
              0 : s := 'Operator request or state change input';
              1 : s := 'Operator medium removal request';
              end;
            $5B : case Sense[13] of
              0 : s := 'Log exception';
              1 : s := 'Threshold condition met';
              2 : s := 'Log counter at maximum';
              3 : s := 'Log list codes exhausted';
              end;
            $63 : s := 'End of user area encountered on this track';
            $64 : s := 'Illegal mode for this track';
            else s := 'Unknown error code';
         end;
         write(Log, s, ' (ASC=', Sense[12], ', ASCQ=', Sense[13], ')');
      end;
   end;
   writeln(Log);
   flush(Log);
end;
function BVal(Arg : TCheckBox) : string;
begin with Arg do begin
   if Checked then result := Name + '=TRUE, '
              else result := Name + '=FALSE, ';
end; end;
function DVal(Arg : TSpinEdit) : string;
begin with Arg do begin
   result := Name + '=' + IntToStr(Value) + ', ';
end; end;
var IObuf : array[0..9999] of Byte;  // Data buffer for all I/O related ops
procedure LogHex(Buf : pointer; BufLen : DWORD);
var
   i     : integer;
   mb    : array[0..15] of byte;
   s1,s2 : string;
   procedure LogLine(Len : integer);
   var j  : integer;
   begin
      s1 := Format('      %3x0 ', [i]);
      s2 := ' |';
      for j := 0 to 15 do begin
         if (j MOD 4) = 0 then begin
            s1 := s1 + ' ';
           { s2 := s2 + ' '; }
         end { else s1 := s1 + '-' };
         if j >= Len then begin
            s1 := s1 + '   ';
            s2 := s2 + ' ';
         end else begin
            s1 := s1 + Format('%2x', [mb[j]]);
            if mb[j] < $20 then s2 := s2 + ' '
                           else s2 := s2 + CHR(mb[j]);
      end; end;
      writeln(Log, s1, s2, ' |');
   end;
begin
   i := 0;
   while BufLen >= 16 do begin
      Move(Buf^, mb, sizeof(mb));
      LogLine(16);
      Inc(PChar(Buf), sizeof(mb));
      Dec(BufLen, 16);
      Inc(i);
   end;
   if BufLen > 0 then begin
      Move(Buf^, mb, BufLen);
      LogLine(BufLen);
   end;
   flush(Log);
end;
//=========================================================
procedure LogDeviceInfo;
begin
  with Form1.CdRom1.DeviceInfo do begin
   writeln(Log, '   DeviceInfo structure fields:');
   writeln(Log, '     PeripheralQualifier = ', PeripheralQualifier);
   writeln(Log, '     DeviceType          = ', DeviceType);
   writeln(Log, '     DeviceTypeModifier  = ', DeviceTypeModifier);
   writeln(Log, '     RemovableMedium     = ', RemovableMedium);
   writeln(Log, '     ISOversion  = ', ISOversion);
   writeln(Log, '     ECMAversion = ', ECMAversion);
   writeln(Log, '     ANSIversion = ', ANSIversion);
   writeln(Log, '     AsyncEventCapability  = ', AsyncEventCapability);
   writeln(Log, '     TerminateIOcapability = ', TerminateIOcapability);
   writeln(Log, '     ResponseDataFormat    = ', ResponseDataFormat);
   writeln(Log, '     AdditionalDataLength  = ', AdditionalDataLength);
   writeln(Log, '     WideBus32capability   = ', WideBus32capability);
   writeln(Log, '     WideBus16capability   = ', WideBus16capability);
   writeln(Log, '     RelativeAddressingCapability  = ', RelativeAddressingCapability);
   writeln(Log, '     SynchronousTransferCapability = ', SynchronousTransferCapability);
   writeln(Log, '     LinkedCommandsCapability      = ', LinkedCommandsCapability);
   writeln(Log, '     CommandQueuingCapability      = ', CommandQueuingCapability);
   writeln(Log, '     SoftResetCapability           = ', SoftResetCapability);
   writeln(Log, '     VendorID        = "', VendorID, '"');
   writeln(Log, '     ProductID       = "', ProductID, '"');
   writeln(Log, '     ProductRevision = "', ProductRevision, '"');
   writeln(Log, '     VendorSpecific  = "', VendorSpecific, '"');
  with Form1.CdRom1.HAinfo do begin
   writeln(Log, '   HAinfo structure fields:');
   writeln(Log, '     ScsiID            = ', ScsiID);
   writeln(Log, '     MaxTargetCount    = ', MaxTargetCount);
   writeln(Log, '     ResidualSupport   = ', ResidualSupport);
   writeln(Log, '     MaxTransferLength = ', MaxTransferLength);
   writeln(Log, '     BufferAlignMask   = ', BufferAlignMask);
   writeln(Log, '     ScsiManagerID     = "', ScsiManagerID, '"');
   writeln(Log, '     HostAdapterID     = "', HostAdapterID, '"');
  end;
end; end;
var ComboBoxAddItem : boolean;
procedure LogNewDevice;      // CallBack for EnumDevices
var s : string;
begin
   with Form1.CdRom1 do begin
      s := Format('%1x,%1x,%1x : ', [DeviceID.Adapter,
                    DeviceID.Target, DeviceID.Lun]) +
        DeviceInfo.VendorID + ' ' + DeviceInfo.ProductID +
        ' rev.' + DeviceInfo.ProductRevision;
      writeln(Log, TScsiDeviceTypeName[DeviceType], ' found at ', s);
   end;
   LogDeviceInfo;
   flush(Log);
   if ComboBoxAddItem then Form1.ComboBox1.Items.Add(s);
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
   function HexToByte(C : char) : BYTE;
   begin
      result := 0;
      if C in ['0'..'9'] then result := ORD(C) - $30;
      if C in ['A'..'F'] then result := ORD(C) - $37;
      if C in ['a'..'f'] then result := ORD(C) - $57;
   end;
var
   s : string;
   d : TDeviceID;
begin
   s := ComboBox1.Items[ComboBox1.ItemIndex];
   d.Adapter := HexToByte(s[1]);
   d.Target  := HexToByte(s[2]);
   d.Lun     := HexToByte(s[3]);
   CdRom1.DeviceID := d;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
   CdRom1 := TCdRom.Create(self);
   LogFileAssignRewrite( ExtractFilePath(ParamStr(0)) + 'tcbddemo.log');
   ComboBoxAddItem := TRUE;
   CdRom1.EnumDevices(TSDCdRom, LogNewDevice);
   ComboBoxAddItem := FALSE;               // Next EnumDevices calls will
                                           //  not affects ComboBox
   if ComboBox1.Items.Count > 0 then begin
      ComboBox1.ItemIndex := 0;
      ComboBox1Change(self);
end; end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   CloseFile(Log);
   CdRom1.free;
end;
procedure TForm1.About1Click(Sender: TObject);
begin  AboutBox.ShowModal;  end;
procedure TForm1.TestReady1Click(Sender: TObject);
begin   Report('Trying: SCSItestReady;', CdRom1.SCSItestReady);    end;
procedure TForm1.Reserve1Click(Sender: TObject);
begin   Report('Trying: SCSIreserve;', CdRom1.SCSIreserve);        end;
procedure TForm1.Release1Click(Sender: TObject);
begin   Report('Trying: SCSIrelease;', CdRom1.SCSIrelease);        end;
procedure TForm1.RezeroUnit1Click(Sender: TObject);
begin   Report('Trying: SCSIrezeroUnit;', CdRom1.SCSIrezeroUnit);  end;
procedure TForm1.PauseAudio1Click(Sender: TObject);
begin   Report('Trying: SCSIpauseAudio;', CdRom1.SCSIpauseAudio);  end;
procedure TForm1.ResumeAudio1Click(Sender: TObject);
begin  Report('Trying: SCSIresumeAudio;', CdRom1.SCSIresumeAudio); end;
procedure TForm1.ModeSenseAudio1Click(Sender: TObject);
var APage : TCdRomModePageAudio;
begin
   Report('Trying: SCSImodeSenseAudio(var sh: TCdRomModePageAudio);',
          CdRom1.SCSImodeSenseAudio(APage));
   with APage do begin
      writeln(Log, '     Returned record TCdRomModePageAudio :');
      writeln(Log, '       PSAV = ', PSAV);
      writeln(Log, '       IMM  = ', IMM);
      writeln(Log, '       SOTC = ', SOTC);
      writeln(Log, '       APRV = ', APRV);
      writeln(Log, '       LBAformat = ', LBAformat);
      writeln(Log, '       LBSaudio  = ', LBSaudio);
      writeln(Log, Format('       Volume  = [%2x, %2x, %2x, %2x] hex',
          [Volume[0],  Volume[1],  Volume[2],  Volume[3]]));
      writeln(Log, Format('       Channel = [%2x, %2x, %2x, %2x] hex',
          [Channel[0], Channel[1], Channel[2], Channel[3]]));
      flush(Log);
end; end;
procedure TForm1.ModeSenseDevice1Click(Sender: TObject);
var ITimer : BYTE;
begin
   Report('Trying: SCSImodeSenseDevice(var ITimer: BYTE);',
          CdRom1.SCSImodeSenseDevice(ITimer));
   writeln(Log, '     Returned ITimer = ', ITimer, ' decimal');
   flush(Log);
end;
procedure TForm1.ModeSenseHeader1Click(Sender: TObject);
var
   AHeader : TCdRomModeHeader;
   B       : BYTE;
begin
   Report('Trying: SCSImodeSenseHeader(var sh: TCdRomModeHeader);',
          CdRom1.SCSImodeSenseHeader(AHeader));
   with AHeader do begin
      writeln(Log, '     Returned record TCdRomModeHeader :');
      writeln(Log, '       Meduim = ', TCdRomMediumName[Medium]);
      writeln(Log, '       DPOFUA = ', DPOFUA);
      if BDlength = 0 then
         writeln(Log, '       BDlength = 0')
      else begin
         writeln(Log, '       TCdRomBlockDescriptor Table (',
                   BDlength, ' record total :');
         for B := 0 to BDlength-1 do
          with BD[B] do
           writeln(Log, '       BD[', B:3, ']: Density=', Density,
              ', BlkCount=', BlkCount:6, ', BlkSize=', BlkSize);
      end;
      flush(Log);
end; end;
procedure TForm1.SelfTest1Click(Sender: TObject);
begin with SelfTestDlg do begin
   if ShowModal = mrOk then begin
      Report('Trying: SCSIselfTest('+BVal(DOFF)+BVal(UOFF),
             CdRom1.SCSIselfTest(DOFF.Checked, UOFF.Checked));
   end;
end; end;
procedure TForm1.ReadCapacity1Click(Sender: TObject);
var BCnt, BSize : DWORD;
begin
   Report('Trying: SCSIreadCapacity(var BlkCount, BlkSize : DWORD);',
          CdRom1.SCSIreadCapacity(BCnt,BSize));
   writeln(Log, '     Returned BlkCount = ', BCnt,  ' decimal');
   writeln(Log, '     Returned BlkSize  = ', BSize, ' decimal');
   flush(Log);
end;
procedure TForm1.ReadCapacityPM1Click(Sender: TObject);
var BCnt, BSize : DWORD;
begin with ReadCaPMDlg do begin
   if ShowModal = mrOk then begin
      Report('Trying: SCSIreadCapacityPM(' + DVal(Partition) + DVal(GLBA)+
             'var BlkCount, BlkSize : DWORD);',
             CdRom1.SCSIreadCapacityPM(WORD(Partition.Value),
                                       GLBA.Value, BCnt, BSize));
      writeln(Log, '     Returned BlkCount = ', BCnt,  ' decimal');
      writeln(Log, '     Returned BlkSize  = ', BSize, ' decimal');
      flush(Log);
   end;
end; end;
procedure TForm1.StartStopUnit1Click(Sender: TObject);
begin with StartStopDlg do begin
   if ShowModal = mrOk then begin
      Report('Trying: SCSIstartStopUnit('+BVal(STRT)+BVal(LOEJ)+BVal(IMM),
        CdRom1.SCSIstartStopUnit(STRT.Checked, LOEJ.Checked, IMM.Checked));
   end;
end; end;
procedure TForm1.Seek101Click(Sender: TObject);
begin with Seek10Dlg do begin
   if ShowModal = mrOk then begin
      Report('Trying: SCSIseek10(' + DVal(GLBA),
             CdRom1.SCSIseek10(GLBA.Value));
      flush(Log);
   end;
end; end;
procedure TForm1.ReadSubchannel1Click(Sender: TObject);
var Info : TCdRomSubQinfo;
begin with ReadSubchannelDlg do begin
   if ShowModal = mrOk then begin
      Report('Trying: SCSIreadSubchannel('+BVal(MSFform)+
             'var Info : TCdRomSubQinfo);',
        CdRom1.SCSIreadSubchannel(MSFform.Checked, Info));
      with Info do begin
        writeln(Log, '     Returned record TCdRomSubQinfo :');
        writeln(Log, '       AudioStatus = ',TAudioStatusName[AudioStatus]);
        writeln(Log, '       ADR         = ',TsubchannelADRname[ADR]);
        writeln(Log, '       PreEmphasis = ', PreEmphasis);
        writeln(Log, '       CopyPermit  = ', CopyPermit);
        writeln(Log, '       DataTrack   = ', DataTrack);
        writeln(Log, '       QuadAudio   = ', QuadAudio);
        writeln(Log, '       TrackNumber = ', TrackNumber);
        writeln(Log, '       IndexNumber = ', IndexNumber);
        writeln(Log, '       UPC  = "', UPC,  '"');
        writeln(Log, '       ISRC = "', ISRC, '"');
        if MSFform.Checked then begin
          writeln(Log, '       AbsAddress = ',AbsAddressM:2,' : ',
             AbsAddressS:2,' : ',AbsAddressF:2,'  // in MSF');
          writeln(Log, '       RelAddress = ',RelAddressM:2,' : ',
             RelAddressS:2,' : ',RelAddressF:2,'  //   form');
        end else begin
          writeln(Log, '       AbsAddress = ',AbsAddress,'  // in LBA');
          writeln(Log, '       RelAddress = ',RelAddress,'  //   form');
        end;
        flush(Log);
   end; end;
end; end;
procedure TForm1.ReadToc1Click(Sender: TObject);
var
   Toc : TCdRomToc;
   i   : integer;
begin with ReadTocDlg do begin
   if ShowModal = mrOk then begin
      Report('Trying: SCSIreadToc('+BVal(MSFform)+DVal(Start)+
             'var Toc : TCdRomToc);',
        CdRom1.SCSIreadToc(MSFform.Checked, BYTE(Start.Value), Toc));
      with Toc do begin
        writeln(Log, '     Returned record TCdRomToc :');
        writeln(Log, '       FirstTrack = ', FirstTrack);
        writeln(Log, '       LastTrack  = ', LastTrack);
        writeln(Log, '       TrackCount = ', TrackCount,
           '  // Real tracks + lead-off area (TrackNumber=170)');
        writeln(Log, '       InMSF      = ', InMSF);
      end;
      for i := 0 to Toc.TrackCount-1 do
       with Toc.Track[i] do begin
        writeln(Log, '       TrackNumber = ', TrackNumber);
        writeln(Log, '       ADR         = ',TsubchannelADRname[ADR]);
        writeln(Log, '       PreEmphasis = ', PreEmphasis);
        writeln(Log, '       CopyPermit  = ', CopyPermit);
        writeln(Log, '       DataTrack   = ', DataTrack);
        writeln(Log, '       QuadAudio   = ', QuadAudio);
        if MSFform.Checked then
          writeln(Log, '       Address = ',AddressM:2,' : ',
             AddressS:2,' : ',AddressF:2,'  // in MSF form')
        else
          writeln(Log, '       Address = ',Address,'  // in LBA form');
      end;
      flush(Log);
   end;
end; end;
procedure TForm1.PreFetch1Click(Sender: TObject);
begin with PreFetchDlg do begin
   if ShowModal = mrOk then
      Report('Trying: SCSIpreFetch('
             + BVal(IMM) + DVal(GLBA) + DVal(Sectors),
             CdRom1.SCSIpreFetch(IMM.Checked,
                     GLBA.Value, WORD(Sectors.Value)));
end; end;
procedure TForm1.LockUnlockCache1Click(Sender: TObject);
begin with LockCacheDlg do begin
   if ShowModal = mrOk then
      Report('Trying: SCSIlockUnlockCache('
             + BVal(LOK) + DVal(GLBA) + DVal(Sectors),
             CdRom1.SCSIlockUnlockCache(LOK.Checked,
                         GLBA.Value, WORD(Sectors.Value)));
end; end;
procedure TForm1.PlayAudio101Click(Sender: TObject);
begin with PlayAudio10Dlg do begin
   if ShowModal = mrOk then
      Report('Trying: SCSIplayAydio10(' + DVal(GLBA) + DVal(Sectors),
             CdRom1.SCSIplayAudio10(GLBA.Value, WORD(Sectors.Value)));
end; end;
procedure TForm1.PlayAudio121Click(Sender: TObject);
begin with PlayAudio12Dlg do begin
   if ShowModal = mrOk then
      Report('Trying: SCSIplayAydio12(' + DVal(GLBA) + DVal(Sectors),
             CdRom1.SCSIplayAudio12(GLBA.Value, Sectors.Value));
end; end;
procedure TForm1.PlayAudioTI1Click(Sender: TObject);
begin with PlayAudioTIDlg do begin
   if ShowModal = mrOk then
      Report('Trying: SCSIplayAydioTI('
             + DVal(StartTrack) + DVal(StartIndex)
             + DVal(StopTrack)  + DVal(StopIndex),
             CdRom1.SCSIplayAudioTI(
             BYTE(StartTrack.Value), BYTE(StartIndex.Value),
             BYTE(StopTrack.Value), BYTE(StopIndex.Value)));
end; end;
procedure TForm1.PlayAudioMSF1Click(Sender: TObject);
begin with PlayAudioMSFDlg do begin
   if ShowModal = mrOk then
      Report('Trying: SCSIplayAydioMSF('
             + DVal(StartM) + DVal(StartS) + DVal(StartF)
             + DVal(StopM)  + DVal(StopS)  + DVal(StopF),
             CdRom1.SCSIplayAudioMSF(
               BYTE(StartM.Value), BYTE(StartS.Value), BYTE(StartF.Value),
               BYTE(StopM.Value), BYTE(StopS.Value), BYTE(StopF.Value)));
end; end;
procedure TForm1.ReadLong1Click(Sender: TObject);
var Leng : DWORD;
begin with ReadLongDlg do begin
   if ShowModal = mrOk then begin
      Leng := BufLen.Value;
      Report('Trying: SCSIreadLong(' + BVal(CORR) + DVal(GLBA)
             + 'Buf : Pointer, ' + DVal(BufLen),
             CdRom1.SCSIreadLong(CORR.Checked, GLBA.Value, @IObuf, Leng));
      if (CdRom1.LastError = Err_None) AND (Leng > 0) then begin
         writeln(Log, '     Returned Data Buffer :');
         LogHex(@IObuf, Leng);
      end;
   end;
end; end;
procedure TForm1.Read101Click(Sender: TObject);
var Leng : DWORD;
begin with Read10Dlg do begin
   if ShowModal = mrOk then begin
      Leng := BufLen.Value;
      Report('Trying: SCSIread10(' + BVal(DPO) + BVal(FUA) + DVal(GLBA)
             + DVal(Sectors) + 'Buf : Pointer, ' + DVal(BufLen),
             CdRom1.SCSIread10(DPO.Checked, FUA.Checked, GLBA.Value,
             Sectors.Value, @IObuf, Leng));
      if (CdRom1.LastError = Err_None) AND (Leng > 0) then begin
         writeln(Log, '     Returned Data Buffer :');
         LogHex(@IObuf, Leng);
      end;
   end;
end; end;
procedure TForm1.ModeSenseRecoverEX1Click(Sender: TObject);
var
   PSAV : boolean;
   RLEV, RETR : byte;
begin with ModeSenseRecoverEXDlg do begin
   if ShowModal = mrOk then begin
      Report('Trying: SCSIModeSenseRecoverEX(PCTL='
         + TCdRomModePageTypeName[TCdRomModePageType(PCTL.ItemIndex)]
         + '; var PSAV : boolean; var RLEV, RETR : byte);',
         CdRom1.SCSIModeSenseRecoverEX(
            TCdRomModePageType(PCTL.ItemIndex), PSAV, RLEV, RETR));
      writeln(Log, '     Returned PSAV = ', PSAV);
      writeln(Log, '     Returned RLEV = ', RLEV, ' decimal');
      writeln(Log, '     Returned RETR = ', RETR, ' decimal');
      flush(Log);
   end;
end; end;
procedure TForm1.ModeSenseMediumEX1Click(Sender: TObject);
var
   PSAV : boolean;
   Med1,Med2,Med3,Med4 : TCdRomMediumType;
begin with ModeSenseMediumEXDlg do begin
   if ShowModal = mrOk then begin
      Report('Trying: SCSIModeSenseMediumEX(PCTL='
         + TCdRomModePageTypeName[TCdRomModePageType(PCTL.ItemIndex)]
         + '; var PSAV : boolean; var Med1,Med2,Med3,Med4 : TCdRomMediumType);',
         CdRom1.SCSIModeSenseMediumEX(
            TCdRomModePageType(PCTL.ItemIndex), PSAV, Med1,Med2,Med3,Med4));
      writeln(Log, '     Returned PSAV = ', PSAV);
      writeln(Log, '     Returned Med1 = ', TCdRomMediumName[Med1]);
      writeln(Log, '     Returned Med2 = ', TCdRomMediumName[Med2]);
      writeln(Log, '     Returned Med3 = ', TCdRomMediumName[Med3]);
      writeln(Log, '     Returned Med4 = ', TCdRomMediumName[Med4]);
      flush(Log);
   end;
end; end;
procedure TForm1.ModeSenseDeviceEX1Click(Sender: TObject);
var
   PSAV : boolean;
   ITimer : byte;
   SperMunits, FperSunits : word;
begin with ModeSenseDeviceEXDlg do begin
   if ShowModal = mrOk then begin
      Report('Trying: SCSIModeSenseDeviceEX(PCTL='
         + TCdRomModePageTypeName[TCdRomModePageType(PCTL.ItemIndex)]
         + '; var ITimer : byte; var SperMunits, FperSunits : word);',
         CdRom1.SCSIModeSenseDeviceEX(
            TCdRomModePageType(PCTL.ItemIndex),
            PSAV, ITimer, SperMunits, FperSunits));
      writeln(Log, '     Returned PSAV = ', PSAV);
      writeln(Log, '     Returned ITimer = ', ITimer, ' decimal');
      writeln(Log, '     Returned SperMunits = ', SperMunits, ' decimal');
      writeln(Log, '     Returned FperSunits = ', FperSunits, ' decimal');
      flush(Log);
   end;
end; end;
procedure TForm1.ModeSenseAudioEX1Click(Sender: TObject);
var APage : TCdRomModePageAudio;
begin with ModeSenseAudioEXDlg do begin
   if ShowModal = mrOk then begin
      Report('Trying: SCSImodeSenseAudioEX(PCTL='
         + TCdRomModePageTypeName[TCdRomModePageType(PCTL.ItemIndex)]
         + '; var sh: TCdRomModePageAudio);',
          CdRom1.SCSImodeSenseAudioEX(
              TCdRomModePageType(PCTL.ItemIndex), APage));
      with APage do begin
         writeln(Log, '     Returned record TCdRomModePageAudio :');
         writeln(Log, '       PSAV = ', PSAV);
         writeln(Log, '       IMM  = ', IMM);
         writeln(Log, '       SOTC = ', SOTC);
         writeln(Log, '       APRV = ', APRV);
         writeln(Log, '       LBAformat = ', LBAformat);
         writeln(Log, '       LBSaudio  = ', LBSaudio);
         writeln(Log, Format('       Volume  = [%2x, %2x, %2x, %2x] hex',
             [Volume[0],  Volume[1],  Volume[2],  Volume[3]]));
         writeln(Log, Format('       Channel = [%2x, %2x, %2x, %2x] hex',
             [Channel[0], Channel[1], Channel[2], Channel[3]]));
         flush(Log);
   end; end;
end; end;
procedure TForm1.TASPI1Click(Sender: TObject);
begin
   writeln(Log, 'TASPIdevice fields :');
   with CdRom1 do begin
      writeln(Log, '   HAcount = ', HAcount);
      writeln(Log, '   Sense[0..', sizeof(Sense)-1, '] in table form:');
      LogHex(@Sense, sizeof(Sense));
      writeln(Log, '   LastError = ', SCSIerrorName[LastError]);
      writeln(Log, '   ShortTimeout  = ', ShortTimeout,  ' mSec');
      writeln(Log, '   MediumTimeout = ', MediumTimeout, ' mSec');
      writeln(Log, '   LongTimeout   = ', LongTimeout,   ' mSec');
      writeln(Log, '   AudioTimeout  = ', AudioTimeout,  ' mSec');
      writeln(Log, '   DeviceID   = ',
          DeviceID.Adapter, ',', DeviceID.Target, ',', DeviceID.Lun);
      writeln(Log, '   DeviceType = ', TScsiDeviceTypeName[DeviceType]);
   end;
   LogDeviceInfo;
   flush(Log);
end;
procedure TForm1.EnumDevices1Click(Sender: TObject);
var
   i  : integer;
   DT : TScsiDeviceType;
begin with EnumDevicesDlg do begin
   if ShowModal = mrOk then begin
      DT := TScsiDeviceType(DType.ItemIndex);
      if DT = TSDInvalid then DT := TSDAny;
      Report('Trying: EnumDevices(DType=' + TScsiDeviceTypeName[DT]
         + '; CBack: TCallBackProc);', TRUE);
      i := CdRom1.EnumDevices(DT, LogNewDevice);
      write(Log, '**** ');
      if i < 2 then begin
         if i = 0 then write(Log, 'No') else write(Log, 'Only');
         writeln(Log, ' one device found.');
      end else writeln(Log, '**** Total ', i, ' devices found.');
      flush(Log);
   end;
end; end;
procedure TForm1.RequestSense1Click(Sender: TObject);
var Leng : integer;
begin
   Leng := SizeOf(TscsiSenseInfo);
   Report(Format('Trying: SCSIrequestSense(Buf : Pointer, BufLen=%d);',
          [Leng]),  CdRom1.SCSIrequestSense(@IObuf, Leng));
   if (CdRom1.LastError = Err_None) AND (Leng > 0) then begin
      writeln(Log, '     Returned Data Buffer :');
      LogHex(@IObuf, Leng);
end; end;
end.

						