createacctbook.pas

ERP 一段源码,也许你会用到,在一个朋友处拿来的.

{//标题：服装MRP系统
 //内容：创建套帐总模块。
 //修改：
}
unit CreateAcctBook;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, jpeg, DB, DBCtrls, ADODB, FileCtrl, Base;

type
  TfrmCreateAcctBook = class(TfrmBase)
    Label1: TLabel;
    Label2: TLabel;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    Image1: TImage;
    Panel1: TPanel;
    Label3: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    BitBtn1: TBitBtn;
    edtAccountPath: TEdit;
    edtAccountName: TEdit;
    Panel2: TPanel;
    Label9: TLabel;
    edtCompanyName: TEdit;
    Label7: TLabel;
    edtNaturalMoney: TEdit;
    Label8: TLabel;
    edtAdminUser: TEdit;
    Label11: TLabel;
    edtAdminPWD: TEdit;
    Label10: TLabel;
    edtDBName: TEdit;
    Label4: TLabel;
    spCreateAccount: TADOStoredProc;
    ComboBox1: TComboBox;
    QExistsAccName: TADOQuery;
    spIsExistsDbName: TADOStoredProc;
    procedure BitBtn4Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmCreateAcctBook: TfrmCreateAcctBook;

implementation

uses serverdm;

{$R *.dfm}

procedure TfrmCreateAcctBook.BitBtn4Click(Sender: TObject);
begin
  self.Close;
end;

procedure TfrmCreateAcctBook.FormShow(Sender: TObject);
begin
  panel1.Visible := true;
  panel2.Visible := false;
end;

procedure TfrmCreateAcctBook.BitBtn5Click(Sender: TObject);
begin
  bitbtn5.Enabled := false;
  bitbtn7.Enabled := false;
  bitbtn6.Enabled := true;
  panel1.Visible := true;
  panel2.Visible := false;
end;

procedure TfrmCreateAcctBook.BitBtn6Click(Sender: TObject);
begin
  if Trim(edtAccountName.Text) = '' then
    raise Exception.Create('请指定帐套名称！');
  if Trim(edtAccountPath.Text) = '' then
    raise Exception.Create('请指定帐套路径！');
  if Trim(edtDbName.Text) = '' then
    raise Exception.Create('请指定数据库名称！');
  if not DirectoryExists(Trim(edtAccountPath.Text)) then
    raise Exception.Create('无效的帐套路径！');

  bitbtn5.Enabled := true;
  bitbtn7.Enabled := true;
  bitbtn6.Enabled := false;
  panel1.Visible := false;
  panel2.Visible := true;
end;

procedure TfrmCreateAcctBook.BitBtn7Click(Sender: TObject);
var
  sPath: string;
  sDbname: string;
  sMdfFileName, sLdfFileName: string;
begin
  if Trim(edtCompanyName.Text) = '' then
    raise Exception.Create('请指定企业名称！');
  if Trim(edtNaturalMoney.Text) = '' then
    raise Exception.Create('请指定本位币！');
  if Trim(edtAdminUser.Text) = '' then
    raise Exception.Create('请指定帐套管理员！');
  with QExistsAccName do
  begin
    parameters.ParamValues['Name'] := trim(edtAccountName.Text);
    if Active then Requery() else open;
    if RecordCount > 0 then
      raise Exception.Create('当前帐套名已经存在！');
  end;
  with spIsExistsDBName do
  begin
    parameters.ParamValues['@DbName'] := trim(edtDbName.Text);
    ExecProc;
    if parameters.ParamValues['@RETURN_VALUE'] = 1 then
      raise Exception.Create('当前数据库名已经存在！');
  end;

  sDbName := Trim(edtDBName.Text);
  sPath := Trim(edtAccountPath.Text);
  if Copy(sPath, length(sPath), 1) <> '\' then
    sPath := sPath + '\';
  sMdfFileName := sPath + sDbName + '.mdf';
  sLdfFileName := sPath + sDbName + '.ldf';
  if CopyFile(pchar('.\data\LANGYA2006.mdf'), pchar(sMdfFileName), False) and
    CopyFile(pchar('.\data\LANGYA2006.ldf'), pchar(sLdfFileName), False) then
  begin
    try
      with spCreateAccount do
      begin
        Parameters.ParamValues['@nType'] := 1;
        Parameters.ParamValues['@DbName'] := sDbName;
        Parameters.ParamValues['@FilePath'] := sPath;
        Parameters.ParamValues['@AccSetName'] := trim(edtAccountName.Text);
        Parameters.ParamValues['@FileNamemdf'] := sMdfFileName;
        Parameters.ParamValues['@FileNameldf'] := sLdfFileName;
        Parameters.ParamValues['@CorpName'] := trim(edtCompanyName.Text);
        Parameters.ParamValues['@NaturalMoney'] := trim(edtNaturalMoney.Text);
        Parameters.ParamValues['@AccSetMan'] := trim(edtAdminUser.Text);
        Parameters.ParamValues['@AccSetPWD'] := trim(edtAdminPWD.Text);
        ExecProc;
      end;
    except
      on E: Exception do
        raise Exception.Create('新建帐套失败！' + #13#10 + E.Message)
    end;
    dmServer.adodsAccount.Requery();
    Close;
  end
  else
    raise Exception.Create('新建帐套失败！' + #13#10 + '复制模板错误！')
end;

procedure TfrmCreateAcctBook.FormCreate(Sender: TObject);
begin
IF nOT DMSERVER.adodsAccount.Active THEN DMSERVER.adodsAccount.Open;
  with dmServer.adodsAccount do
  begin
    first;
    while not eof do
    begin
      ComboBox1.Items.Add(fieldbyname('aName').asString);
      next;
    end;
    ComboBox1.ItemIndex := 0;
  end;
end;

procedure TfrmCreateAcctBook.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  action := cafree;
  frmCreateAcctBook := nil;
end;

procedure TfrmCreateAcctBook.BitBtn1Click(Sender: TObject);
var
  sOutDir: string;
begin
  if SelectDirectory('请选择存放路径：', '', sOutDir) then
    edtAccountPath.Text := sOutDir;
end;

end.