unit1.pas

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

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, adodb,ComCtrls, StdCtrls, Buttons, Mask, ToolEdit, RXClock,filectrl,
  DB,shellapi, WinSkinStore, WinSkinData,inifiles, RXShell, RXSpin,registry,DateUtils,
  Placemnt, ImgList,StrUtils, RXCtrls, ScktComp;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Label2: TLabel;
    MaskEdit1: TMaskEdit;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    DirectoryEdit1: TDirectoryEdit;
    Memo1: TMemo;
    Label3: TLabel;
    DirectoryEdit2: TDirectoryEdit;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    GroupBox4: TGroupBox;
    GroupBox5: TGroupBox;
    GroupBox6: TGroupBox;
    Label4: TLabel;
    DirectoryEdit3: TDirectoryEdit;
    Bevel1: TBevel;
    Label5: TLabel;
    DirectoryEdit4: TDirectoryEdit;
    Label6: TLabel;
    CheckBox3: TCheckBox;
    MaskEdit2: TMaskEdit;
    ADOConnection1: TADOConnection;
    BitBtn1: TBitBtn;
    Timer1: TTimer;
    BitBtn4: TBitBtn;
    RxTrayIcon1: TRxTrayIcon;
    RxSpinEdit1: TRxSpinEdit;
    RxSpinEdit2: TRxSpinEdit;
    ADOCommand1: TADOCommand;
    TabSheet4: TTabSheet;
    GroupBox7: TGroupBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    Label9: TLabel;
    CheckBox6: TCheckBox;
    Edit1: TEdit;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    ComboBox1: TComboBox;
    Label7: TLabel;
    Bevel2: TBevel;
    SkinStore1: TSkinStore;
    FormStorage1: TFormStorage;
    ImageList1: TImageList;
    RxLabel1: TRxLabel;
    Bevel3: TBevel;
    CheckBox9: TCheckBox;
    Label8: TLabel;
    ComboBox2: TComboBox;
    Label10: TLabel;
    ComboBox3: TComboBox;
    SkinData1: TSkinData;
    ServerSocket1: TServerSocket;
    procedure hideF(Sender :Tobject);
    procedure DirectoryEdit1ButtonClick(Sender: TObject);
    procedure DirectoryEdit1BeforeDialog(Sender: TObject; var Name: String;
      var Action: Boolean);
    procedure DirectoryEdit2ButtonClick(Sender: TObject);
    procedure DirectoryEdit2BeforeDialog(Sender: TObject; var Name: String;
      var Action: Boolean);
    procedure DirectoryEdit2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DirectoryEdit2KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DirectoryEdit1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DirectoryEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DirectoryEdit3KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DirectoryEdit4KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DirectoryEdit4KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DirectoryEdit3KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DirectoryEdit3BeforeDialog(Sender: TObject; var Name: String;
      var Action: Boolean);
    procedure DirectoryEdit4BeforeDialog(Sender: TObject; var Name: String;
      var Action: Boolean);
    procedure DirectoryEdit3ButtonClick(Sender: TObject);
    procedure DirectoryEdit4ButtonClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure RxTrayIcon1DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ComboBox1Change(Sender: TObject);
    procedure showstyle();
    procedure hotk(var message :Tmessage) ; message wm_hotkey;
    //procedure newproc(var message :Tmessage) ;
    procedure wndproc(var msg :Tmessage) ;override;
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
     oldproc :Twndmethod;
    { Private declarations }
  public
    { Public declarations }
  end;

function ToUnicode(str:string;dest:PWideChar):integer;
function SendMsg(Toh,From,Msg:string):integer;
function NetMessageBufferSend(servername:PWideChar;
                              MsgName:PWideChar;
                              FromName:PWideChar;
                              Buf: PWideChar;
                              var BufLen:integer):integer;cdecl;
var
  Form1: TForm1;

implementation

{$R *.dfm}

//延时
procedure Delay(msecs:cardinal);
 var FirstTickCount:cardinal;
begin
  FirstTickCount:=GetTickCount;
  repeat
  Application.ProcessMessages;
  until (GetTickCount-FirstTickCount) >= msecs;
end; 

//
{procedure Tform1.newproc(var message :Tmessage) ;
begin
if (message.Msg=wm_syscommand) and (message.WParam=SC_MINIMIZE) then
    ShowWindow( Application.Handle, sw_Hide )
  else if assigned(oldproc) then
    oldproc(message);

end; }

//最小化
procedure Tform1.wndproc(var msg :Tmessage) ;
begin
inherited;
if (msg.Msg=wm_sysCommand) and (msg.wParam=SC_MINIMIZE) then
    begin
     ShowWindow( Application.Handle, sw_Hide );
     //showmessage('');
    end;
  //else
    //inherited;
end;

//热键消息
procedure Tform1.hotk(var message :Tmessage) ;
begin
  if  self.Visible then
      begin
        self.hide;
        RxTrayIcon1.Active:=false;
        //ShowWindow( Application.Handle, sw_Hide );
      end
      else
      begin
        RxTrayIcon1.Active:=true;
        form1.RxTrayIcon1DblClick(form1)
      end;
end;

//定义热键
function reghotkey(handle :Thandle ; id :integer ) : longbool;
var pk,sk :integer;
begin
  pk:=0;
  sk:=0;
       case form1.combobox2.ItemIndex of
           0 : pk:=2;
           1 : pk:=4;
           2 : pk:=1;
           3 : pk:=2+4;
           4 : pk:=2+1
       end;
       sk:=form1.combobox3.ItemIndex+65;
       result:=windows.RegisterHotKey(handle,id,pk,sk);

end;

///////////////////////实现系统控制//////////////////////////////
{    注销当前用户 => ExitWin32Sys(EWX_FORCE or EWX_LOGOFF);
    重新启动计算机 => ExitWin32Sys(EWX_FORCE or EWX_REBOOT);
    关闭计算机 => ExitWin32Sys(EWX_FORCE or EWX_POWEROFF);
}
function GetSysTypes: Boolean;
var
  Ver: TOSVersionInfo;
begin
  Result := False;
  Ver.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  if GetVersionEx(Ver) then
    if Ver.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
      Result := True
    else
      Result := False;
end;

function SetPrivilege(sPrivilegeName: AnsiString; bEnable: Boolean): Boolean;
var
  TPPrev, TP: TTokenPrivileges;
  Token : THandle;
  dwRetLen : DWord;
begin
  Result := False;
  OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or
                   TOKEN_QUERY, Token);
  TP.PrivilegeCount := 1;
  if LookupPrivilegeValue(nil,PAnsiChar(sPrivilegeName),TP.Privileges[0].LUID) then
  begin
    if bEnable then
      TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
    else
      TP.Privileges[0].Attributes := 0;
    dwRetLen := 0;
    Result := AdjustTokenPrivileges(Token, False, TP, SizeOf(TPPrev), TPPrev, dwRetLen);
  end;
  CloseHandle(Token);
end;

procedure ExitWin32Sys(iFlags: Integer);
begin
  if GetSysTypes then
    ExitWindowsEx(iFlags,0)
  else
    if SetPrivilege('SeShutdownPrivilege',True) then
      if not ExitWindowsEx(iFlags,0) then
        SetPrivilege('SeShutdownPrivilege',False);
end;
//////////////////////////////////////////////////////////////////

//界面风格
procedure TForm1.showstyle();
begin

 if form1.combobox1.ItemIndex=0 then
    begin
      form1.skindata1.Active:=false;
      //form1.SkinData1.SkinStore^:=pointer('');
      exit;
    end;
 form1.skindata1.LoadFromCollection(form1.skinstore1,form1.combobox1.ItemIndex);
 if not form1.skindata1.Active then form1.skindata1.Active:=true;
end;

//删除备份文件
procedure deleteFile(strd:string ; ex:string ; bex:string ; count :integer);
var sr :TSearchRec;
    name :string;
    filetime :Tdatetime;
begin
 if FindFirst(strd+ex,faAnyFile,sr)=0 then
    begin
      repeat
        begin
          name:=copy(sr.Name,length(bex)+1,length(sr.Name) - length(ex+bex)+1);
          //showmessage(name);
          try
            filetime:=strtodatetime(name)
            except
            continue
          end;
          if daysbetween(now(),filetime) >= count then
             begin
                if ex<>'*' then
                  winexec(pchar('cmd.exe /c del '+strd+sr.name+' /q'),sw_hide) //文件
                else
                  winexec(pchar('cmd.exe /c rd '+strd+sr.name+' /q/s'),sw_hide); //目录
                form1.Memo1.Lines.Add(datetimetostr(now())+' '+'删除文件'+strd+sr.Name);
                delay(1);
             end;
        end;
        until FindNext(sr)<>0
    end;
    findclose(sr);
end;
procedure Tform1.hideF(sender :Tobject);
begin
  ShowWindow( Application.Handle, sw_Hide );
  //showmessage('');
end;

//备份文件
procedure backupFile();
var nowtime :Tdatetime;
    strD :string;
begin
  try nowtime:=strtotime(form1.maskedit1.text)
  except
    //showmessage(timetostr(nowtime));
    form1.Memo1.Lines.Add(datetostr(now)+' 备份文件时间错误！');
  exit;
  end;
  if (time()>=strtotime(form1.MaskEdit1.text+':00')) and (time()<=strtotime(form1.MaskEdit1.text+':59')) then
     begin
     //删除多余文件
      if form1.CheckBox7.checked then
        deleteFile(form1.DirectoryEdit2.Text+'\'  , '*', '',strtoint(form1.RxSpinEdit1.text));
      strd:=inttostr(yearof(now))+'-'+inttostr(monthof(now))+'-'+inttostr(dayof(now))+'-'+inttostr(hourof(now))+'-'+inttostr(minuteof(now));
      form1.Memo1.Lines.Add(datetimetostr(now)+' 开始备份文件...');
      winexec(pchar('cmd.exe /c xcopy '+form1.DirectoryEdit1.Text+'\*.*  '+form1.DirectoryEdit2.Text+'\'+strd+'\ /e/y'),sw_hide);
      form1.Memo1.Lines.Add(datetimetostr(now)+' 备份文件完毕！');
      if form1.CheckBox2.Checked then
        begin
          Delay(30000);
          ExitWin32Sys(EWX_FORCE or EWX_POWEROFF);
        end;
     end;
end;

//备份数据库
procedure backupDB();
var dbname :string;
    nowtime :Tdatetime;
    strd :string;
begin
  try nowtime:=strtotime(form1.maskedit2.text)
  except
    //form1.Memo1.Lines.Add(datetostr(now)+' 数据库时间错误！');
  exit;
  end;
  if (time()<=strtotime(form1.MaskEdit2.text+':00')) or  (time()>=strtotime(form1.MaskEdit2.text+':59')) then   exit;
  dbname:=copy(form1.DirectoryEdit3.text,pos('Initial Catalog=',form1.DirectoryEdit3.text)+16,pos(';Data Source',form1.DirectoryEdit3.text) - pos('Initial Catalog=',form1.DirectoryEdit3.text) - 16 );
  //删除多余文件
  if form1.CheckBox8.checked then
     deleteFile(form1.DirectoryEdit4.Text+'\'  , '*.bak', dbname,strtoint(form1.RxSpinEdit2.text));
  strd:=inttostr(yearof(now))+'-'+inttostr(monthof(now))+'-'+inttostr(dayof(now))+'-'+inttostr(hourof(now))+'-'+inttostr(minuteof(now));
  form1.ADOCommand1.CommandText:='Backup DataBase  '+dbname+' to disk='''+form1.DirectoryEdit4.Text+'\'+dbname+strd+'.bak''';
  try
     form1.Memo1.Lines.Add(datetimetostr(now)+' 开始备份数据库...');
     form1.ADOCommand1.Execute;
     form1.Memo1.Lines.Add(datetimetostr(now)+' 备份数据库完毕！');
     if form1.CheckBox3.Checked then
        begin
          Delay(30000);
          ExitWin32Sys(EWX_FORCE or EWX_POWEROFF);
        end;
  except
     form1.Memo1.Lines.Add(datetimetostr(now)+' 备份数据库错误！')
  end;
end;

//初始化
procedure sysinit();
var inif :Tinifile;
    reg :Tregistry;
    mychar :char;
    lisport :integer;
begin
  ///Listen
  lisport:=8155;
  form1.serversocket1.Port:=lisport;
  while not form1.ServerSocket1.Active do
  begin
    try
    form1.ServerSocket1.Open ;
    //showmessage(inttostr(lisport));
    except
    inc(lisport , 1);
    form1.ServerSocket1.Port:=lisport;
    end;
  end;
  ///
  form1.pagecontrol1.ActivePageIndex:=0;
  //
   for mychar:='A' to 'Z' do
       form1.ComboBox3.Items.Add(mychar);
   form1.ComboBox3.ItemIndex:=0;
       //form1.ComboBox3.Items.add
  //
  if not fileexists(extractfilepath(application.ExeName)+'\set.ini') then exit;

  inif:=Tinifile.Create(extractfilepath(application.ExeName)+'\set.ini');
  form1.DirectoryEdit1.Text:=inif.ReadString('fileBK','source','');
  form1.DirectoryEdit2.Text:=inif.ReadString('fileBK','desti','');
  form1.maskedit1.Text:=inif.ReadString('fileBK','bktime','');