开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 多媒体 > DVD > 查看源码
DVDUnit.pas
资源名称：freeburner.rar　[点击查看]
上传用户：wanyu_2000
上传日期：2021-02-21
资源大小：527k
文件大小：9k
源码类别：

DVD

开发平台：

Delphi

DVDUnit.pas：源码内容
  1. unit DVDUnit;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, ExtCtrls, ComCtrls, StdCtrls, DVDImage, ISO9660MicroUDFImageTree,
  8.   ImgList,Resources;
  10. type
  11.   TISOForm = class(TForm)
  12.     StatusBar1: TStatusBar;
  13.     MainMenu1: TMainMenu;
  14.     mm_File: TMenuItem;
  15.     sm_File_Open: TMenuItem;
  16.     sm_File_Close: TMenuItem;
  17.     sm_File_Break1: TMenuItem;
  18.     sm_File_Quit: TMenuItem;
  19.     dlg_OpenImage: TOpenDialog;
  20.     SaveDialog1: TSaveDialog;
  21.     sm_File_SaveAs: TMenuItem;
  22.     ImageList1: TImageList;
  23.     Panel1: TPanel;
  24.     mem_DebugOut: TMemo;
  25.     tv_Directory: TTreeView;
  26.     Panel2: TPanel;
  27.     VolIDEdit: TEdit;
  28.     Label1: TLabel;
  29.     PopupMenu1: TPopupMenu;
  30.     CreateDirctory1: TMenuItem;
  31.     N2: TMenuItem;
  32.     DeleteDirectory1: TMenuItem;
  33.     AddFile1: TMenuItem;
  34.     OpenDialog2: TOpenDialog;
  35.     NewISOImage1: TMenuItem;
  36.     SaveDVDImageas1: TMenuItem;
  37.     N3: TMenuItem;
  38.     Procedure ISOStatus(CurrentStatus:String);
  39.     procedure sm_File_QuitClick(Sender: TObject);
  40.     procedure sm_File_OpenClick(Sender: TObject);
  41.     procedure FormCreate(Sender: TObject);
  42.     procedure FormDestroy(Sender: TObject);
  43.     procedure tv_DirectoryDblClick(Sender: TObject);
  44.     procedure sm_File_CloseClick(Sender: TObject);
  45.     procedure tv_DirectoryChange(Sender: TObject; Node: TTreeNode);
  46.     procedure Image1Click(Sender: TObject);
  47.     procedure CheckDirs1Click(Sender: TObject);
  48.     procedure CreateDVDDirctory;
  49.     procedure CreateDirctory1Click(Sender: TObject);
  50.     procedure AddFile1Click(Sender: TObject);
  51.     procedure DeleteDirectory1Click(Sender: TObject);
  52.     procedure SaveDVDImageas1Click(Sender: TObject);
  53.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  54.   private
  55.     TreeObj : TObject;
  57.     FDVDImage  : TDVDImage;
  59.     Procedure  BuildStructureTree(ATV: TTreeView; RootNode : TTreeNode; ADirEntry : TDirectoryEntry);
  61.   public
  62.     ISOFilename : String;
  63.   end;
  65. var
  66.   ISOForm: TISOForm;
  68. implementation
  70. {$R *.DFM}
  72. procedure TISOForm.ISOStatus(CurrentStatus:String);
  73. begin
  74.    mem_debugout.Lines.Add(CurrentStatus);
  75. end;
  79. procedure TISOForm.sm_File_QuitClick(Sender: TObject);
  80. begin
  81.   Close;
  82. end;
  85. procedure TISOForm.sm_File_OpenClick(Sender: TObject);
  86. Var
  87.   Node : TTreeNode;
  88. begin
  89.   If ( dlg_OpenImage.Execute ) Then
  90.   Begin
  91.     If ( Assigned(FDVDImage) ) Then  FreeAndNil(FDVDImage);
  93.     mem_DebugOut.Clear;
  94.     tv_Directory.Items.Clear;
  96.     FDVDImage := TDVDImage.Create;
  97.     Try
  98.       FDVDImage.Filename := dlg_OpenImage.FileName;
  99.       FDVDImage.OnDVDStatus := ISOStatus;
  100.       //FDVDImage.OpenImage;
  101.       Node := tv_Directory.Items.Add(Nil, FDVDImage.Volume_ID+'/');
  102.       Node.Data := FDVDImage.Structure.RootDirectory;
  103.       BuildStructureTree(tv_Directory, Node, FDVDImage.Structure.RootDirectory);
  105.       sm_File_SaveAs.Enabled := True;
  106.       sm_File_Close.Enabled := True;
  108.     Except
  109.          mem_DebugOut.Lines.Add('Exception: ' + Exception(ExceptObject).ClassName + ' -> ' + Exception(ExceptObject).Message);
  110.       Raise;
  112.     End;
  113.   End;
  114. end;
  118. procedure TISOForm.FormCreate(Sender: TObject);
  119. begin
  120.   FDVDImage := Nil;   // not necessary, but safety first...
  121. end;
  124. procedure TISOForm.FormDestroy(Sender: TObject);
  125. begin
  126.   If ( Assigned(FDVDImage) ) Then FreeAndNil(FDVDImage);
  127. end;
  131. procedure TISOForm.tv_DirectoryDblClick(Sender: TObject);
  132. Var
  133.   Node : TTreeNode;
  134.   Obj  : TObject;
  135. begin
  136.   Node := TTreeView(Sender).Selected;
  137.   If Assigned(Node.Data) Then
  138.   Begin
  139.     Obj := TObject(Node.Data);
  140.     If ( Obj Is TFileEntry ) And ( SaveDialog1.Execute ) Then
  141.       FDVDImage.ExtractFile(TFileEntry(Obj), SaveDialog1.FileName);
  142.   End;
  143. end;
  147. Procedure TISOForm.BuildStructureTree(ATV: TTreeView; RootNode : TTreeNode; ADirEntry : TDirectoryEntry);
  148. Var
  149.   i : Integer;
  150.   Node : TTreeNode;
  151.   Dir  : TDirectoryEntry;
  152.   Fil  : TFileEntry;
  153. Begin
  154.   For i:=0 To ADirEntry.DirectoryCount-1 Do
  155.   Begin
  156.     Dir := ADirEntry.Directories[i];
  157.     Node := ATV.Items.AddChild(RootNode, Dir.Name + '/');
  158.     Node.ImageIndex := 1;
  159.     Node.SelectedIndex := 1;
  160.     Node.Data := Pointer(Dir);
  161.     BuildStructureTree(ATV, Node, Dir);
  162.   End;
  164.   For i:=0 To ADirEntry.FileCount-1 Do
  165.   Begin
  166.     Fil := ADirEntry.Files[i];
  167.     Node := ATV.Items.AddChild(RootNode, Fil.Name);
  168.     Node.ImageIndex := 2;
  169.     Node.SelectedIndex := 2;
  170.     Node.Data := Pointer(Fil);
  171.   End;
  172. End;
  176. procedure TISOForm.sm_File_CloseClick(Sender: TObject);
  177. begin
  178.   If ( Assigned(FDVDImage) ) Then FDVDImage.CloseImage;
  179.   sm_File_Close.Enabled  := False;
  180.   sm_File_SaveAs.Enabled := False;
  181. end;
  185. procedure TISOForm.tv_DirectoryChange(Sender: TObject; Node: TTreeNode);
  187. begin
  188.   If Assigned(Node) Then
  189.   Begin
  190.     TreeObj := TObject(Node.Data);
  191.  End;
  192. end;
  200. procedure TISOForm.Image1Click(Sender: TObject);
  202. var
  203.      DirEntry : TDirectoryEntry;
  204.      FileEntry : TFileEntry;
  206. begin
  207.     If ( Assigned(FDVDImage) ) Then FreeAndNil(FDVDImage);
  208.     FDVDImage := TDVDImage.Create;
  209.     FDVDImage.OnDVDStatus := ISOStatus;
  210.     CheckDirs1Click(nil);
  211.     CreateDVDDirctory;
  212. end;
  218. procedure TISOForm.CheckDirs1Click(Sender: TObject);
  219. Var
  220.   Node : TTreeNode;
  221. begin
  222.     tv_Directory.Items.Clear;
  223.     Try
  224.       Node := tv_Directory.Items.Add(Nil, '/');
  225.       Node.ImageIndex := 0;
  226.       Node.Data := FDVDImage.Structure.RootDirectory;
  227.       BuildStructureTree(tv_Directory, Node, FDVDImage.Structure.RootDirectory);
  228.       tv_Directory.Items[0].Expand(true);
  229.     Except
  230.       mem_DebugOut.Lines.Add('Exception: ' + Exception(ExceptObject).ClassName + ' -> ' + Exception(ExceptObject).Message);
  231.       Raise;
  232.     End;
  233. end;
  237. procedure TISOForm.CreateDVDDirctory;
  238. var
  239.         DirName : String;
  240.         DirEntry : TDirectoryEntry;
  241. begin
  242.         DirEntry := FDVDImage.Structure.RootDirectory;
  243.         DirName := 'VIDEO_TS';
  244.         if DirName <> '' then
  245.         begin
  246.            DirEntry := TDirectoryEntry.Create(FDVDImage.Structure,DirEntry,dsfFromImage);
  247.            DirEntry.Name := DirName;
  248.         end;
  250.         DirEntry := FDVDImage.Structure.RootDirectory;
  251.         DirName := 'AUDIO_TS';
  252.         if DirName <> '' then
  253.         begin
  254.            DirEntry := TDirectoryEntry.Create(FDVDImage.Structure,DirEntry,dsfFromImage);
  255.            DirEntry.Name := DirName;
  256.         end;
  257.         CheckDirs1Click(nil);
  258. end;
  262. procedure TISOForm.CreateDirctory1Click(Sender: TObject);
  263. var
  264.         DirName : String;
  265.         DirEntry : TDirectoryEntry;
  266. begin
  267.     If Assigned(TreeObj) Then
  268.     Begin
  269.       If ( TreeObj Is TDirectoryEntry ) Then
  270.       Begin
  271.         DirEntry := TDirectoryEntry(TreeObj);
  272.         DirName := InputBox('New Dir : ','Dir : ','');
  273.         if DirName <> '' then
  274.         begin
  275.            DirEntry := TDirectoryEntry.Create(FDVDImage.Structure,DirEntry,dsfFromImage);
  276.            DirEntry.Name := DirName;
  277.         end;
  278.         CheckDirs1Click(nil);
  279.       End;
  280.     End;
  281. end;
  285. procedure TISOForm.AddFile1Click(Sender: TObject);
  286. var
  287.         DirName : String;
  288.         DirEntry : TDirectoryEntry;
  289.         FileEntry : TFileEntry;
  290. begin
  291.     If Assigned(TreeObj) Then
  292.     Begin
  293.       If ( TreeObj Is TDirectoryEntry ) Then
  294.       Begin
  295.         DirEntry := TDirectoryEntry(TreeObj);
  296.         if OpenDialog2.execute then
  297.         begin
  298.            FileEntry := TFileEntry.Create(DirEntry,dsfFromLocal);
  299.            FileEntry.Name := ExtractFilename(Opendialog2.filename);
  300.            FileEntry.SourceFileName := Opendialog2.filename;
  301.         end;
  302.         CheckDirs1Click(nil);
  303.       End;
  304.     End;
  305. end;
  309. procedure TISOForm.DeleteDirectory1Click(Sender: TObject);
  310. var
  311.         DirName : String;
  312.         DirEntry : TDirectoryEntry;
  313. begin
  314.     If Assigned(TreeObj) Then
  315.     Begin
  316.       If ( TreeObj Is TDirectoryEntry ) Then
  317.       Begin
  318.         DirEntry := TDirectoryEntry(TreeObj).Parent;
  319.         DirEntry.DelDirectory(TDirectoryEntry(TreeObj));
  320.         CheckDirs1Click(nil);
  321.       End;
  322.     End;
  323. end;
  325. procedure TISOForm.SaveDVDImageas1Click(Sender: TObject);
  326. begin
  327.     savedialog1.Title := resFileDialogTitle;
  328.     if savedialog1.execute then
  329.     begin
  330.        ISOFilename := savedialog1.filename;
  331.        FDVDImage.Filename := ISOFilename;
  332.        FDVDImage.Volume_ID := VolIDEdit.text;
  333.        FDVDImage.SaveDVDImageToDisk;
  334.        ShowMessage(resISOSaved);
  335.     end;
  336. end;
  338. procedure TISOForm.FormClose(Sender: TObject; var Action: TCloseAction);
  339. begin
  340. If ( Assigned(FDVDImage) ) Then FreeAndNil(FDVDImage);
  341. end;
  343. end.