Quick.HttpServer.Response.pas 5.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190
  1. { ***************************************************************************
  2. Copyright (c) 2016-2019 Kike Pérez
  3. Unit : Quick.HttpServer.Response
  4. Description : Http Server Response
  5. Author : Kike Pérez
  6. Version : 1.0
  7. Created : 30/08/2019
  8. Modified : 06/10/2019
  9. This file is part of QuickLib: https://github.com/exilon/QuickLib
  10. ***************************************************************************
  11. Licensed under the Apache License, Version 2.0 (the "License");
  12. you may not use this file except in compliance with the License.
  13. You may obtain a copy of the License at
  14. http://www.apache.org/licenses/LICENSE-2.0
  15. Unless required by applicable law or agreed to in writing, software
  16. distributed under the License is distributed on an "AS IS" BASIS,
  17. WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  18. See the License for the specific language governing permissions and
  19. limitations under the License.
  20. *************************************************************************** }
  21. unit Quick.HttpServer.Response;
  22. {$i QuickLib.inc}
  23. interface
  24. uses
  25. Classes,
  26. SysUtils,
  27. Quick.Value,
  28. Quick.Commons;
  29. type
  30. IHttpResponse = interface
  31. ['{3E90F34D-5F4D-41E5-89C5-CA9832C7405E}']
  32. procedure SetStatusCode(const Value: Cardinal);
  33. procedure SetStatusText(const Value: string);
  34. function GetStatusCode: Cardinal;
  35. function GetStatusText: string;
  36. function GetHeaders: TPairList;
  37. procedure SetHeaders(const Value: TPairList);
  38. function GetContentStream: TStream;
  39. procedure SetContentStream(const Value: TStream);
  40. function GetContentText: string;
  41. procedure SetContentText(const Value: string);
  42. function GetContentType: string;
  43. procedure SetContentType(const Value: string);
  44. property Headers : TPairList read GetHeaders write SetHeaders;
  45. property StatusCode : Cardinal read GetStatusCode write SetStatusCode;
  46. property StatusText : string read GetStatusText write SetStatusText;
  47. property Content : TStream read GetContentStream write SetContentStream;
  48. property ContentText : string read GetContentText write SetContentText;
  49. property ContentType : string read GetContentType write SetContentType;
  50. end;
  51. THttpResponse = class(TInterfacedObject,IHttpResponse)
  52. private
  53. fHeaders : TPairList;
  54. fStatusText: string;
  55. fStatusCode: Cardinal;
  56. fContentText : string;
  57. fContent : TStream;
  58. fContentType : string;
  59. procedure SetStatusCode(const Value: Cardinal);
  60. procedure SetStatusText(const Value: string);
  61. function GetStatusCode: Cardinal;
  62. function GetStatusText: string;
  63. function GetContentText: string;
  64. function GetContentStream: TStream;
  65. procedure SetContentText(const Value: string);
  66. procedure SetContentStream(const Value: TStream);
  67. function GetHeaders: TPairList;
  68. procedure SetHeaders(const Value: TPairList);
  69. function GetContentType: string;
  70. procedure SetContentType(const Value: string);
  71. public
  72. constructor Create;
  73. destructor Destroy; override;
  74. procedure ContentFromStream(const Value: TStream);
  75. published
  76. property Headers : TPairList read GetHeaders write SetHeaders;
  77. property StatusCode : Cardinal read GetStatusCode write SetStatusCode;
  78. property StatusText : string read GetStatusText write SetStatusText;
  79. property Content : TStream read GetContentStream write SetContentStream;
  80. property ContentText : string read GetContentText write SetContentText;
  81. property ContentType : string read GetContentType write SetContentType;
  82. end;
  83. implementation
  84. { THttpResponse }
  85. constructor THttpResponse.Create;
  86. begin
  87. fContentText := '';
  88. fContent := nil;
  89. fStatusCode := 200;
  90. fStatusText := '';
  91. //add custom header to response
  92. fHeaders := TPairList.Create;
  93. fHeaders.Add('Server','QuickHttpServer');
  94. end;
  95. destructor THttpResponse.Destroy;
  96. begin
  97. fHeaders.Free;
  98. if Assigned(fContent) and (fContent <> nil) then fContent.Free;
  99. inherited;
  100. end;
  101. function THttpResponse.GetContentStream: TStream;
  102. begin
  103. Result := fContent;
  104. end;
  105. function THttpResponse.GetContentText: string;
  106. begin
  107. Result := fContentText;
  108. end;
  109. function THttpResponse.GetContentType: string;
  110. begin
  111. Result := fContentType;
  112. end;
  113. function THttpResponse.GetHeaders: TPairList;
  114. begin
  115. Result := fHeaders;
  116. end;
  117. function THttpResponse.GetStatusCode: Cardinal;
  118. begin
  119. Result := fStatusCode;
  120. end;
  121. function THttpResponse.GetStatusText: string;
  122. begin
  123. Result := fStatusText;
  124. end;
  125. procedure THttpResponse.SetStatusCode(const Value: Cardinal);
  126. begin
  127. fStatusCode := Value;
  128. end;
  129. procedure THttpResponse.SetStatusText(const Value: string);
  130. begin
  131. fStatusText := Value;
  132. end;
  133. procedure THttpResponse.SetContentStream(const Value: TStream);
  134. begin
  135. fContent := Value;
  136. end;
  137. procedure THttpResponse.SetContentText(const Value: string);
  138. begin
  139. fContentText := Value;
  140. end;
  141. procedure THttpResponse.SetContentType(const Value: string);
  142. begin
  143. fContentType := Value;
  144. end;
  145. procedure THttpResponse.SetHeaders(const Value: TPairList);
  146. begin
  147. fHeaders := Value;
  148. end;
  149. procedure THttpResponse.ContentFromStream(const Value: TStream);
  150. begin
  151. if Value <> nil then
  152. begin
  153. if fContent = nil then fContent := TMemoryStream.Create;
  154. fContent.CopyFrom(Value,Value.Size);
  155. end
  156. else fContent := nil;
  157. end;
  158. end.