unit1.pas

使用ASPI读SCSI/IDE/ATAPI的CDROM数据或音乐磁道数据的程序

              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