aspiunit.pas

用于CD/DVD烧录的Delphi源码,包括source和demo

              if (ASPIgetDriveInt13info(DID.DriveID, DevInfo) = Err_None)
                and (DevInfo.DriveNumber > 0) then
                DID.DriveID := GatherDeviceID(Dadapter, Dtarget, Dlun,
                  CHR(DevInfo.DriveNumber + $41));

              if TestModeSense then
              begin
                ASPIsetDeviceIDflag(DID.DriveID, ADIDmodeSense6, True);
                if TestModeSense then
                begin
                  ASPIsetDeviceIDflag(DID.DriveID, ADIDmodeSense6, False);
                  ASPIsetDeviceIDflag(DID.DriveID, ADIDmodeSenseDBD, True);
                  if TestModeSense then
                    ASPIsetDeviceIDflag(DID.DriveID, ADIDmodeSense6, True);
                end;
              end;
              if not CallBack(Caller, DID, CDName) then
                exit;
              Inc(Result);
            end;
        end;
end;

procedure ASPIsetDeviceIDflag(var DeviceID: TBurnerID;
  Flag: TAspiDeviceIDflag; Value: boolean);
begin
  if Value then
    DeviceID := DeviceID or (1 shl ORD(Flag))
  else
    DeviceID := DeviceID and not (1 shl ORD(Flag));
end;

{$WARNINGS OFF}

function ASPIgetDeviceType(DeviceID: TBurnerID;
  var DeviceType: TScsiDeviceType): TScsiError;
var
  Gsrb: SRB_GetDeviceType;
begin
  FillChar(Gsrb, sizeof(Gsrb), 0);
  Gsrb.SRB_Cmd := 1;
  ScatterDeviceID(DeviceID, Gsrb.SRB_HaId, Gsrb.SRB_Target, Gsrb.SRB_Lun);
  SendASPI32Command(@Gsrb);
  Result := GetAspiError(Gsrb.SRB_Status, $FF, $FF);
  if (Result = Err_None) and (Gsrb.SRB_DeviceType < ORD(TSDInvalid)) then
    DeviceType := TScsiDeviceType(Gsrb.SRB_DeviceType)
  else
    DeviceType := TSDInvalid;
end;
{$WARNINGS ON}

function ASPIgetDriveInt13info(DeviceID: TBurnerID;
  var Info: TScsiInt13info): TScsiError;
var
  Isrb: SRB_Int13info;
begin
  FillChar(Isrb, sizeof(Isrb), 0);
  with Isrb do
  begin
    SRB_Cmd := 6;
    ScatterDeviceID(DeviceID, SRB_HaId, SRB_Target, SRB_Lun);
  end;
  SendASPI32Command(@Isrb);
  with Info, Isrb do
  begin
    Result := GetAspiError(SRB_Status, $FF, $FF);
    Support := (Result = Err_None) and ((SRB_DriveFlags and 3) <> 0);
    DosSupport := (Result = Err_None) and ((SRB_DriveFlags and 1) <> 0);
    DriveNumber := SRB_Int13Drive;
    Heads := SRB_Heads;
    Sectors := SRB_Sectors;
  end;
end;

function ASPIhaInquiry(HaId: BYTE; var sh: TScsiHAinfo): TScsiError;
var
  Isrb: SRB_Inquiry;
begin
  FillChar(Isrb, sizeof(Isrb), 0);
  Isrb.SRB_Cmd := 0;
  Isrb.SRB_HaId := HaId;
  SendASPI32Command(@Isrb);
  with Isrb do
  begin
    Result := GetAspiError(SRB_Status, $FF, $FF);
    sh.ScsiId := SRB_HA_SCSIID;
    ASPIstrCopy(SRB_ManagerID, sh.ScsiManagerId, 16);
    ASPIstrCopy(SRB_AdapterID, sh.HostAdapterId, 16);
    sh.BufferAlignMask := SRB_BufAlign;
    sh.ResidualSupport := (SRB_Residual and 2) <> 0;
    if SRB_Targets = 0 then
      sh.MaxTargetCount := 8
    else
      sh.MaxTargetCount := SRB_Targets;
    sh.MaxTransferLength := SRB_TransfLen;
  end;
end;

function ResetAspi(ID, Target, LUN: Integer): Boolean;
var
  AdaptorSRB: PSRB_GDEVBlock;
  //  ASPI_Status: DWord;
begin
  //  result := False;
  New(AdaptorSRB);
  FillChar(AdaptorSRB^, Sizeof(SRB_HAInquiry), #0);
  AdaptorSRB^.SRB_Cmd := SC_RESET_DEV;
  AdaptorSRB^.SRB_HaId := ID;
  AdaptorSRB^.SRB_Target := Target;
  AdaptorSRB^.SRB_Lun := LUN;
  AdaptorSRB^.SRB_Flags := 0;
  AdaptorSRB^.SRB_Hdr_Rsvd := 0;
  //  ASPI_Status :=
  SendASPI32Command(AdaptorSRB);

  if AdaptorSRB^.SRB_Status <> SS_COMP then
    result := False
  else
    result := True;
  Dispose(AdaptorSRB);
end;

function GetAdaptorName(ID: Integer): string;
var
  AdaptorSRB: PSRB_HAInquiry;
  //  ASPI_Status: DWord;
  Res: string;
begin
  setlength(Res, 16);
  New(AdaptorSRB);
  FillChar(AdaptorSRB^, Sizeof(SRB_HAInquiry), #0);
  AdaptorSRB^.SRB_Cmd := SC_HA_INQUIRY;
  AdaptorSRB^.SRB_HaId := ID;
  AdaptorSRB^.SRB_Flags := 0;
  AdaptorSRB^.SRB_Hdr_Rsvd := 0;
  //  ASPI_Status :=
  SendASPI32Command(AdaptorSRB);

  if AdaptorSRB^.SRB_Status <> SS_COMP then
    RES := 'Inquery Error'
  else
  begin
    Res := AdaptorSRB^.HA_Identifier;
  end;
  Result := Res;
  Dispose(AdaptorSRB);
end;

function GetAspiErrorSense(Status, HaStat, TargStat: BYTE;
  Sense: PscsiSenseInfo): TScsiError;
begin
  Result := GetAspiError(Status, HaStat, TargStat);
  if (Result = Err_CheckCondition) and Assigned(Sense) then
    if Sense^[0] = 0 then
      Result := Err_None
    else if (Sense^[0] and $7E) <> $70 {// recognized values} then
      Result := Err_SenseUnknown
    else
      case (Sense^[2] and $0F) of
        0:
          begin // Skey_NoSense
            if (Sense^[2] and $80) <> 0 {// FileMark flag} then
              Result := Err_SenseFileMark
            else if (Sense^[2] and $40) <> 0 {// EndOfMedia flag} then
              Result := Err_SenseEndOfMedia
            else if (Sense^[2] and $20) <> 0 {// IllegalLength flag} then
              Result := Err_SenseIllegalLength
            else if (Sense^[3] and $80) <> 0 {// ResidualCount < 0} then
              Result := Err_SenseIncorrectLength
            else
              Result := Err_SenseNoSense;
          end;
        1: Result := Err_SenseRecoveredError; //Skey_RecoveredError
        2: Result := Err_SenseNotReady; //Skey_NotReady
        3: Result := Err_SenseMediumError; //Skey_MediumError
        4: Result := Err_SenseHardwareError; //Skey_HardwareError
        5: Result := Err_SenseIllegalRequest; //Skey_IllegalRequest
        6: Result := Err_SenseUnitAttention; //Skey_UnitAttention
        7: Result := Err_SenseDataProtect; //Skey_DataProtect
        8: Result := Err_SenseBlankCheck; //Skey_BlankCheck
        9: Result := Err_SenseVendorSpecific; // Skey_VendorSpecific
        10: Result := Err_SenseCopyAborted; // Skey_CopyAborted
        11: Result := Err_SenseAbortedCommand; // Skey_AbortedCommand
        12: Result := Err_SenseEqual; // Skey_Equal
        13: Result := Err_SenseVolumeOverflow; // Skey_VolumeOverflow
        14: Result := Err_SenseMiscompare; // Skey_Miscompare
        15: Result := Err_SenseReserved; // Skey_Reserved
      end;
end;

function ASPIsend12CDB(DeviceID: TCDBurnerInfo; CDB: TCDB12; Pbuf: pointer;
  BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
begin
  if Assigned(Pbuf) and (Direction = SRB_DIR_IN) then
    FillChar(Pbuf^, BufLen, 0);
  Result := ASPIsendScsiCommand(DeviceID, @cdb, 12, Pbuf, BufLen, Direction,
    Sdf);
end;

function ASPIsend10CDB(DeviceID: TCDBurnerInfo; CDB: TCDB10; Pbuf: pointer;
  BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
begin
  if Assigned(Pbuf) and (Direction = SRB_DIR_IN) then
    FillChar(Pbuf^, BufLen, 0);
  Result := ASPIsendScsiCommand(DeviceID, @cdb, 10, Pbuf, BufLen, Direction,
    Sdf);
end;

function ASPIsend6CDB(DeviceID: TCDBurnerInfo; CDB: TCDB6; Pbuf: pointer;
  BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
begin
  if Assigned(Pbuf) and (Direction = SRB_DIR_IN) then
    FillChar(Pbuf^, BufLen, 0);
  Result := ASPIsendScsiCommand(DeviceID, @cdb, 6, Pbuf, BufLen, Direction,
    Sdf);
end;

function ASPIsend6(DeviceID: TCDBurnerInfo;
  OpCode: BYTE; Lba: DWORD; Byte4: BYTE;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
var
  cdb: array[0..5] of BYTE;
begin
  if Assigned(Pbuf) and (Direction = SRB_DIR_IN) then
    FillChar(Pbuf^, BufLen, 0);

  cdb[5] := 0;
  cdb[4] := Byte4;
  FillDWORD(LBA, cdb[0]);
  cdb[1] := AttachLUN(cdb[1], DeviceID.DriveID);
  cdb[0] := OpCode;

  Result := ASPIsendScsiCommand(DeviceID, @cdb, 6, Pbuf, BufLen, Direction,
    Sdf);
end;

function ASPIsend10(DeviceID: TCDBurnerInfo; OpCode: BYTE;
  Byte1: BYTE; Lba: DWORD; Byte6: BYTE; Word7: WORD;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
var
  cdb: array[0..9] of BYTE;
begin
  if Assigned(Pbuf) and (Direction = SRB_DIR_IN) then
    FillChar(Pbuf^, BufLen, 0);

  cdb[9] := 0;
  FillWORD(Word7, cdb[7]);
  cdb[6] := Byte6;
  FillDWORD(LBA, cdb[2]);
  cdb[1] := AttachLUN(Byte1, DeviceID.DriveID);
  cdb[0] := OpCode;
  Result := ASPIsendScsiCommand(DeviceID, @cdb, 10, Pbuf, BufLen, Direction,
    Sdf);
end;

function ASPIsend12(DeviceID: TCDBurnerInfo; OpCode: BYTE;
  Byte1: BYTE; Lba: DWORD; TLength: DWORD; Byte10: BYTE;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
var
  cdb: array[0..11] of BYTE;
begin
  if Assigned(Pbuf) and (Direction = SRB_DIR_IN) then
    FillChar(Pbuf^, BufLen, 0);
  cdb[11] := 0;
  cdb[10] := Byte10;
  FillDWORD(TLength, cdb[6]);
  FillDWORD(LBA, cdb[2]);
  cdb[1] := AttachLUN(Byte1, DeviceID.DriveID);
  cdb[0] := OpCode;
  Result := ASPIsendScsiCommand(DeviceID, @cdb, 12, Pbuf, BufLen, Direction,
    Sdf);
end;

function ASPIsendScsiCommandInternal(DeviceID: TCDBurnerInfo;
  Pcdb: pointer; CdbLen: DWORD;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;

var
  Esrb: SRB_ExecSCSICmd;
  hEvent: THandle;
begin
  Result := Err_None;
  hEvent := CreateEvent(nil, true, false, nil); // event to notify completion
  if hEvent = 0 then
  begin
    Result := Err_NoEvent;
    exit;
  end;
  ResetEvent(hEvent);
  FillChar(Esrb, sizeof(Esrb), 0); // Scsi Request Block init
  with Esrb do
  begin
    SRB_Cmd := 2; // SC_EXEC_SCSI_CMD
    ScatterDeviceID(DeviceID.DriveID, SRB_HaId, SRB_Target, SRB_Lun);
    SRB_Flags := Direction or $40; // set SRB_EVENT_NOTIFY flag
    SRB_BufLen := BufLen;
    SRB_BufPtr := Pbuf;
    SRB_SenseLen := sizeof(TscsiSenseInfo) - 2;
    if CdbLen > 16 then
      SRB_CDBLen := 16
    else
      SRB_CDBLen := CdbLen;
    SRB_PostProc := hEvent;
    Move(Pcdb^, SRB_CDBByte, SRB_CDBLen);
  end;
  SendASPI32Command(@Esrb); // send command to aspi
  if Esrb.SRB_Status = 0 then
  begin // signaled SS_PENDING  >> WAIT !
    if WaitForSingleObject(hEvent, Sdf.Timeout) <> WAIT_OBJECT_0 then
    begin
      Result := Err_NotifyTimeout;
      ASPIabortCommand(Esrb.SRB_HaId, @Esrb);
    end;
  end;
  if Esrb.SRB_Status <> 1 then
    Result := Err_NoDevice;

  CloseHandle(hEvent);
  if Result = Err_None then
    with Esrb do
    begin
      Sdf.Sense := SRB_Sense;
      Result := GetAspiErrorSense(SRB_Status, SRB_HaStat,
        SRB_TargStat, @SRB_Sense);
    end;
end;

function ASPIsendScsiCommand(DeviceID: TCDBurnerInfo;
  Pcdb: pointer; CdbLen: DWORD;
  Pbuf: pointer; BufLen: DWORD;
  Direction: DWORD; var Sdf: TScsiDefaults): TScsiError;
begin
  //  Result := Err_None;
  FillChar(Sdf.Sense, sizeof(TscsiSenseInfo), 0);

  Result := ASPIsendScsiCommandInternal(DeviceID,
    Pcdb, CdbLen, Pbuf, BufLen, Direction, Sdf);

  if Assigned(Sdf.fOnCommandSent) then
    Sdf.fOnCommandSent(DeviceID, Pcdb, CdbLen, Pbuf, BufLen, Direction, @Sdf,
      Result);
end;

procedure ASPIabortCommand(HaId: BYTE; Psrb: pointer);
var
  Asrb: SRB_Abort;
begin
  FillChar(Asrb, sizeof(Asrb), 0);
  Asrb.SRB_Cmd := 3;
  Asrb.SRB_HaId := HaId;
  Asrb.SRB_ToAbort := Psrb;
  SendASPI32Command(@Asrb);
end;

end.