repairdb.pas

医院X光片资料管理系统—全部源码 这是源码。去年做的一个小软件。因为这是给一家医院做的

unit repairdb;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, FileCtrl, Buttons, ExtCtrls, shellapi;

type
  Trepair = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    BitBtn3: TBitBtn;
    Panel4: TPanel;
    BitBtn5: TBitBtn;
    Label1: TLabel;
    BitBtn1: TBitBtn;
    BitBtn4: TBitBtn;
    Label5: TLabel;
    procedure FormShow(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  repair: Trepair;

implementation

uses ADO_access, MAIN, dm;

{$R *.DFM}
{$I-}

function CloseMdi(): boolean;
begin
  result := true;
  with Mainform do
  begin
    if MDIChildCount > 1 then
    begin
      showmessage('请将所有录入、查询窗口关闭！');
      result := false;
      exit;
    end;
  end;
end;

procedure Trepair.FormShow(Sender: TObject);
begin
  dmfm.ADOConnection1.Connected := false;
end;

procedure Trepair.BitBtn3Click(Sender: TObject);
begin
//检查其他窗口是否已经关闭
  if closemdi() = false then exit;
  label5.Caption := '正在修复压缩，请稍等！';
  label5.Refresh;
  if CompactRepairMDB('xray.mdb', '', '', '2000') = false then
    MessageDlg('修复过程出现错误！！', mtWarning, [mbOk], 0)
  else MessageDlg('修复完毕！', mtInformation, [mbOk], 0);
  label5.Caption := '';
end;

procedure Trepair.BitBtn4Click(Sender: TObject);
begin
  close;
end;

procedure Trepair.BitBtn1Click(Sender: TObject);
var
  sf, df: string;
  F: TShFileOpStruct;
begin
//检查其他窗口是否已经关闭
  if closemdi() = false then exit;
  label5.Caption := '正在备份，请稍等！';
  label5.Refresh;
  sf := 'xray.mdb';
  df := 'backup\xray.mdb';
  F.wnd := Handle;
  F.wFunc := FO_Copy; {操作方式}
  F.pFrom := pchar(sf + #0#0);
  F.pTo := pchar(df + #0#0);
  F.fFlags := FOF_CONFIRMMOUSE;
//F.fFlags:=FOF_ALLOWUNDO OR FOF_RENAMEONCOLLISION; {操作选项}
  if ShFileOperation(F) <> 0 then
    MessageDlg('备份失败!', mtInformation, [mbOk], 0)
  else
    MessageDlg('备份成功!', mtInformation, [mbOk], 0);
  label5.Caption := '';
  label5.Refresh;
end;

procedure Trepair.BitBtn5Click(Sender: TObject);
var
  sf, df: string;
  F: TShFileOpStruct;
begin
//检查其他窗口是否已经关闭
  if closemdi() = false then exit;
  label5.Caption := '正在恢复数据，请稍等！';
  label5.Refresh;
  sf := 'backup\xray.mdb';
  df := 'xray.mdb';
  if not fileexists(sf) then begin
    showmessage('备份数据库没找到!');
    exit;
  end;
  F.wnd := Handle;
  F.wFunc := FO_Copy; {操作方式}
  F.pFrom := pchar(sf + #0#0);
  F.pTo := pchar(df + #0#0);
  F.fFlags := FOF_CONFIRMMOUSE;
//F.fFlags:=FOF_ALLOWUNDO OR FOF_RENAMEONCOLLISION; {操作选项}
  if ShFileOperation(F) <> 0 then
    MessageDlg('恢复失败!', mtInformation, [mbOk], 0)
  else
    MessageDlg('恢复成功!', mtInformation, [mbOk], 0);
  label5.Caption := '';
  label5.Refresh;
end;

procedure Trepair.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  with Mainform do
  begin
    if MDIChildCount = 1 then
      StatusBar.Panels[1].Text := '';
  end;
  dmfm.ADOConnection1.Connected := true;
  Action := caFree;
end;

end.