mbdrvlib.pas

刻录机源码

    +'ASC:'+IntToHex(sc.SenseArea.AddSenseCode, 2)+',ASQ:'+IntToHex(sc.SenseArea.AddSenQual, 2)+' '
    +fErrorString, mtUNKNOWN);
  end
  else
  begin
    if not DontShowError then
    begin
      DontShowError := True;
      if (sc.Status <> 1) and (sc.Status <> 0) then
      if (sc.cdbcmd <> $5C) and (sc.cdbcmd <> $12) and (sc.cdbcmd <> $35) then
      if (sc.cdbcmd <> $BB) and (sc.cdbcmd <> $5a) and (sc.cdbcmd <> $35) then
      if (sc.cdbcmd <> $B6) and (sc.cdbcmd <> $1e) and (sc.cdbcmd <> $55) then
      if (sc.cdbcmd <> $00) and (sc.cdbcmd <> $01) and (sc.cdbcmd <> $23) then
      if (sc.cdbcmd <> $43) and (sc.cdbcmd <> $04) and (sc.cdbcmd <> $46) then
      if (sc.cdbcmd <> $52) and (sc.cdbcmd <> $1B) and (sc.cdbcmd <> $51) then
      if not ((sc.SenseArea.AddSenseCode = 04) and (sc.SenseArea.AddSenQual = 08)) then
      begin
        s := IntToStr(sc.HAID)+':'+IntToHex(sc.Target, 1)+':'+IntToStr(sc.Lun)+' <'+IntToHex(sc.Status, 2)+'>'+' ['+IntToHex(sc.BufLen,5)+']';
        s := '('+IntToHex(sc.CDBCmd, 2)+') {'+IntToHex(sc.Flags, 2)+'|'+IntToHex(sc.CDBLen, 2)+'} - '+s+' ';
        for i:=1 to 15 do s := s + IntTohex(sc.CDBByte[i], 2)+' ';
        s := CommandName[sc.cdbCmd]+' '+s+' ';
        s := s + '|';
        if sc.BufLen <> 0 then
        begin
          for i:=0 to Min($100, sc.BufLen-1) do s := s + IntTohex(Byte(sc.BufPointer[i]), 2)+' ';
        end;
        DebugMsg('<<< '+s + '= '
        +IntToHex(sc.HaStat, 2)+' '+ IntToHex(sc.TargStat, 2)+' '+IntToHex(sc.SenseArea.ErrorCode,2)+' '+IntToHex(sc.SenseArea.SenseKey, 2)+' '
        +'ASC:'+IntToHex(sc.SenseArea.AddSenseCode, 2)+',ASQ:'+IntToHex(sc.SenseArea.AddSenQual, 2)+' '
        +fErrorString, mtUNKNOWN);
      end;
    end;
  end;

  if sc.Status = 0 then
  begin
    if EventNotify then
    begin
      CloseHandle(Event);
      ResetEvent(Event);
    end;
    AbortSCSICommand(sc);
    sc.Status := 4;
    sc.HaStat := HASTAT_TIMEOUT;
  end
  else
  begin
    CloseHandle(Event);      
  end;
  result := 1;
  if Integer(sc.BufPointer) mod 4 <> 0 then
    DebugMsg('aaaa'+intToStr(Integer(sc.BufPointer)), 0);
end;

{******************************************************************************}
{                                                                              }
{******************************************************************************}
function TSCSIDevice.SendCueSheet(buffer: PChar; BufferLength: Integer): Boolean;
var
  lsrb: TSRB_ExecSCSICmd;
begin
  fillchar(lsrb, sizeof(lsrb), 0);
  lsrb.Flags := $50;
  lsrb.CDBLen := $0A;
  lsrb.BufLen := bufferlength;
  lsrb.BufPointer := buffer;
  lsrb.CDBCmd := $5D;
  lsrb.CDBByte[7] := HiByte(Bufferlength);
  lsrb.CDBByte[8] := LoByte(Bufferlength);
  ExecScsiCommand(lsrb, 30000);
  result := lsrb.Status = SS_COMP;
end;
{******************************************************************************}
{                                Is Unit Ready ?                               }
{******************************************************************************}
function TSCSIDevice.TestUnitReady;
var
  lsrb: TSRB_ExecSCSICmd;
begin
  fillchar(lsrb, sizeof(lsrb), 0);
  lsrb.Flags := SRB_EVENT_NOTIFY;
  lsrb.CDBLen := 06;
  lsrb.SenseLen := SENSE_LEN;
  ExecScsiCommand(lsrb, TimeOut);
  result := lsrb.Status = SS_COMP;
end;
{******************************************************************************}
{                                Is Unit Ready ?                               }
{******************************************************************************}

function TSCSIDevice.WaitForReady(TimeOut: Integer = 10000; Step: Integer = 5000): Boolean;
var
  OTO: Integer;
label Wait02End;
begin
  result := false;
  OTO := TimeOut;
  fillchar(_SenseInfo, sizeof(_SenseInfo), 0);
  if (PDVR103) or (Wait02) then
  begin
    repeat
      SleepEx(1500, False);
      Dec(OTO, 1500);
      if OTO < 0 then goto Wait02End;
      TestUnitReady;
    until (LastSense.AddSenseCode <> 4);
  end;
Wait02End:  
  if (MediumIs <> mtDVD_RAM) then
  begin
    repeat
      SleepEx(Step, False);
      ReadDiscInformation;
      Dec(OTO, Step);
      if OTO < 0 then exit;
    until (LastSense.AddSenseCode <> 4);
  end
  else
  _SenseInfo.ASC := 4;
  if not TestUnitReady or (_SenseInfo.ASC <> 0) then
  begin
    repeat
      SleepEx(Step, False);
      Dec(OTO, Step);
      if OTO < 0 then exit;
      TestUnitReady;
    until (LastSense.AddSenseCode <> 4);
    repeat
      fillchar(_SenseInfo, sizeof(_SenseInfo), 0);
      RequestSense(@_SenseInfo, sizeof(_SenseInfo));
      Dec(OTO, Step);
      if OTO < 0 then exit;
      if _SenseInfo.ResponseCode = $F0 then
        _SenseInfo.ASC := 04;
      if _SenseInfo.ASC = 4 then
        SleepEx(Step, False);
    until (_SenseInfo.ASC = 0);
  end;
  result := true;
end;
{******************************************************************************}
{                               Reset SCSI Device                              }
{******************************************************************************}
function TSCSIDevice.ScsiReset: Integer;
var
  srb: SRB_BusDeviceReset;
  res: Integer;
begin
  fillchar (srb, sizeof(SRB_BusDeviceReset), 0);
  srb.Target := fTarget;
  srb.Command := SC_RESET_DEV;
  srb.Flags := SRB_DIR_SCSI;
  srb.Lun := fLun;
  srb.HaId := fHaID;
  res := SendASPI32Command (@srb);
  result := res;
end;
{******************************************************************************}
{                               Erase CD/DVD                                   }
{******************************************************************************}
var
  th: TEraseThread;

function TSCSIDevice.EraseProgress: Integer;
begin
  if not Erasing then
    result := 0
  else
    result := th.Progress;
end;

procedure TEraseThread.EraseDoneEvent;
begin
  Device.fErasing := False;
  if Assigned(Device.fEraseDone) then
    Device.fEraseDone(Device, EraseDoneWithError);

end;
{******************************************************************************}
{                    Wait for Erase to be completed                            }
{******************************************************************************}

procedure TEraseThread.Execute;
var
  Seconds: Double;
  i: Integer;
label endoferase;  
begin
  fProgress := 0;
  Seconds := 0;
  if  (MediumIs = mtDVD_RW_RO) or (MediumIs = mtDVD_RW_SR) then
  begin
    repeat
      fProgress  := Round(Seconds / AproxSecs * 100);
      Seconds := Seconds + 1;
      if not Device.TestUnitReady then
        SleepEx(2000, False);
      fProgress  := Round(Seconds / AproxSecs * 100);
    until (Device.LastSense.AddSenseCode <> 4) or (AproxSecs < Seconds);
    SleepEx(5000, False);
    repeat
      fProgress  := Round(Seconds / AproxSecs * 100);
      Seconds := Seconds + 1;
      if not Device.TestUnitReady then
        SleepEx(2000, False);
    until (Device.LastSense.AddSenseCode <> 4) or (AproxSecs < Seconds);
    
  end
  else if ((MediumIs = mtDVD_PLUSRW)) then
  begin
    buf1 := #$00#$82#$00#$08#$00#$23#$05#$40#$98#$00#$00#$00;
    //if (device.FormatUnit($11, @buf1, 12)) then
    repeat
       Sleep(2000);
       Seconds := Seconds + 2;
       device.ReadDiscInformation;
       fProgress  := Round(Seconds / AproxSecs * 100);
    until (device.LastSense.AddSenseCode <> 04);

    fillchar(buf2, $ff00, 0);
    if (Device.EraseType_ = etQuick) then
    begin
      for i:=0 to 64 do
        if not Device.Write10(i*32, 32, buf2, 32*2048) then
          goto endoferase;
        SleepEx(300, False);
        fProgress  := Round(Seconds / AproxSecs * 100);
        Seconds := Seconds + 1;
    end
    else
    begin
      for i:=0 to 71000 do
        if not Device.Write10(i*32, 32, buf2, 32*2048) then
          goto endoferase;
        SleepEx(300, False);
        Seconds := Seconds + 1;
        fProgress  := Round(Seconds / AproxSecs * 100);
    end;
    Device.FlushCache(30000, FALSE);
    Device.CloseTrackDVD(FALSE, 03, 0, 0, 0);

  end else if ((MediumIs = mtDVD_RAM))and (Device.EraseType_ = etQuick) then
  begin
    fillchar(buf2, $ff00, 0);
    for i:=0 to 64 do
    begin
      Device.Write10(i*32, 32, buf2, 32*2048);
    end;
    Device.FlushCache(30000, FALSE);
  end;
endoferase:
  if Wait02 then
  begin
    repeat
      fProgress  := Round(Seconds / AproxSecs * 100);
      Seconds := Seconds + 2;
      if not Device.TestUnitReady then
        SleepEx(2000, False);
    until (Device.LastSense.AddSenseCode <> 4) or (AproxSecs < Seconds);
    Device.ReadDiscInformation;
    SleepEx(5000, False);
  end;
  if not Device.TestUnitReady or not Device.ReadDiscInformation then
  begin
    if (Medium <> mtDVD_RAM) then
    begin
      repeat
        fProgress  := Round(Seconds / AproxSecs * 100);
        Device.ReadDiscInformation;
        Seconds := Seconds + 5;
        if Device.LastSense.AddSenseCode = 4 then
          SleepEx(5000, False);
      until (Device.LastSense.AddSenseCode <> 4) or (AproxSecs < Seconds);
    end;
    repeat
      fProgress  := Round(Seconds / AproxSecs * 100);
      Seconds := Seconds + 2;
      if not Device.TestUnitReady then
        SleepEx(2000, False);
    until (Device.LastSense.AddSenseCode <> 4) or (AproxSecs < Seconds);

    repeat
      fProgress  := Round(Seconds / AproxSecs * 100);
      fillchar(_SenseInfo, sizeof(_SenseInfo), 0);
      Device.RequestSense(@_SenseInfo, sizeof(_SenseInfo));
      Seconds := Seconds + 2;
      if _SenseInfo.ResponseCode = $F0 then
        _SenseInfo.ASC := 04;
      if _SenseInfo.ASC = 4 then
        SleepEx(2000, False)
      else
        SleepEx(2000, False);
    until (_SenseInfo.ASC = 0) or (AproxSecs < Seconds);
  end;

  if ASPILayerName = 'BMASPI32' then
    _ReInitializeASPI;
  fProgress := 100;
  Device.SetWriteParams(False, False, False, 1);
  Device.SetCDSpeed(Device.MaxReadSpeed, 2);
  Device.Rewind;
  Device.LockMedium(True);
  Device.LoadMedium;
  Device.Rewind;
  Device.TestUnitReady;
  Device.fErasing := False;
  if Device.ConsoleApplication then
  begin
    if Assigned(Device.fEraseDone) then
      Device.fEraseDone(Device, EraseDoneWithError);
  end
  else
    Synchronize(EraseDoneEvent);
end;
{******************************************************************************}
{                                 Erase Disc                                   }
{******************************************************************************}
function TSCSIDevice.EraseDisc;
var
  lsrb: TSRB_ExecSCSICmd;
  WriteSpeed, i: Integer;
begin
  TestUnitReady;
  LoadMedium;
  MediumIs := DiscType;
  Result := False;
  EraseType_ := EraseType;
  if not TestUnitReady then
  begin
    if not waitForReady(30000) then
    begin
      result := False;
      exit;
    end;
  end;
  if (MediumIs <> mtDVD_RAM) then
  begin
    SetCDSpeed(fReadSpeed, fWriteSpeed);
    SetWriteParams(False, False, False, MediumIs);
  end;
  WriteSpeed := CurrentWriteSpeed;
  if not TestUnitReady then
  begin
    if not waitForReady(30000) then
    begin
      result := False;
      exit;
    end;
  end;
  if (MediumIs = mtDVD_RAM) or (MediumIs = mtDVD_RW) or (MediumIs = mtDVD_RW_RO) or (MediumIs = mtDVD_RW_SR) or (MediumIs = mtDVD_PLUSRW) then
    DebugMsg('>>> '+format(MSG_ERASESTART,[DiscTypeString[MediumIs], FormatFloat('0.0X', WriteSpeed / 1385)+FormatFloat('(#,##0 KB/s)', WriteSpeed)]), mtMessage)
  else
    DebugMsg('>>> '+format(MSG_ERASESTART,[DiscTypeString[MediumIs], FormatFloat('0X', WriteSpeed / 176.4)+FormatFloat('(#,##0 KB/s)', WriteSpeed)]), mtMessage);
  if (MediumIs <> mtDVD_RAM) and (MediumIs <> mtDVD_PLUSRW) then
  begin
    fillchar(lsrb, sizeof(lsrb), 0);
    lsrb.Flags := SRB_EVENT_NOTIFY;
    lsrb.CDBLen := $0C;
    lsrb.SenseLen := SENSE_LEN;
    lsrb.CDBCmd := $A1;
    lsrb.CDBByte[1] := Byte(EraseType);
    lsrb.CDBByte[1] := lsrb.CDBByte[1] or 16; //16 for Background Erase
    ExecScsiCommand(lsrb, (60 * 1000)*80);    // max timeout 80 mins
    result := (lsrb.Status = SS_COMP) or (lsrb.Status = SS_PENDING);
  end
  else
  begin
    if (MediumIs = mtDVD_RAM) then
    begin
      if EraseType = etQuick then
      begin