unit1.pas

非常实用本人心血研制不是为了更多我需要的代码不会轻易拿出来换东东的关于盘刻录程序代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, ExtCtrls, OleCtrls, CDWriterXPLib_TLB,
  Buttons, ComCtrls,Unit2,Unit3,shellapi, Menus, DB, ADODB, Grids, DBGrids,
  WinSkinData, mbDrvLib, mbCDBC;

type
  TForm1 = class(TForm)
    F1: TFileListBox;
    D1: TDirectoryListBox;
    F2: TFileListBox;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Pa1: TPanel;
    Pa3: TPanel;
    Pa2: TPanel;
    Panel9: TPanel;
    Button1: TButton;
    Button3: TButton;
    ProgressBar0: TProgressBar;
    Panel12: TPanel;
    CDRW0: TButton;
    Li0: TListBox;
    Li1: TListBox;
    Panel6: TPanel;
    CDRW1: TButton;
    ProgressBar1: TProgressBar;
    Panel7: TPanel;
    CDRW2: TButton;
    ProgressBar2: TProgressBar;
    Li2: TListBox;
    Button4: TButton;
    l1: TMemo;
    Button5: TButton;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    PopupMenu1: TPopupMenu;
    PopupMenu2: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    Q1: TADOQuery;
    PopupMenu3: TPopupMenu;
    N5: TMenuItem;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SkinData1: TSkinData;
    Timer1: TTimer;
    MCDBurner1: TMCDBurner;
    Button2: TButton;
    CDWriterXP1: TCDWriterXP;
    procedure Button1Click(Sender: TObject);
    procedure D1Change(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure L1DblClick(Sender: TObject);
    procedure F1DblClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure CDRW0Click(Sender: TObject);
    procedure Rr0WritingComplete(Sender: TObject);
    procedure Rr0TrackWriteStatus(ASender: TObject; Track: Smallint;
      BlocksWritten: Integer; DeviceBufferUsed: Smallint);
    procedure Li1DblClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure MCDBurner1WriteDone(Sender: TObject; Error: String);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
  private

          Function  PanHao
          (s:string):string;
      Function Biao:string;
      Function Sd:string;

    { Private declarations }

    { Private declarations }
  protected

  procedure WndProc(var Message: TMessage); override;

    { Private declarations }
  public

  procedure KP(I1:integer;a1,a2:string);
      { Public declarations }
  end;

var

  Form1: TForm1;
  lj01:String;
implementation
uses Unit4;


{$R *.dfm}

      var
                Msg: LongInt;

procedure TForm1.WndProc(var Message: TMessage);
 var

   s:string;
begin

  if Message.msg = msg  then
begin
    s:=inttostr(message.lparam);
    TCDWriterXP(FindComponent('rr'+s)).OnWritingComplete(FindComponent('rr'+s));

     end;

    inherited;
 end;













Function  List01(s1:String):Integer;
begin
  form1.q1.SQL.Clear;
  form1.q1.SQL.Add('select * from cdrw where fileN like "'+s1+'"');
  form1.Q1.Open;
  Result:=0;
  if   FORM1.q1.RecordCount >0  then
  Begin
     Result:=FORM1.q1.RecordCount;
     Exit;
     end;

end;


procedure Rz(     s1,s2:String;d1:tdatetime);

begin

      form1.q1.SQL.Clear;
      form1.q1.SQL.Add('insert into cdrw(fileN,PATH01,DATE01) VALUES("'+s1+'","'+s2+'",'+':D1)');
      form1.q1.Parameters.ParamByName('d1').Value:=d1 ;
      form1.q1.ExecSQL;

      end;


procedure TForm1.KP(I1:integer;a1,a2:string) ;
var

     s1,s2,s3,s4,S5,s6:String;

begin

  s2:=a1;
  s3:=s2;


     MCDBurner1.Device:=MCDBurner1.Devices.Strings[i1];



  if   MCDBurner1.TestUnitReady =false then Begin ShowMessage('第'+IntToStr(i1)+'光驱未准备好');


  Button5.Click;
  l1.Lines.Insert(0,TListBox(FindComponent('Li'+inttostr(i1))).Items.Strings[0]);
  TListBox(FindComponent('Li'+inttostr(i1))).Items.Delete(0);
   Button4.Click;
       tbutton(FindComponent('cdrw'+inttostr(i1) )).Enabled :=true;
  Exit; end;

  s1:=ExtractFileDir(ParamStr(0))+'\p\ ';
  s2:=trim(copy(s2,pos('&',s2)+3,MaxInt))+'\'+copy(s2,1,6)+'\ ';




s6:=ExtractFileDir(ParamStr(0))+'\p1.exe '+inttostr(i1)+' '+s1+s2+Biao+' '+PanHao(TListBox(FindComponent('Li'+inttostr(i1))).Items.Strings[0])+' "'+Caption+'" '+sd ;
WinExec(pchar(s6),sw_hide);


      end;




procedure TForm1.Button1Click(Sender: TObject);
VAR

I,i1:integer;
 s1:String;
begin



l1.Clear;
i:=2;
while i< f1.Count do
begin
s1:=copy(f1.Items.Strings[i],2,6);

if Length(s1)=6  then
  l1.Lines.Add (s1+'&&&'+f1.Directory );

i:=i+1;

     end;

     button4.Click;
     {ExtractFileDir(ParamStr(0) );
f1.Items.Delimiter:=']';
caption:=f1.Items.Strings[2];
 }
end;

procedure TForm1.D1Change(Sender: TObject);
begin
f1.Directory :=
     (Sender as TDirectoryListBox).Directory;

end;

procedure TForm1.FormShow(Sender: TObject);
var
  i:integer;

begin
   Caption:=Biao()+'  '+Caption;
    l1.Lines.LoadFromFile (ExtractFileDir(ParamStr(0))+'\cctv.txt');

  MCDBurner1.InitializeASPI(True);

  if (MCDBurner1.Devices <> nil) and (MCDBurner1.Devices.Count > 0) then
  begin
  i:=0;
  while  i<MCDBurner1.Devices.Count do
   begin
   if      Pos('RW',UpperCase ( MCDBurner1.Devices.Strings[i])) <1 then
      MCDBurner1.Devices.Delete(i) ELSE

      i:=i+1;
   end;



       if  MCDBurner1.Devices.Count >0 then
            begin

 for i:=1 to MCDBurner1.Devices.Count do
tPanel(FindComponent('pa'+IntToStr(i))).Visible :=True;

F2.Directory:=ExtractFileDir(ParamStr(0))+'\P';  //

q1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ExtractFileDir(ParamStr(0))+'\data\CDRW.mdb;Persist Security Info=False';

              end;

 end;





end;

procedure TForm1.L1DblClick(Sender: TObject);
begin
if Application.MessageBox(pchar('真的去掉此文件么'+l1.seltext),'警告',4 or 32 or 256)=6 then
begin
l1.lines.delete(l1.Lines.IndexOf(l1.seltext)  );
Button4.Click;
     end;

end;

procedure TForm1.F1DblClick(Sender: TObject);
begin
if f1.ItemIndex <2 then Exit;


if Application.MessageBox('真的添加文件么','警告',4 or 32 or 256)=6 then
BEGIN
l1.lines.Add (copy(f1.Items.Strings[f1.ItemIndex ],2,length(f1.Items.Strings[f1.ItemIndex])-2)+'&&&'+f1.Directory );
     BUTTON4.Click;
     END;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if Application.MessageBox('真的完全清除么','警告',4 or 32 or 256)=6 then
l1.Lines.Clear ;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  s1,s2:string;
begin
  s1:=ExtractFileDir(ParamStr(0))+'\cctv.txt';
l1.Lines.SaveToFile(s1);
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  s1,s2:String;

  begin
  s1:=ExtractFileDir(ParamStr(0))+'\cctv.txt';
  l1.Lines.LoadFromFile (s1);
end;

Function  TForm1.PanHao(s:string):string;
var
  s1,str:String;
  i:integer;
 F:Textfile;
strs:String;
  begin
  result:='';
  i:=  pos( '&',s);
  S1:=copy(s,i+3,MaxInt);
          s:=s1+'\'+copy(s,1,6)+'\盘号.txt';

          if fileExists(s) then
begin
  AssignFile(F,s);

 Reset(f); {打开并读取文件 F }
Readln(f, strs);

Closefile(F); {关闭文件 F}
result:=strs;
End;

end;


Function tform1.Biao:string;
var
  s1,str:String;
  i:integer;
 F:Textfile;
strs:String;
  begin
  result:='';
     s1:= ExtractFileDir(ParamStr(0))+'\Biao.txt';

          if fileExists(s1) then
begin
  AssignFile(F,s1);
 Reset(f); {打开并读取文件 F }
Readln(f, strs);
Closefile(F); {关闭文件 F}
result:=strs;
End;

end;

Function Tform1.Sd:string;
var
  s1,str:String;
  i:integer;
 F:Textfile;
strs:String;
  begin
  result:='';
     s1:= ExtractFileDir(ParamStr(0))+'\Biao.txt';

          if fileExists(s1) then
begin
  AssignFile(F,s1);
 Reset(f); {打开并读取文件 F }
Readln(f, strs);
Readln(f, strs);
Closefile(F); {关闭文件 F}
result:=strs;
End;

end;



procedure TForm1.CDRW0Click(Sender: TObject);
var
  s1,s2,s3:String;

  begin


  s1:=ExtractFileDir(ParamStr(0))+'\cctv.txt';
  l1.Lines.LoadFromFile (s1);
       s2:=copy(TButton(Sender).name,5,5);



if  l1.lines <>nil then
   begin
      if l1.lines.Count<1  then Exit;
    TCDWriterXP(FindComponent('r'+s2) ).Free;
         if length(l1.lines.Strings[0])<6 then Exit;
          s1:=copy(l1.lines.Strings[0],1,6);
           IF List01(s1)>0 THEN
if Application.MessageBox(pchar('该证书已经被刻录过'+IntToStr(List01(s1))+'次是否继续？'),'提示',4 or 32 or 256 )<>6 then exit;


     s1:=  l1.lines.Strings[0];
    TListBox(FindComponent ('Li'+s2)).Items.Insert(0,s1);
     l1.lines.Delete(0);
   Button4.Click;
  (Sender as tbutton).Enabled :=False;
KP(strtoint(s2),TListBox(FindComponent ('Li'+s2)).Items.Strings[0],'0');
   end;



end;




procedure TForm1.Rr0WritingComplete(Sender: TObject);
var
  s1:string;
begin
  TCDWriterXP(sender).Eject;
s1:=copy(TCDWriterXP(sender).name,length(TCDWriterXP(sender).name),length(TCDWriterXP(sender).name));


ShowMessage('第'+s1+'号光驱'+
#13+panhao(TListBox(FindComponent('li'+s1)).Items.Strings[0]) +'号'+#13+'完成');

rz(copy(TListBox(FindComponent('li'+s1)).Items.Strings[0],1,6),copy(TListBox(FindComponent('li'+s1)).Items.Strings[0],10,maxint),now);
tbutton(FindComponent('CDRW'+ s1)).Enabled :=True;
tProgressBar(FindComponent('ProgressBar'+s1)).Position := 0;


end;


procedure TForm1.Rr0TrackWriteStatus(ASender: TObject; Track: Smallint;
  BlocksWritten: Integer; DeviceBufferUsed: Smallint);
  var
    s1:string;
  begin
s1:=    copy(TCDWriterXP(asender).name,length(TCDWriterXP(asender).name),length(TCDWriterXP(asender).name));

tProgressBar(FindComponent('ProgressBar'+s1)).Position := BlocksWritten div 30;


end;

procedure TForm1.Li1DblClick(Sender: TObject);
begin
if not tButton(FindComponent('CDRW'+copy(tlistbox(Sender).Name,length(tlistbox(Sender).Name),length(tlistbox(Sender).Name)))).Enabled  then
begin
Button5.Click;
l1.Lines.Insert(0,TListBox(Sender).Items.Strings[0]);
  TListBox(Sender).Items.Delete(0);
Button4.Click;
tButton(FindComponent('CDRW'+copy(tlistbox(Sender).Name,length(tlistbox(Sender).Name),length(tlistbox(Sender).Name)))).Enabled:=True; ;
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin

TPanel(FindComponent('PA'+COPY(TButton(Sender).Name,LENGTH(TButton(Sender).Name),LENGTH(TButton(Sender).Name)))).Visible:=False;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
Button5.Click
end;

procedure TForm1.N2Click(Sender: TObject);
begin
Button4.Click
end;

procedure TForm1.N3Click(Sender: TObject);
begin
Button3.Click;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
Button1.Click;
end;

procedure TForm1.N5Click(Sender: TObject);
 var
   form4:TForm4;
begin


      form4:=TForm4.Create(nil);
      form4.ShowModal;
      form4.Free ;

end;

procedure TForm1.N6Click(Sender: TObject);
begin
Caption:=  TMemo(Sender).Name;
// TCDWriterXP(FindComponent('rr'+copy))

end;

procedure TForm1.Button6Click(Sender: TObject);
begin
//        MCDBurner0.LoadMedium(TRUE);


end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if not CDRW0.Enabled  then
   begin
     ProgressBar0.Position :=ProgressBar0.Position+1;
     if ProgressBar0.Position>95 then ProgressBar0.Position:=0;
        end;
     end;

procedure TForm1.MCDBurner1WriteDone(Sender: TObject; Error: String);
begin
         Timer1.Enabled:=False;
        TMCDBurner(SENDER).LoadMedium(TRUE);


s1:=copy(TMCDBurner(SENDER).name,length(TMCDBurner(SENDER).name),length(TMCDBurner(SENDER).name));


ShowMessage('第'+s1+'号光驱'+#13+panhao(TListBox(FindComponent('li'+s1)).Items.Strings[0]) +'号'+#13+'完成');

rz(copy(TListBox(FindComponent('li'+s1)).Items.Strings[0],1,6),copy(TListBox(FindComponent('li'+s1)).Items.Strings[0],10,maxint),now);
tbutton(FindComponent('CDRW'+ s1)).Enabled :=True;
ProgressBar1.Position:=0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Msg:= RegisterWindowMessage('陈亚光');//返回系统唯一消息号，1111为自定义消息内容

end;
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
 MCDBurner1.Device:=MCDBurner1.Devices.Strings[0];
MCDBurner1.LoadMedium(false);
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
 MCDBurner1.Device:=MCDBurner1.Devices.Strings[1];
MCDBurner1.LoadMedium(false);
end;

end.