ClientInfoService.pas 3.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151
  1. unit ClientInfoService;
  2. interface
  3. uses
  4. SysUtils, Classes, DB, DBClient, TypeUnit, TypeConfig;
  5. type
  6. TClientInfoDM = class(TDataModule)
  7. cdsClientInfo: TClientDataSet;
  8. cdsClientInfoIP: TWideStringField;
  9. cdsClientInfoLinkTime: TDateTimeField;
  10. cdsClientInfoFlag: TIntegerField;
  11. cdsClientInfoAppType: TWideStringField;
  12. cdsCloneClientInfo: TClientDataSet;
  13. cdsCloneClientInfoIP: TWideStringField;
  14. cdsCloneClientInfoFlag: TIntegerField;
  15. cdsCloneClientInfoLinkTime: TDateTimeField;
  16. cdsModify: TClientDataSet;
  17. cdsModifyLinkTime: TDateTimeField;
  18. cdsModifyIP: TWideStringField;
  19. cdsModifyFlag: TIntegerField;
  20. procedure DataModuleCreate(Sender: TObject);
  21. private
  22. function GetAppType(const AType: Integer): string;
  23. procedure ClearRecords;
  24. function DeleteRecord(const AIP: string; AUser: Integer): Boolean;
  25. procedure ModifyRecord(const AIP: string; AUser: Integer);
  26. function GetCurIP: string;
  27. function GetCurUser: Integer;
  28. public
  29. procedure DeleteCurRecord;
  30. procedure HandlerNotify(AType: TOperType; APointer: Pointer);
  31. property CurIP: string read GetCurIP;
  32. property CurUser: Integer read GetCurUser;
  33. end;
  34. implementation
  35. {$R *.dfm}
  36. { TClientInfoDM }
  37. procedure TClientInfoDM.HandlerNotify(AType: TOperType;
  38. APointer: Pointer);
  39. var
  40. infoRec: PInfoRecd;
  41. begin
  42. if Assigned(APointer) then
  43. begin
  44. infoRec := APointer;
  45. if AType = otAdd then
  46. begin
  47. cdsClientInfo.Insert;
  48. cdsClientInfoIP.Value := infoRec.IP;
  49. cdsClientInfoLinkTime.Value := Now;
  50. cdsClientInfoFlag.Value := infoRec.User;
  51. cdsClientInfoAppType.Value := GetAppType(infoRec.User);
  52. cdsClientInfo.Post;
  53. end
  54. else if AType = otModify then
  55. begin
  56. ModifyRecord(infoRec.IP, infoRec.User);
  57. end
  58. else
  59. begin
  60. DeleteRecord(infoRec.IP, infoRec.User);
  61. end;
  62. end
  63. else
  64. ClearRecords;
  65. end;
  66. procedure TClientInfoDM.DataModuleCreate(Sender: TObject);
  67. begin
  68. cdsClientInfo.Active := True;
  69. cdsClientInfo.IndexFieldNames := 'Flag';
  70. cdsCloneClientInfo.CloneCursor(cdsClientInfo, True);
  71. cdsCloneClientInfo.IndexFieldNames := 'Flag';
  72. cdsModify.CloneCursor(cdsClientInfo, True);
  73. cdsModify.IndexFieldNames := 'Flag';
  74. end;
  75. function TClientInfoDM.GetAppType(const AType: Integer): string;
  76. begin
  77. Result := CfgManager.GetAppType(AType);
  78. end;
  79. function TClientInfoDM.DeleteRecord(const AIP: string;
  80. AUser: Integer): Boolean;
  81. begin
  82. cdsCloneClientInfo.SetRange([AUser], [AUser]);
  83. try
  84. while not cdsCloneClientInfo.Eof do
  85. begin
  86. if SameText(cdsCloneClientInfoIP.AsString, AIP) then
  87. begin
  88. cdsCloneClientInfo.Delete;
  89. Break;
  90. end;
  91. cdsCloneClientInfo.Next;
  92. end;
  93. finally
  94. cdsCloneClientInfo.CancelRange;
  95. end;
  96. end;
  97. procedure TClientInfoDM.ClearRecords;
  98. begin
  99. cdsClientInfo.EmptyDataSet;
  100. end;
  101. procedure TClientInfoDM.ModifyRecord(const AIP: string; AUser: Integer);
  102. begin
  103. cdsModify.SetRange([AUser], [AUser]);
  104. try
  105. while not cdsModify.Eof do
  106. begin
  107. if SameText(cdsModifyIP.AsString, AIP) then
  108. begin
  109. cdsModify.Edit;
  110. cdsModifyLinkTime.Value := Now;
  111. cdsModify.Post;
  112. Break;
  113. end;
  114. cdsModify.Next;
  115. end;
  116. finally
  117. cdsModify.CancelRange;
  118. end;
  119. end;
  120. procedure TClientInfoDM.DeleteCurRecord;
  121. begin
  122. cdsClientInfo.Delete;
  123. end;
  124. function TClientInfoDM.GetCurIP: string;
  125. begin
  126. Result := cdsClientInfoIP.Value;
  127. end;
  128. function TClientInfoDM.GetCurUser: Integer;
  129. begin
  130. Result := cdsClientInfoFlag.Value;
  131. end;
  132. end.