Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 01.06.2010, 12:47
buenosaire buenosaire вне форума
Прохожий
 
Регистрация: 01.06.2010
Сообщения: 2
Репутация: 10
Сообщение запись дисков в Delphi 7

Здравствуйте!!! Помогите, пожалуйста, написать программу для записи дисков Я тут нашел статейку интересную: http://www.interface.ru/home.asp?artId=21190. Все сделал так как описано, но при попытке стереть или же записать диск появляется ошибка "Access violation at address 42DA5168 in module imapi2.dll". В чем проблема, не знаю
Ответить с цитированием
  #2  
Старый 02.06.2010, 08:43
Rat Rat вне форума
Активный
 
Регистрация: 12.09.2008
Сообщения: 391
Репутация: 6078
По умолчанию

Вы бы полный свой исходничек предоставили.
Очень часто бывает, что при копировании кода из чужих статей, люди ошибаются или что то не замечают/забывают.
Ответить с цитированием
  #3  
Старый 04.06.2010, 00:45
buenosaire buenosaire вне форума
Прохожий
 
Регистрация: 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.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 17:59.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025