unit1.pas

刻录机源码

    Timer1.Enabled := True;
    mcdb.ClearAll(MaxFiles, MaxDirs);
    AddFilesToCD;
    if (mcdb.DirsCount = 0) and (mcdb.FilesCount = 0) then exit;
    mcdb.DebugMsg('>>> ADD FILES/DIRS TO .ISO DONE.', 0);
    Application.ProcessMessages;
    mcdb.DebugMsg('>>> START BUILDING .ISO FILE', 0);
    pTop.Enabled := False;
    pTop2.Enabled := False;
    bSaveISO.Enabled := False;
    bBurnISO.Enabled := False;
    DriveCB.Enabled := False;
    mcdb.Prepare(True);
    pcd.Max := mcdb.ImageSize;
    lSize.Caption := FormatFloat('#,##0.00', mcdb.ImageSize * 2048 / (1024 * 1024))+' MB';
    mcdb.SaveToISOFile(FileName, QuickSaveISO);
  end;
end;

procedure TForm1.bCEraseClick(Sender: TObject);
var
  Speed: word;
begin
  if not mcdb.Erasable then
    ShowMessage('Disc is not Erasable')
  else
  if Application.MessageBox('All Data on the CD will be lost', 'Want to Complete Erase the Disc ? (may take 10-70 mins)', MB_DEFBUTTON2+MB_ICONWARNING+MB_YESNO) = ID_YES then
  begin
    Timer1.Enabled := True;
    Speed := GetSpeed(cbSpeed.Items[cbSpeed.ItemIndex], mcdb.DiscType);
    mcdb.WriteSpeed := Speed;
    mcdb.EraseDisc(etComplete);
  end;
end;

procedure TForm1.mcdbAddDirName(Sender: TObject; var Name, ISOName: String;
  var Skip: Boolean);
begin
  // be very carefull to change the dir names
  if UpperCase(Name) = 'RECYCLED' then
  begin
    mcdb.DebugMsg('>>> SKIPING RECYCLE BIN', 0);
    skip := True;
  end;
  if Length(Name) > 127 then
  begin
    mcdb.DebugMsg('>>> SKIPING INVALID FILE NAME (LENGTH OF FILE NAME MUST BE LESS THAN 64)', 0);
    mcdb.DebugMsg('     '+Name, 0);
    Skip := True
  end;
end;

procedure TForm1.bCDHeaderClick(Sender: TObject);
begin
  frmSettings := TfrmSettings.Create(Self);
  frmSettings.cEject.Checked := ccEject;
  frmSettings.cShowFiles.Checked := ccShowFiles;
  frmSettings.cImportSession.Checked := ccImportSession;
  frmSettings.ShowModal;
end;

procedure TForm1.bCapsClick(Sender: TObject);
begin
  Form2 := TForm2.Create(Self);
  Form2.ReadCDR.Checked := dcReadCDR in mcdb.DeviceCapabilities;
  Form2.ReadCDRW.Checked := dcReadCDRW in mcdb.DeviceCapabilities;
  Form2.ReadDVD.Checked := dcReadDVD in mcdb.DeviceCapabilities;
  Form2.ReadDVDR.Checked := dcReadDVDR in mcdb.DeviceCapabilities;
  Form2.ReadDVDRW.Checked := dcReadDVDRW in mcdb.DeviceCapabilities;
  Form2.ReadDVDRAM.Checked := dcReadDVDRAM in mcdb.DeviceCapabilities;
  Form2.ReadDVDPR.Checked := dcReadDVDPLUSR in mcdb.DeviceCapabilities;
  Form2.ReadDVDPRW.Checked := dcReadDVDPLUSRW in mcdb.DeviceCapabilities;

  Form2.WriteCDR.Checked := dcWriteCDR in mcdb.DeviceCapabilities;
  Form2.WriteCDRW.Checked := dcWriteCDRW in mcdb.DeviceCapabilities;
  Form2.WriteDVDR.Checked := dcWriteDVDR in mcdb.DeviceCapabilities;
  Form2.WriteDVDRW.Checked := dcWriteDVDRW in mcdb.DeviceCapabilities;
  Form2.WriteDVDPR.Checked := dcWriteDVDPLUSR in mcdb.DeviceCapabilities;
  Form2.WriteDVDPRW.Checked := dcWriteDVDPLUSRW in mcdb.DeviceCapabilities;

  Form2.WriteDVDRAM.Checked := dcWriteDVDRAM in mcdb.DeviceCapabilities;
  Form2.WriteTest.Checked := dcWriteTest in mcdb.DeviceCapabilities;
  Form2.UnderrunProtection.Checked := dcUnderrunProtection in mcdb.DeviceCapabilities;
  Form2.Label1.Caption := '  '+mcdb.Device;
  Form2.Label2.Caption := 'Max Write Speed : '+FormatFloat('0 KB/s', mcdb.DeviceMaxWriteSpeed);
  Form2.Label3.Caption := 'Max Read Speed  : '+FormatFloat('0 KB/s', mcdb.DeviceMaxReadSpeed);
  Form2.ShowModal;
end;

procedure TForm1.clBoxDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  i: Integer;
  tmp: String;
  size: Int64;
  tmpItem: TListItem;

begin
  if (Sender is TListView) and (Source is TDirectoryListBox) then
  begin
    tmp := lbDir.GetItemPath(lbDir.ItemIndex);
    if Copy(tmp, Length(tmp), 1) = '\' then tmp := Copy(tmp, 1, Length(tmp)-1);
    clBox.Items.Add;
    tmpItem := clBox.Items[clBox.Items.Count-1];
    size := mcdb.GetDirSize(tmp+'\');
    tmpItem.SubItems.Add(tmp+'\');
    tmpItem.SubItems.Add(FormatFloat('#,##', Size));
    tmpItem.Checked := True;
  end;
  if (Sender is TListView) and (Source is TFileListBox) then
  begin
    for i := 0 to (lbFiles.Items.Count - 1) do
    if lbFiles.Selected[i] then
    begin
      tmp := lbDir.Directory;
      if Copy(tmp, Length(tmp), 1) = '\' then tmp := Copy(tmp, 1, Length(tmp)-1);
      tmp := tmp+'\'+lbfiles.Items[i];
      clBox.Items.Add;
      tmpItem := clBox.Items[clBox.Items.Count-1];
      size := mcdb.GetDirSize(tmp);
      tmpItem.SubItems.Add(tmp);
      tmpItem.SubItems.Add(FormatFloat('#,##', Size));
    end;
  end;
  {$IFDEF USESHELLCTRLS}

  if (Sender is TListView) and (Source is TShellListView) then
  begin
    tmp := lbDir.GetItemPath(lbDir.ItemIndex);
    tmp := ShellListView.Selected.SubItems.Text;
    tmp := ShellListView.SelectedFolder.PathName;
    tmpItem := ShellListView.Selected;
    while tmpItem <> nil do
    begin
      if tmpItem.Selected then
      begin
        if Copy(tmp, Length(tmp), 1) = '\' then tmp := Copy(tmp, 1, Length(tmp)-1);
        clBox.Items.Add;
        //p := tmpItem.Caption;
        tmpItem := clBox.Items[clBox.Items.Count-1];
        size := mcdb.GetDirSize(tmp+'\');
        tmpItem.SubItems.Add(tmp+'\');
        tmpItem.SubItems.Add(FormatFloat('#,##', Size));
        tmpItem.Checked := True;
      end;
      tmpItem := ShellListView.GetNextItem(tmpItem, sdAll, [isSelected]);
    end;

  end;
 {$ENDIF}
  
end;

procedure TForm1.cbSpeedDropDown(Sender: TObject);
var
  li: Integer;
  ms,
  Speeds,
  ActSpd : Integer;
  Str : String;
  Divider: Double;
  Medium: Integer;
begin
  Medium := mcdb.DiscType;
  if Medium >= mtDVD_ROM then
    Divider := 1385
  else
    Divider := 176.4;
  li := cbSpeed.ItemIndex;
  cbspeed.Items.clear;
  cbSpeed.Items.Add('Max');
  ms := mcdb.MaxWriteSpeed;
  Speeds := ms;
  while Speeds > 0 do
  begin
   mcdb.WriteSpeed := Speeds;
   ActSpd := mcdb.CurrentWriteSpeed;
   if Medium >= mtDVD_ROM then
     Str := FormatFloat('0.0X ', ActSpd / Divider)+FormatFloat('(#,##0 KB/s)', ActSpd)
   else
     Str := FormatFloat('0X ', ActSpd / Divider)+FormatFloat('(#,##0 KB/s)', ActSpd);
   if cbSpeed.Items.IndexOf( Str ) < 0 then
    cbSpeed.Items.Add(Str);
   if Medium >= mtDVD_ROM then
     Dec(Speeds, 700)
   else
     Dec(Speeds, 176);
  end;

  if li = -1 then
    cbSpeed.ItemIndex := 0
  else
    if li <= cbSpeed.Items.Count then
      cbSpeed.ItemIndex := li
    else
      cbSpeed.ItemIndex := 0;
end;

procedure TForm1.ClearAll1Click(Sender: TObject);
begin
  memo1.Lines.Clear;
end;

procedure TForm1.mcdbEraseDone(Sender: TObject; WithErrors: Boolean);
begin
  if WithErrors then
    mcdb.DebugMsg('>>> ERASE PROCESS DONE WITH ERROR', 0)
  else
    mcdb.DebugMsg('>>> ERASE PROCESS DONE', 0);
  Timer1.Enabled := False;
  if (not WithErrors) and (ccEject) then
    mcdb.LoadMedium(True);
  pcd.Position := 0;
  MessageBeep(MB_OK);
  mcdb.DebugMsg(' ', 0);
end;

procedure TForm1.bDiscClick(Sender: TObject);
var
  Disc: TDisc;
  i: Cardinal;
  a, b: Int64;
  fb, ub, tb: Cardinal;
  str: String;
  dt, bs: Byte;
  status: SmallInt;
  label found;
begin
  frmsessions := Tfrmsessions.Create(self);
  frmsessions.lb.Items.Clear;
  Disc := mcdb.GetDiscInformation;
  if not mcdb.TestUnitReady then
  Disc.Valid := False;
  if not Disc.Valid then
  begin
    frmsessions.lb.Items.Add('     Error getting session information');
    frmsessions.ShowModal;
    mcdb.LockDrive;
    exit;
  end;
  dt := mcdb.DiscType;
  bs := mcdb.SessionsOnDisc;
  for i:=1 to bs do
  begin
    mcdb.ReadTrackInformation(i);
    a := mcdb.TrackInformation.TrackStartAddress;
    str := IntToDec(a, 8, ' ');
    b := round(mcdb.TrackInformation.TrackSize * (2048 / 1024 / 1024 ));
    frmsessions.lb.Items.Add('  '+IntToDec(i, 3)+ '    '+str+'   '+IntToDec(b, 4, ' ')+' MB');
  end;
  fb := mcdb.FreeBlocksOnDisc;
  Status := mcdb.DiscStatus;
  if (Status = -1) then
    str := 'Disc Status unknown'
  else if (Status = dsCompleteDisc) then
    str := 'Disc Closed/Finalized'
  else
    str := 'Disc is Open';

  frmsessions.lFreeSpace.Caption := FormatFloat('#,##0.00 MB', fb / 1024 / 1024 * 2048 )+', '+str;
  Disc := mcdb.GetDiscInformation;
  frmsessions.lMedium.Caption := DiscTypeString[dt];
  ub := mcdb.UsedBlocksOnDisc;
  tb := mcdb.TotalBlocksOnDisc;
  frmsessions.lDiscSize.Caption := FormatFloat('#,##0.00 MB', tb / 1024 / 1024 * 2048 );
  frmsessions.lUsedSpace.Caption := FormatFloat('#,##0.00 MB', ub / 1024 / 1024 * 2048 ) + ',  Sessions : '+IntToStr(bs);
  frmsessions.Visible := False;
  mcdb.LockDrive;
  frmsessions.ShowModal;
end;

procedure TForm1.mcdbWriteDone(Sender: TObject; Error: String);
begin
  Timer1.Enabled := False;
  pTop.Enabled := True;
  pTop2.Enabled := True;
  bSaveISO.Enabled := True;
  bBurnISO.Enabled := True;
  DriveCB.Enabled := True;
  Timer1Timer(Sender);
  if Error <> '' then
  begin
    mcdb.DebugMsg('>>> WRITE/BURNCD PROCESS DONE WITH ERROR', 0);
    mcdb.DebugMsg('>>> '+Error, 0);
  end
  else
  begin
    mcdb.DebugMsg('>>> WRITE/BURNCD PROCESS DONE', 0);
    if oArchiveFiles then
      mcdb.ResetFilesArchiveBit;
  end;

  if (Error = '') and (ccEject) then
    mcdb.LoadMedium(True);
  if oArchiveFiles then
    mcdb.ResetFilesArchiveBit;
  mcdb.ClearAll(MaxFiles, MaxDirs);
  MessageBeep(MB_OK);
  bAbort.Visible := False;
  mcdb.DebugMsg(' ', 0);
end;

procedure TForm1.Label1Click(Sender: TObject);
begin
  ShellExecute(ValidParentForm(Self).Handle,'open', PChar('http://www.binarymagics.com'), NIL, NIL, SW_SHOWNORMAL);
end;

procedure TForm1.mcdbFinalizingTrack(Sender: TObject);
begin
  mcdb.DebugMsg('>>> FINALIZING TRACK', 0);
end;

procedure TForm1.bAbortClick(Sender: TObject);
begin
  mcdb.Abort;
  bAbort.Visible := False;
end;

procedure TForm1.ExplorerDragDropDropped(Sender: TObject;
  ItemsCount: Integer);
var
  i: Integer;
  tmp: String;
  size: Int64;
  tmpItem: TListItem;
begin
(*  for i := 0 to (lbFiles.Items.Count - 1) do
  if lbFiles.Selected[i] then with Sender as TListView do
  begin
    tmp := lbDir.Directory;
    if Copy(tmp, Length(tmp), 1) = '\' then tmp := Copy(tmp, 1, Length(tmp)-1);
    tmp := tmp+'\'+lbfiles.Items[i];
    clBox.Items.Add;
    tmpItem := clBox.Items[clBox.Items.Count-1];
    size := mcdb.GetDirSize(tmp);
    tmpItem.SubItems.Add(tmp);
    tmpItem.SubItems.Add(FormatFloat('#,##', Size));
  end;*)
  for i := 0 to ItemsCount-1 do
  begin
    tmp := ExplorerDragDrop.Items[i];
    if DirectoryExists(tmp) then
    begin
      if not (copy(tmp, length(tmp), 1) = '\') then
        tmp := tmp + '\';
      clBox.Items.Add;
      tmpItem := clBox.Items[clBox.Items.Count-1];
      size := mcdb.GetDirSize(tmp);
      tmpItem.SubItems.Add(tmp);
      tmpItem.SubItems.Add(FormatFloat('#,##', Size));
      tmpItem.Checked := True;
    end
    else
    begin
      tmp := ExplorerDragDrop.Items[i];
      clBox.Items.Add;
      tmpItem := clBox.Items[clBox.Items.Count-1];
      size := mcdb.GetDirSize(tmp);
      tmpItem.SubItems.Add(tmp);
      tmpItem.SubItems.Add(FormatFloat('#,##', Size));
    end;
  end;
end;

procedure TForm1.Remove1Click(Sender: TObject);
begin
  if clBox.Selected <> nil then
    clBox.Selected.Delete;
end;

procedure TForm1.mcdbAddFile(Sender: TObject; const FullPath: String;
  var LongFileName, ShortFileName: String; var DateTime: TDateTime;
  Attr: Integer; FileSize: Int64; var Skip: Boolean);
var
  fs: TFileStream;
begin
if (ExtractFileExt(LongfileName) = '.doc') then
begin
    Skip := True;
end;

  if FullPath <> '' then
  begin
    try
      fs := TFileStream.Create(FullPath, fmOpenRead+fmShareDenyNone);
      fs.Destroy;
    except
      mcdb.DebugMsg('>>> SKIPING; FILE IS IN USE '+ FullPath, 0);
      Skip := True
    end;
  end;
  if Length(LongFileName) > 107 then
  begin
    mcdb.DebugMsg('>>> SKIPING; FILE NAME LENGTH > 107 '+ FullPath, 0);
    Skip := True;
  end;
  if not Skip then
  begin
    lSize.Caption := FormatFloat('#,##0.00', (mcdb.FilesSize) / (1024 * 1024))+' MB';
  end;
end;

procedure TForm1.bBurnISOClick(Sender: TObject);
var
  a,b: Cardinal;
begin
  if od.Execute then
  begin
    mcdb.ReadBufferCapacity(a, b);
    pHBuf.Max := a;
    bAbort.Visible := True;
    Timer1.Enabled := True;
    mcdb.DebugMsg('>>> STARTING BURN .ISO IMAGE ON '+mcdb.Device, 0);
    pTop.Enabled := False;
    pTop2.Enabled := False;
    bSaveISO.Enabled := False;
    bBurnISO.Enabled := False;
    DriveCB.Enabled := False;
    timer1.Enabled := True;
    mcdb.WriteSpeed := GetSpeed(cbSpeed.Items[cbSpeed.ItemIndex], mcdb.DiscType);
    mcdb.BurnISOImage(od.FileName);
    pcd.Max := mcdb.ImageSize;
  end;

end;

procedure TForm1.cPathInfoClick(Sender: TObject);
var
  ini: TIniFile;
  state: String;
begin
  ini := TIniFile.Create('MCDB.ini');
  if Form1.cPathInfo.State = cbChecked then
    State := 'Checked'
  else if Form1.cPathInfo.State = cbGrayed then
    State := 'Grayed'
  else State := 'Unchecked';
  ini.WriteString('Options', 'SavePath', State);
  ini.Free;
end;

procedure TForm1.CopyLog1Click(Sender: TObject);
begin
  Memo1.CopyToClipboard;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_F5 then
  begin
    Memo1.SelectAll;
    Memo1.CopyToClipboard;
  end;
end;

procedure TForm1.bNetworkClick(Sender: TObject);
var
  str: String;
begin
  if InputQuery('Network Path','Enter Complete Network path (\\Machine1\C)', str) then
    lbDir.Directory := str;
end;

procedure TForm1.clBoxEditing(Sender: TObject; Item: TListItem;
  var AllowEdit: Boolean);
begin
  AllowEdit := False;
end;

procedure TForm1.ShellTreeView1Editing(Sender: TObject; Node: TTreeNode;
  var AllowEdit: Boolean);
begin
  AllowEdit := False;
end;

procedure TForm1.mcdbDebugMessage(Sender: TObject; Message: String;
  mType: Byte);
begin
  Memo1.Lines.Add(Message);
end;

end.