/newStructBase/units/CommonBpl_DBFormBaseEx.pas

  1unit CommonBpl_DBFormBaseEx;
  2//{$DEFINE DEBUG}
  3
  4interface
  5
  6uses
  7  SysUtils,
  8  Windows,
  9  Messages,
 10  Classes,
 11  MASK,
 12  Grids,
 13  Graphics,
 14  Controls,
 15  AppEvnts,
 16  Forms,
 17  Dialogs,
 18  {$IFNDEF DEBUG}
 19     CnDebug,
 20  {$ENDIF}
 21  dbclient,
 22  ExtCtrls,
 23  DBpl_DBUtil,
 24  DBGrids,
 25  DBpl_IDBProvide,
 26  CommonBpl_DBFormUtil,
 27  CommonBpl_DBFormBase,
 28  CommonBpl_BaseType,
 29  Struct_CntlDataInput,
 30  commonBpl_JzUserBase;
 31
 32Const
 33  Auth_App_Prefix = 'APP_';
 34  Auth_Moudle_Prefix = 'MOD_';
 35  Auth_Function_Prefix = 'FUN_';
 36
 37type
 38  TDBFormBaseEx = class(TDBFormBase)
 39  private
 40
 41  public
 42    function mGetLoginUser: TLoginUser;
 43    procedure mSetLoginUser(aLoginUser: TLoginUser);
 44
 45    procedure mSetUserAuth(aUserId: String;metaDB:IDBProvideInterface);
 46    function  mHaveAppAuth(authString: String): Boolean;
 47    function  mHaveModuleAuth(authString: String): Boolean;
 48    constructor Create(AOwner: TComponent); override;
 49    destructor Destroy; override;
 50
 51    function mDBProvide: IDBProvideInterface;
 52    function mgetDbControl(controlName: string): TDbControl;
 53    procedure mSetDbControlDefaultValue(controlName, strValue: string);
 54
 55    procedure mRegistCntrl(aPanel: TPanel; aTableName: String); overload;
 56    procedure mRegistCntrl(cntrlList: TStringList; aTableName: String);
 57      overload;
 58
 59    procedure mCleanPanel(aPanel: TPanel);
 60
 61    procedure mDisplayRecord(cntrlList: TStringList; whereSql: string);
 62      overload;
 63    procedure mDisplayRecord(cntrlList: TStringList; ACDS: TClientDataSet);
 64      overload;
 65    procedure mDisplayRecord(aPanel: TPanel; whereSql: string); overload;
 66    procedure mDisplayRecord(aPanel: TPanel; ACDS: TClientDataSet); overload;
 67
 68    function mGetSelectCdsByPanel(cntrlList: TStringList; ACDS: TClientDataSet)
 69      : String; overload;
 70    function mGetSelectCdsByPanel(aPanel: TPanel; ACDS: TClientDataSet)
 71      : String; overload;
 72
 73    function mGetSqlByPanel(aPanel: TPanel): String;
 74
 75    procedure mTranslateGrid(AGrid: TDBGrid; aTableName: String); overload;
 76
 77    function mGetDicValue(dbcntl: TDbControl): String;
 78
 79    function mUpdateRecord(aPanel: TPanel; aTableName: String): integer;
 80      overload;
 81    function mInsertRecord(aPanel: TPanel; aTableName: String): integer;
 82      overload;
 83    function mInsertRecord(cntrlList: TStringList; aTableName: String)
 84      : integer; overload;
 85    function mGetGuid: String;
 86
 87    function mGetMetaDBProvide:IDBProvideInterface;
 88    procedure mClearEnv;
 89  end;
 90
 91  { TODO : ???????? }
 92var
 93  uLoginUser: TLoginUser;
 94  uUserAuthList: TStringList;
 95
 96implementation
 97
 98uses Struct_Util, Variants, DB;
 99
100{ TDBFormBaseEx }
101
102constructor TDBFormBaseEx.Create(AOwner: TComponent);
103begin
104  inherited;
105  // uUserAuthList:=TStringList.Create;
106end;
107
108destructor TDBFormBaseEx.Destroy;
109begin
110  inherited;
111end;
112
113function TDBFormBaseEx.mGetLoginUser: TLoginUser;
114begin
115  if not assigned(uLoginUser) then
116    uLoginUser := TLoginUser.Create;
117
118  result := uLoginUser;
119end;
120
121function TDBFormBaseEx.mGetMetaDBProvide: IDBProvideInterface;
122begin
123  result:=StructUtil.getApplication(self.getAppId).MetaSource.dbProvide;
124end;
125
126procedure TDBFormBaseEx.mSetLoginUser(aLoginUser: TLoginUser);
127begin
128  uLoginUser := aLoginUser;
129end;
130
131procedure TDBFormBaseEx.mSetUserAuth(aUserId: String;metaDB:IDBProvideInterface);
132var
133  sql,authid: string;
134  cdsAuth:TClientDataSet;
135begin
136  if not assigned(uUserAuthList)
137     then uUserAuthList:=TStringList.Create;
138  cdsAuth:=TClientDataSet.Create(nil);
139
140  sql := 'select * from  GROUP_AUTHORITY a ';
141  sql := sql +
142    ' where a.GROUP_id=''10000'' or exists ';
143  sql:=sql+' ( select * from  group_user b where b.user_id=%s and a.group_id=b.group_id) ';
144  sql := format(sql, [quotedstr(aUserId)]);
145
146  metaDB.SelectCommand(cdsAuth,sql,0);
147  cdsAuth.First;
148  repeat
149      Forms.Application.ProcessMessages;
150      authid:=uppercase(cdsAuth.FieldByName('Auth_id').AsString) ;
151      uUserAuthList.Add(authid);
152     // showmessage('add auth'+cdsAuth.FieldByName('Auth_id').AsString);
153      cdsAuth.Next;
154  until cdsAuth.eof;
155  cdsAuth.Free;
156end;
157
158function TDBFormBaseEx.mgetDbControl(controlName: string): TDbControl;
159begin
160  result := dbFormUtil.getDbControl(controlName);
161end;
162
163procedure TDBFormBaseEx.mRegistCntrl(aPanel: TPanel; aTableName: String);
164var
165  i: integer;
166begin
167  for i := 0 to aPanel.ControlCount - 1 do
168  begin
169    if aPanel.Controls[i].ClassName = 'TMaskEdit' then
170    begin
171      with (aPanel.Controls[i] as TMaskedit) do
172      begin
173        dbFormUtil.RegistCntrl(aPanel.Controls[i] as TMaskedit, aTableName,
174          self.getAppId);
175      end;
176    end;
177  end;
178end;
179
180function TDBFormBaseEx.mGetGuid: String;
181var
182  cds: TClientDataSet;
183begin
184  // result:=self.dbprovide.
185  cds := TClientDataSet.Create(self);
186  self.mDBProvide.SelectCommand(cds, 'select sys_guid() from dual', 0);
187  result := cds.Fields[0].AsString;
188  cds.free;
189end;
190
191function TDBFormBaseEx.mDBProvide: IDBProvideInterface;
192begin
193  { ?????????
194    ??????????:
195    dbutil.getDBProvide('SYSCONFIG') ;
196    }
197  // result:=dbutil.getDBProvide(self.getDbName);
198  result := StructUtil.getApplication(self.getAppId).DBProvide;
199end;
200
201{ ===================DISPLAY RECORD======================= }
202procedure TDBFormBaseEx.mDisplayRecord(cntrlList: TStringList;
203  whereSql: string);
204begin
205  self.dbFormUtil.DisplayRecord(cntrlList, whereSql);
206end;
207
208procedure TDBFormBaseEx.mDisplayRecord(cntrlList: TStringList;
209  ACDS: TClientDataSet);
210begin
211  self.dbFormUtil.DisplayRecord(cntrlList, ACDS);
212end;
213
214procedure TDBFormBaseEx.mDisplayRecord(aPanel: TPanel; whereSql: string);
215var
216  ulist: TStringList;
217var
218  i: integer;
219begin
220  ulist := TStringList.Create;
221  for i := 0 to aPanel.ControlCount - 1 do
222  begin
223    if aPanel.Controls[i].ClassName = 'TMaskEdit' then
224    begin
225      with (aPanel.Controls[i] as TMaskedit) do
226      begin
227        ulist.Addobject((aPanel.Controls[i] as TMaskedit).name,
228          aPanel.Controls[i] as TMaskedit);
229      end;
230    end;
231  end;
232  self.mDisplayRecord(ulist, whereSql);
233  ulist.free;
234end;
235
236procedure TDBFormBaseEx.mDisplayRecord(aPanel: TPanel; ACDS: TClientDataSet);
237var
238  ulist: TStringList;
239var
240  i: integer;
241begin
242  self.dbFormUtil.DisplayRecord(aPanel, ACDS);
243end;
244
245function TDBFormBaseEx.mUpdateRecord(aPanel: TPanel; aTableName: String)
246  : integer;
247var
248  ulist: TStringList;
249var
250  i: integer;
251begin
252  ulist := TStringList.Create;
253  for i := 0 to aPanel.ControlCount - 1 do
254  begin
255    if aPanel.Controls[i].ClassName = 'TMaskEdit' then
256    begin
257      with (aPanel.Controls[i] as TMaskedit) do
258      begin
259        ulist.Addobject((aPanel.Controls[i] as TMaskedit).name,
260          aPanel.Controls[i] as TMaskedit);
261      end;
262    end;
263  end;
264  result := self.dbFormUtil.UpdateRecord(ulist, aTableName);
265end;
266
267function TDBFormBaseEx.mInsertRecord(aPanel: TPanel; aTableName: String)
268  : integer;
269var
270  ulist: TStringList;
271var
272  i: integer;
273begin
274  ulist := TStringList.Create;
275  for i := 0 to aPanel.ControlCount - 1 do
276  begin
277    if aPanel.Controls[i].ClassName = 'TMaskEdit' then
278    begin
279      with (aPanel.Controls[i] as TMaskedit) do
280      begin
281        ulist.Addobject((aPanel.Controls[i] as TMaskedit).name,
282          aPanel.Controls[i] as TMaskedit);
283      end;
284    end;
285  end;
286  result := self.dbFormUtil.InsertRecord(ulist, aTableName);
287  ulist.free;
288end;
289
290procedure TDBFormBaseEx.mCleanPanel(aPanel: TPanel);
291var
292  i: integer;
293begin
294  for i := 0 to aPanel.ControlCount - 1 do
295  begin
296    if aPanel.Controls[i].ClassName = 'TMaskEdit' then
297    begin
298      with (aPanel.Controls[i] as TMaskedit) do
299      begin (aPanel.Controls[i] as TMaskedit)
300        .Text := '';
301      end;
302    end;
303  end;
304
305end;
306
307procedure TDBFormBaseEx.mClearEnv;
308begin
309  uLoginUser.free;
310  uUserAuthList.free;
311end;
312
313function TDBFormBaseEx.mGetSelectCdsByPanel
314  (aPanel: TPanel; ACDS: TClientDataSet): String;
315var
316  ulist: TStringList;
317var
318  i: integer;
319begin
320  ulist := TStringList.Create;
321  for i := 0 to aPanel.ControlCount - 1 do
322  begin
323    if aPanel.Controls[i].ClassName = 'TMaskEdit' then
324    begin
325      with (aPanel.Controls[i] as TMaskedit) do
326      begin
327        ulist.Addobject((aPanel.Controls[i] as TMaskedit).name,
328          aPanel.Controls[i] as TMaskedit);
329      end;
330    end;
331  end;
332  result := self.mGetSelectCdsByPanel(ulist, ACDS);
333  ulist.free;
334
335end;
336
337function TDBFormBaseEx.mGetSqlByPanel(aPanel: TPanel): String;
338begin
339   result:=mGetSelectCdsByPanel(aPanel,nil);
340end;
341
342function TDBFormBaseEx.mHaveAppAuth(authString: String): Boolean;
343var i:integer;
344begin
345   {$IFNDEF NDEBUG}
346       for i := 0 to uUserAuthList.Count - 1 do
347            cndebugger.TraceMsg(uUserAuthList.Strings[i]);
348            cndebugger.TraceMsg(authString);
349   {$ENDIF}
350  if uUserAuthList.IndexOf(uppercase(authString)) > -1 then
351    result := true
352  else
353    result := false;
354
355end;
356
357function TDBFormBaseEx.mHaveModuleAuth(authString: String): Boolean;
358begin
359 {$IFNDEF NDEBUG}
360    if uUserAuthList.IndexOf(Auth_Moudle_Prefix+uppercase(authString)) > -1 then
361      result := true
362  else
363       result := false;
364 {$ENDIF}
365end;
366
367function TDBFormBaseEx.mGetSelectCdsByPanel(cntrlList: TStringList;
368  ACDS: TClientDataSet): String;
369begin
370  result := self.dbFormUtil.mGetSelectCdsByPanel(cntrlList, ACDS);
371end;
372
373procedure TDBFormBaseEx.mTranslateGrid(AGrid: TDBGrid; aTableName: String);
374{ //?dbgrid????????????? }
375var
376  i, j: integer;
377var
378  fieldName, fieldNames, dicID: String;
379  // var dicCDS:array of TClientDataSet;
380var
381  uDiccds, uTableDefine: TClientDataSet;
382var
383  ACDS: TDataSet;
384var
385  aDBControl: TDbControl;
386var
387  idx: integer;
388var
389  T: TStringField;
390var
391  list: TStringList;
392var
393  tmpField: array of TStringField;
394var
395  strDicId, strDicKey, strDicValue: String;
396begin
397  with StructUtil.getApplication(self.getAppId).MetaSource do
398  begin
399    // first;
400    // filtered:=false;
401    uTableDefine := getCDSTableDefine(self.getAppId, aTableName);
402  end;
403
404  ACDS := AGrid.DataSource.DataSet;
405  aTableName := UpperCASE(aTableName);
406  for i := 0 to ACDS.FieldDefs.Count - 1 do
407    fieldNames := fieldNames + ACDS.FieldDefs[i].Name + ',';
408
409  list := TStringList.Create;
410  list.CommaText := fieldNames;
411  setlength(tmpField, list.Count);
412  ACDS.Close;
413  ACDS.Fields.Clear;
414  for i := 0 to list.Count - 2 do
415  begin
416    fieldName := UpperCASE(list[i]);
417    tmpField[i] := TStringField.Create(ACDS);
418    tmpField[i].FieldKind := fkdata;
419    tmpField[i].fieldName := fieldName;
420    tmpField[i].DataSet := ACDS;
421
422    uTableDefine.first;
423    uTableDefine.filtered := false;
424    uTableDefine.Locate('AppId;TableName;ColName', VarArrayOf
425        ([self.getAppId, aTableName, fieldName]), [loCaseInsensitive,
426      loCaseInsensitive, loCaseInsensitive]);
427
428    strDicId := uTableDefine.FieldByName('dicId').AsString; ;
429
430    if strDicId <> '' then
431    begin
432      with StructUtil.getApplication(self.getAppId).MetaSource do
433      begin
434        with getCDSDicDefine do
435        begin
436          first;
437          filtered := false;
438          Locate('dicid', VarArrayOf([strDicId]), [loCaseInsensitive]);
439          strDicKey := FieldByName('dicKeyField').AsString;
440          strDicValue := FieldByName('dicValField').AsString;
441        end;
442        uDiccds := getDicCds(strDicId);
443      end;
444
445      T := TStringField.Create(ACDS);
446      // acds.Fields.Add(T);
447
448      // uDiccds :=  StructUtil.getApplication(self.getAppId).MetaSource.getDicCdsCopy(adbcontrol.dicMetaBase.dicId,self);
449      T.LookupDataSet := uDiccds;
450
451      T.fieldName := fieldName + '_DIC';
452      T.DataSet := ACDS;
453      T.Name := fieldName + '_DIC';
454      T.FieldKind := fklookup;
455      T.KeyFields := fieldName;
456      // aGrid.DataSource.DataSet.Fields[i].LookupDataSet.Owner:=self;
457      T.LookupKeyFields := strDicKey;
458      T.LookupResultField := strDicValue;
459      T.Lookup := true;
460
461      ACDS.FieldDefs.Update;
462      for j := 0 to AGrid.Columns.Count - 1 do
463      begin
464        if AGrid.Columns[j].fieldName = fieldName then
465        begin
466          AGrid.Columns[j].fieldName := T.fieldName;
467        end;
468      end;
469    end;
470    aDBControl.free;
471  end;
472  ACDS.Open;
473
474end;
475
476procedure TDBFormBaseEx.mRegistCntrl(cntrlList: TStringList;
477  aTableName: String);
478var
479  i: integer;
480begin
481  for i := 0 to cntrlList.Count - 1 do
482  begin
483    // if   cntrlList.Objects[i]a as  TMaskEdit   then
484    // begin
485    //
486    with (cntrlList.Objects[i] as TMaskedit) do
487    begin
488      dbFormUtil.RegistCntrl(cntrlList.Objects[i] as TMaskedit, aTableName,
489        self.getAppId);
490    end;
491    // end;
492  end;
493end;
494
495function TDBFormBaseEx.mGetDicValue(dbcntl: TDbControl): String;
496begin
497  result := StructUtil.getFieldDicValue(dbcntl);
498end;
499
500function TDBFormBaseEx.mInsertRecord(cntrlList: TStringList; aTableName: String)
501  : integer;
502var
503  i: integer;
504begin
505  result := self.dbFormUtil.InsertRecord(cntrlList, aTableName);
506  cntrlList.free;
507end;
508
509procedure TDBFormBaseEx.mSetDbControlDefaultValue
510  (controlName, strValue: string);
511begin
512  self.mgetDbControl(controlName).setDefaultValue(strValue);
513end;
514
515end.