builddatabase.pas

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

unit BuildDatabase;

interface

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

type
  TBuildDatabaseForm = class(TMyForm)
    GCImg1: TGCImg;
    MIBtnPath: TMoveImgBtn;
    lbBtnOpen: TLabelBtn;
    lbBtnExit: TLabelBtn;
    MIBtnExit: TMoveImgBtn;
    lbBtnOK: TLabelBtn;
    MIBtnOK: TMoveImgBtn;
    edtPath: TEdit;
    Label1: TLabel;
    SaveDialog1: TSaveDialog;
    procedure MIBtnPathClick(Sender: TObject);
    procedure MIBtnOKClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  BuildDatabaseForm: TBuildDatabaseForm;

implementation

{$R *.dfm}

procedure TBuildDatabaseForm.MIBtnPathClick(Sender: TObject);
var
  strPath:string;
begin
  inherited;
  savedialog1.FileName :='jfgl.jfg';
  if savedialog1.Execute then
  begin
    strPath:=savedialog1.FileName;
    if FileExists(strPath) then
    begin
      if MessageBox(handle,'文件已存在，是否覆盖？','新建数据库',MB_OKCANCEL or MB_ICONWARNING)=IDOK then
      begin
        edtPath.Text :=strPath;
      end;
    end
    else begin
      edtPath.Text :=strPath;
    end;
  end;
end;

procedure TBuildDatabaseForm.MIBtnOKClick(Sender: TObject);
var
  adoTemp:TADOQuery;
  adoCon:TADOConnection;
  strCon:string;
begin
  inherited;
  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='+''''+'jfgl'+'''');
  adoTemp.Active :=true;
  if adoTemp.RecNo >0 then
    (adoTemp.FieldByName('Templet') as tblobfield).SaveToFile(edtPath.Text);
  adoTemp.Free;
  adoCon.Free;
  ShowMessage('建立数据库成功！');
except
  adoTemp.Free;
  adoCon.Free;
  ShowMessage('建立数据库失败');
end;
end;

end.