?? main.~pas
字號:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, ADODB, Registry, ComCtrls, Mask, DBCtrlsEh,
DBLookupEh, Buttons, DBGridEh;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
Label2: TLabel;
ADOQuery1: TADOQuery;
ADOQuery2: TADOQuery;
ADOConnection2: TADOConnection;
btCancel: TButton;
OpenDialog1: TOpenDialog;
Edit2: TEdit;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Label3: TLabel;
Label4: TLabel;
Button1: TButton;
Edit3: TEdit;
Edit4: TEdit;
CheckBox1: TCheckBox;
btOpen: TButton;
btConnect: TButton;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
DBLookupComboboxEh1: TDBLookupComboboxEh;
ADOQuery3: TADOQuery;
DataSource1: TDataSource;
Label5: TLabel;
Edit5: TEdit;
Label6: TLabel;
SaveDialog1: TSaveDialog;
btSave: TButton;
btBuckup: TButton;
DBLookupComboboxEh2: TDBLookupComboboxEh;
Label7: TLabel;
ADOQuery4: TADOQuery;
BitBtn1: TBitBtn;
DataSource2: TDataSource;
TabSheet4: TTabSheet;
btSetup: TButton;
ADOQuery5: TADOQuery;
ADOConnection3: TADOConnection;
ADOQuery6: TADOQuery;
TabSheet5: TTabSheet;
Label9: TLabel;
ReportName: TDBLookupComboboxEh;
ComboBox1: TComboBox;
Button2: TButton;
Button3: TButton;
Button4: TButton;
DBLookupComboboxEh3: TDBLookupComboboxEh;
Label10: TLabel;
Button5: TButton;
ADOReportMst: TADOQuery;
ADOReportDtl: TADOQuery;
DataSource3: TDataSource;
Edit7: TEdit;
Label1: TLabel;
Edit1: TEdit;
ADOQuery7: TADOQuery;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure btCancelClick(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure btOpenClick(Sender: TObject);
procedure btConnectClick(Sender: TObject);
procedure Edit2Change(Sender: TObject);
procedure btSaveClick(Sender: TObject);
procedure btBuckupClick(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure btSetupClick(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ReportNameChange(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
m_sSQLPlan: string;
m_sBackupFile: string;
m_sServer: string;
m_bConnect, m_bNt: boolean;
m_bHasSystem: boolean;
iFontName: integer;
procedure GetFontNames(Combox: TComboBox);
public
{ Public declarations }
end;
var
Form1: TForm1;
function SetAdoQue(AdoQue: TADOQuery; sSQL: string; bSel: boolean): boolean;
implementation
{$R *.dfm}
function SetAdoQue(AdoQue: TADOQuery; sSQL: string; bSel: boolean): boolean;
//設定ADOQuery結果集
begin
Result := true;
try
AdoQue.Close;
AdoQue.SQL.Clear;
AdoQue.SQL.Add(sSQL);
if bSel then begin
AdoQue.open;
if AdoQue.RecordCount = 0 then begin
Result := false;
exit;
end
end else AdoQue.ExecSQL;
except
Result := false;
exit;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
var
sLedgerCode, sServer: string;
Registry, Registry1: TRegistry;
sSQLPlan: string;
begin
Registry := TRegistry.Create;
Registry1 := TRegistry.Create;
Registry.RootKey := HKEY_LOCAL_MACHINE;
Registry.OpenKey('SYSTEM\ControlSet001\Control\ComputerName\ActiveComputerName', false);
sServer := Registry.ReadString('ComputerName');
Registry1.RootKey := HKEY_LOCAL_MACHINE;
if Registry1.OpenKey('SOFTWARE\MicroSoft\MSSQLSERVER\Setup', false) then begin
sLedgerCode := Registry1.ReadString('LedgerName');
end else begin
Application.MessageBox(PChar('本系統要在SQL數據庫服務器下運行!'), '警告', MB_YESNO + MB_ICONWARNING);
Application.Terminate;
end;
sSQLPlan := Registry1.ReadString('SQLDataRoot');
Registry.free;
m_sSQLPlan := sSQLPlan;
// Edit3.Text:=sLedgerCode;
// Edit3.Text:=sSQLPlan;
Edit2.Text := sServer;
m_sServer := sServer;
m_bConnect := false;
m_bHasSystem := false;
m_bNt := false;
Registry1.free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
sSQL: string;
sBackupFile, sCode: string;
bExists: boolean;
sDataCode,sLogCode:string;
begin
{ sSQL:='select name from sysdatabases where name=''EDTSystem''';
if not SetAdoQue(ADOQuery1,sSQL,true) then begin
Application.MessageBox(PChar('系統數據庫不存在!先安裝系統數據庫!'),'警告',MB_YESNO+MB_ICONWARNING);
exit;
end;
}
// m_sSQLPlan:='C:\Program Files\Microsoft SQL Server\MSSQL';
if (not m_bConnect) or (not m_bHasSystem) then begin
Application.MessageBox(PChar('先連接服務器或未安裝系統數據庫!'), '警告', MB_YESNO + MB_ICONWARNING);
exit;
end;
bExists := false;
sCode := Trim(Edit3.Text);
if sCode = '' then begin
Application.MessageBox(PChar('請輸入數據庫代碼!'), '警告', MB_YESNO + MB_ICONWARNING);
exit;
end;
// if Trim(Edit4.Text) = '' then begin
// Application.MessageBox(PChar('請輸入數據庫中文名稱!'), '警告', MB_YESNO + MB_ICONWARNING);
// exit;
// end;
if SetAdoQue(ADOQuery2, 'select * from tLedger where code=''' + sCode + '''', true) then begin
if Application.MessageBox(PChar('該系統已存在這個數據庫!確定要執行?'), '警告', MB_YESNO + MB_ICONWARNING) = idno then exit;
bExists := true;
end;
sSQL := 'select name from sysdatabases where name=''' + Edit3.Text + '''';
if SetAdoQue(ADOQuery1, sSQL, true) then begin
if Application.MessageBox(PChar('該系統已存在這個數據庫!確定要執行?'), '警告', MB_YESNO + MB_ICONWARNING) = idno then exit;
end;
if CheckBox1.Checked then begin
if m_sBackupFile = '' then begin
Application.MessageBox(PChar('你還沒有選擇備份文件!'), '警告', MB_YESNO + MB_ICONWARNING);
exit;
end else sBackupFile := m_sBackupFile;
end else begin
sBackupFile := ExtractFilePath(application.ExeName) + '\Song.bak';
end;
// if Application.MessageBox(PChar('該操作將會修改數據庫!確定要執行?'),'警告',MB_YESNO+MB_ICONWARNING)=idno then exit;
{sSQL:='select * from tLedger';
SetAdoQue(ADOQuery2,sSQL,true);
ADOQuery2.Append;
ADOQuery2.FieldByName('Code').AsString:=sCode;
ADOQuery2.FieldByName('Name').AsString:=Trim(Edit4.Text);
ADOQuery2.Post; }
// m_sSQLPlan:='C:\Program Files\Microsoft SQL Server\MSSQL';
try
ADOConnection1.BeginTrans;
sDataCode :='';
if SetAdoQue(ADOQuery7,'RESTORE FILELISTONLY FROM DISK ='+QuotedStr(sBackupFile)) then
begin
if ADOQuery7.Locate('Type','D',[]) then
begin
sDataCode := ADOQuery7.FieldByName('LogicalName').AsString;
end;
if ADOQuery7.Locate('Type','L',[]) then
begin
sLogCode := ADOQuery7.FieldByName('LogicalName').AsString;
end;
end; //if
// sSQL:='select * from tLedger';
// SetAdoQue(ADOQuery2,sSQL,true);
if sDataCode<>'' then
begin
if bExists then ADOQuery2.Edit else ADOQuery2.Append;
ADOQuery2.FieldByName('Code').AsString := sCode;
ADOQuery2.FieldByName('Name').AsString := Trim(Edit4.Text);
ADOQuery2.FieldByName('sSQLPlan').AsString := m_sSQLPlan;
ADOQuery2.Post;
Screen.Cursor := crHourGlass;
sSQL := 'RESTORE DATABASE ' + Edit3.Text +
' FROM DISK = ''' + sBackupFile + '''' + // D:\quickbook\exe\GuamaFbas.1105'
' WITH MOVE '+QuotedStr(sDataCode)+' TO ''' + m_sSQLPlan + '\Data\' + sCode + '.mdf'' ,' + // ''d:\test\xinda2.mdf'',
' MOVE '+QuotedStr(sLogCode)+' TO ''' + m_sSQLPlan + '\Data\' + sCode + '.ldf'', REPLACE'; //d:\test\xinda2.ldf'
ADOConnection1.Execute(sSQL);
end;
ADOConnection1.CommitTrans;
ADOQuery3.Requery();
ADOQuery4.Requery();
Screen.Cursor := crDefault;
Application.MessageBox('提交成功!', '信息', MB_OK + MB_ICONINFORMATION);
except
ADOConnection1.RollbackTrans;
Application.MessageBox('提交錯誤,請重試。', '警告', MB_OK + MB_ICONWARNING);
end;
end;
procedure TForm1.btCancelClick(Sender: TObject);
begin
Close;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
btOpen.Enabled := CheckBox1.Checked;
end;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -