main.pas

简单的SQL Server数据库安装

procedure TForm1.btOpenClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    m_sBackupFile := OpenDialog1.FileName;
    Edit7.Text := m_sBackupFile;
  end;
end;

procedure TForm1.btConnectClick(Sender: TObject);
var
  sSQL: string;
begin

  try
    try
      ADOConnection1.Connected := False;
      ADOConnection1.ConnectionString := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=Master;Data Source=' + m_sServer;
      ADOConnection1.Connected := True;
      m_bNt := true;

    except
      ADOConnection1.Connected := False;
      ADOConnection1.ConnectionString := 'Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password='+Edit1.Text+';Initial Catalog=master;Data Source=' + m_sServer;
      ADOConnection1.Connected := True;
      m_bNt := false;
    end;
    SetAdoQue(ADOQuery3, 'select * from sysdatabases order by name', true);
    sSQL := 'select * from sysdatabases where name not in (''master'',''msdb'',''model'',''pubs'',''tempdb'',''EDTSystem'',''NorthWind'') order by name';
    SetAdoQue(ADOQuery4, sSQL, true);
    m_bConnect := true;
    btConnect.Enabled := false;
    btSetup.Enabled := true;
  except
    Application.MessageBox('连接数据库错误,输入服务器名称！', '警告', MB_OK + MB_ICONWARNING);
    exit;
  end;
  sSQL := 'select * from sysdatabases where name=''EDTSystem''';
  if not SetAdoQue(ADOQuery5, sSQL, true) then begin
    Application.MessageBox('先安装系统数据库！', '警告', MB_OK + MB_ICONWARNING);
    exit;
  end;

  try
    if m_bNt then begin
      ADOConnection2.Connected := False;
      ADOConnection2.ConnectionString := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=EDTSystem;Data Source=' + m_sServer;
      ADOConnection2.Connected := True;
    end else begin
      ADOConnection2.Connected := False;
      ADOConnection2.ConnectionString := 'Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password='+Edit1.Text+';Initial Catalog=EDTSystem;Data Source=' + m_sServer;
      ADOConnection2.Connected := True;
    end;
    m_bHasSystem := true;
    btSetup.Enabled := false;
  except
    Application.MessageBox('系统数据库连接错误,先安装系统数据库！', '警告', MB_OK + MB_ICONWARNING);
    exit;
  end;


end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
  btConnect.Enabled := true;
  m_sServer := trim(Edit2.Text);
end;

procedure TForm1.btSaveClick(Sender: TObject);
begin
  if SaveDialog1.Execute then begin
    if Pos('.bak', SaveDialog1.FileName) > 0 then
      Edit5.Text := SaveDialog1.FileName
    else
      Edit5.Text := SaveDialog1.FileName + '.bak';
  end;
end;

procedure TForm1.btBuckupClick(Sender: TObject);
var
  sSQL: string;
begin
  if (Trim(Edit5.Text) = '') or (not m_bConnect) or (DBLookupComboboxEh1.Text = '') then exit;
  sSQL := 'Backup database ' + DBLookupComboboxEh1.Text + ' to disk=''' + Trim(Edit5.Text) + ''' with init';
  try
//    if SetAdoQue(ADOQuery2,'select * from tLedger where ',true)
    ADOConnection1.Execute(sSQL);
    Application.MessageBox('提交成功！', '信息', MB_OK + MB_ICONINFORMATION);
  except
    Application.MessageBox('备份数据库错误！', '警告', MB_OK + MB_ICONWARNING);
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  sSQL: string;
begin
  sSQL := 'select name from sysdatabases where name=''' + DBLookupComboboxEh2.Text + '''';
  if not SetAdoQue(ADOQuery1, sSQL, true) then exit;

  if (not m_bConnect) or (DBLookupComboboxEh2.Text = '') then exit;
  if Application.MessageBox(PChar('该操作将会删除数据库！确定要执行？'), '警告', MB_YESNO + MB_ICONWARNING) = idno then exit;
  sSQL := 'drop database ' + DBLookupComboboxEh2.Text;
  try
    if m_bHasSystem then begin
      if SetAdoQue(ADOQuery2, 'select * from tLedger where code=''' + DBLookupComboboxEh2.Text + '''', true) then
        ADOQuery2.Delete;
    end;
    ADOConnection1.Execute(sSQL);
    Application.MessageBox('提交成功！', '信息', MB_OK + MB_ICONINFORMATION);
    ADOQuery2.Requery();
    ADOQuery4.Requery();
    ADOQuery3.Requery();
  except
    Application.MessageBox('删除数据库错误！', '警告', MB_OK + MB_ICONWARNING);
  end;
end;

procedure TForm1.btSetupClick(Sender: TObject);
var
  sSQL: string;
begin
  if not m_bConnect then begin
    Application.MessageBox(PChar('先连接服务器！'), '警告', MB_YESNO + MB_ICONWARNING);
    exit;
  end;
  sSQL := 'select name from sysdatabases where name=''EDTSystem''';
  if SetAdoQue(ADOQuery1, sSQL, true) then begin
    Application.MessageBox(PChar('该系统已存在这个数据库！'), '警告', MB_OK);
    exit;
  end else begin

  //      if  Application.MessageBox(PChar('该操作将会修改数据库！确定要执行？'),'警告',MB_YESNO+MB_ICONWARNING)=idno then exit;
    try

      ADOConnection1.BeginTrans;

      sSQL := 'RESTORE DATABASE EDTSystem ' +
        ' FROM DISK = ''' + ExtractFilePath(application.ExeName) + '\EDT.bak''' + // D:\quickbook\exe\GuamaFbas.1105'
        ' WITH MOVE ''EDTSystem_data'' TO ''' + m_sSQLPlan + '\Data\EDTSystem_data.mdf'',' + //     ''d:\test\xinda2.mdf'',
        ' MOVE ''EDTSystem_log'' TO ''' + m_sSQLPlan + '\Data\EDTSystem_log.ldf'''; //d:\test\xinda2.ldf'

      ADOConnection1.Execute(sSQL);

      ADOConnection1.CommitTrans;

      Application.MessageBox('提交成功！', '信息', MB_OK + MB_ICONINFORMATION);
    except
      ADOConnection1.RollbackTrans;
      Application.MessageBox('提交错误，请重试。', '警告', MB_OK + MB_ICONWARNING);
    end;
  end;
  try
    if m_bNt then begin
      ADOConnection2.Connected := False;
      ADOConnection2.ConnectionString := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=EDTSystem;Data Source=' + m_sServer;
      ADOConnection2.Connected := True;
    end else begin
      ADOConnection2.Connected := False;
      ADOConnection2.ConnectionString := 'Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password='+Edit1.Text+';Initial Catalog=EDTSystem;Data Source=' + m_sServer;
      ADOConnection2.Connected := True;
    end;
    m_bHasSystem := true;
  except
    Application.MessageBox('系统数据库连接错误,先安装系统数据库！', '警告', MB_OK + MB_ICONWARNING);

    exit;
  end;



  if ADOQuery4.Active then ADOQuery4.Requery();
end;

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): integer; stdcall;
begin
  TStrings(Data).Add(LogFont.lfFaceName);
  Result := 1;
end;


procedure TForm1.GetFontNames(Combox: TComboBox);
var
  DC: HDC;
begin
  DC := GetDC(0);
  EnumFonts(DC, nil, @EnumFontsProc, Pointer(Combox.Items));
  ReleaseDC(0, DC);
  Combox.Sorted := true;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  sSQL: string;
begin
  if not m_bConnect then begin
    Application.MessageBox(PChar('先连接服务器！'), '警告', MB_YESNO + MB_ICONWARNING);
    exit;
  end;
  try
    if m_bNt then begin
      ADOConnection3.Connected := False;
      ADOConnection3.ConnectionString := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=' + DBLookupComboboxEh3.Text + ';Data Source=' + m_sServer;
      ADOConnection3.Connected := True;
    end else begin
      ADOConnection3.Connected := False;
      ADOConnection3.ConnectionString := 'Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password='+Edit1.Text+';Initial Catalog=' + DBLookupComboboxEh3.Text + ';Data Source=' + m_sServer;
      ADOConnection3.Connected := True;
    end;
  except
    Application.MessageBox('连接数据库错误！', '警告', MB_OK + MB_ICONWARNING);
    exit;
  end;
  sSQL := 'select * from tReportMst order by name';
  if SetAdoQue(ADOReportMst, sSQL, true) then ReportName.Enabled := true else begin
    Application.MessageBox('连接数据库错误！', '警告', MB_OK + MB_ICONWARNING);
    exit;
  end;
  GetFontNames(ComboBox1);
  iFontName := ComboBox1.Items.IndexOf('宋体');
  ComboBox1.Text := ComboBox1.Items[iFontName];
  ReportNameChange(Sender);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if ADOReportDtl.Locate('iDataSource;fieldname', VarArrayOf([2, 'remark']), []) then begin
    ADOReportDtl.Edit;
    ADOReportDtl.FieldByName('FontName').AsString := ComboBox1.Items[iFontName];
    ADOReportDtl.Post;
    Application.MessageBox('设置字体成功！', '提示', MB_OK);
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if ADOReportDtl.Locate('iDataSource;fieldname', VarArrayOf([1, 'remark']), []) then begin
    ADOReportDtl.Edit;
    ADOReportDtl.FieldByName('FontName').AsString := ComboBox1.Items[iFontName];
    ADOReportDtl.Post;
    Application.MessageBox('设置字体成功！', '提示', MB_OK);
  end;
end;

procedure TForm1.ReportNameChange(Sender: TObject);
var
  sSQL: string;
begin
  if (DBLookupComboboxEh3.Text = '') or (ReportName.Text = '') then exit;
  sSQL := 'select * from tReportDtl1 where name=''' + ADOReportMst.fieldbyname('name').AsString + ''' order by tOrder';
  if SetAdoQue(ADOReportDtl, sSQL, true) then begin

    Button4.Enabled := true;
    Button2.Enabled := true;
    Button3.Enabled := true;
  end else begin
    Application.MessageBox('连接数据库错误！', '警告', MB_OK + MB_ICONWARNING);
    exit;
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  sSQL: string;
begin
  if (DBLookupComboboxEh3.Text = '') or (ReportName.Text = '') then exit;
  sSQL := 'update tReportDtl1 set FontName=''' + ComboBox1.Text + ''' where iPosition>1 and name=''' + ReportName.Text + '''';
  ADOConnection3.Execute(sSQL);
  Application.MessageBox('设置字体成功！', '提示', MB_OK);
end;

end.