dcm.pas

1. 纯粹的合同管理,不涉及其它业务,独立成系统2. 简单明了,流程清析3. 合同条款可预定制4. 丰富强大的打印预览系统5. 实用的导入导出功能,可与excel交互使用6. 时刻追踪合同执行情况,包

unit DCM;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ModalForm, Menus, MoveImageButton, LabelButton, ComCtrls,
  ToolWin, StdCtrls, ExtCtrls, DB, ADODB;

type
  TDCMForm = class(TMyModalForm)
    rg: TRadioGroup;
    Edit1: TEdit;
    MIBtnPath: TMoveImgBtn;
    lbBtnOpen: TLabelBtn;
    Label1: TLabel;
    odlgDatafile: TOpenDialog;
    Panel1: TPanel;
    Label2: TLabel;
    dtpStart: TDateTimePicker;
    Label3: TLabel;
    dtpEnd: TDateTimePicker;
    SaveDialog1: TSaveDialog;
    MoveImgBtnNew: TMoveImgBtn;
    LbBtnNew: TLabelBtn;
    procedure MIBtnOKClick(Sender: TObject);
    procedure MIBtnPathClick(Sender: TObject);
    procedure rgClick(Sender: TObject);
    procedure MoveImgBtnNewClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure CreateOnlineNote(AFName: string);
  end;

var
  DCMForm: TDCMForm;

implementation

uses InOutData, data;

{$R *.dfm}

procedure TDCMForm.MIBtnOKClick(Sender: TObject);
begin
  inherited;
  if Trim(Edit1.Text)='' then
    ShowMessage('请选择数据库文件路径！')
  else begin
    InOutDataForm:=TInOutDataForm.Create(Application);
    InOutDataForm.DatafilePath :=Edit1.Text;
    InOutDataForm.startDate :=dtpStart.Date;
    InOutDataForm.endDate :=dtpEnd.Date;
    InOutDataForm.OpType :=rg.ItemIndex;
    InOutDataForm.ShowModal;
  end;
end;

procedure TDCMForm.MIBtnPathClick(Sender: TObject);
begin
  inherited;
  case rg.ItemIndex of
  0:    begin
          odlgDatafile.DefaultExt :='*.jfg';
          odlgDatafile.FileName :='*.jfg';
          odlgDatafile.Filter :='机房管理数据库文件 (*.jfg)|*.jfg';
        end;
  1..2: begin
          odlgDatafile.DefaultExt :='*.oln';
          odlgDatafile.FileName :='*.oln';
          odlgDatafile.Filter :='机房管理系统上机记录文件(*.oln)|*.oln';
        end;
  end;
  if odlgDatafile.Execute then
    edit1.Text :=odlgDatafile.FileName;
end;

procedure TDCMForm.rgClick(Sender: TObject);
begin
  inherited;
  panel1.Visible :=rg.ItemIndex =1;
end;

procedure TDCMForm.MoveImgBtnNewClick(Sender: TObject);
var
  strPath:string;
begin
  inherited;
  savedialog1.FileName :='OnlineNote'+DateToStr(dtpstart.date);
  if savedialog1.Execute then
  begin
    strPath:=savedialog1.FileName;
    if FileExists(strPath) then
    begin
      if MessageBox(handle,'文件已存在，是否覆盖？','新建数据库',MB_OKCANCEL or MB_ICONWARNING)=IDOK then
      begin
        CreateOnlineNote(strPath);//新建
      end;
    end
    else begin
      CreateOnlineNote(strPath);//新建
    end;
  end;

end;

procedure TDCMForm.CreateOnlineNote(AFName: string);
var
  adoTemp:TADOQuery;
  adoCon:TADOConnection;
  strCon:string;
begin
  adoCon:=TADOConnection.Create(nil);
  adoTemp:=TADOQuery.Create(nil);
try
  strCon:=ExtractFilePath(Application.ExeName)+'\Templet.dat;';
  strCon:='Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='
    +strCon+'Mode=Share Deny None;Extended Properties="";Jet OLEDB:System database="";'
    +'Jet OLEDB:Registry Path="";Jet OLEDB:Database Password=06608841019;'
    +'Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=1;'
    +'Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;'
    +'Jet OLEDB:New Database Password="";Jet OLEDB:Create System Database=False;'
    +'Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don'+''''+'t Copy Locale on Compact=False;'
    +'Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False';
  adoCon.ConnectionString :=strCon;  
  adoCon.LoginPrompt :=false;
  adoCon.Connected :=true;
  adoTemp.Connection :=adoCon;
  adoTemp.SQL.Add('select Templet from Templet where DEnName='+''''+'OnlineNote'+'''');
  adoTemp.Active :=true;
  if adoTemp.RecNo >0 then
    (adoTemp.FieldByName('Templet') as tblobfield).SaveToFile(AFName);
  adoTemp.Free;
  adoCon.Free;
  Edit1.Text :=AFName;
except
  adoTemp.Free;
  adoCon.Free;
  ShowMessage('建立数据库失败');
end;
end;

procedure TDCMForm.FormCreate(Sender: TObject);
begin
  inherited;
  dtpStart.DateTime :=now;
  dtpEnd.DateTime :=now;
end;

end.