⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 udm.pas

📁 delphi 源码 小型企业管理软件
💻 PAS
字号:
unit uDM;

interface
uses
  SysUtils, Classes, DB, ADODB, JvStringHolder, AdoConEd, ImgList, Controls,
  wwDialog, Wwlocate, Graphics, JvComponent, JvBaseDlg, JvProgressDialog,
  JvComputerInfoEx, frxDesgn, variants;

type
  TDM = class(TDataModule)
    ADOConnection1: TADOConnection;
    Query1: TADOQuery;                      
    T_users: TADOTable;
    D_users: TDataSource;
    JvProgressDialog1: TJvProgressDialog;
    JvComputerInfoEx1: TJvComputerInfoEx;
    wwLocateDialog1: TwwLocateDialog;
    ImageList1: TImageList;
    frxDesigner1: TfrxDesigner;
    T_userPriv: TADOTable;
    D_userPriv: TDataSource;
    D_Power: TDataSource;
    Q_Power: TADOQuery;
    Q_PowerformName: TStringField;
    Q_PowerCaption: TStringField;
    Q_PowerPiname: TStringField;
    Q_Poweruid: TStringField;
    Q_PowerCPow: TStringField;
    Q_PowerRPow: TStringField;
    Q_PowerUPow: TStringField;
    Q_PowerDPow: TStringField;
    Q_PowerALLPow: TStringField;
    Q_PowerFlag: TIntegerField;
    Q_PowerEPow: TStringField;
    T_LookupTab: TADOTable;
    D_LookupTab: TDataSource;
    T_LookupTabn: TIntegerField;
    T_LookupTabs: TStringField;
    QDM_CP: TADOQuery;
    IntegerField1: TIntegerField;
    StringField1: TStringField;
    StringField2: TStringField;
    StringField3: TStringField;
    StringField4: TStringField;
    FloatField2: TFloatField;
    StringField5: TStringField;
    QDM_kh: TADOQuery;
    QDM_khkhid: TStringField;
    QDM_khkhType: TSmallintField;
    QDM_khkhname: TStringField;
    QDM_khtel: TStringField;
    QDM_khfax: TStringField;
    QDM_khaddr: TStringField;
    QDM_khpostalCode: TStringField;
    QDM_khlinkman: TStringField;
    QDM_khwebsite: TStringField;
    QDM_khemail: TStringField;
    QDM_khremark: TStringField;
    QDM_khkhTypeStr: TStringField;
    QDM_LJ: TADOQuery;
    IntegerField2: TIntegerField;
    StringField6: TStringField;
    StringField7: TStringField;
    StringField8: TStringField;
    StringField9: TStringField;
    FloatField4: TFloatField;
    StringField10: TStringField;
    QDM_sup: TADOQuery;
    StringField11: TStringField;
    SmallintField1: TSmallintField;
    StringField12: TStringField;
    StringField13: TStringField;
    StringField14: TStringField;
    StringField15: TStringField;
    StringField16: TStringField;
    StringField17: TStringField;
    StringField18: TStringField;
    StringField19: TStringField;
    StringField20: TStringField;
    StringField21: TStringField;
    T_SupplierType: TADOTable;
    T_Huobi: TADOTable;
    T_HuobiHBCode: TStringField;
    T_HuobiHB01: TStringField;
    T_HuobiHB02: TStringField;
    T_HuobiHB03: TStringField;
    T_HuobiHB04: TFloatField;
    D_Huobi: TDataSource;
    T_payTerm: TADOTable;
    D_payTerm: TDataSource;
    T_payTermptName: TStringField;
    T_payTermptDelayDays: TSmallintField;
    T_payTermremark: TStringField;
    T_SupplierTypetypeName: TStringField;
    Q_common: TADOQuery;
    QDM_SP: TADOQuery;
    IntegerField3: TIntegerField;
    StringField22: TStringField;
    StringField23: TStringField;
    StringField24: TStringField;
    StringField25: TStringField;
    FloatField1: TFloatField;
    StringField26: TStringField;
    QDM_kh_sup: TADOQuery;
    StringField27: TStringField;
    SmallintField2: TSmallintField;
    StringField28: TStringField;
    StringField29: TStringField;
    StringField30: TStringField;
    StringField31: TStringField;
    StringField32: TStringField;
    StringField33: TStringField;
    StringField34: TStringField;
    StringField35: TStringField;
    StringField36: TStringField;
    StringField37: TStringField;
    QDM_LJspClass: TStringField;
    procedure ADOConnection1AfterConnect(Sender: TObject);
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure T_usersAfterScroll(DataSet: TDataSet);
    procedure T_usersBeforeDelete(DataSet: TDataSet);
    procedure T_usersBeforePost(DataSet: TDataSet);
    procedure T_usersAfterOpen(DataSet: TDataSet);
    procedure Q_PowerCPowChange(Sender: TField);
    procedure Q_PowerALLPowChange(Sender: TField);
    procedure T_usersAfterPost(DataSet: TDataSet);
    procedure wwLocateDialog1InitDialog(Dialog: TwwLocateDlg);

  private
    bNeedRefreshUserUI: Boolean;
    procedure refreshUserUI;
//    procedure SetNewID(DataSet: TDataSet; mTablename:string='');

    { Private declarations }

  public
    { Public declarations }
    SQLs,LOGs: TStringList;
    procedure ReSetConnectionString;
    function ConnectDB: Boolean;
    function DBReady: Boolean;
  end;

  TDJHeadData=record
    DJno: string;
    Addr: string;
    Tel : string;
    Fax : string;
    Contact : string;
    DJDate  : string;
    Supplier: string;
    ck      : string;
    remark  : string;
  end;

var
  DM: TDM;
  GUserCanC,GUserCanD,GUserCanU,GUserCanR,GUserCanE: Boolean;  //增删改读 权限


implementation

uses uFunc, UUsers{, uDJ, uBaseData};

{$R *.dfm}

procedure TDM.ADOConnection1AfterConnect(Sender: TObject);
begin
  WriteIniFile('DBConn','ConnectionString'
    ,ADOConnection1.ConnectionString);

  UpdateDB;       //升级数据库表结构
  ExecQuery(GetSQLText('DBCheck.SQL'));  //常规检查

  if GetQuery('IF not EXISTS (SELECT name FROM sysobjects'
    + ' WHERE name = ''trig_updateInv'' AND type = ''TR'')'
    + ' select 1 else select 0').Fields[0].AsInteger=1
  then
    ExecQuery(GetSQLText('DBCheckTrigger.SQL'));

  if GetQuery('IF not EXISTS (SELECT name FROM sysobjects'
    + ' WHERE name = ''trig_updateKHPrice'' AND type = ''TR'')'
    + ' select 1 else select 0').Fields[0].AsInteger=1
  then
    ExecQuery(GetSQLText('DBCheckTrigger2.SQL'));
end;

procedure TDM.DataModuleCreate(Sender: TObject);
begin
  CheckLic;
  SQLs := TStringList.Create ;
  LOGs := TStringList.Create ;
  ADOConnection1.Connected := False;
  ADOConnection1.ConnectionString := '';
  ADOConnection1.AfterConnect := ADOConnection1AfterConnect;
end;

procedure TDM.DataModuleDestroy(Sender: TObject);
begin
  SQLs.Free;

  WriteErrorLog(LOGs.Text,True);
  LOGs.Free;
end;

function TDM.DBReady: Boolean;
begin
  Result := ADOConnection1.Connected ;
end;

procedure TDM.ReSetConnectionString;
begin
  if ADOConnection1.Connected then
     ADOConnection1.Connected := False;
     
  if EditConnectionString(ADOConnection1) then ;
  DM.ConnectDB ;
end;

function TDM.ConnectDB: Boolean;
begin
  if ADOConnection1.Connected then
     ADOConnection1.Connected := False;

  while True do
  try
    if ADOConnection1.ConnectionString='' then
       ADOConnection1.ConnectionString :=
       ReadIniFile('DBConn','ConnectionString');
    ADOConnection1.Connected := True;
    Result := True;
    Break;
  except
    Result := False;
    if ADOConnection1.Connected then
     ADOConnection1.Connected := False;
     
    ADOConnection1.ConnectionString := '';
    if sure('MSSQLServer数据库连接失败,要编辑连接参数吗?') then begin
      if not EditConnectionString(ADOConnection1)
      then Break;
    end else Break;
  end;

end;

procedure TDM.T_usersAfterScroll(DataSet: TDataSet);
begin
  refreshUserUI;
end;

procedure TDM.T_usersBeforeDelete(DataSet: TDataSet);
begin
  if Dataset.FieldByName('UID').AsString = 'admin' then begin
    AbortMsg('不能删除管理员帐号!');
  end;
end;

procedure TDM.T_usersBeforePost(DataSet: TDataSet);
begin
  with FrmUsers do
  if (FrmUsers<>nil) and showing then begin
    if edUPass.text<>edUPass2.text then AbortMsg('前后两次密码不相同,请重新输入!')
    else Dataset.FieldByName('Pass').AsString := edUPass.text;

    if Dataset.State = dsInsert then bNeedRefreshUserUI := True;
  end
end;

procedure TDM.T_usersAfterOpen(DataSet: TDataSet);
begin
  refreshUserUI;
end;

procedure TDM.refreshUserUI;
var
  uid: string;
begin
  if (FrmUsers<>nil) {and FrmUsers.showing} then
  begin
    EnablePanCtrls(FrmUsers.panEdArea, False);
    uid := T_Users.FieldByName('uid').AsString;

    FrmUsers.edUPass.text := T_Users.FieldByName('pass').AsString ;
    FrmUsers.edUPass2.text := FrmUsers.edUPass.text;

    FrmUsers.DBGridEh2.Enabled := not sameText(uid,'admin');
    FrmUsers.btnChangePower.Enabled := FrmUsers.DBGridEh2.Enabled ;

    if uid='' then uid := ' ';
    DropTempTables;
    ExecQuery(GetSQLText('showPI','MISC'),[uid]);
    with Q_Power do begin
      Close;
      SQL.Text := 'select * from #temp1 order by Flag';
      Open;
    end;
  end;
end;

procedure TDM.Q_PowerCPowChange(Sender: TField);
var
  Fieldname,FieldValue: string;
  FieldOnChange: TFieldNotifyEvent;
  bm: string;
begin
  inherited;
  with Q_Power do begin
    Fieldname := Sender.FieldName ;
    FieldValue := Sender.AsString ;

    //若无读权限,则其它权限自动取消
    if (Fieldname='RPow') and (FieldValue='N') then begin
      Edit;
      FieldByname('CPow').AsString := FieldValue;
      Edit;
      FieldByname('UPow').AsString := FieldValue;
      Edit;
      FieldByname('DPow').AsString := FieldValue;
      Edit;
      FieldByname('EPow').AsString := FieldValue;
    end;

    //若有其它权限,则自动拥有读权限
    if   ((Fieldname='CPow') and (FieldValue='Y'))
      or ((Fieldname='UPow') and (FieldValue='Y'))
      or ((Fieldname='DPow') and (FieldValue='Y'))
      or ((Fieldname='EPow') and (FieldValue='Y'))
    then begin
      Edit;
      FieldByname('RPow').AsString := 'Y';
    end;

    //第一行的设定需传递到下面所有行
    if FieldByName('Flag').asInteger<>0 then exit;

    FieldOnChange := Sender.OnChange ;
    Sender.OnChange := nil;
    bm := Bookmark;
    try
      DisableControls;
      First;
      while not eof do begin
        Edit;
        FieldByname(Fieldname).AsString := FieldValue;
        Next;
      end;
    finally
      Bookmark := bm;
      EnableControls;
      Sender.OnChange := FieldOnChange;
    end;

  end;
end;

procedure TDM.Q_PowerALLPowChange(Sender: TField);
var
  Fieldname,FieldValue: string;
  FieldOnChange: TFieldNotifyEvent;
  bm: string;  
begin
  inherited;
  Fieldname := Sender.FieldName ;
  FieldValue := Sender.AsString ;

  with Q_Power do begin
    Edit;
    FieldByname('CPow').AsString := FieldValue;
    Edit;
    FieldByname('RPow').AsString := FieldValue;
    Edit;
    FieldByname('UPow').AsString := FieldValue;
    Edit;
    FieldByname('DPow').AsString := FieldValue;
    Edit;
    FieldByname('EPow').AsString := FieldValue;

    if FieldByName('Flag').asInteger<>0 then exit;
    
    FieldOnChange := Sender.OnChange ;
    Sender.OnChange := nil;
    bm := Bookmark;
    try
      DisableControls;
      First;
      while not eof do begin
        Edit;
        FieldByname('ALLPow').AsString := FieldValue;
        Next;
      end;
    finally
      Bookmark := bm;
      EnableControls;
      Sender.OnChange := FieldOnChange;
    end;
  end;


end;

procedure TDM.T_usersAfterPost(DataSet: TDataSet);
begin
  if bNeedRefreshUserUI then
  try
    refreshUserUI;
  finally
    bNeedRefreshUserUI := False;
  end;

end;

//procedure TDM.SetNewID(DataSet: TDataSet; mTablename:string='');
//var
//  tableName: string;
//  IDFieldname:string;
//  newid: integer;
//begin
//  if mTablename<>'' then
//    tableName := mTablename
//  else
//    tableName := TadoTable(DataSet).TableName ;
//    
//  IDFieldname := GetIDFieldname(DataSet) ;
//  newid := GetMaxInt(tableName,IDFieldname);
////  if (DataSet=T_SP) and (newid<10001) then
////    newid := 10001;  //单据序号从10001开始
//
//  with Dataset do begin
//    FieldByName(IDFieldname).AsInteger := newid;
//    post;
//    Edit;
//  end;
//end;

procedure TDM.wwLocateDialog1InitDialog(Dialog: TwwLocateDlg);
begin
  Dialog.FirstButton.Caption := '第一笔';
  Dialog.NextButton.Caption := '下一笔';
  Dialog.CancelBtn.Caption := '关闭';
  Dialog.FieldsGroup.Visible := False;
  Dialog.SearchTypeGroup.Visible := False;

  Dialog.FieldValueGroup.Caption := '在 ' + Dialog.Caption +' 中查找';
  Dialog.Caption := '数据查找...';
  Dialog.Height := 130;

  Dialog.FirstButton.Top := 59;
  Dialog.NextButton.Top := 59;
  Dialog.CancelBtn.Top := 59;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -