mbdrvlib.pas

刻录机源码

{*******************************************************************************
  Unit        : mbSCSILib.pas
  Date        : Jul 2001 - Apr 2004
  Author      : Ehsan Khan
  Description :
  Copyright   : 2001-04 Binary Magic, All rights reserved.
{******************************************************************************}
unit mbDrvLib;

interface
{$I DEFINES.INC}
{$DEFINE DEBUG}

uses
  Windows, Messages, SysUtils, Classes, mbASPI, Math, SyncObjs, mbConst, mbSPTI;

var
  CommandName: array[0..254] of string;
  TrialMCDB: Boolean = True;
  TrialMCB: Boolean = True;
  GenerateLogs: Boolean = False;

const
  etQuick = 1;
  etComplete = 0;
  etTrack = 2;

  dsEmptyDisc = 0;
  dsIncompleteDisc = 1;
  dsCompleteDisc = 2;
  dsOther = 3;
  lsEmptySession = 0;
  lsIncompleteLastSession = 1;
  lsDamagedLastSession = 2;
  lsCompleteLastSession = 3;
  bfNoRewriteable = 0;
  bfError = 1;
  bfInProgress = 2;
  bfDone = 3;

  dtNoDevice = -1;
  dtUnKnown = -2;
  dtDirectAccess = 0;
  dtSeqAccess = 1;
  dtPrinter = 2;
  dtProcessor = 3;
  dtWORM = 4;
  dtCDROM = 5;

  mtUNKNOWN   = 0;
  mtCD_ROM    = 1;
  mtCD_R      = 2;
  mtCD_RW     = 3;
  mtDVD_ROM   = 4;
  mtDVD_R     = 5;
  mtDVD_RAM   = 6;
  mtDVD_RW    = 7;
  mtDVD_RW_RO = 8;
  mtDVD_RW_SR = 9;
  mtDVD_PLUSRW= 10;
  mtDVD_PLUSR = 11;
  mtDVD_PLUSRDL = 12;
  mtDDCD_ROM = 13;
  mtDDCD_R = 14;
  mtDDCD_RW = 15;

  DiscTypeString: array [0..15] of String = 
  (
    'UNKNOWN',
    'CD-ROM',
    'CD-R',
    'CD-RW',
    'DVD-ROM',
    'DVD-R',
    'DVD-RAM',
    'DVD-RW',
    'DVD-RW',
    'DVD-RW',
    'DVD+RW',
    'DVD+R',
    'DVD+R DL',
    'DDCD-ROM',
    'DDCD-R',
    'DDCD-RW'
  );

type
  TScsiDeviceCapabilities = (dcReadCDR, dcReadCDRW, dcReadMethod2, dcReadDVD, dcReadDVDR, dcReadDVDRW, dcReadDVDRAM, dcReadDVDPLUSR, dcReadDVDPLUSRDL, dcReadDVDPLUSRW, dcWriteCDR, dcWriteCDRW, dcWriteTest, dcWriteDVDR, dcWriteDVDRW, dcWriteDVDRAM, dcWriteDVDPLUSR, dcWriteDVDPLUSRDL, dcWriteDVDPLUSRW, dcWriteISRC, dcUnderrunProtection);

  TDeviceCapabilities = set of TScsiDeviceCapabilities;
  TWriteMethod = (wmDAO, wmSAO, wmTAO);
  TWriteMethods = set of TWriteMethod;
  TEraseDoneEvent = procedure (Sender: TObject; WithError: Boolean) of object;
  TOnDebugMsg = procedure (Sender: TObject; Message: String; mType: Byte) of object;
  TDeviceChangedEvent = procedure (Sender: TObject) of object;

  TDisc = record
    Valid: Boolean;
    TotalBlocks: Cardinal;
    UsedBlocks: Cardinal;
    BlockLength: Cardinal;
    FirstCompleteSession,
    LastCompleteSession,
    DiscStatus,
    LastSession : Byte;
    DiscTypeCode: Word;
    DiscType: String;
    Eraseable: Boolean;
  end;
  type
  TSenseInfo = packed record
    ResponseCode: Byte;      // 0
    B1: Byte;                // 1
    SenseKey: Byte;          // 2
    Information: DWORD;      // 3-6
    AddSenseLen: Byte;       // 7
    CommandSpecific: DWORD;  // 8-11
    ASC: Byte;               // 12
    ASQ: Byte;               // 13
    FRUC: Byte;              // 14
    B15, B16, B17: Byte;     // 15-17
    B18n: array[0..16] of byte; // 18 -
    P: DWord;
    B19n: byte;              // 18 -
  end;


  TSCSIDevice = class;

  PAPerformaceDescriptor = ^TAPerformaceDescriptor;

  TAPerformaceDescriptor = packed record
    OtherInfo: Byte;
    Reserverd: packed array [0..2] of Byte;
    StartLBA: LongWord;
    EndLBA: LongWord;
    ReadSize: LongWord;
    ReadTime: LongWord;
    WriteSize: LongWord;
    WriteTime: LongWord;
  end;

  TEraseThread = class(TThread)
  private
    fProgress: Integer;
    Medium: Byte;
    Device: TSCSIDevice;
    AproxSecs: Word;
    EraseDoneWithError: Boolean;
    procedure EraseDoneEvent;

  protected
    procedure Execute; override;
    property Progress: Integer read fProgress write fProgress;

  end;
  TSCSIDevice = class(TComponent)
  private
    { Private declarations }
    fDriveLetters: array[0..26] of string;
    fDeviceSubType: ShortInt;
    fHaID,
    fTarget,
    fLun: Byte;
    EraseType_: Byte;
    fAdapters: ShortInt;
    ModePage2A: TModePage2A;
    ModePage05: TModePage05;
    fUnderrunProtection,
    fTestWrite: Boolean;
    fErrorString,
    fDevice: string;
    fDeviceType: ShortInt;
    fDeviceName: string;
    fInquiryData: TInquiryData;
    fDoDebug: Boolean;
    fDevCaps: TDeviceCapabilities;
    fDevices: TStrings;
    fTargetBusy: Boolean;
    fOnDeviceChange:  TDeviceChangedEvent;
    fHAInquiry: TSRB_HAInquiry;
    fSCAbort: TSRB_Abort;
    fEraseDone: TEraseDoneEvent;
    fDisc: TDisc;
    fTrackInformation: TTrackInformationBlock;
    fTOC100: TTOCPMATIP0100;
    fDeviceMaxWriteSpeed,
    fDeviceMaxReadSpeed: Word;
    fDeviceBufferSize, fDeviceFreeBufferSize: Cardinal;
    fFinalizeDisc, fErasing: Boolean;
    fLastSense: TSenseArea;
    fOnDebugMsg: TOnDebugMsg;
    fWriteMethod: TWriteMethod;
    fWriteMethods: TWriteMethods;
    function  GetHostAdapterInfo(HA: Byte): ShortInt;
    function  AbortSCSICommand(srb: TSRB_ExecSCSICmd): Boolean;
    function  GetASPIInitialized: Boolean;
    function  GetDriveLetter: Char;
    function  SetDeviceByDriveLetter(DriveLetter: Char): Boolean;
    function  GetWriteMethods: Boolean;
    function  CheckWriteMethod(wm: TWriteMethod): Boolean;
    procedure SetDriveLetter(Value: Char);
    procedure DeviceChanged;
    procedure SetDeviceID(Value: string);
    procedure SetWriteSpeed(Value: Word);

  protected
    { Protected declarations }
    fReadSpeed, fWriteSpeed: Word;
    CriticalSection: TCriticalSection;
    procedure Notification(aComponent: TComponent; Operation: TOperation); override;
    function GetConfigData(RT: Byte; Profile: Word; buf: Pointer; buflen: Integer): Boolean;
  public
    { Public declarations }
    PDVR103,
    SonyCRX100E,
    TEAC512EB,
    SonyPowerBurn: Boolean;
    DontShowError, ConsoleApplication: Boolean;

    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure Lock;
    procedure Unlock;
    procedure Rewind;
    procedure ScanDevices;
    //function CalcFreeDiscSpace: Int64;
    property Erasing: Boolean read fErasing;
    property Disc: TDisc read fDisc;
    property DeviceMaxWriteSpeed: Word read fDeviceMaxWriteSpeed;
    property DeviceMaxReadSpeed: Word read fDeviceMaxReadSpeed;
    property ASPIInitialized: Boolean read GetASPIInitialized;
    property DeviceType: ShortInt read fDeviceType;
    property DeviceSubType: ShortInt read fDeviceSubType;
    property DeviceName: String read fDeviceName;
    property Device: String read fDevice write SetDeviceID;
    property Devices: TStrings read fDevices;
    property HostAdapters: ShortInt read fAdapters;
    property DeviceCapabilities: TDeviceCapabilities read fDevCaps;
    property InquriyData: TInquiryData read fInquiryData write fInquiryData;
    property TestWrite: Boolean read fTestWrite write fTestWrite;
    property UnderrunProtection: Boolean read fUnderrunProtection write fUnderrunProtection;
    property DoDebug: Boolean read fDoDebug write fDoDebug default false;
    property OnDeviceChange: TDeviceChangedEvent read fOnDeviceChange write fOnDeviceChange;
    property OnEraseDone: TEraseDoneEvent read fEraseDone write fEraseDone;
    property ReadSpeed: Word read fReadSpeed write fReadSpeed;
    property WriteSpeed: Word read fWriteSpeed write SetWriteSpeed;
    property FinalizeDisc: Boolean read fFinalizeDisc write fFinalizeDisc;
    property DeviceBufferSize: Cardinal read fDeviceBufferSize write fDeviceBufferSize;
    property DeviceFreeBufferSize: Cardinal read fDeviceFreeBufferSize write fDeviceFreeBufferSize;
    property TargetBusy: Boolean read fTargetBusy;
    property DeviceByDriveLetter: Char read GetDriveLetter write SetDriveLetter;
    function GetDiskLetter(H, T, L: Byte): Byte;
    function InitializeASPI(InternalFirst: Boolean = False; AspiPath: String = ''): Boolean;
    function DeInitializeASPI: Boolean;
    function GetDiskInformation: Boolean;
    function ExecScsiCommand(var sc: TSRB_ExecSCSICmd; TimeOut: Integer): Integer;
    function ModeSense10(PageCode: Byte; var buf: Array of byte; buflen: Integer; PS: Boolean = False): Boolean;
    function ModeSelect10(Buffer: pchar; buflen: Integer): Boolean;
    function SetStreaming(Buffer: Pointer; BufLength: WORD): Boolean;
    function SetPerformance(StartLBA: LongWord; EndLBA: LongWord; ReadSize: LongWord; WriteSize: LongWord; ReadTime: LongWord; WriteTime: LongWord): Boolean;
    function SendCueSheet(buffer: PChar; BufferLength: Integer): Boolean;
    function ReadDVDStructure(Layer, Format: Byte; Buf: Pointer; BufLength: Word): Boolean;
    function SendDVDStructure(Format: Byte; Buf: Pointer; BufLength: Word): Boolean;
    function SendDVDStructureTimeStamp(Time: TDateTime): Boolean;
    function Inquiry: Boolean;
    function SessionsOnDisc: Smallint;
    function UsedBlocksOnDisc: Cardinal;
    function FreeBlocksOnDisc: Cardinal;
    function TotalBlocksOnDisc: Cardinal;
    function Erasable: Boolean;
    function DiscType: Byte;
    function ScsiReset: Integer;
    function DiscStatus: SmallInt;
    function LastSessionStatus: SmallInt;
    function GetDeviceCapabilities(Physical: Boolean = False): Boolean;
    function IsJustLinkCapable: Boolean;
    function SetWriteParams(TestWrite, UnderrunProtected, MultiSession: Boolean; MediumIs: SmallInt): Boolean;
    function GetLastRecordedAddress: Cardinal;
    function DecodeSense(scm : TSRB_ExecSCSICmd): string;
    function GetAspiError(Status, HaStat, TargStat : BYTE) : string;
    function AdditionalSenseInformation(scm : TSRB_ExecSCSICmd): String;
    function MaxWriteSpeed: Word;
    function MaxReadSpeed: Word;
    function CurrentWriteSpeed: Word;
    function CurrentReadSpeed: Word;
    function TestUnitReady(TimeOut: Integer = 5000): Boolean;
    function WaitForReady(TimeOut: Integer = 10000; Step: Integer = 5000): Boolean;
    function LockMedium(Unlock: Boolean = False): Boolean;
    procedure LockDrive(UnLock: Boolean = True);
    function LoadMedium(Eject: Boolean=False): Boolean;
    function EraseDisc(EraseType: Byte = etQuick): Boolean;
    function ReadCapacity(var Capacity, SectorSize: Cardinal): Boolean;
    function ReserveTrack(ReservationSize: Cardinal): Boolean;
    function Read10(LBA: Cardinal; TransferLength: Word; Buffer: PChar; buflen: Cardinal): Boolean;
    function ReadCD(LBA: Cardinal; TransferLength: Word; Buffer: PChar; buflen: Cardinal; SecType, Other, SubChannelsSelection: Byte): Boolean;
    function Write10(LBA: Cardinal; TransferLength: Word; Buffer: PChar; buflen: Cardinal; Flags: Byte = $50): Boolean;
    function FlushCache(TimeOut: Integer = 60 * 1000 * 5; Immed: Boolean = False): Boolean;
    function FormatUnit(FormatCode: Byte; Buffer: PChar; Length: Integer): Boolean;
    function CloseTrack(Session: Boolean=False; Immed: Boolean = True; DVDPR: Boolean = False; TrackNo: Byte = 0): Boolean;
    function CloseTrackDVD(Immed: Boolean; b2, b3, b4, b5: Byte): Boolean;
    function SetCDSpeed(ReadSpeed, WriteSpeed: Cardinal): Boolean;
    function SendOPC: Boolean;
    function ReadBufferCapacity(var BufferLength, BlankBufferLength: Cardinal): Boolean;
    function GetFormatCapacity(var Capacity: Cardinal; var SectorSize: Cardinal): Boolean;
    function ReadTrackInformation(TrackNumber: Byte): Boolean;
    function ReadTOC(Format: Byte; buffer: PChar; BufferLength: Integer; SessionTrackNumber: Byte = 0; Time: Boolean = False; Control: Byte = 0): Boolean;
    function ReadDiscInformation: Boolean;
    function ReadDiscInformationRaw(Buffer: PChar; BufferLength: Integer): Boolean;
    function RequestSense(Buffer: PChar; Len: Byte): Boolean;
    function GetDiscInformation: TDisc;
    function EraseProgress: Integer;
    function SelectDevice(sDevice: String): Boolean;

    procedure DebugMsg(Msg: String; mType: Byte);
    property TrackInformation: TTrackInformationBlock read fTrackInformation;
    property ErrorString: String read fErrorString write fErrorString;
    property LastSense: TSenseArea read fLastSense;
    property WriteMethod: TWriteMethod read fWriteMethod write fWriteMethod;

    property WriteMethods: TWriteMethods read fWriteMethods;
  published
    { Published declarations }
    property OnDebugMessage: TOnDebugMsg read fOnDebugMsg write fOnDebugMsg;
  end;

var
  buf1: array[0..$ff0] of char;
  buf2: array[0..$ff00] of char;
  buf3: array[0..$FF] of byte;
  buf4: packed array [0..65534] of Char;
  tmps: array[0..1000] of char;
  wms: Boolean = False;
  fwms: Boolean = False;
  _SenseInfo: TSenseInfo;
  DiscInfo: TDiscInformation;
  MediumIs: SmallInt;
  fImmedCT: Boolean;

function L2MDW(DW: DWORD) : DWORD;
function L2MW(W: WORD) : WORD;

implementation

type
  TConfigHeader = packed record
    DataLength: DWord;
    Res1: Word;
    CurrentProfile: Word;
    FeatureCode: Word;
    Version: Byte;
    AdditionalLength:  Byte;
    otherData: array[0..101] of byte
end;

var
  dtBuf: TConfigHeader;
  Wait02: Boolean;
  
//------------------------------------------------------------------------------
function L2MW(W: WORD) : WORD;
begin
  result := ((W SHL 8) AND $FF00) OR ((W SHR 8) AND $00FF);
end;

//------------------------------------------------------------------------------
function L2MDW(DW: DWORD) : DWORD;
begin
  result := ((DW SHL 24) AND $FF000000)
  OR ((DW SHL  8) AND $00FF0000)