
04.06.2010, 00:45
|
Прохожий
|
|
Регистрация: 01.06.2010
Сообщения: 2
Репутация: 10
|
|
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IMAPI2_TLB, OleServer, IMAPI2FS_TLB,activeX, comobj,
ComCtrls;
type
TForm1 = class(TForm)
MsftFileSystemImage: TMsftFileSystemImage;
MsftDiscFormat2Data: TMsftDiscFormat2Data;
MsftDiscMaster: TMsftDiscMaster2;
MsftDiscRecorder: TMsftDiscRecorder2;
BurnButton: TButton;
FilesListBox: TListBox;
UpdateRecordersButton: TButton;
RecordersComboBox: TComboBox;
DiscVolumeNameEdit: TEdit;
Label1: TLabel;
Button1: TButton;
Button2: TButton;
ProgressBar1: TProgressBar;
MsftDiscFormat2Erase: TMsftDiscFormat2Erase;
LogListBox: TListBox;
procedure Button2Click(Sender: TObject);
procedure BurnButtonClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure UpdateRecordersButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure MsftDiscFormat2DataUpdate(ASender: TObject; const object_,
progress: IDispatch);
procedure Button1Click(Sender: TObject);
private
procedure WMDropFiles(var msg: TMessage); message WM_DROPFILES;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses shellapi;
///-----------------------------------------------------------------------------
Function SHCreateStreamOnFileEx( pszFile: PWChar; grfMode:DWORD; dwAttributes:DWORD;
fCreate:BOOL; pstmTemplate:IStream; var ppstm:IStream):DWORD;stdcall;
external 'shlwapi.dll' name 'SHCreateStreamOnFileEx';
//------------------------------------------------------------------------------
var
cfile:array[0..999] of char;
procedure TForm1.WMDropFiles(var msg : TMessage);
var
i, n : word;
hdrop : dword;
begin
hdrop := msg.WParam;
n := DragQueryFile(hdrop, $ffffffff, nil, 0);
for i := 0 to n-1 do
begin
DragQueryFile(hdrop, i, @cfile, 1000);
FilesListBox.Items.Add(cfile);
end;
msg.Result := 0;
inherited;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FilesListBox.Clear;
end;
procedure TForm1.BurnButtonClick(Sender: TObject);
var
wstr:WideString;
//f:IFsiFileItem;
i:integer;
DiscRoot:IFsiDirectoryItem;
resimage:IFileSystemImageResult;
DiscStream,fstream:IMAPI2_TLB.IStream;
DR:IDiscRecorder2;
begin
if RecordersComboBox.Items[RecordersComboBox.ItemIndex]='---' then exit;
if FilesListBox.Count=0 then exit;
MsftDiscRecorder.InitializeDiscRecorder(MsftDiscMaster.Item[RecordersComboBox.ItemIndex]);
//MsftDiscRecorder.InitializeDiscRecorder(MsftDiscMaster.Item[0]);
DiscRoot:=MsftFileSystemImage.Root;
MsftDiscFormat2Data.Recorder:=MsftDiscRecorder.DefaultInterface;
MsftDiscFormat2Data.ClientName:='IMAPI';
DR:=IDiscRecorder2(MsftDiscRecorder.DefaultInterface);
MsftFileSystemImage.ChooseImageDefaults(DR);
MsftFileSystemImage.VolumeName:= DiscVolumeNameEdit.Text;
for i:=0 to FilesListBox.Count-1 do
begin
if DirectoryExists(FilesListBox.Items[i]) then
DiscRoot.AddTree(FilesListBox.Items[i],true);
if FileExists(FilesListBox.Items[i]) then
begin
wstr:=FilesListBox.Items[i];
SHCreateStreamOnFileEx(PWideChar(wstr),0,0,False,nil,IStream(fstream));
DiscRoot.AddFile(ExtractFileName(FilesListBox.Items[i]),IMAPI2FS_TLB.IStream(fstream));
end;
end;
resimage:=MsftFileSystemImage.CreateResultImage;
DiscStream:=IMAPI2_TLB.IStream(resimage.ImageStream);
LogListBox.Clear;
LogListBox.Items.Add('Запись началась');
try
MsftDiscFormat2Data.Write(DiscStream);
MsftDiscRecorder.EjectMedia;
except
ShowMEssage('Ошибка');
close;
end;
MsftDiscRecorder.Disconnect;
BurnButton.Enabled:=false;
ShowMessage('Запись закончилась');
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
if not MsftDiscMaster.IsSupportedEnvironment then
begin
showmessage('нет ни одного пишущего привода');
close;
end;
UpdateRecordersButton.Click;
end;
procedure TForm1.UpdateRecordersButtonClick(Sender: TObject);
var
i:integer;
begin
RecordersComboBox.Clear;
for i:=0 to MsftDiscMaster.Count-1 do
begin
try
MsftDiscRecorder.InitializeDiscRecorder(MsftDiscMaster.Item[i]);
RecordersComboBox.Items.Add(MsftDiscRecorder.VendorId+' '+MsftDiscRecorder.ProductId);
MsftDiscRecorder.Disconnect;
except
RecordersComboBox.Items.Add('---');
end;
end;
RecordersComboBox.ItemIndex:=0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle,true);
end;
var
counter:dword=0;
procedure TForm1.MsftDiscFormat2DataUpdate(ASender: TObject; const object_,
progress: IDispatch);
var
CurProgress: IDiscFormat2DataEventArgs;
CurDiscF2D:IDiscFormat2Data;
writtensectors:int64;
begin
// inc(counter);
// Label2.Caption:=inttostr(counter);
CurProgress:= progress as IDiscFormat2DataEventArgs;
CurDiscF2D:=object_ as IDiscFormat2Data;
if CurProgress.CurrentAction=IMAPI_FORMAT2_DATA_WRITE_ACTION_VALIDATING_MEDIA then
LogListBox.Items.Add('Validating media');
if CurProgress.CurrentAction=IMAPI_FORMAT2_DATA_WRITE_ACTION_FORMATTING_MEDIA then
LogListBox.Items.Add('Formatting media');
if CurProgress.CurrentAction=IMAPI_FORMAT2_DATA_WRITE_ACTION_INITIALIZING_HARDWARE then
LogListBox.Items.Add('Init hadrware');
if CurProgress.CurrentAction=IMAPI_FORMAT2_DATA_WRITE_ACTION_CALIBRATING_POWER then
LogListBox.Items.Add('calibrating');
if CurProgress.CurrentAction=IMAPI_FORMAT2_DATA_WRITE_ACTION_WRITING_DATA then
begin
writtensectors:=CurProgress.LastWrittenLba-CurProgress.StartLba;
ProgressBar1.Position:=round((writtensectors/CurProgress.SectorCount)*100);
end;
if CurProgress.CurrentAction=IMAPI_FORMAT2_DATA_WRITE_ACTION_FINALIZATION then
LogListBox.Items.Add('Finalization');
if CurProgress.CurrentAction=IMAPI_FORMAT2_DATA_WRITE_ACTION_COMPLETED then
LogListBox.Items.Add('Burn completed');
Application.ProcessMessages;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
MsftDiscRecorder.InitializeDiscRecorder(MsftDiscMaster.Item[RecordersComboBox.itemindex]);
MsftDiscFormat2Erase.Recorder:=MsftDiscRecorder.DefaultInterface;
MsftDiscFormat2Erase.ClientName:='IMAPI';
MsftDiscFormat2Erase.EraseMedia;
MsftDiscRecorder.Disconnect;
ShowMessage('Диск стёрт');
end;
end.
Admin: Пользуемся тегами!
Последний раз редактировалось Admin, 04.06.2010 в 10:09.
|