mainfrm.pas

delphi下自动建立数据库的源代码

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ADODB;

type
  TfrmMain = class(TForm)
    edtUserId: TEdit;
    lblUserId: TLabel;
    lblPassWd: TLabel;
    edtPassWd: TEdit;
    btnBuild: TButton;
    btnExit: TButton;
    lblServerName: TLabel;
    edtServerName: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnBuildClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDblClick(Sender: TObject);

  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;


implementation

{$R *.DFM}

const
  ResourceFile: array[0..2] of string = ('Database', 'Popdom', 'Table');


function GetCurrMachName: string;
var
  pMachName: PChar;
  iLen: DWORD;
begin
  iLen := 255;
  try
    GetMem(pMachName, iLen);
    GetComputerName(pMachName, iLen);
    Result := pMachName;
  finally
    FreeMem(pMachName);
  end;

end;

function GetTempDirectory: string;
var
  pTempPath: PChar;
  iLen: DWORD;
begin
  iLen := 255;
  try
    GetMem(pTempPath, iLen);
    GetTempPath(iLen, pTempPath);
    Result := pTempPath;

    if Result[Length(Result)] <> '\' then
      Result := Result + '\';
  finally
    FreeMem(pTempPath);
  end;

end;


procedure TfrmMain.FormCreate(Sender: TObject);
var
  I: Integer;
begin

  edtServerName.Text := GetCurrMachName;
  edtUserId.Text := 'sa';
  edtPassWd.Text := '';

{$R ExecSQL.RES}
  for I := 0 to Length(ResourceFile) - 1 do
    with TResourceStream.Create(HInstance, ResourceFile[I], RT_RCDATA) do
      try
        SaveToFile(GetTempDirectory + ResourceFile[I] + '.sql');
      finally
        Free;
      end;
end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.btnBuildClick(Sender: TObject);
const
  ConnectStr = 'Provider=SQLOLEDB.1;Password=%s; Persist Security Info=False;'
    + 'User ID=%s;Initial Catalog=%s;Data Source=%s';
begin
  if MessageBox(Handle, '服务器、用户名和密码信息填写正确吗？', '询问',
    MB_YESNO + MB_ICONQUESTION) = ID_NO then
      Exit;
  try
    with TADOQuery.Create(Self) do
      try
        ConnectionString := Format(ConnectStr, [edtPassWd.Text,
          edtUserId.Text, 'Master', edtServerName.Text]);


        Prepared := True;

        SQL.LoadFromFile(GetTempDirectory + 'Database.sql');
        ExecSQL;
        Application.ProcessMessages;
        SQL.LoadFromFile(GetTempDirectory + 'Popdom.sql');
        ExecSQL;


      finally
        Free;
      end;

    Application.ProcessMessages;
    with TADOQuery.Create(Self) do
      try
        ConnectionString := Format(ConnectStr, ['sql',
          'dba', 'Master', edtServerName.Text]);


        Prepared := True;

        SQL.LoadFromFile(GetTempDirectory + 'Table.sql');

        ExecSQL;
      finally
        Free;
      end;

  except
    MessageBox(Handle, '创建数据库出错，请检查服务器！', '错误',
      MB_OK + MB_ICONERROR);

    Exit;
  end;
  MessageBox(Handle, '创建数据库完毕，谢谢使用！', '信息',
    MB_OK + MB_ICONINFORMATION);

end;



procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  I: Integer;
begin
  
  for I := 0 to Length(ResourceFile) - 1 do
    DeleteFile(GetTempDirectory + ResourceFile[I] + '.sql');


end;

procedure TfrmMain.FormDblClick(Sender: TObject);
begin
  MessageBox(Handle, '网络数据库创建程序 2002/11/08'#$0d#$0a,
    '关于……', MB_OK);

end;

end.