Немного отрефакторил код OnCommandGet, получилось так, довольно коротко…
1 2 3 4 5 6 7 8 9 10 11 12 13 |
var r: IResponses; begin r := TResponses.Create(ARequestInfo, AResponseInfo); try ProcessTests(ARequestInfo, AResponseInfo); ProcessUsers(ARequestInfo, AResponseInfo); AResponseInfo.ResponseNo := 404; except on E: Exception do r.Error(e.Message); end; end; |
Обработка запросов происходит в методах Process…, например ProcessUsers выглядит так
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
procedure TCommandGet.ProcessUsers(ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); var u: IRPUsers; uri: string; begin uri := ARequestInfo.URI; if GetFirstURISection(uri) = 'Users' then begin u := TRPUsers.Create(ARequestInfo, AResponseInfo); if uri = '/Users/Add' then u.Add else if uri = '/Users/Delete' then u.Delete else if uri = '/Users/Update' then u.Update else if uri = '/Users/GetInfo' then u.GetInfo; end; end; |
Модуль RPUsers оформлен как интерфейс следующим образом
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 |
unit uRPUsers; {< Request processing users} interface uses System.SysUtils, System.Classes, IdCustomHTTPServer, superobject, uResponses, uCommon; type IRPUsers = interface procedure Add(); procedure Delete(); procedure Update(); procedure GetInfo(); end; TRPUsers = class(TInterfacedObject, IRPUsers) private FAResponseInfo: TIdHTTPResponseInfo; FARequestInfo: TIdHTTPRequestInfo; FResponses: IResponses; public constructor Create(aRequestInfo: TIdHTTPRequestInfo; aResponseInfo: TIdHTTPResponseInfo); published procedure Add(); procedure Delete(); procedure Update(); procedure GetInfo(); property ARequestInfo: TIdHTTPRequestInfo read FARequestInfo write FARequestInfo; property AResponseInfo: TIdHTTPResponseInfo read FAResponseInfo write FAResponseInfo; end; implementation { TRPUsers } procedure TRPUsers.Add; begin // insert your code here... FResponses.OK(); end; constructor TRPUsers.Create(aRequestInfo: TIdHTTPRequestInfo; aResponseInfo: TIdHTTPResponseInfo); begin FResponses := TResponses.Create(aRequestInfo, aResponseInfo); FAResponseInfo := aResponseInfo; FARequestInfo := aRequestInfo; end; procedure TRPUsers.Delete; begin // insert your code here... FResponses.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'; FResponses.ResponseOkWithJson(jsonUser.AsJSon(false, false)); end; procedure TRPUsers.Update; begin // insert your code here... FResponses.OK(); end; end. |
Также немного поработал над TResponses, написал метод ResponseOkWithJson
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
... procedure TResponses.ResponseOkWithJson(aJsonData: string); var json,jsonResult: ISuperobject; begin json :=SO(aJsonData); jsonResult := SO(); jsonResult.S['answer'] := 'ok'; jsonResult.O['data'] := json; FAResponseInfo.ResponseNo := 200; FAResponseInfo.ContentType := 'application/json'; FAResponseInfo.CacheControl := 'no-cache'; FAResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *'); FAResponseInfo.ContentText := jsonResult.AsJSon(false, false); // toString; FAResponseInfo.WriteContent; end; ... |