main.pas

绝对精品 预算管理系统 本人花钱购买来的源代 人民大学出版社会出版的教程

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ComCtrls, DB, DBTables, Grids, DBGrids,ComObj,
  Excel2000, OleServer, ADODB;

type
  Tfrmmain = class(TForm)
    MainMenu1: TMainMenu;
    menuysxm: TMenuItem;
    menudbfwh: TMenuItem;
    submenudbfbf: TMenuItem;
    submenudbfhf: TMenuItem;
    menufzgl: TMenuItem;
    submenuyskm: TMenuItem;
    submenuyskmlb: TMenuItem;
    submenuglbm: TMenuItem;
    submenugsbm: TMenuItem;
    submenupzmc: TMenuItem;
    menuxtgl: TMenuItem;
    menuquit: TMenuItem;
    conn: TADOConnection;
    ADOQuery1: TADOQuery;
    menuysxmxc: TMenuItem;
    ADOQuery2: TADOQuery;
    procedure menuxtglClick(Sender: TObject);
    procedure menuquitClick(Sender: TObject);
    procedure submenuyskmlbClick(Sender: TObject);
    procedure submenuyskmClick(Sender: TObject);
    procedure submenupzmcClick(Sender: TObject);
    procedure submenugsbmClick(Sender: TObject);
    procedure submenuglbmClick(Sender: TObject);
    procedure menuysxmClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure submenudbfbfClick(Sender: TObject);
    procedure submenudbfhfClick(Sender: TObject);
    procedure menuysxmxcClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
     procedure writename(name:string);
  end;

var
  frmmain: Tfrmmain;
  //记录用户名
  username:string;
  //记录用户密码
  userpwd:string;
  //记录用户权限
  userqx:string;
  //记录数据库连接字符串
  adoconn:string;
  //记录数据库备份文件存放的路径
  path:string;
implementation

uses Unit2, yskmlb, yskm, pzlb, fygsbm, gkglbm, kjyw, login, splash,
  display, dbfxz, search, Unit1, ts;
{$R *.dfm}

procedure Tfrmmain.menuxtglClick(Sender: TObject);
begin
 frmuser:=tfrmuser.create(application);
  frmuser.ShowModal;
 // frmuser.Close;
  frmuser.Free;
end;

procedure Tfrmmain.menuquitClick(Sender: TObject);
begin
close;
end;

procedure Tfrmmain.submenuyskmlbClick(Sender: TObject);
begin
 frmyskmlb:=tfrmyskmlb.create(application);
  frmyskmlb.ShowModal;
  //frmyskmlb.Close;
  frmyskmlb.Free;
end;

procedure Tfrmmain.submenuyskmClick(Sender: TObject);
begin
  frmyskm:=tfrmyskm.create(application);
  frmyskm.ShowModal;
  frmyskm.Close;
  frmyskm.Free;
end;

procedure Tfrmmain.submenupzmcClick(Sender: TObject);
begin
  frmpzlb:=tfrmpzlb.create(application);
  frmpzlb.ShowModal;
  frmpzlb.Close;
  frmpzlb.Free;
end;

procedure Tfrmmain.submenugsbmClick(Sender: TObject);
begin
  frmfygsbm:=tfrmfygsbm.create(application);
  frmfygsbm.ShowModal;
  //frmfygsbm.Close ;
  frmfygsbm.Free;
end;

procedure Tfrmmain.submenuglbmClick(Sender: TObject);
begin
  frmgkglbm:=tfrmgkglbm.create(application);
  frmgkglbm.ShowModal;
 // frmgkglbm.Close;
  frmgkglbm.Free;
end;

procedure Tfrmmain.menuysxmClick(Sender: TObject);
begin
  //建立“预算项目管理”的窗体对象
  frmkjyw:=tfrmkjyw.create(application);
  // 显示“预算项目管理”窗口
  frmkjyw.ShowModal;
  //关闭“预算项目管理”窗口
  frmkjyw.Close;
  //释放“预算项目管理”窗口占用的资源
  frmkjyw.Free;
end;

procedure Tfrmmain.FormShow(Sender: TObject);
var
  //模式对话框返回值
  rt:integer;
  //登陆时允许的失败次数
  n:integer;
begin
  n:=0;
  frmsplash:=tfrmsplash.create(application);
  frmsplash.ShowModal;
  //frmsplash.Free;
  frmlogin:=tfrmlogin.create(application);
  while n<3 do
    begin
      rt:=frmlogin.ShowModal ;
     //用户按'取消'按钮
      if rt=mrcancel then
        begin
          close;
          exit;
        end
     else if (rt=mrok) and frmlogin.canpass then
     //用户登陆成功
     begin
       username:=frmlogin.comboxname.text;
       userpwd:=frmlogin.editpass.text;
       userqx:=frmlogin.Querycompanyuser.FieldValues['yhjb'];
       frmlogin.Close;
       frmlogin.Free;
       if  userqx='一般人员' then
          begin
            frmmain.menuysxm.Enabled:=false;
            frmmain.menufzgl.Enabled:=false;
            frmmain.menudbfwh.enabled:=false;
            frmmain.menuxtgl.Enabled:=false;
          end;
       exit;
     end
     else
       //用户登陆失败
       begin
         //失败次数加1
         n:=n+1;
         if n>=3 then
          //用户登陆失败次数超过3次
          begin
            messagedlg('您已经登陆失败3次,程序将中止',mtwarning,[mbok],0);
            close;
            application.Terminate;
            exit;
          end
         //重新尝试登陆
         else
           messagedlg('密码错误，请重试',mtwarning,[mbok],0);
       end
    end
end;

procedure Tfrmmain.submenudbfbfClick(Sender: TObject);
var
  path:string;
  str:string;
begin
if MessageDlg('准备备份数据库，您确认备份数据库吗？',mtInformation,[mbYes,mbNo],0)=mrno THEN
  exit;
//改变光标的显示状态为工作忙状态
Screen.Cursor:= crHourGlass;
str := path+'backup\ysglbookdedelphi'+datetostr(Date);

//判断系统设备表中是否存在设备名为ysgldelphibak的设备，如果没有则创建
//设备名为ysgldelphibak的设备
If adoquery1.EOF = True Then
   //系统设备表中没有设备名为ysgldelphibak的设备，创建设备名为ysgldelphibakk的设备
   begin
       conn.Execute ('EXECute sp_addumpdevice '''+'disk'','''+'ysgldelphibak'','''+str+'.bak''');
       //备份当前数据库
       conn.Execute ('BACKUP DATABASE [ysglbookdelphi] TO [ysgldelphibak] WITH  INIT ,NOUNLOAD ,  NOSKIP ,  STATS = 10,  NOFORMAT ');
       //删除设备名为ysgldelphibak的设备
       conn.Execute ('execute sp_dropdevice '''+'ysgldelphibak''');
   end
Else
   //系统设备表中存在设备名为ysgldelphibak的设备，备份当前数据库
    conn.Execute ('BACKUP DATABASE [ysgl2004bookdelphi] TO [ysgldelphibak] WITH  INIT ,NOUNLOAD ,  NOSKIP ,  STATS = 10,  NOFORMAT ');

str :='ysglbookdedelphi'+datetostr(Date);
writename(str);
Screen.Cursor:=crArrow ;
showmessage('备份成功');
end;

procedure Tfrmmain.writename(name:string);
var
 f: TextFile;
 filename:string;
 str:string;
begin
    //获得“预算管理.ini配置文件“的具体路径
    filename:=extractfilepath(application.ExeName)+'bfwj.txt';
  {$I-}
   //将配置文件与文件变量关联
    AssignFile(f, filename);
   //以附加文本方式打开文件
    append(f);
    //在文件末尾添加数据库备份文件名
    writeln(f, name);
    //关闭文件
    CloseFile(F);
end;

procedure Tfrmmain.submenudbfhfClick(Sender: TObject);
var
  //模式对话框返回值
  rt:integer;
  path:string;
  str:string;
begin
//建立数据库备份选择窗口
frmdbfxz:=tfrmdbfxz.create(application);
//选择数据库备份选择窗口
rt:=frmdbfxz.ShowModal;
if rt=mrcancel then
 begin
  exit;
 end;
//提示用户将进行数据的恢复操作
if MessageDlg('准备恢复数据库，请关闭所有使用该数据库的应用程序，您确认恢复数据库吗？'
,mtInformation,[mbYes,mbNo],0)=mrno THEN
  //用户选择了“取消”按钮，取消数据库恢复操作
  begin
  exit;
  end;
//获得用户选择的数据库备份的文件名
str := path+'backup\'+frmdbfxz.listboxdbf.Items.Strings[frmdbfxz.listboxdbf.itemindex];
//关闭数据库备份选择窗口
frmdbfxz.Close;
//释放数据库备份选择窗口占用的资源
frmdbfxz.Free;
//改变光标的显示状态为工作忙状态
Screen.Cursor:= crHourGlass;

//判断是否有使用欲恢复的数据库的应用程序
While adoquery2.EOF = False do
    //存在使用欲恢复的数据库的应用程序或进程
    begin
      //停止使用欲恢复的数据库的应用程序或进程
        str := 'kill  '+inttostr(adoquery2.FieldValues['spid']);
        conn.Execute(str);
        adoquery2.MoveBy(1);
    end;

//判断系统设备表中是否存在设备名为ysgldelphibak的设备，如果没有则创建设备名为
//ysgldelphibak的设备
If adoquery1.EOF = True Then
   //系统设备表中没有设备名为ysgldelphibak的设备，创建设备名为ysgldelphibak的设备
   begin
       conn.Execute ('EXECute sp_addumpdevice '''+'disk'','''+'ysgldelphibak'','''+str+'.bak''');
       //恢复当前数据库
       conn.Execute ('restore DATABASE [ysgl2004bookdelphi] TO [ysgldelphibak]');
       //删除设备名为ysglbak的设备
       conn.Execute ('execute sp_dropdevice '''+'ysgldelphibak''');
   end
Else
   //系统设备表中存在设备名为ysglbak的设备，恢复当前数据库
   conn.Execute ('restore DATABASE [ysgl2004bookdelphi] from [ysgldelphibak]');

Screen.Cursor:= crArrow;
showmessage('恢复成功')
end;

procedure Tfrmmain.menuysxmxcClick(Sender: TObject);
begin
 frmsearch:=tfrmsearch.create(application);
 frmsearch.ShowModal;
 frmsearch.Close;
 frmsearch.Free;
end;

procedure Tfrmmain.FormCreate(Sender: TObject);
var
 f: TextFile;
 filename:string;
begin
    //获得“预算管理.ini配置文件“的具体路径
    filename:=extractfilepath(application.ExeName)+'预算管理.ini';
  {$I-}
    //将配置文件与文件变量关联
    AssignFile(f, filename);
    //以只读方式打开配置文件
    reset(f);
    //读出数据库连接字符串
    readln(f,adoconn);
    //读出数据库的备份路径
    readln(f,path);
    //关闭配置文件
    CloseFile(F);
    //配置conn控件的数据库连接字符串
    conn.ConnectionString:=adoconn;
    conn.Connected:=true;
end;
end.