HTTPClient.pas 5.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190
  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: 11259: HTTPClient.pas
  11. {
  12. { Rev 1.6 8/2/2003 05:17:20 AM JPMugaas
  13. { Added HTTP Decompression test cases in a new test in this unit.
  14. }
  15. {
  16. { Rev 1.5 2003.07.11 4:07:42 PM czhower
  17. { Removed deprecated BXBoxster reference.
  18. }
  19. {
  20. { Rev 1.4 6/24/2003 01:13:50 PM JPMugaas
  21. { Updates for minor API change.
  22. }
  23. {
  24. Rev 1.3 4/15/2003 2:40:58 PM BGooijen
  25. Other TempDir
  26. }
  27. {
  28. Rev 1.2 4/14/2003 11:25:46 PM BGooijen
  29. }
  30. {
  31. Rev 1.1 4/4/2003 7:43:44 PM BGooijen
  32. compile again
  33. }
  34. {
  35. { Rev 1.0 11/12/2002 09:18:36 PM JPMugaas
  36. { Initial check in. Import from FTP VC.
  37. }
  38. unit HTTPClient;
  39. interface
  40. uses
  41. SysUtils, Classes, BXBubble, Forms;
  42. type
  43. TdmodHTTPClient = class(TDataModule)
  44. HTTPClient: TBXBubble;
  45. HTTPDecompression: TBXBubble;
  46. procedure HTTPClientTest(Sender: TBXBubble);
  47. procedure HTTPDecompressionTest(Sender: TBXBubble);
  48. private
  49. public
  50. end;
  51. var
  52. dmodHTTPClient: TdmodHTTPClient;
  53. implementation
  54. {$R *.dfm}
  55. { THTTPClient }
  56. uses
  57. IdHTTP,
  58. IdCompressorBorZLib,
  59. IdCookieManager,
  60. IdGlobal,IdCoreGlobal,
  61. BXGlobal,
  62. // IdSSLOpenSSL,
  63. IniFiles,
  64. IdTCPConnection;
  65. procedure TdmodHTTPClient.HTTPClientTest(Sender: TBXBubble);
  66. var
  67. URLFile: TIniFile;
  68. sMethod,
  69. sTest,
  70. sFile : string;
  71. i,
  72. iTestCases: Integer;
  73. strmPostRequest, strmResult : TFileStream;
  74. begin
  75. with HTTPClient do begin
  76. sFile := DataDir + 'HTTPClient.ini';
  77. if FileExists(sFile) then begin
  78. URLFile := TIniFile.Create(sFile);
  79. try
  80. // Load the number of test cases
  81. iTestCases := URLFile.ReadInteger('Global', 'TestCases', 0);
  82. for i := 1 to iTestCases do begin
  83. // Read the current test case
  84. sTest := 'Test' + IntToStr(i);
  85. with TIdHTTP.Create(nil) do try
  86. // Host := URLFile.ReadString(sTest, 'Host', '');
  87. // Port := URLFile.ReadInteger(sTest, 'Port', 80);
  88. if URLFile.ReadString(sTest, 'ProtocolVersion', 'pv1_0') = 'pv1_0' then
  89. ProtocolVersion := pv1_0
  90. else
  91. ProtocolVersion := pv1_1;
  92. with Request do begin
  93. Username := URLFile.ReadString(sTest, 'Username', '');
  94. Password := URLFile.ReadString(sTest, 'Password', '');
  95. // TODO Add suport for SSL
  96. ProxyParams.ProxyPort := URLFile.ReadInteger(sTest, 'ProxyPort', 0);
  97. ProxyParams.ProxyServer := URLFile.ReadString(sTest, 'ProxyServer', '');
  98. // ProxyAuthenticate is used in the response.
  99. // ProxyAuthenticate.CommaText := URLFile.ReadString(sTest, 'ProxyAuthenticate', '');
  100. ProxyParams.ProxyUsername := URLFile.ReadString(sTest, 'ProxyUsername', '');
  101. ProxyParams.ProxyPassword := URLFile.ReadString(sTest, 'ProxyPassword', '');
  102. end;
  103. HandleRedirects := URLFIle.ReadBool(sTest, 'HandleRedirects', False);
  104. Status('Testing Test' + IntToStr(i) + ': ' + URLFile.ReadString(sTest, 'URL', ''));
  105. sMethod := URLFile.ReadString(sTest, 'Method', 'GET');
  106. if AnsiSameText(sMethod, 'GET') then begin
  107. strmResult := TFileStream.Create(GTempDir + sTest +'.html', fmCreate);
  108. try
  109. Get(URLFile.ReadString(sTest, 'URL', ''), strmResult);
  110. finally
  111. strmResult.Free;
  112. end;
  113. continue;
  114. end;
  115. if AnsiSameText(URLFile.ReadString(sTest, 'Cookies', ''), 'YES') then begin
  116. CookieManager := TIdCookieManager.Create(nil);
  117. end;
  118. if AnsiSameText(sMethod, 'HEAD') then begin
  119. Head(URLFile.ReadString(sTest, 'URL', ''));
  120. continue;
  121. end;
  122. // Post Support
  123. if AnsiSameText(sMethod, 'POST') then begin
  124. Request.ContentType := URLFile.ReadString(sTest, 'ContentType', '');
  125. strmPostRequest := TFileStream.Create(DataDir +
  126. URLFile.ReadString(sTest, 'PostInfo', ''), fmOpenRead);
  127. strmResult := TFileStream.Create(GTempDir + sTest + '.html', fmCreate);
  128. try
  129. Post(URLFile.ReadString(sTest, 'URL', ''), strmPostRequest, strmResult);
  130. finally
  131. strmResult.Free;
  132. strmPostRequest.Free;
  133. end;
  134. continue;
  135. end;
  136. finally
  137. if Assigned(CookieManager) then CookieManager.Free;
  138. Free;
  139. end;
  140. end;
  141. finally
  142. URLFile.Free;
  143. end;
  144. end;
  145. end;
  146. end;
  147. procedure TdmodHTTPClient.HTTPDecompressionTest(Sender: TBXBubble);
  148. var LHTTP : TIdHTTP;
  149. LZ : TIdCompressorBorZLib;
  150. s : TStream;
  151. begin
  152. LHTTP := TIdHTTP.Create(nil);
  153. LZ := TIdCompressorBorZLib.Create(nil);
  154. s := TMemoryStream.Create;
  155. try
  156. LHTTP.Compressor := LZ;
  157. //with chunked transfer encoding
  158. LHTTP.Get('http://www.webcompression.org',s);
  159. //without chunked transfer encoding
  160. s.Size := 0;
  161. LHTTP.Get('http://groups.yahoo.com',s);
  162. //This is just here as I did see an oddity with groups.yahboo.com.
  163. //I can not reproduce reliably.
  164. s.Size := 0;
  165. LHTTP.Get('http://groups.yahoo.com',s);
  166. finally
  167. FreeAndNil(s);
  168. FreeAndNil(LZ);
  169. FreeAndNil(LHTTP);
  170. end;
  171. end;
  172. end.