Дописал базовый класс TRP, от которого можно наследовать всю бизнес логику. Теперь можно обращаться, скажем по адресу Users/Create, сервер найдет класс TRPUsers и попытается найти у него метод Create. Реализация TRP включает в себя RTTI механизм. Чуть позже есть идея добавить атрибуты [HttpGet], [HttpPost] которые можно будет добавлять над методами.
Сам базовый класс выглядит так
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 |
unit uRP; {< Request processing base class, derive from this all your logical classes} interface uses System.SysUtils, System.Classes, IdCustomHTTPServer, superobject, uCommon, uDB, System.Generics.Collections,System.Rtti; type TProcedure = reference to procedure; TRP = class private FAResponseInfo: TIdHTTPResponseInfo; FARequestInfo: TIdHTTPRequestInfo; FResponses: ISP<TResponses>; FDB: ISP<TDB>; protected FClassAlias: string; public constructor Create(aRequestInfo: TIdHTTPRequestInfo; aResponseInfo: TIdHTTPResponseInfo); overload; virtual; procedure Create(); overload; virtual; procedure Delete(); virtual; procedure Update(); virtual; procedure GetInfo(); virtual; procedure Execute(aURI: string); property ARequestInfo: TIdHTTPRequestInfo read FARequestInfo write FARequestInfo; property AResponseInfo: TIdHTTPResponseInfo read FAResponseInfo write FAResponseInfo; property DB: ISP<TDB> read FDB; property Responses: ISP<TResponses> read FResponses; property ClassAlias: string read FClassAlias write FClassAlias; end; implementation uses System.TypInfo; { TRP } procedure TRP.Create; begin // insert your code here... FResponses.OK(); end; constructor TRP.Create(aRequestInfo: TIdHTTPRequestInfo; aResponseInfo: TIdHTTPResponseInfo); var c: ISP<TCommon>; begin c := TSP<TCommon>.Create(); c.IsNotNull(aResponseInfo); c.IsNotNull(aRequestInfo); FResponses := TSP<TResponses>.Create(TResponses.Create(aRequestInfo, aResponseInfo)); FAResponseInfo := aResponseInfo; FARequestInfo := aRequestInfo; FDB := TSP<TDB>.Create(); FClassAlias := ''; end; procedure TRP.Delete; begin // insert your code here... FResponses.OK(); end; procedure TRP.Execute(aURI: string); var ctx: TRttiContext; t: TRttiType; m: TRttiMethod; classAlias: TRttiField; classAliasValue: TValue; className: string; args: array of TValue; s: string; begin ctx := TRttiContext.Create(); try t := ctx.GetType(Self.ClassType); SetLength(args, 0); classAlias := t.GetField('FClassAlias'); // looking for className classAliasValue := classAlias.GetValue(Self); if (classAliasValue.AsString)<>'' then className := classAliasValue.AsString else className := Self.ClassName; for m in t.GetMethods do if (m.MethodKind <> mkConstructor) and (m.MethodKind <> mkDestructor) and (aURI = '/' + className + '/' + m.Name) then begin m.Invoke(Self, args); break; end; finally ctx.Free(); end; end; procedure TRP.GetInfo; begin // insert your code here... FResponses.OK(); end; procedure TRP.Update; begin // insert your code here... FResponses.OK(); end; end. |
Пользоваться им можно вот так, в конструкторе прописать свойство
|
1 |
FClassAlias := 'Users'; |
Вот пример
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 |
unit uRPUsers; {< Request processing users} interface uses System.SysUtils, System.Classes, IdCustomHTTPServer, superobject, uCommon, uDB, uRP; type TRPUsers = class(TRP) public constructor Create(aRequestInfo: TIdHTTPRequestInfo; aResponseInfo: TIdHTTPResponseInfo); overload; override; procedure Create(); overload; override; procedure Delete(); override; procedure Update(); override; procedure GetInfo(); override; end; implementation { TRPUsers } procedure TRPUsers.Create(); begin // insert your code here... Responses.OK(); end; constructor TRPUsers.Create(aRequestInfo: TIdHTTPRequestInfo; aResponseInfo: TIdHTTPResponseInfo); begin inherited; FClassAlias := 'Users'; Execute(ARequestInfo.URI); end; procedure TRPUsers.Delete; begin // insert your code here... Responses.OK(); end; procedure TRPUsers.GetInfo; var id :string; jsonUser : ISuperobject; begin // insert your code here... id := ARequestInfo.Params.Values['password']; // getInfo by id... ... for ex in db jsonUser := SO(); jsonUser.S['name'] := 'Bill Gates'; Responses.OkWithJson(jsonUser.AsJSon(false, false)); end; procedure TRPUsers.Update; begin // insert your code here... Responses.OK(); end; end. |
То есть в CommandGet мы пишем что-то вроде
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
procedure TCommandGet.Execute(); var r: ISP<TResponses>; u: ISP<TRPUsers>; begin r := TSP<TResponses>.Create(TResponses.Create(FRequestInfo, FResponseInfo)); try if (ParseFirstSection('Users')) then u := TSP<TRPUsers>.Create(TRPUsers.Create(FRequestInfo, FResponseInfo)) { if (ParseFirstSection('SmthOther')) then u := TSP<TRPSmthOther>.Create(TRPSmthOther.Create(FRequestInfo, FResponseInfo)) } else FResponseInfo.ResponseNo := 404; except on E: Exception do r.Error(e.Message); end; end; |
Таким образом, можно сосредоточиться на бизнес-логике, а routing запросов стал намного проще.
