 |
| 当前在线：1位 |
| 今日来宾：位 |
| 来宾总数：位 |
| CD、Combao刻录Delphi编程一例 | ||
| 通过CDwriter控件,支持CD、combao,如有需要该控件可与公司联系 unit cdwriterUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleCtrls, CDWriterXPLib_TLB, StdCtrls, ExtCtrls, ComCtrls, treeview2, ImgList, Buttons; type TForm1 = class(TForm) Panel1: TPanel; chkUseBurnProof: TCheckBox; Panel2: TPanel; driver: TComboBox; speedcombo: TComboBox; Label1: TLabel; Label2: TLabel; Splitter1: TSplitter; CDWriter: TCDWriterXP; ImageList1: TImageList; lvwImageFiles: TListView; txtVolIdentifier: TLabeledEdit; chkUseJoliet: TCheckBox; chkCacheImage: TCheckBox; chkFinalizeDisc: TCheckBox; cmdWriteDisc: TBitBtn; Cancelcmd: TBitBtn; tvwDirectories: TTreeView; chkTestWrite: TCheckBox; sbrStatus: TStatusBar; prgTrackProgress: TProgressBar; prgTotalProgress: TProgressBar; Label3: TLabel; Label4: TLabel; lblReadBuffer: TLabel; lblDriveBuffer: TLabel; Button1: TButton; readeProgress: TProgressBar; driverProgress: TProgressBar; procedure loaddrivercombo(Sender: TObject); procedure loadwriteSpeed; procedure FormCreate(Sender: TObject); procedure driverChange(Sender: TObject); procedure enableform(blnenable: boolean); procedure CDWriterCachingTrack(ASender: TObject; Track: Smallint; BlocksToCache: Integer); procedure CDWriterCachingTrackStatus(ASender: TObject; BlocksCached: Integer); procedure CDWriterClosingDisc(Sender: TObject); procedure CDWriterClosingSession(Sender: TObject); procedure CDWriterClosingTrack(ASender: TObject; Track: Smallint); procedure CDWriterEnumISOItems(ASender: TObject; const ParentDestPath, ItemDestPath, ItemName, SourceFilePath: WideString; IsDirectory: WordBool; FileDate: TDateTime; FileSize: Integer); procedure resetimage; procedure RecalcImageSize; procedure CDWriterISOImageReset(Sender: TObject); procedure CDWriterISOItemAdded(ASender: TObject; const ParentDestPath, ItemDestPath, ItemName, SourceFilePath: WideString; IsDirectory: WordBool; FileDate: TDateTime; FileSize: Integer); procedure CDWriterPreparingToWrite(Sender: TObject); procedure CDWriterReadBufferStatus(ASender: TObject; ReadBufferUsed: Smallint); procedure CDWriterReadingFile(ASender: TObject; FileIndex: Integer); Function GetWriteErrorMessage(Asender:Tobject;writeError:eWriteError;DeviceError:eCDError):string; Function GetDeviceErrorMsg(DeviceError:eCDError):String; Function GetFileErrorMessage(FileError:eTrackFileError;FileName:String):string; procedure CDWriterTrackFileError(ASender: TObject; FileError: TOleEnum; const FileName: WideString); procedure CDWriterTrackWriteStart(ASender: TObject; Track: Smallint; BlocksToWrite: Integer); procedure CDWriterTrackWriteStatus(ASender: TObject; Track: Smallint; BlocksWritten: Integer; DeviceBufferUsed: Smallint); procedure CDWriterWriteError(ASender: TObject; WriteError, DeviceError: TOleEnum); procedure CDWriterWritingCancelled(Sender: TObject); procedure CDWriterWritingComplete(Sender: TObject); procedure CancelcmdClick(Sender: TObject); procedure cmdWriteDiscClick(Sender: TObject); procedure txtVolIdentifierChange(Sender: TObject); procedure Button1Click(Sender: TObject); procedure loadfilelist(strCurrentDestPath:string); procedure tvwDirectoriesChange(Sender: TObject; Node: TTreeNode); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} type Pconid=^Tconid; Tconid=record key:string; end; const sglSplitLimit:single=500; var mintCurrentDrive,mintTracksToWrite,mintCurrentTrackCaching:smallint; mlngTrackBlocksToWrite,mlngCurrentTrackBlocksToCache:integer; mblnUnloadOk:boolean; pnt:Ttreenode; conid:Pconid; procedure TForm1.loaddrivercombo(Sender: TObject); var i:integer; begin for i:=0 to cdwriter.GetDriveCount-1 do driver.Items.Add(cdwriter.GetDriveLetter(i)+':'+cdwriter.GetDriveName(i)+' '+cdwriter.GetDriveVendor(i)); if driver.Items.Count>0 then driver.ItemIndex:=0; driverchange(nil); enableform(true); end; procedure TForm1.FormCreate(Sender: TObject); begin loaddrivercombo(nil); cdwriter.ClearISOImage; end; procedure Tform1.loadwriteSpeed; var maxspeed,intspeed:integer; begin maxspeed:=cdwriter.GetMaxWriteSpeed; speedcombo.Items.Clear; intspeed:=maxspeed; if maxspeed>0 then repeat speedcombo.Items.Add(inttostr(intspeed)+'X'); if intspeed<=4 then intspeed:=intspeed div 2 else intspeed:=intspeed-4; until intspeed<=0 else speedcombo.Items.Add('default'); if speedcombo.Items.Count>0 then speedcombo.ItemIndex:=0; end; procedure TForm1.driverChange(Sender: TObject); var i:integer; begin i:=driver.ItemIndex; if cdwriter.OpenDrive(i) then mintCurrentDrive:=i else mintCurrentDrive:=-1; loadwriteSpeed; if cdwriter.IsDriveBurnProofCapable then chkUseBurnProof.Enabled:=true else chkUseBurnProof.Enabled:=false; chkUseBurnProof.Checked:=true; end; procedure TForm1.enableform(blnenable:boolean); begin Driver.Enabled := blnEnable; Speedcombo.Enabled := blnEnable; lvwImageFiles.Enabled := blnEnable; tvwDirectories.Enabled := blnEnable; cmdWriteDisc.Enabled := blnEnable; chkCacheImage.Enabled := blnEnable; chkFinalizeDisc.Enabled := blnEnable; chkTestWrite.Enabled := blnEnable; chkUseJoliet.Enabled := blnEnable; txtVolIdentifier.Enabled := blnEnable; If (CDWriter.IsDriveBurnProofCapable) and (blnEnable) Then chkUseBurnProof.Enabled:=True Else chkUseBurnProof.Enabled:=False; Cancelcmd.enabled := (not blnEnable); mblnUnloadOk:= blnEnable; application.ProcessMessages; end; procedure TForm1.CDWriterCachingTrack(ASender: TObject; Track: Smallint; BlocksToCache: Integer); begin mlngCurrentTrackBlocksToCache:=BlocksToCache; mintCurrentTrackCaching:=Track; end; procedure TForm1.CDWriterCachingTrackStatus(ASender: TObject; BlocksCached: Integer); var intpercenttrackcached:int64; begin intpercenttrackcached:=round((blockscached/mlngCurrentTrackBlocksToCache)*100); sbrstatus.Panels[0].Text:='贮存轨道完成'+inttostr(intpercenttrackcached)+'%'; end; procedure TForm1.CDWriterClosingDisc(Sender: TObject); begin sbrstatus.Panels[0].Text:='正在关封闭光盘......'; end; procedure TForm1.CDWriterClosingSession(Sender: TObject); begin sbrstatus.Panels[0].Text:='正在关闭进程......'; end; procedure TForm1.CDWriterClosingTrack(ASender: TObject; Track: Smallint); begin sbrstatus.Panels[0].Text:='正在关闭轨道'+inttostr(track); end; procedure TForm1.CDWriterEnumISOItems(ASender: TObject; const ParentDestPath, ItemDestPath, ItemName, SourceFilePath: WideString; IsDirectory: WordBool; FileDate: TDateTime; FileSize: Integer); var list:Tlistitem; begin if not isdirectory then begin list:=lvwimagefiles.Items.Add; list.Caption:=ItemName; list.ImageIndex:=3; list.SubItems.Add(inttostr(round(filesize/1000))+'KB'); list.SubItems.Add(datetimetostr(filedate)); application.ProcessMessages; end; end; procedure TForm1.resetimage; begin lvwImageFiles.Items.Clear; tvwDirectories.Items.Clear; cdwriter.VolumeIdentifier:='New Disc'; new(conid); conid.key:='\'; pnt:=tvwDirectories.Items.AddObject(nil,'New Disc',conid); pnt.ImageIndex:=0; pnt.SelectedIndex:=0; txtVolIdentifier.Text:=cdwriter.VolumeIdentifier; RecalcImageSize; end; procedure Tform1.RecalcImageSize; var lngSizeBlocks,lngSizeBytes:integer; begin lngSizeBlocks:=cdwriter.GetISOVolumeSizeBlocks; lngSizeBytes:=cdwriter.ConvertBlocksToBytes(lngSizeBlocks,wtpdata); sbrStatus.Panels[0].Text:='数据文件大小：'+Format('%8.2f',[lngSizeBytes/1000000])+'MB'; sbrStatus.Panels[1].Text:='文件数：'+inttostr(cdwriter.GetISOFileCount); sbrStatus.Panels[2].Text:='目录数：'+inttostr(cdwriter.GetDriveCount); end; procedure TForm1.CDWriterISOImageReset(Sender: TObject); begin resetimage; end; procedure TForm1.CDWriterISOItemAdded(ASender: TObject; const ParentDestPath, ItemDestPath, ItemName, SourceFilePath: WideString; IsDirectory: WordBool; FileDate: TDateTime; FileSize: Integer); var pnnt,prnt:Ttreenode; i:integer; begin i:=0; if isdirectory then begin repeat prnt:=tvwdirectories.Items.Item[i]; i:=i+1; until pconid(tvwdirectories.Items.Item[i-1].Data)^.key=parentdestpath; new(conid); conid.key:=ItemDestPath; pnnt:=tvwdirectories.Items.AddChildObject(prnt,ItemName,conid); pnnt.ImageIndex:=1; pnnt.SelectedIndex:=2; sbrstatus.Panels[0].Text:='添加......'+itemdestpath; end; application.ProcessMessages; end; procedure TForm1.CDWriterPreparingToWrite(Sender: TObject); begin mintTracksToWrite:=1; sbrstatus.Panels[0].Text:='正在准备刻录......'; prgTotalProgress.Position := 0; prgTrackProgress.Position := 0; readeprogress.Position:=0; driverprogress.Position:=0; enableform(false); end; procedure TForm1.CDWriterReadBufferStatus(ASender: TObject; ReadBufferUsed: Smallint); begin readeprogress.Position:=readbufferused; {lblReadBuffer.Caption:='读缓存：'+inttostr(readbufferused)+'%';} end; procedure TForm1.CDWriterReadingFile(ASender: TObject; FileIndex: Integer); begin sbrStatus.Panels[1].Text:='读文件......'+inttostr(fileindex); end; Function Tform1.GetWriteErrorMessage(Asender:Tobject;writeError:eWriteError;DeviceError:eCDError):string; begin case WriteError of errDriveError: if DeviceError = cdUnknownError Then result:='发生未知错误,扩展错误号：'+cdwriter.GetErrorData else result:= GetDeviceErrorMsg(DeviceError); errFileError: result:='刻录过程中发生了文件错误！'; errInvalidFormat:result:='轨道已被以无效的格式添加到刻录映像中...请重试！'; errNoTracksQueued:result:='轨道已被添加到刻录映像中...请重试！'; errReadBufferInitFailed:result:='读缓存未能初始化...请检查内存/磁盘资源。'; errWriteBufferInitFailed:result:='写缓存未能初始化...请检查内存/磁盘资源。'; else result:='未知的刻录错误。'; end; end; Function Tform1.GetDeviceErrorMsg(DeviceError:eCDError):String; begin Case DeviceError of cdNoAdditionalErrorData:result:='No additional error data was reported' ;//1000 cdIOTerminated: result:='Abnormal I/O Termination';//'1001 cdLogicalUnitNotReady:result:='The drive is not ready';//'1002 cdLogicalUnitCommFailed:result:='Communication with drive unit failed';// '1003 cdDeviceTrackingError:result:='The drive could not track properly' ;//1004 cdWriteGenericError:result:='Writing error of unknown origin' ;// '1005 cdWriteRecoveryNeeded:result:='Writing occurred, but recovery is needed'; //'1006 cdWriteRecoveryFailed ://1007 result:='Recovery attempt failed'; cdWriteLossOfStreaming ://1008 result:='A buffer under-run has occurred'; cdReadUnrecovered ://1009 result:='The disc could not be read'; cdReadRetriesExhausted ://1010 result:='The drive attempts at reading retries failed'; cdReadErrorTooLong ://1011 result:='The read timed out'; cdReadLECUncorrectable ://1012 result:='While reading, the LEC was not recovered'; cdReadCIRCUnrecovered ://1013 result:='The CIRC could not be validated'; cdReadUPCEANFailed ://1014 result:='Reading of the UPC failed'; cdReadISRCFailed ://1015 result:='Reading of the ISRC failed'; cdReadLossOfStreaming ://1016 result:='Streaming while reading was interrupted'; cdPositioningError ://1017 result:='Drive could not position media'; cdParameterListLengthError ://1018 result:='An incompatible parameter length was sent to the drive'; cdSynchronousTransferError ://1019 result:='A transfer error occurred to the drive'; cdInvalidCommandCode ://1020 result:='An invalid command was sent to the drive'; cdLBAOutOfRange ://1021 result:='Error trying to write past the end of the media'; cdInvalidCDBField ://1022 result:='Invalid command field'; cdInvalidParamterListField ://1023 result:='An incompatible parameter field was sent to the drive'; cdParameterNotSupported ://1024 result:='A command parameter is not supported'; cdParamterValueInvalid ://1025 result:='A command parameter had an invalid value'; cdBusOrDeviceReset ://1026 result:='The SCSI/ATAPI bus was reset and caused a write failure'; cdParametersChanged ://1027 result:='A command parameter changed while in progress'; cdIncompatibleMedium ://1028 result:='The disc is not compatible with the drive mode'; cdReadUnknownMediumFormat ://1029 result:='The drive does not recognize the format of the disc'; cdReadIncompatibleMediumFormat ://1030 result:='The disc format is not compatible with the drive'; cdWriteUnknownMediumFormat ://1031 result:='The disc is of an unknown format'; cdIncompatibleWriteFormat ://1032 result:='The drive cannot write because of an incompatible format'; cdMediaNotPresent ://1033 result:='A disc is not present'; cdLogicalUnitFailure ://1034 result:='The drive had an unknown failure'; cdLogicalUnitTimedOut ://1035 result:='The drive has timed out while completing a command'; cdEraseFailed ://1036 result:='The disc could not be erased'; cdUnableToRecoverTOC ://1037 result:='The Table of Contents is unrecoverable'; cdEndOfUserAreaOnTrack ://1038 result:='Error trying to write past the user area of the media'; cdPacketDoesNotFit ://1039 result:='Packet recording is not configured correctly'; cdIllegalTrackMode ://1040 result:='The current track mode is incompatible with the disc format'; cdInvalidPacketSize ://1041 result:='Packet recording has incorrect size'; cdSessionFixationError ://1042 result:='A generic session closing error occurred'; cdSessionFixationErrorLeadIn ://1043 result:='Error closing Lead-in area'; cdSessionFixationErrorLeadOut ://1044 result:='Error closing Lead-out area'; cdSessionFixationIncompleteTrack ://1045 result:='While closing, the track was never completed'; cdEmptyPartialReservedTrack ://1046 result:='Error attempting to write to a reserved track'; cdPowerCalibrationFull ://1047 result:='Power calibration area is full'; cdPowerCalibrationAreaError ://1048 result:='A flaw exists in the Power calibration area'; cdPMAUpdateFailure ://1049 result:='The disc is PMA could not be updated'; cdPMAFull ://1050 result:='The disc is PMA is full'; cdUnknownError ://1051 result:='Unknown error - use extended data for more information'; cdNoError ://1052 - You will never see this most likely result:='No Error Reported'; cdNoSeekComplete ://1053 result:='A seek command was interrupted by another command' End; end; Function Tform1.GetFileErrorMessage(FileError:eTrackFileError;FileName:String):string; begin Case FileError of tfeFileBufferError:result:='Error buffering file:' + FileName; tfeFileOpenError:result:='Error opening file: '+ FileName; tfeFileReadError:result:='Error reading file:'+ FileName; tfeFileWriteError:result:='Error writing file: '+ FileName; Else result:='Unknown file error!:'; end; end; procedure TForm1.CDWriterTrackFileError(ASender: TObject; FileError: TOleEnum; const FileName: WideString); var strerrormsg:string; begin strerrormsg:=getfileErrorMessage(fileerror,filename); sbrstatus.Panels[0].Text:=strerrormsg; end; procedure TForm1.CDWriterTrackWriteStart(ASender: TObject; Track: Smallint; BlocksToWrite: Integer); begin sbrstatus.Panels[0].Text:='正准备写轨道#：'+inttostr(track); prgTrackProgress.Position:=0; mlngTrackBlocksToWrite:=BlocksToWrite; end; procedure TForm1.CDWriterTrackWriteStatus(ASender: TObject; Track: Smallint; BlocksWritten: Integer; DeviceBufferUsed: Smallint); var intPercentTrackWritten,intPercentTotalTracksWritten:Integer; begin driverProgress.Position:=DeviceBufferUsed; {lblDriveBuffer.Caption:='刻录缓存：'+inttostr(DeviceBufferUsed)+'%';} intPercentTrackWritten:=round((BlocksWritten/mlngTrackBlocksToWrite) * 100); intPercentTotalTracksWritten:=round(((Track - 1 + (intPercentTrackWritten/100))/mintTracksToWrite)*100); prgTrackProgress.Position:=intPercentTrackWritten; prgTotalProgress.Position:=intPercentTotalTracksWritten; sbrStatus.Panels[0].Text:='正写轨道#：'+ inttostr(Track) +'... '; end; procedure TForm1.CDWriterWriteError(ASender: TObject; WriteError, DeviceError: TOleEnum); var strErrorMsg:String; begin strErrorMsg:=GetWriteErrorMessage(ASender, WriteError, DeviceError); application.MessageBox(pchar(strErrorMsg),'提示',0); EnableForm(true); sbrStatus.Panels[0].Text:='刻录发生错误..'; end; procedure TForm1.CDWriterWritingCancelled(Sender: TObject); begin sbrStatus.Panels[0].Text:='取消刻录......'; EnableForm(True); end; procedure TForm1.CDWriterWritingComplete(Sender: TObject); begin sbrStatus.Panels[0].Text:='刻录完毕!'; EnableForm(True); readeprogress.Position:=0; driverprogress.Position:=0; application.MessageBox('刻录完成！','提示',0); If not CDWriter.TestWrite Then CDWriter.Eject; prgtotalprogress.Position:=0; prgtrackprogress.Position:=0; end; procedure TForm1.CancelcmdClick(Sender: TObject); begin cdwriter.CancelWrite; end; procedure TForm1.cmdWriteDiscClick(Sender: TObject); begin if mintCurrentDrive=-1 then begin application.MessageBox('未选择刻录机或刻录机不存在！','提示',0); exit; end; if not cdwriter.IsMediaLoaded then begin application.MessageBox('请插入可刻录CD盘！','提示',0); cdwriter.Eject; exit; end; with cdwriter do begin WriteType:=wtpdata; CloseDisc:=chkfinalizedisc.Checked; CloseSession:=true; Joliet:=chkusejoliet.Checked; VolumeIdentifier:=txtvolidentifier.Text; TestWrite:=chktestwrite.Checked; CacheDataTrack:=chkcacheimage.Checked; SetBurnProofMode(chkuseburnproof.Checked); end; if not cdwriter.WriteDisc then application.MessageBox('刻录盘刻录失败！','提示',0); end; procedure TForm1.txtVolIdentifierChange(Sender: TObject); begin pnt.Text:=txtvolidentifier.Text; end; procedure Tform1.loadfilelist(strCurrentDestPath:string); begin lvwimagefiles.Items.Clear; cdwriter.EnumerateISOItems(strCurrentDestPath); end; procedure TForm1.Button1Click(Sender: TObject); begin cdwriter.ClearISOImage; cdwriter.CloneDirectoryToISO('\','H:\smallhis\*.*'); RecalcImageSize; end; procedure TForm1.tvwDirectoriesChange(Sender: TObject; Node: TTreeNode); begin loadfilelist(pconid(node.Data)^.key); end; end. |
||
| 出处：公司自创 | 发表时间:2006-11-11 2:20:30 | |
| 阅读次数：2111 | ||