/newStructBase/units/CommonBpl_DBFormBaseEx.pas
Pascal | 515 lines | 421 code | 65 blank | 29 comment | 23 complexity | bd507018138ddb642f8d5e6d9e67a765 MD5 | raw file
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.