Сделал обработку ошибок следующим образом
В модуле CommandGet сделал единый блок try / except
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
procedure TCommandGet.Execute(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); var json: ISuperObject; r: IResponses; d, a, b: Double; begin r := TResponses.Create(ARequestInfo, AResponseInfo); try if ARequestInfo.URI = '/testConnection' then r.OK() else if ARequestInfo.URI = '/testException' then begin a := 1; b := 0; d := a / b; end else AResponseInfo.ResponseNo := 404; except on E: Exception do r.Error(e.Message); end; end; |
Теперь, если возникнет ошибка при обработке запроса, она не потеряется, а придет в понятном json формате, то есть вот так….
Кстати, здесь же можно посмотреть, что в статус баре появилось измерение оперативной памяти.
Возможно информация избыточная, над этим надо подумать, но в целом мне нравится.
Класс TResponses
Как вы видели из кода выше, я использовал класс под интерфейсом – TResponses. Давайте посмотрим на него более внимательно. Ещё не все методы я заполнил, но в целом, подход, я думаю, понятен.
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 |
unit uResponses; interface uses System.SysUtils, System.Classes, IdCustomHTTPServer, superobject; type IResponses = interface ['{CF59B6D2-D745-469D-8E16-E8EC501A6024}'] procedure OK(); procedure Error(EMessage: string = ''; ACodeNumber: integer = -1); procedure ResponseOkWithJson(aJsonData: string); procedure ResponseSuccessfullInsert(aId: integer); end; TResponses = class(TInterfacedObject, IResponses) private FAResponseInfo: TIdHTTPResponseInfo; FARequestInfo: TIdHTTPRequestInfo; procedure SetARequestInfo(const Value: TIdHTTPRequestInfo); procedure SetAResponseInfo(const Value: TIdHTTPResponseInfo); published constructor Create(aRequestInfo: TIdHTTPRequestInfo; aResponseInfo: TIdHTTPResponseInfo); procedure OK(); procedure Error(EMessage: string = ''; ACodeNumber: integer = -1); procedure ResponseOkWithJson(aJsonData: string); procedure ResponseSuccessfullInsert(aId: integer); property ARequestInfo: TIdHTTPRequestInfo read FARequestInfo write SetARequestInfo; property AResponseInfo: TIdHTTPResponseInfo read FAResponseInfo write SetAResponseInfo; end; implementation { TResponses } constructor TResponses.Create(aRequestInfo: TIdHTTPRequestInfo; aResponseInfo: TIdHTTPResponseInfo); begin FAResponseInfo := aResponseInfo; FARequestInfo := aRequestInfo; end; procedure TResponses.Error(EMessage: string = ''; ACodeNumber: integer = -1); var json: ISuperObject; begin json := SO; json.S['answer'] := 'not ok'; json.S['errorCode'] := ACodeNumber.ToString(); json.S['errorMessage'] := EMessage; json.S['uri'] := aRequestInfo.URI; json.S['responseNo'] := AResponseInfo.ResponseNo.ToString(); aResponseInfo.ResponseNo := 200; aResponseInfo.ContentType := 'application/json'; aResponseInfo.CacheControl := 'no-cache'; aResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *'); aResponseInfo.ContentText := json.AsJSon(false, false); aResponseInfo.WriteContent; end; procedure TResponses.OK(); var json: ISuperObject; begin json := SO; json.S['answer'] := 'ok'; json.S['uri'] := aRequestInfo.URI; json.S['responseNo'] := AResponseInfo.ResponseNo.ToString(); aResponseInfo.ResponseNo := 200; aResponseInfo.ContentType := 'application/json'; aResponseInfo.CacheControl := 'no-cache'; aResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *'); aResponseInfo.ContentText := json.AsJSon(false, false); aResponseInfo.WriteContent; end; procedure TResponses.ResponseOkWithJson(aJsonData: string); begin end; procedure TResponses.ResponseSuccessfullInsert(aId: integer); begin end; procedure TResponses.SetARequestInfo(const Value: TIdHTTPRequestInfo); begin FARequestInfo := Value; end; procedure TResponses.SetAResponseInfo(const Value: TIdHTTPResponseInfo); begin FAResponseInfo := Value; end; end. |
Вот, например, процедура ответа OK
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
procedure TResponses.OK(); var json: ISuperObject; begin json := SO; json.S['answer'] := 'ok'; json.S['uri'] := aRequestInfo.URI; json.S['responseNo'] := AResponseInfo.ResponseNo.ToString(); aResponseInfo.ResponseNo := 200; aResponseInfo.ContentType := 'application/json'; aResponseInfo.CacheControl := 'no-cache'; aResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *'); aResponseInfo.ContentText := json.AsJSon(false, false); aResponseInfo.WriteContent; end; |
Мы здесь используем superobject, заполняем его информацией ответа и отправляем обратно клиенту. Такой подход здорово экономит экран, иначе это бы все пришлось писать в каждом OnCommandGet.
Измерение оперативной памяти
Дописал измерение оперативной памяти, вывожу его в TStatusBar главной формы.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
var t: TThread; begin t := TThread.CreateAnonymousThread( procedure var s: string; memory: ISmartPointer<TRPMemory>; begin memory := TSmartPointer<TRPMemory>.Create(); s := memory. CurrentProcessMemoryKB.ToString()+' KB / '+memory.CurrentProcessMemoryPeakKB.ToString()+' KB'; PostMessage(Main.Handle, WM_APP_MEMORY, 0, LParam(PChar(s))); end); t.FreeOnTerminate := true; t.Start; end; |
На главной форме
1 2 3 4 |
procedure TMain.UpdateAppMemory(var aMsg: TMessage); begin StatusBar.Panels[2].Text := PChar(aMsg.LParam); end; |