?? main.~pas
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -