unit1.pas

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

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';