IdUserAccounts.pas 7.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258
  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 10415: IdUserAccounts.pas
  11. {
  12. { Rev 1.0 2002.11.12 10:59:32 PM czhower
  13. }
  14. unit IdUserAccounts;
  15. {
  16. Original Author: Sergio Perry
  17. Date: 24/04/2001
  18. }
  19. interface
  20. uses
  21. Classes,
  22. IdException,
  23. IdGlobal,
  24. IdBaseComponent,
  25. IdComponent,
  26. IdStrings,
  27. SysUtils;
  28. type
  29. TIdUserManager = class;
  30. TIdUserAccount = class(TCollectionItem)
  31. protected
  32. FAttributes: Tstrings;
  33. FData: TObject;
  34. FUserName: string;
  35. FPassword: string;
  36. FRealName: string;
  37. //
  38. procedure SetAttributes(const AValue: TStrings);
  39. public
  40. constructor Create(ACollection: TCollection); override;
  41. destructor Destroy; override;
  42. //
  43. function CheckPassword(const APassword: String): Boolean;
  44. //
  45. property Data: TObject read FData write FData;
  46. published
  47. property Attributes: Tstrings read FAttributes write SetAttributes;
  48. property UserName: string read FUserName write FUserName;
  49. property Password: string read FPassword write FPassword;
  50. property RealName: string read FRealName write FRealName;
  51. end;
  52. TIdUserAccounts = class(TOwnedCollection)
  53. protected
  54. FCaseSensitiveUsernames: Boolean;
  55. FCaseSensitivePasswords: Boolean;
  56. //
  57. function GetAccount(const AIndex: Integer): TIdUserAccount;
  58. function GetByUsername(const AUsername: String): TIdUserAccount;
  59. procedure SetAccount(const AIndex: Integer; AAccountValue: TIdUserAccount);
  60. public
  61. function Add: TIdUserAccount; reintroduce;
  62. constructor Create(AOwner: TIdUserManager);
  63. //
  64. property CaseSensitiveUsernames: Boolean read FCaseSensitiveUsernames
  65. write FCaseSensitiveUsernames;
  66. property CaseSensitivePasswords: Boolean read FCaseSensitivePasswords
  67. write FCaseSensitivePasswords;
  68. property UserNames[const AUserName: String]: TIdUserAccount read GetByUsername; default;
  69. property Items[const AIndex: Integer]: TIdUserAccount read GetAccount write SetAccount;
  70. end;
  71. TOnAfterAuthentication = procedure(const AUsername: String; const APassword: String;
  72. AAuthenticationResult: Boolean) of object;
  73. TIdUserManager = class(TIdBaseComponent)
  74. protected
  75. FAccounts: TIdUserAccounts;
  76. FOnAfterAuthentication: TOnAfterAuthentication;
  77. //
  78. procedure DoAfterAuthentication(const AUsername, APassword: String;
  79. AAuthenticationResult: Boolean);
  80. function GetCaseSensitivePasswords: Boolean;
  81. function GetCaseSensitiveUsernames: Boolean;
  82. procedure SetAccounts(AValue: TIdUserAccounts);
  83. procedure SetCaseSensitivePasswords(const AValue: Boolean);
  84. procedure SetCaseSensitiveUsernames(const AValue: Boolean);
  85. public
  86. function AuthenticateUser(const AUsername, APassword: String): Boolean;
  87. constructor Create(AOwner: TComponent); override;
  88. destructor Destroy; override;
  89. published
  90. property Accounts: TIdUserAccounts read FAccounts write SetAccounts;
  91. property CaseSensitiveUsernames: Boolean read GetCaseSensitiveUsernames
  92. write SetCaseSensitiveUsernames;
  93. property CaseSensitivePasswords: Boolean read GetCaseSensitivePasswords
  94. write SetCaseSensitivePasswords;
  95. property OnAfterAuthentication: TOnAfterAuthentication read FOnAfterAuthentication
  96. write FOnAfterAuthentication;
  97. end;
  98. implementation
  99. { TIdUserAccount }
  100. function TIdUserAccount.CheckPassword(const APassword: String): Boolean;
  101. begin
  102. if (Collection as TIdUserAccounts).CaseSensitivePasswords then
  103. begin
  104. Result := Password = APassword;
  105. end
  106. else
  107. begin
  108. Result := AnsiSameText(Password, APassword);
  109. end;
  110. end;
  111. constructor TIdUserAccount.Create(ACollection: TCollection);
  112. begin
  113. inherited Create(ACollection);
  114. FAttributes := TStringList.Create;
  115. end;
  116. destructor TIdUserAccount.Destroy;
  117. begin
  118. FreeAndNil(FAttributes);
  119. inherited Destroy;
  120. end;
  121. procedure TIdUserAccount.SetAttributes(const AValue: TStrings);
  122. begin
  123. FAttributes.Assign(AValue);
  124. end;
  125. { TIdUserAccounts }
  126. constructor TIdUserAccounts.Create(AOwner: TIdUserManager);
  127. begin
  128. inherited Create(AOwner, TIdUserAccount);
  129. end;
  130. function TIdUserAccounts.GetAccount(const AIndex: Integer): TIdUserAccount;
  131. begin
  132. Result := TIdUserAccount(inherited Items[AIndex]);
  133. end;
  134. function TIdUserAccounts.GetByUsername(const AUsername: String): TIdUserAccount;
  135. var
  136. i: Integer;
  137. begin
  138. Result := nil;
  139. if CaseSensitiveUsernames then
  140. begin
  141. for i := 0 to Count - 1 do
  142. begin
  143. if AUsername = Items[i].UserName then
  144. begin
  145. Result := Items[i];
  146. Break;
  147. end;
  148. end;
  149. end
  150. else
  151. begin
  152. for i := 0 to Count - 1 do
  153. begin
  154. if AnsiSameText(AUsername, Items[i].UserName) then
  155. begin
  156. Result := Items[i];
  157. Break;
  158. end;
  159. end;
  160. end;
  161. end;
  162. procedure TIdUserAccounts.SetAccount(const AIndex: Integer; AAccountValue: TIdUserAccount);
  163. begin
  164. inherited SetItem(AIndex, AAccountValue);
  165. end;
  166. function TIdUserAccounts.Add: TIdUserAccount;
  167. begin
  168. Result := inherited Add as TIdUserAccount;
  169. end;
  170. { IdUserAccounts - Main Component }
  171. constructor TIdUserManager.Create(AOwner: TComponent);
  172. begin
  173. inherited Create(AOwner);
  174. FAccounts := TIdUserAccounts.Create(Self);
  175. end;
  176. destructor TIdUserManager.Destroy;
  177. begin
  178. FreeAndNil(FAccounts);
  179. inherited Destroy;
  180. end;
  181. function TIdUserManager.AuthenticateUser(const AUsername, APassword: String): Boolean;
  182. var
  183. LUser: TIdUserAccount;
  184. begin
  185. Result := False;
  186. LUser := Accounts[AUsername];
  187. if LUser = nil then
  188. begin
  189. Exit; //Result := False;
  190. end
  191. else
  192. begin
  193. if LUser.CheckPassword(APassword) = True then
  194. begin
  195. Result := True;
  196. end;
  197. end;
  198. DoAfterAuthentication(AUsername, APassword, Result);
  199. end;
  200. procedure TIdUserManager.SetAccounts(AValue: TIdUserAccounts);
  201. begin
  202. FAccounts.Assign(AValue);
  203. end;
  204. procedure TIdUserManager.DoAfterAuthentication(const AUsername, APassword: String;
  205. AAuthenticationResult: Boolean);
  206. begin
  207. if Assigned(FOnAfterAuthentication) then
  208. begin
  209. FOnAfterAuthentication(AUsername, APassword, AAuthenticationResult);
  210. end;
  211. end;
  212. function TIdUserManager.GetCaseSensitivePasswords: Boolean;
  213. begin
  214. Result := FAccounts.CaseSensitivePasswords;
  215. end;
  216. function TIdUserManager.GetCaseSensitiveUsernames: Boolean;
  217. begin
  218. Result := FAccounts.CaseSensitiveUsernames;
  219. end;
  220. procedure TIdUserManager.SetCaseSensitivePasswords(const AValue: Boolean);
  221. begin
  222. FAccounts.CaseSensitivePasswords := AValue;
  223. end;
  224. procedure TIdUserManager.SetCaseSensitiveUsernames(const AValue: Boolean);
  225. begin
  226. FAccounts.CaseSensitiveUsernames := AValue;
  227. end;
  228. end.