unit1.pas

刻录机源码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Gauges, mbDrvLib, mbCDBC, ExtCtrls, IniFiles;

type
  TForm1 = class(TForm)
    pb: TGauge;
    bBurn: TButton;
    Memo1: TMemo;
    mcdb: TMCDBurner;
    Timer1: TTimer;
    eDirToBurn: TEdit;
    eMask: TEdit;
    Label1: TLabel;
    cbDrives: TComboBox;
    procedure mcdbWriteDone(Sender: TObject; Error: String);
    procedure bBurnClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure mcdbFinalizingTrack(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure cbDrivesChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function BurnCD: boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.mcdbWriteDone(Sender: TObject; Error: String);
begin
  mcdb.WaitForReady;
  if Error = '' then
    Memo1.Lines.Add('>>> Burning done - No error')
  else
    Memo1.Lines.Add('>>> Burning done - With error');
end;

procedure TForm1.bBurnClick(Sender: TObject);
begin
  mcdb.InsertDir('\', eDirToBurn.Text, eMask.Text);
  BurnCD;
end;

function TForm1.BurnCD: boolean;
begin
  result := false;
  mcdb.WriteSpeed := 0;
  Application.ProcessMessages;
  if (mcdb.DirsCount = 0) and (mcdb.FilesCount = 0) then exit;
  mcdb.Prepare;
  if mcdb.FreeBlocksOnDisc < mcdb.ImageSize then
  begin
    Memo1.Lines.Add('>>> INSUFFICIENT DISC SPACE. REQUIRED '+IntToStr(mcdb.ImageSize*2048 div 1024)+'KB ,  AVAILABLE '+IntToStr(mcdb.FreeBlocksOnDisc*2048 div 1024)+'KB');
    exit;
  end;
  Memo1.Lines.Add('>>> Burning CD - Please wait');
  if mcdb.BurnCD then
    pb.MaxValue := mcdb.ImageSize;
  result := true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  pb.Progress := mcdb.BytesWritten div 2048;
end;

procedure TForm1.mcdbFinalizingTrack(Sender: TObject);
begin
  Memo1.Lines.Add('>>> FINALIZING TRACK - PLEASE WAIT');
end;

procedure TForm1.FormShow(Sender: TObject);
var
  ini: TIniFile;
begin
  ini := TIniFile.Create('.\CDBurner.ini');
  ini.WriteString('CDBurner', 'Files', '*.*');
  ini.Free;
  mcdb.InitializeASPI;
  if not mcdb.ASPIInitialized then
  begin
    bBurn.Enabled := False;
    Memo1.Lines.Add('Error initializing ASPI Layer, Please visit support page, http://www.binarymagics.com/html/support.html for more information');
    exit;
  end;
  mcdb.SessionToImport := 0;
  mcdb.ReplaceFile := True;
  mcdb.JolietFileSystem := True;
  mcdb.FinalizeDisc := False;
  if (mcdb.Devices <> nil) and (mcdb.Devices.Count > 0) then
     cbDrives.Items.Assign(mcdb.Devices);
  if cbDrives.Items.Count > 0 then
  begin
    cbDrives.ItemIndex := 0;
    cbDrivesChange(Sender);
  end;

end;

procedure TForm1.cbDrivesChange(Sender: TObject);
begin
  mcdb.Device := cbDrives.Text;
  Memo1.Lines.Add('>>> DRIVE SELECTED '+mcdb.Device)

end;

end.