⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 device.pas

📁 用于CD/DVD烧录的Delphi源码,包括source和demo
💻 PAS
字号:
{-----------------------------------------------------------------------------
 Unit Name: Device
 Author:    Paul Fisher / Andrew Semack
 Purpose:   Class for CD / DVD device
 History:
          03-11-05 Changed burn properties to a record of settings
-----------------------------------------------------------------------------}

unit Device;

interface

uses
  Windows, Classes, messages, Dialogs, DeviceTypes, DeviceReader, DeviceInfo,
    DiscInfo, CustomImage, SCSIUnit, DiskNotifier, SCSITypes;

type
  TDevice = class
  private
    FInfoRecord: PCDBurnerInfo;
    FDeviceInfo: TDeviceInfo;
    FDiscInfo: TDiscInfo;
    FDeviceReader: TDeviceReader;
    FBurnSettings: TBurnSettings;
    FLastError: TScsiError;
    FDefaults: TScsiDefaults;
    // notify events
    FOnCopyStatus: TCopyStatusEvent;
    FOnCDStatus: TCDStatusEvent;
    FOnBufferProgress: TCDBufferProgressEvent;
    FOnFileBufferProgress: TCDFileBufferProgressEvent;
    FOnBufferStatus: TCDBufferStatusEvent;
    FOnWriteStatusEvent: TCDWriteStatusEvent;
    FOnDriveDiskInsert : TNotifyEvent;
    FOnDriveDiskRemove : TNotifyEvent;
    FDiskNotifier : TDiskNotifier;

    procedure DiskInserted(DriveLetter : String); // for notify
    procedure DiskRemoved(DriveLetter : String); // for notify
    function GetBurnerInfo: TCDBurnerInfo;
    function GetIsLocked: boolean;
    function GetReady: boolean;
    function GetCapability: TCdRomCapabilities;
    function GetWriteParameters: string;
    function GetBufferSize: WORD;

    procedure AutoInitialize;
    procedure AutoDestroy;
    procedure SetDefaultBurnSettings;
    Procedure GetSpecialDeviceSettings;
  protected
    property BurnerInfo: TCDBurnerInfo read GetBurnerInfo;
  public
    constructor Create(InfoRecord: PCDBurnerInfo);
    destructor Destroy; override;

    procedure Lock;
    procedure UnLock;
    procedure Load(const NoWait: boolean = True);
    procedure Eject(const NoWait: boolean = True);
    procedure GetSpeed(out MaxReadSpeed, MaxWriteSpeed, CurrentReadSpeed,
      CurrentWriteSpeed: integer);
    function SetSpeed(const ReadSpeed, WriteSpeed: integer): Boolean;
    procedure BurnFromFile(const FileName: string);
    procedure BurnFromImage(Image: TCustomImage);
    procedure Erase(const FullErase: boolean = False);
    function CloseSession: Boolean;
    procedure QuickSetAudioBurnSettings;
    procedure QuickSetISOBurnSettings;
    procedure QuickSetDAOBurnSettings;
    procedure QuickSetSAOBurnSettings;

    property BurnSettings: TBurnSettings read FBurnSettings write FBurnSettings;
    property IsLocked: boolean read GetIsLocked;
    property IsReady: boolean read GetReady;
    property Capability: TCdRomCapabilities read GetCapability;
    property DeviceBurnSettings: string read GetWriteParameters; //??
    property DeviceInfo: TDeviceInfo read FDeviceInfo;
    property DiscInfo: TDiscInfo read FDiscInfo;
    property DeviceReader: TDeviceReader read FDeviceReader;
    property LastError: TScsiError read FLastError;
    property CDBufferSize: WORD read GetBufferSize;
    // notify properties
    property OnCopyStatus: TCopyStatusEvent read FOnCopyStatus write
      FOnCopyStatus;
    property OnCDStatus: TCDStatusEvent read FOnCDStatus write FOnCDStatus;
    property OnBufferProgress: TCDBufferProgressEvent read FOnBufferProgress
      write FOnBufferProgress;
    property OnFileBufferProgress: TCDFileBufferProgressEvent read
      FOnFileBufferProgress write FOnFileBufferProgress;
    property OnBufferStatus: TCDBufferStatusEvent read FOnBufferStatus write
      FOnBufferStatus;
    property OnWriteStatusEvent: TCDWriteStatusEvent read FOnWriteStatusEvent
      write FOnWriteStatusEvent;
    property OnDriveDiskInsert : TNotifyEvent Read FOnDriveDiskInsert
      write FOnDriveDiskInsert;
    property OnDriveDiskRemove : TNotifyEvent Read FOnDriveDiskRemove
      write FOnDriveDiskRemove;
  end;



implementation

uses
  BurnerThread, EraserThread, FileImage;

{ TDevice }

procedure TDevice.BurnFromFile(const FileName: string);
var
  FileImage: TFileImage;
begin
  FileImage := TFileImage.Create(FileName);
  FileImage.ImageType := ITISOFileImage; // set a just a filename to a iso file
  try
    BurnFromImage(FileImage);
  finally
    FileImage.Free;
  end;
end;


procedure TDevice.BurnFromImage(Image: TCustomImage);
var
  BurnerThread: TBurnerThread;
begin
  SetSpeed(SCDS_MAXSPEED, SCDS_MAXSPEED);
  BurnerThread := TBurnerThread.Create(FInfoRecord, Image);
  BurnerThread.OnCDStatus := FOnCdStatus;
  BurnerThread.OnCopyStatus := FOnCopyStatus;
  BurnerThread.OnBufferProgress := FOnBufferProgress;
  BurnerThread.OnFileBufferProgress := FOnFilebufferProgress;
  BurnerThread.OnBufferStatus := FOnBufferStatus;
  BurnerThread.OnWriteStatusEvent := FOnWriteStatusEvent;
  BurnerThread.BurnSettings := FBurnSettings;
  BurnerThread.Resume;
end;



Procedure TDevice.GetSpecialDeviceSettings;
begin
   FBurnSettings.SpecialDeviceType.PDVR103 := False;
   FBurnSettings.SpecialDeviceType.SonyCRX100E := False;
   FBurnSettings.SpecialDeviceType.TEAC512EB := False;
   FBurnSettings.SpecialDeviceType.SonyPowerBurn := False;
   FBurnSettings.SpecialDeviceType.FlmmedCT := False;

   if (BurnerInfo.ProductID = 'CRX175E') or (BurnerInfo.ProductID = 'CD-RW CRX800E') then
     FBurnSettings.SpecialDeviceType.SonyPowerBurn := True;

   if (BurnerInfo.ProductID = 'CD-RW CRX800E') then
     FBurnSettings.SpecialDeviceType.SonyCRX100E := True;

   if (BurnerInfo.ProductID = 'CDRW321040X') then
     FBurnSettings.SpecialDeviceType.FlmmedCT := True;

   if (BurnerInfo.ProductID = 'DVD-RW DVR-103') or (BurnerInfo.ProductID = 'DVD-RW DVR-103') then
   Begin
     FBurnSettings.SpecialDeviceType.PDVR103 := True;
     FBurnSettings.SpecialDeviceType.FlmmedCT := True;
   End;
end;




procedure TDevice.QuickSetISOBurnSettings;
begin
  FBurnSettings.DataBlockType := btMODE_1;
  FBurnSettings.WriteType := wtTRACK_AT_ONCE;
  FBurnSettings.TrackMode := tmCDR_MODE_DATA;
  FBurnSettings.SessionType := stCDROM_CDDA;
  FBurnSettings.EraseType := etBLANK_DISC;
  FBurnSettings.BurnProof := True;
  FBurnSettings.TestWrite := False;
  FBurnSettings.CloseSession := True;
  FBurnSettings.AudioPause := 150;
  FBurnSettings.PacketSize := 0;
  GetSpecialDeviceSettings;
end;


procedure TDevice.QuickSetAudioBurnSettings;
begin
  FBurnSettings.DataBlockType := btRAW_DATA_BLOCK;
  FBurnSettings.WriteType := wtTRACK_AT_ONCE;
  FBurnSettings.TrackMode := tmCDR_MODE_AUDIO;
  FBurnSettings.SessionType := stCDROM_CDDA;
  FBurnSettings.EraseType := etBLANK_DISC;
  FBurnSettings.BurnProof := True;
  FBurnSettings.TestWrite := False;
  FBurnSettings.CloseSession := True;
  FBurnSettings.AudioPause := 150;
  FBurnSettings.PacketSize := 0;
  GetSpecialDeviceSettings;
end;


procedure TDevice.QuickSetDAOBurnSettings; //looks like it is wrong
begin
  FBurnSettings.DataBlockType := btRAW_DATA_BLOCK;
  FBurnSettings.WriteType := wtSESSION_AT_ONCE;
  FBurnSettings.TrackMode := tmCDR_MODE_DATA;
  FBurnSettings.SessionType := stCDROM_CDDA;
  FBurnSettings.EraseType := etBLANK_DISC;
  FBurnSettings.BurnProof := True;
  FBurnSettings.TestWrite := False;
  FBurnSettings.CloseSession := True;
  FBurnSettings.AudioPause := 0;
  FBurnSettings.PacketSize := 0;
  FBurnSettings.SessionAtOnce := True;
  FBurnSettings.DiskAtOnce := True;
  GetSpecialDeviceSettings;
end;


procedure TDevice.QuickSetSAOBurnSettings;
begin
  FBurnSettings.DataBlockType := btRAW_DATA_BLOCK;
  FBurnSettings.WriteType := wtSESSION_AT_ONCE;
  FBurnSettings.TrackMode := tmCDR_MODE_DAO_96;
  FBurnSettings.SessionType := stCDROM_CDDA;
  FBurnSettings.EraseType := etBLANK_DISC;
  FBurnSettings.BurnProof := True;
  FBurnSettings.TestWrite := False;
  FBurnSettings.CloseSession := True;
  FBurnSettings.AudioPause := 0;
  FBurnSettings.PacketSize := 0;
  FBurnSettings.SessionAtOnce := True;
  FBurnSettings.DiskAtOnce := False;
  GetSpecialDeviceSettings;
end;



procedure TDevice.SetDefaultBurnSettings;
begin
  QuickSetISOBurnSettings;
end;

procedure TDevice.AutoInitialize; // Initialize variables
begin
  FDeviceInfo := TDeviceInfo.Create(FInfoRecord);
  FDiscInfo := TDiscInfo.Create(FInfoRecord);
  FDeviceReader := TDeviceReader.Create(FInfoRecord);
  FDiskNotifier := TDiskNotifier.Create(nil);
  FDiskNotifier.OnDiskInserted := DiskInserted;
  FDiskNotifier.OnDiskRemoved := DiskRemoved;
  SetDefaultBurnSettings;
  FDefaults := SCSI_DEF;
  FLastError := Err_None;
  SetSpeed($FFFF, $FFFF);
end;

constructor TDevice.Create(InfoRecord: PCDBurnerInfo);
begin
  FInfoRecord := InfoRecord;
  AutoInitialize;
end;

{ Method to free any objects created by AutoInitialize }

procedure TDevice.AutoDestroy;
begin
  FDiskNotifier.free;
  if assigned(FDiscInfo) then
    FDiscInfo.Free;
  if assigned(FDeviceInfo) then
    FDeviceInfo.Free;
  if assigned(FInfoRecord) then
    Dispose(FInfoRecord);
end;

destructor TDevice.Destroy;
begin
  AutoDestroy;
  inherited;
end;



procedure TDevice.DiskInserted(DriveLetter : String); // for disk notify
Begin
 if (DriveLetter = FDeviceInfo.DriveLetter) then
 begin
    if assigned(FDiscInfo) then FDiscInfo.RefreshInfo;
    if assigned(FOnDriveDiskInsert) then FOnDriveDiskInsert(self);
 end;
end;


procedure TDevice.DiskRemoved(DriveLetter : String); // for disk notify
Begin
 if (DriveLetter = FDeviceInfo.DriveLetter) then
 begin
    if assigned(FDiscInfo) then FDiscInfo.RefreshInfo;
    if assigned(OnDriveDiskRemove) then OnDriveDiskRemove(self);
 end;
end;


procedure TDevice.Eject(const NoWait: boolean);
begin
  FLastError := SCSIstartStopUnit(BurnerInfo, False, True, NoWait, fDefaults);
end;

procedure TDevice.Erase(const FullErase: boolean);
begin
  // create thread to erase disk
end;

function TDevice.GetBurnerInfo: TCDBurnerInfo;
begin
  Result := FInfoRecord^;
end;

function TDevice.GetIsLocked: boolean; //to do
begin
  Result := False;
end;

procedure TDevice.Load(const NoWait: boolean);
begin
  FLastError := SCSIstartStopUnit(BurnerInfo, True, True, NoWait, fDefaults);
end;

procedure TDevice.GetSpeed(out MaxReadSpeed, MaxWriteSpeed, CurrentReadSpeed,
  CurrentWriteSpeed: integer);
var
  CDROMSpeeds: TCDReadWriteSpeeds;
begin
  SCSIGetDriveSpeeds(BurnerInfo, CDROMSpeeds, fDefaults);
  MaxReadSpeed := CDRomSpeeds.MaxReadSpeed;
  MaxWriteSpeed := CDRomSpeeds.MaxWriteSpeed;
  CurrentReadSpeed := CDRomSpeeds.CurrentReadSpeed;
  CurrentWriteSpeed := CDRomSpeeds.CurrentWriteSpeed;
end;

function TDevice.GetWriteParameters: string;
var
  Params: string;
  // TBurnSettings
begin
  FLastError := ScsiGetWriteParams(BurnerInfo, 0, Params, fDefaults);
  Result := Params;
end;

procedure TDevice.Lock;
begin
  FLastError := SCSIpreventMediumRemoval(BurnerInfo, True, fDefaults);
end;

procedure TDevice.UnLock;
begin
  FLastError := SCSIpreventMediumRemoval(BurnerInfo, False, fDefaults);
end;

function TDevice.SetSpeed(const ReadSpeed, WriteSpeed: integer): Boolean;
begin
  FLastError := SCSISetSpeed(BurnerInfo, ReadSpeed, WriteSpeed, fDefaults);
  Result := FLastError = Err_None;
end;

function TDevice.GetReady: boolean;
begin
  FLastError := SCSItestReady(BurnerInfo, fDefaults);
  Result := FLastError = Err_None;
end;

function TDevice.GetCapability: TCdRomCapabilities;
begin
  FLastError := SCSIgetCdRomCapabilities(BurnerInfo, Result, fDefaults);
end;


function TDevice.CloseSession: Boolean;
begin
  FLastError := SCSICloseSession(BurnerInfo, fDefaults);
  Result := FLastError = Err_None;
end;

function TDevice.GetBufferSize: WORD;
var
  Temp: Word;
begin
  Temp := 0;
  FLastError := SCSIgetBufferSize(BurnerInfo, Temp, fDefaults);
  Result := Temp;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -