mainunit.pas

MsSQL通用数据库创建程序源码 ,程序的功能主要是在Delphi中利用程序创建MsSQL通用数据库

    mystrings.Free;
  end;
end;

function TMainForm.Table_Exists(const tbName:String;const myadocon:TAdoconnection): Boolean;
var
  i:integer;
  mystrings:TStrings;
begin
  try
    Result := False;
    mystrings := TStringList.Create;

    myadocon.GetTableNames(mystrings);
    for i:=0 to mystrings.Count-1 do
    begin
      if UpperCase(tbName)=UpperCase(mystrings.Strings[i]) then
      begin
        Result := True;
        break;
      end;
    end;
  finally
    mystrings.Free;
  end;
end;

function TMainForm.Create_Db(dbName:String;dbfn,logfn:String): Boolean;
var
  adoquery1:Tadoquery;
  sql_str :String;
begin
  try
    Result := False;

    deletefile(dbfn);
    deletefile(logfn);

    sql_str := 'CREATE DATABASE '+dbName+' ON (NAME='+dbName+'_dat,FILENAME='+quotedstr(dbfn)+',SIZE=1,FILEGROWTH = 10%) '+
               'LOG ON (NAME='+dbName+'_log,FILENAME='+quotedstr(logfn)+',FILEGROWTH = 10%)';

    adoquery1 := TAdoquery.Create(nil);
    with adoquery1  do
    begin
      Connection := AdoConnection1;
      CommandTimeout := 300;
      close;
      sql.Clear;
      sql.Add(sql_str);
      try
        ExecSql;
        Result := True;
        Close;
        vmsg := '数据库创建成功！';
        Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
      except
        on e:Exception do begin
          vmsg := e.Message;
          Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
          Result := False;
        end;
      end;
    end;
  finally
    adoquery1.Free;
  end;
end;

function TMainForm.Init_Create_db_fn(sql_fn:String): Boolean;
var
  i,ii:integer;
  s,ss:string;
begin
  try
    Result := False;

    if not fileexists(sql_fn) then
    begin
       vmsg := '数据库创建脚本文件：'+sql_fn+'未找到！请检查！';
       Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
       Application.MessageBox(pchar(vmsg),'文件未找到',MB_OK+MB_ICONINFORMATION);
       Exit;
    end;

    vmsg := '正在初始化数据库创建脚本';
    Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
    StatusBarEx1.Panels.Items[1].Text := vmsg;
    Application.ProcessMessages;

    Memo1.Lines.LoadFromFile(sql_fn);

    Initialized_dbscriptfn := ExtractFilePath(Application.ExeName)+'create_db.sql';
    DeleteFile(Initialized_dbscriptfn);

    Gauge1.MaxValue := 4;
    Gauge1.Progress := 1;

    Application.ProcessMessages;

    s := '$DB_NAME$';
    Memo1.Text := ReplaceStr(Memo1.Text,s,newdbEdit.Text);

    s := '$DB_PATH$';
    Memo1.Text := ReplaceStr(Memo1.Text,s,newdbfnEdit.Text);

    s := '$SA_NAME$';
    Memo1.Text := ReplaceStr(Memo1.Text,s,newdbsaEdit.Text);

    s := '$SA_PWD$';
    Memo1.Text := ReplaceStr(Memo1.Text,s,newdbpwdEdit.Text);

    Gauge1.Progress := Gauge1.MaxValue;
    Application.ProcessMessages;

    Memo1.Lines.SaveToFile(Initialized_dbscriptfn);

    {
    s := ExtractFilePath(Application.ExeName);
    if s[length(s)]<>'\' then
      s := s+'\';

    Memo1.Lines.Clear;
    if not CheckBox2.Checked then
       Memo1.Lines.Add('isqlw -S "'+IPEdit.Text+'" -U '+saEdit.Text+' -P '+sapwdEdit.Text+' -i "'+sql_fn+'" -o '+s+'result.txt')
    else
       Memo1.Lines.Add('isqlw -S "'+IPEdit.Text+'" -E '+' -i "'+sql_fn+'" -o '+s+'result.txt');

    Memo1.Lines.SaveToFile(s+'create_db.bat');
    }
    
    Result := True;
    Log_Strings.Add(DateTimeToStr(now)+'  '+'........完成！')
  except
    on e:Exception do begin
      vmsg := '.........失败！'+e.Message;
      Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
      Result := False;
    end;
  end;
end;

function TMainForm.Init_Data: Boolean;
var
  i:Integer;
  ss,msg_str : string;
begin

  if not AccessDB_Is_OK(initaccessfn) then
  begin
    vmsg := '初始化数据库文件：'+initaccessfn+'打开失败！请检查！';
    Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
    Application.MessageBox(pchar(vmsg),'错误',MB_OK+MB_ICONERROR);
    Result := False;
    Exit;
  end;

  msg_str := '';

  try

    Screen.Cursor := crHourGlass;
    Result := False;
    vmsg := '正在初始化数据库....';
    Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
    StatusBarEx1.Panels.Items[1].Text := vmsg;

    ss := '';
    if stClosed in AdoConnection1.State then
       ss:=ss+' stClosed';
    if stOpen in AdoConnection1.State then
 	     ss:=ss+' stOpen';
    if stConnecting in AdoConnection1.State then
       ss:=ss+' stConnecting';
    if stExecuting in AdoConnection1.State then
       ss:=ss+' stExecuting';
    if stFetching in AdoConnection1.State then
       ss:=ss+' stFetching';

    //ShowMessage(ss);

    while (stExecuting in AdoConnection1.State) do ;

    ADOConnection1.Close;
    ADOConnection1.DefaultDatabase := newDbedit.Text;
    ADOConnection1.Open;
    ADOConnection1.BeginTrans;

    try
      {
      for i:=Table_Name_Strings.Count-1 downto 0 do
      begin
        Application.ProcessMessages;
        tmpquery.Close;
        tmpquery.sql.Text := 'delete from '+Table_Name_Strings[i];
        tmpquery.ExecSQL;
        tmpquery.Close;
      end;
      }
      Gauge1.MaxValue := Table_Name_Strings.Count;
      for i:=0 to Table_Name_Strings.Count-1 do
      begin

        Gauge1.Progress := i+1;
        Application.ProcessMessages;

        tmpquery.Close;
        tmpquery.sql.Text := 'select * from '+Table_Name_Strings[i];
        tmpquery.Open;

        Access_query.Close;
        Access_query.Connection := Access_Connection;
        Access_query.sql.Text := 'select * from '+Table_Name_Strings[i];
        Access_query.Open;

        if not Copy_Table(Access_query,tmpquery,Table_Name_Strings[i]) then
        begin
          ADOConnection1.RollbackTrans;
          vmsg := '数据库初始化失败！请手动录入初始化数据！出错数据表：'+Table_Name_Strings[i];
          Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
          Exit;
        end;
      end;

      ADOConnection1.CommitTrans;

      tmpquery.Close;
      tmpquery.SQL.Text := 'select * from 操作员表 where 操作员等级=-1';
      tmpquery.Open;
      ss := tmpquery.fieldbyname('操作员ID').AsString;
      msg_str := tmpquery.fieldbyname('密码').AsString;
      tmpquery.Close;

      Result := True;
      vmsg := '数据库初化完成！系统默认的操作员ID和密码分别为：'+ss+' ， '+msg_str;
      Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
    except
      on e:Exception do begin
        Result := False;
        vmsg := '数据库初化失败！请手动录入初始化数据！　　';
        Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
        ADOConnection1.RollbackTrans;
      end;
    end;
  finally
    StatusBarEx1.Panels.Items[1].Text := vmsg;
    Access_Connection.Close;
    Screen.Cursor := crDefault;
  end;

end;

function Copy_Table(s,d:Tadoquery;tn:String):Boolean;
var
  i,ii:integer;
  xh,kch:String;
begin
  try
    Screen.Cursor := crHourGlass;
    Result := True;

    try
      MainForm.Gauge1.MaxValue := s.RecordCount;
      s.First;
      while not s.Eof do
      begin
        MainForm.Gauge1.Progress := s.RecNo;
        Application.ProcessMessages;
        d.Append;
        ii := s.FieldCount;
        if ii > d.FieldCount then
          ii := d.FieldCount;

        for i:=0 to ii-1 do
        begin
          if d.Fields[i].DataType <> ftAutoInc then
            d.Fields[i].Value := s.Fields[i].Value;
        end;
        d.Post;
        s.Next;
      end;
    except
      on e:Exception do begin
        vmsg := e.message;
        Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
        Result := False;
        //ShowMessage(tn+'：'+s.Fields[0].AsString);
        //Raise;
      end;
    end;
  finally
    MainForm.Gauge1.Progress := MainForm.Gauge1.MaxValue;
    Screen.Cursor := crDefault;
  end;
end;

function AccessDB_Is_OK(dbfn:String):Boolean;
begin
  Result := True;
  with MainForm.Access_Connection do
  begin
    Close;
    ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+dbfn+';Persist Security Info=False';
    try
      Open;
      Close;
      vmsg := dbfn+'数据库连接成功！';
      Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
    except
      on e:Exception do begin
        vmsg := dbfn+'数据库连接失败！'+e.message;
        Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
        Result := False;
      end;
    end;
  end;
end;

procedure TMainForm.CheckBox2Click(Sender: TObject);
begin
  Label2.Enabled := not CheckBox2.Checked;
  Label3.Enabled := Label2.Enabled;
  saEdit.Enabled := Label2.Enabled;
  sapwdEdit.Enabled := Label2.Enabled;
end;

procedure TMainForm.SysInitialize;
var
  ss,myinifn:string;
begin
  myinifn := ExtractFilePath(Application.ExeName)+'Create_Db_Set.ini';
  btn_Start.Enabled := FileExists(myinifn);
  if not btn_Start.Enabled then
  begin
    vmsg := '系统初始化文件：Create_Db_Set.ini 不存在！　　';
    Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
    MessageBox(Handle, PChar(vmsg),'初始化文件不存在', MB_OK + MB_ICONSTOP);
    Application.Terminate;
  end;

  with TIniFile.Create(myinifn) do
  begin
    try
      IPEdit.Text := '(local)';

      newdbEdit.Items.Clear;
      ss := ReadString('CREATE_DB_SET','SYSNAME','');
      Application.Title := ss;
      Caption := ss+'--通用数据库创建程序';
      Caption := Caption+' Ver '+Get_Version;

      ss := ReadString('CREATE_DB_SET','DBNAMELIST','');
      newdbEdit.Items.AddStrings(SplitString(ss,'|'));

      newdbfnEdit.Text := ReadString('CREATE_DB_SET','DBSAVEDIR','');

      newdbsaEdit.Text := ReadString('CREATE_DB_SET','SANAME','');

      dbscriptfn := ReadString('CREATE_DB_SET','CREATEDBSCRIPT','');
      dbscriptfn := ExtractFilePath(Application.ExeName)+dbscriptfn;

      initaccessfn := ReadString('CREATE_DB_SET','INITACCESSNAME','');
      initaccessfn := ExtractFilePath(Application.ExeName)+initaccessfn;

      ss := ReadString('CREATE_DB_SET','INITTABLENAME','');
      Table_Name_Strings.AddStrings(SplitString(ss,'|'));
    finally
      Free;
    end;
  end;

  btn_Start.Enabled := FileExists(dbscriptfn);
  if not btn_Start.Enabled then
  begin
    vmsg := '数据库创建脚本文件：'+dbscriptfn+' 不存在！　　';
    Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
    MessageBox(Handle, PChar(vmsg),'数据库脚本文件不存在', MB_OK + MB_ICONSTOP);
    Application.Terminate;
  end;

  btn_Start.Enabled := FileExists(initaccessfn);
  if not btn_Start.Enabled then
  begin
    vmsg := '初始化数据库文件：'+initaccessfn+' 不存在！　　';
    Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
    MessageBox(Handle, PChar(vmsg),'数据库初始化文件不存在', MB_OK + MB_ICONSTOP);
    Application.Terminate;
  end;

end;

procedure TMainForm.btn_HelpClick(Sender: TObject);
begin
  with THelpForm.Create(Application) do
  begin
    ShowModal;
    Free;
  end;
end;

function TMainForm.DBSrv_Connect_Is_OK: Boolean;
var
  connect_str:String;
begin
  Result := False;

  if not CheckBox2.Checked then
  begin
    connect_str := 'Provider=SQLOLEDB.1;Password='+SaPwdEdit.Text+';Persist Security Info=True;User ID='+SaEdit.Text+';';
    connect_str := connect_str + 'Initial Catalog=master;Data Source='+IPEdit.Text+';';
    connect_str := connect_str + 'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False';
  end else
  begin
    connect_str := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=master;Data Source='+IPEdit.Text;
  end;

  try
    vmsg := '正在连接数据库服务器....';
    Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
    StatusBarEx1.Panels.Items[1].Text := vmsg;
    Application.ProcessMessages;
    AdoConnection1.Close;
    ADOConnection1.ConnectionTimeout := 5;
    adoconnection1.ConnectionString := connect_str;
    Adoconnection1.Open;
    vmsg := '数据库服务器连接成功！';
    Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
    Result := True;
  except
    on e:Exception do begin
      vmsg := '数据库服务器连接失败！请检查数据库系统　　'+#13+'管理员角色和密码是否正确！';
      Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
      Application.MessageBox(PChar(vmsg),'连接数据库服务器失败',MB_OK+MB_ICONERROR);
      Result := False;
    end;
  end;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  SysInitialize;//准备工作初始化
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FileExists(Initialized_dbscriptfn) then
     DeleteFile(Initialized_dbscriptfn);
end;

initialization
  Table_Name_Strings := TStringList.Create;
  Log_Strings := TStringList.Create;

finalization
  FreeAndNil(Table_Name_Strings); //.Free;
  FreeAndNil(Log_Strings) ;//.Free;
end.