【delphi开源代码栏目提醒】:网学会员,鉴于大家对delphi开源代码十分关注,论文会员在此为大家搜集整理了“DCM.pas”一文,供大家参考学习!
unit DCM;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ModalForm, Menus, MoveImageButton, LabelButton, ComCtrls,
ToolWin, StdCtrls, ExtCtrls, DB, ADODB;
type
TDCMForm = class(TMyModalForm)
rg: TRadioGroup;
Edit1: TEdit;
MIBtnPath: TMoveImgBtn;
lbBtnOpen: TLabelBtn;
Label1: TLabel;
odlgDatafile: TOpenDialog;
Panel1: TPanel;
Label2: TLabel;
dtpStart: TDateTimePicker;
Label3: TLabel;
dtpEnd: TDateTimePicker;
SaveDialog1: TSaveDialog;
MoveImgBtnNew: TMoveImgBtn;
LbBtnNew: TLabelBtn;
procedure MIBtnOKClick(Sender: TObject);
procedure MIBtnPathClick(Sender: TObject);
procedure rgClick(Sender: TObject);
procedure MoveImgBtnNewClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure CreateOnlineNote(AFName: string);
end;
var
DCMForm: TDCMForm;
implementation
uses InOutData, data;
{$R *.dfm}
procedure TDCMForm.MIBtnOKClick(Sender: TObject);
begin
inherited;
if Trim(Edit1.Text)='' then
ShowMessage('请选择数据库文件路径!')
else begin
InOutDataForm:=TInOutDataForm.Create(Application);
InOutDataForm.DatafilePath :=Edit1.Text;
InOutDataForm.startDate :=dtpStart.Date;
InOutDataForm.endDate :=dtpEnd.Date;
InOutDataForm.OpType :=rg.ItemIndex;
InOutDataForm.ShowModal;
end;
end;
procedure TDCMForm.MIBtnPathClick(Sender: TObject);
begin
inherited;
case rg.ItemIndex of
0: begin
odlgDatafile.DefaultExt :='*.jfg';
odlgDatafile.FileName :='*.jfg';
odlgDatafile.Filter :='机房管理数据库文件 (*.jfg)|*.jfg';
end;
1..2: begin
odlgDatafile.DefaultExt :='*.oln';
odlgDatafile.FileName :='*.oln';
odlgDatafile.Filter :='机房管理系统上机记录文件(*.oln)|*.oln';
end;
end;
if odlgDatafile.Execute then
edit1.Text :=odlgDatafile.FileName;
end;
procedure TDCMForm.rgClick(Sender: TObject);
begin
inherited;
panel1.Visible :=rg.ItemIndex =1;
end;
procedure TDCMForm.MoveImgBtnNewClick(Sender: TObject);
var
strPath:string;
begin
inherited;
savedialog1.FileName :='OnlineNote'+DateToStr(dtpstart.date);
if savedialog1.Execute then
begin
strPath:=savedialog1.FileName;
if FileExists(strPath) then
begin
if MessageBox(handle,'文件已存在,是否覆盖?','新建数据库',MB_OKCANCEL or MB_ICONWARNING)=IDOK then
begin
CreateOnlineNote(strPath);//新建
end;
end
else begin
CreateOnlineNote(strPath);//新建
end;
end;
end;
procedure TDCMForm.CreateOnlineNote(AFName: string);
var
adoTemp:TADOQuery;
adoCon:TADOConnection;
strCon:string;
begin
adoCon:=TADOConnection.Create(nil);
adoTemp:=TADOQuery.Create(nil);
try
strCon:=ExtractFilePath(Application.ExeName)+'\Templet.dat;';
strCon:='Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='
+strCon+'Mode=Share Deny None;Extended Properties="";Jet OLEDB:System database="";'
+'Jet OLEDB:Registry Path="";Jet OLEDB:Database Password=06608841019;'
+'Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=1;'
+'Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;'
+'Jet OLEDB:New Database Password="";Jet OLEDB:Create System Database=False;'
+'Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don'+''''+'t Copy Locale on Compact=False;'
+'Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False';
adoCon.ConnectionString :=strCon;
adoCon.LoginPrompt :=false;
adoCon.Connected :=true;
adoTemp.Connection :=adoCon;
adoTemp.SQL.Add('select Templet from Templet where DEnName='+''''+'OnlineNote'+'''');
adoTemp.Active :=true;
if adoTemp.RecNo >0 then
(adoTemp.FieldByName('Templet') as tblobfield).SaveToFile(AFName);
adoTemp.Free;
adoCon.Free;
Edit1.Text :=AFName;
except
adoTemp.Free;
adoCon.Free;
ShowMessage('建立数据库失败');
end;
end;
procedure TDCMForm.FormCreate(Sender: TObject);
begin
inherited;
dtpStart.DateTime :=now;
dtpEnd.DateTime :=now;
end;
end.
上一篇:
frmFaves.frm
下一篇:
论莫泊桑中短篇小说女权主义思想的表现方式