unit1.pas

delphi实现的可以在局域网中两台计算机之间进行SQL server 2000异机同步备份

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Winsock, ExtCtrls,TLHelp32, DB, ADODB, FileCtrl, Buttons,
  ComCtrls, ShellCtrls;

type
    PIPOptionInformation = ^TIPOptionInformation;
    TIPOptionInformation = packed record
    TTL: Byte;
    TOS: Byte;
    Flags: Byte;
    OptionsSize: Byte;
    OptionsData: PChar;
    end;
    PIcmpEchoReply = ^TIcmpEchoReply;
    TIcmpEchoReply = packed record
    Address: DWORD;
    Status: DWORD;
    RTT: DWORD;
    DataSize: Word;
    Reserved: Word;
    Data: Pointer;
    Options: TIPOptionInformation;
    end;
    TIcmpCreateFile = function: THandle; stdcall;
    TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
    TIcmpSendEcho = function(IcmpHandle:THandle;DestinationAddress: DWORD;
    RequestData: Pointer;
    RequestSize: Word;
    RequestOptions: PIPOptionInformation;
    ReplyBuffer: Pointer;
    ReplySize: DWord;
    Timeout: DWord
    ): DWord; stdcall;

  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    PingEdit: TEdit;
    Label1: TLabel;
    Timer1: TTimer;
    ADOTmp: TADOQuery;
    Label2: TLabel;
    BitBtn1: TBitBtn;
    ShellTreeView1: TShellTreeView;
    FileListBox1: TFileListBox;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure ShellTreeView1DblClick(Sender: TObject);
  private
    { Private declarations }
    hICMP: THANDLE;
    IcmpCreateFile : TIcmpCreateFile;
    IcmpCloseHandle: TIcmpCloseHandle;
    IcmpSendEcho: TIcmpSendEcho;
  public
     procedure EndProcess(AFileName: string);
     function CopyFile(sourcefile:string;targetfile:string):boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
Var
    //WSAData: TWSAData;
    hICMPdll: HMODULE;
begin
    // Load the icmp.dll stuff
    hICMPdll := LoadLibrary('icmp.dll');
    @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
    @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
    @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
    hICMP := IcmpCreateFile;
    Memo1.Text := '';
    Memo1.Lines.Add('IP地址         字节 返回(毫秒)');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    IPOpt:TIPOptionInformation;// IP Options for packet to send
    FIPAddress:DWORD;
    pReqData,pRevData:PChar;
    pIPE:PIcmpEchoReply;// ICMP Echo reply buffer
    FSize: DWORD;
    MyString:string;
    FTimeOut:DWORD;
    BufferSize:DWORD;
    Str_Path :string;
Begin
    if PingEdit.Text <> '' then
    begin
    FIPAddress := inet_addr(PChar(PingEdit.Text));
    FSize := 40;
    BufferSize := SizeOf(TICMPEchoReply) + FSize;
    GetMem(pRevData,FSize);
    GetMem(pIPE,BufferSize);
    FillChar(pIPE^, SizeOf(pIPE^), 0);
    pIPE^.Data := pRevData;
    MyString := 'Hello,World';
    pReqData := PChar(MyString);
    FillChar(IPOpt, Sizeof(IPOpt), 0);
    IPOpt.TTL := 64;
    FTimeOut := 2000;
    IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),@IPOpt, pIPE, BufferSize, FTimeOut);
    if pIPE^.DataSize>0 then
    begin
        try
        begin
             if pReqData^ = pIPE^.Options.OptionsData^ then
             begin
                  //Memo1.Lines.Add(PChar(PingEdit.Text) + ' ' +IntToStr(pIPE^.DataSize) + ' ' +IntToStr(pIPE^.RTT));
                  if (strtoint(formatdatetime('ss',Now))mod 30)=0 then
                  begin
                      //========================================================================
                        //ADOConnection1.Close;
                        //ADOConnection1.Connected:=false;
                        EndProcess('Com1.exe');
                        Str_Path:='D:\sqlbackup\test.BAK';
                        if Str_Path<>'' then  //如果路径非空则执行下面代码
                        begin
                              try
                                 try
                                      ADOTmp.Close;
                                      ADOTmp.SQL.Clear;
                                      ADOTmp.SQL.Add('use master restore  DATABASE test from DISK ='+'''' +Str_Path+'''');
                                      ADOTmp.ExecSQL();
                                      Memo1.Lines.Add(formatdatetime('yyyy-mm-dd hh:mm:ss',Now)+'成功恢复');
                                 except
                                      Memo1.Lines.Add(formatdatetime('yyyy-mm-dd hh:mm:ss',Now)+'恢复失败');
                                      exit;
                                 end;
                              Finally //刷新数据库
                                     ADOTmp.Close; //关闭adoquery2
                                     ADOTmp.SQL.Clear; //清除SQL查询语句
                                   //ADOTmp.SQL.Add('USE test');  //刷新数据库
                                   //ADOTmp.ExecSQL;  //执行SQL语句
                              end;
                              //ADOConnection1.Open;
                              //ADOConnection1.Connected:=True;
                        end;
                      //==========================================================================
                  end;
                  if (strtoint(formatdatetime('ss',Now))mod 10)=0 then
                  begin
                      FileListBox1.Directory:=ShellTreeView1.Path;
                      FileListBox1.SetFocus;
                      FileListBox1.Selected[FileListBox1.Count-1]:=true;
                      CopyFile(pchar(FileListBox1.FileName),pchar('D:\SQL异机同步\sqlbackup\test.BAK'));
                      Memo1.Lines.Add(FileListBox1.FileName+'成功复制');
                      //CopyFile(pchar('D:\11.text'),pchar('D:\55.txt'),true);
                  end;
             end;
        end;
        except
        begin
             timer1.Enabled :=true;
             Exit;
        end;
        end;
    end;
    if pIPE^.DataSize<=0 then
    begin
          //Memo1.Lines.Add('err');
    end;
    FreeMem(pRevData);
    FreeMem(pIPE);
    timer1.Enabled :=true;
    end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled:=false;
Button1.Click;
end;

procedure TForm1.EndProcess(AFileName: string);
const
  PROCESS_TERMINATE=$0001;
var
  ExeFileName: String;
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  ExeFileName := AFileName;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
  while integer(ContinueLoop) <> 0 do
    begin
      if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
           UpperCase(ExeFileName))
       or (UpperCase(FProcessEntry32.szExeFile) =
           UpperCase(ExeFileName))) then
        TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),
                          FProcessEntry32.th32ProcessID), 0);
      ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
    end;
end;
//复制文件
Function TForm1.CopyFile(sourcefile:string;targetfile:string):boolean;
var
  s,t:Tfilestream;
begin
  CopyFile:=True;
  s:=Tfilestream.Create(sourcefile,fmopenread);
  try
    Try
      t:=Tfilestream.Create(Targetfile,fmopenwrite or fmcreate);
      try
        t.CopyFrom(s,s.size);
      finally
        t.free;
      end;
    finally
      s.free;
    end;
  except
    CopyFile:=False;
  end;
end;  






procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Timer1.Enabled:=true;
end;
procedure TForm1.ShellTreeView1DblClick(Sender: TObject);
var
sss:string;
begin
       FileListBox1.Directory:=ShellTreeView1.Path ;//'\\Server\sqlbackup\';
       //FileListBox1.SetFocus;
end;

end.