dbmodule.pas

小管理程序主要管理的小咖啡厅我是从网上下的经测试可用

unit dbmodule;

interface

uses
  SysUtils, Classes, DB, ADODB,Dialogs,StrUtils,DateUtils;

type
  Tdm = class(TDataModule)
    conn: TADOConnection;
    Qfangtai: TADOTable;
    QFangtaiDataSource: TDataSource;
    Qmasterclass: TADOTable;
    Qchildclass: TADOTable;
    QmasterclassDataSource: TDataSource;
    QchildclassDataSource: TDataSource;
    Qcaipin: TADOTable;
    QcaipinDataSource: TDataSource;
    QUnitList: TADOTable;
    UnitListDataSource: TDataSource;
    Qfangshi: TADOTable;
    QfangshiDataSource: TDataSource;
    Qfangtaistatus: TADOTable;
    QfangtaistatusDataSource: TDataSource;
    Qsysparam: TADOTable;
    QDisList: TADOTable;
    QDisListDataSource: TDataSource;
    QueryPass: TADOQuery;
    WorkLogQuery: TADOQuery;
    ChuanBiaoQuery: TADOQuery;
    QGuest: TADOTable;
    QGuestDataSource: TDataSource;
    Qusers: TADOTable;
    QusersDataSource: TDataSource;
    Qusersuserid: TAutoIncField;
    Qusersusername: TWideStringField;
    Qusersuserpass: TWideStringField;
    QusersGroupid: TIntegerField;
    Qgroup: TADOTable;
    Qusersgroupname: TStringField;
    QgroupDataSource: TDataSource;
    comquery: TADOQuery;
    Qcaipinitem: TADOTable;
    QcaipinitemDataSource: TDataSource;
    Qcaipincaipingroupname: TStringField;
    QcaipinCaipinid: TIntegerField;
    Qcaipinchclassid: TIntegerField;
    Qcaipincaipinname: TWideStringField;
    Qcaipincaipinunit: TWideStringField;
    Qcaipincaipinprice: TBCDField;
    Qcaipincaipinma: TWideStringField;
    Qcaipinisdel: TIntegerField;
    Qcaipincaipingroup: TIntegerField;
    procedure QfangtaiPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure QfangtaiFilterRecord(DataSet: TDataSet; var Accept: Boolean);
    procedure QmasterclassFilterRecord(DataSet: TDataSet;
      var Accept: Boolean);
    procedure QmasterclassPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure QchildclassFilterRecord(DataSet: TDataSet;
      var Accept: Boolean);
    procedure QcaipinPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure QcaipinFilterRecord(DataSet: TDataSet; var Accept: Boolean);
    procedure QfangshiPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure UpdateFieldFormats(DataSet: TDataSet);
    Function CreateZhangHao():string;
    procedure SaveWorkLog(currdate:Tdatetime;opratename,logconn:string);
    Function  QueryChuanBiao(chuanbiao:string):boolean;
    procedure WriteChuanBiao(chuanbiao:string;caipinname:string;caipincount:integer;caipinprice:real;caipinlei:string);
    procedure DataModuleCreate(Sender: TObject);
    procedure QcaipinEditError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure errormsgdlg(DataSet: TDataSet);
    procedure QGuestPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure QusersPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
  private
    { Private declarations }
    
   
  public
    { Public declarations }
    opratename:string;
    companyname:string;
    companytele:string;
  end;

var
  dm: Tdm;
const
  {Declare constants we're interested in}
  AdoDataSetKeyViol =-105121349;
  AdoDateKeyIsNull=-541331061;
implementation

{$R *.dfm}

procedure Tdm.WriteChuanBiao(chuanbiao:string;caipinname:string;caipincount:integer;caipinprice:real;caipinlei:string);
  begin
    if ChuanBiaoQuery.Active then
      ChuanBiaoQuery.Close;
    ChuanBiaoQuery.SQL.Clear;
    ChuanBiaoQuery.SQL.Add('select * from Q_tuidan where chuanbiaohao='+''''+chuanbiao+'''');
    ChuanBiaoQuery.Open;
    if ChuanBiaoQuery.Eof then
      begin
        ChuanBiaoQuery.Append;
        ChuanBiaoQuery.FieldByName('chuanbiaohao').AsString:=chuanbiao;
        ChuanBiaoQuery.FieldByName('caipinname').AsString:=caipinname;
        ChuanBiaoQuery.FieldByName('caipincount').AsInteger:=caipincount;
        ChuanBiaoQuery.FieldByName('caipinprice').AsCurrency:=caipinprice;
        ChuanBiaoQuery.FieldByName('caipinlei').AsString :=caipinlei;
        ChuanBiaoQuery.FieldByName('opratename').AsString:=dm.opratename;
        ChuanBiaoQuery.FieldByName('opratedate').AsDateTime:=now();
        ChuanBiaoQuery.Post;
      end;
    ChuanBiaoQuery.Close;
  end;
Function  Tdm.QueryChuanBiao(chuanbiao:string):boolean;
  begin
    if ChuanBiaoQuery.Active then
      ChuanBiaoQuery.Close;
    ChuanBiaoQuery.SQL.Clear;
    ChuanBiaoQuery.SQL.Add('select * from Q_tuidan where chuanbiaohao='+''''+chuanbiao+'''');
    ChuanBiaoQuery.Open;
    if ChuanBiaoQuery.Eof then
      Result:=False
    else
      Result:=True;
    ChuanBiaoQuery.Close;
  end;

procedure Tdm.SaveWorkLog(currdate:Tdatetime;opratename,logconn:string);
  begin
     if WorkLogQuery.Active then
       WorkLogQuery.Close;
     WorkLogQuery.SQL.Clear;
     WorkLogQuery.SQL.Add('select * from Q_worklog where id=null');
     WorkLogQuery.Open;
     WorkLogQuery.Append;
     WorkLogQuery.FieldByName('logdate').AsDateTime:=currdate;
     WorkLogQuery.FieldByName('logname').AsString:=logconn;
     WorkLogQuery.FieldByName('opratename').AsString:=opratename;
     WorkLogQuery.Post;
     WorkLogQuery.Close;
  end;

function Tdm.CreateZhangHao():string;
  var
    idnum,idnumstr,str:string[12];
    idcount,i:integer;
    stryear,strmonth,strday:string;
    strdate:Tdatetime;
  begin
        if not dm.Qsysparam.Active then
          dm.Qsysparam.Open ;
        str:='';
        idcount:=0;
        dm.Qsysparam.First ;
        idnum:=dm.Qsysparam.FieldByName('Idnum').AsString ;
         if length(trim(idnum))>0 then
           begin
             stryear:=copy(idnum,1,4);
             strmonth:=copy(idnum,5,2);
             strday:=copy(idnum,7,2);
             strdate:=strtodate(stryear+'-'+strmonth+'-'+strday);
             if strdate=date() then
              begin
                idcount:=StrtoInt(RightStr(idnum,4))+1;
                idnumstr:=IntToStr(idcount);
                if length(idnumstr)<4 then
                begin
                  for i:=1 to 4-length(idnumstr) do
                      str:=str+'0';
                  idnumstr:=str+idnumstr;
                 end;
               end
             else
              idnumstr:='0001';
             stryear:=InttoStr(yearof(date()));
             strmonth:=InttoStr(monthof(date()));
             if length(strmonth)=1 then
                strmonth:='0'+strmonth;
             strday:=IntToStr(dayof(date()));
             if length(strday)=1 then
              strday:='0'+strday;
             idnum:=stryear+strmonth+strday+idnumstr;
           end
         else
           begin
             idnumstr:='0001';
             stryear:=InttoStr(yearof(date()));
             strmonth:=InttoStr(monthof(date()));
             if length(strmonth)=1 then
                strmonth:='0'+strmonth;
             strday:=IntToStr(dayof(date()));
             if length(strday)=1 then
              strday:='0'+strday;
             idnum:=stryear+strmonth+strday+idnumstr;
           end;
         dm.Qsysparam.First ;
         dm.Qsysparam.Edit ;
         dm.Qsysparam.FieldByName('Idnum').AsString :=idnum;
         dm.Qsysparam.Post ;
         dm.Qsysparam.Close ;
         Result:=idnum;
  end;
procedure Tdm.UpdateFieldFormats(DataSet: TDataSet);
const
  defFloatFormat: string = ',0.00';
  defDateFormat: string = 'yyyy-mm-dd';
  defTimeFormat: string = 'hh:mm:ss';
  defDateTimeFormat: string = 'yyyy-mm-dd hh:mm:ss';
var
  I: Integer;
begin
  for I := 0 to DataSet.FieldCount - 1 do begin
    case DataSet.Fields[I].DataType of
      ftFloat, ftCurrency, ftBCD:
        begin
          TNumericField(DataSet.Fields[I]).DisplayFormat := defFloatFormat;
           TNumericField(DataSet.Fields[I]).EditFormat := '#.##';
        end;
      ftDate: TDateTimeField(DataSet.Fields[I]).DisplayFormat := defDateFormat;
      ftTime: TDateTimeField(DataSet.Fields[I]).DisplayFormat := defTimeFormat;
      ftDateTime: TDateTimeField(DataSet.Fields[I]).DisplayFormat := defDateTimeFormat;
    end;
  end;
end;

procedure TDM.errormsgdlg(DataSet: TDataSet);
var
Adoerrors:error;
begin
  Adoerrors:=conn.Errors.item[0];
  //showmessage(inttostr(adoerrors.NativeError));
  case adoerrors.NativeError of
    AdoDataSetKeyViol:
      begin
         MessageDlg('主键编号不能重复！',mtError,[mbok],0);
         DataSet.Cancel;
      end;
    AdoDateKeyIsNull:
      begin
         MessageDlg('红色标识处不能为空！',mtError,[mbok],0);
         DataSet.Cancel;
      end;
    else
      begin
        MessageDlg('数据库操作错误，请关闭重启！',mtError,[mbok],0);
        DataSet.Cancel;
      end;
  end;
end;
procedure Tdm.QfangtaiPostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
 errormsgdlg(DataSet);
end;

procedure Tdm.QfangtaiFilterRecord(DataSet: TDataSet; var Accept: Boolean);
begin
  accept:=qfangtai.FieldByName('isdel').AsInteger =0;
end;

procedure Tdm.QmasterclassFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  accept:=Qmasterclass.FieldByName('isdel').AsInteger =0;
end;

procedure Tdm.QmasterclassPostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  errormsgdlg(DataSet);
end;

procedure Tdm.QchildclassFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  accept:=Qchildclass.FieldByName('isdel').AsInteger =0;
end;

procedure Tdm.QcaipinPostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  errormsgdlg(DataSet);
end;

procedure Tdm.QcaipinFilterRecord(DataSet: TDataSet; var Accept: Boolean);
begin
   accept:=Qcaipin.FieldByName('isdel').AsInteger =0;
end;

procedure Tdm.QfangshiPostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  errormsgdlg(DataSet);
end;

procedure Tdm.DataModuleCreate(Sender: TObject);
var
  DataBasepath:string;
begin
  DataBasepath:=ExtractFileDir(paramstr(0));
  DataBasepath:=DataBasepath+'\database\mydata.mdb';
  if conn.Connected then
    conn.Close;
  conn.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DataBasepath+';Persist Security Info=False';
  conn.Open; 
end;

procedure Tdm.QcaipinEditError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  errormsgdlg(DataSet);
end;

procedure Tdm.QGuestPostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  errormsgdlg(DataSet);
end;

procedure Tdm.QusersPostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  errormsgdlg(DataSet);
end;

end.