home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Demos / FastNet / Http / httpdem.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  9KB  |  302 lines
  1. ///////////////////////////////////////////////////////////////////////////
  2. //                                                                       //
  3. // Copyright ⌐ 1997-1998, NetMasters, L.L.C                              //
  4. //  - All rights reserved worldwide. -                                   //
  5. //  Portions may be Copyright ⌐ Inprise.                                 //
  6. //                                                                       //
  7. // HTTP Demo Unit 1:  (UNIT1.PAS)                                        //
  8. //                                                                       //
  9. // DESCRIPTION:                                                          //
  10. //                                                                       //
  11. // THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY //
  12. // KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE   //
  13. // IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR //
  14. // PURPOSE.                                                              //
  15. //                                                                       //
  16. ///////////////////////////////////////////////////////////////////////////
  17. //
  18. // Revision History
  19. //
  20. //                                                                       //
  21. ///////////////////////////////////////////////////////////////////////////
  22. unit HTTPDem;
  23.  
  24. interface
  25.  
  26. uses
  27.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  28.   StdCtrls, ComCtrls, ExtCtrls, Psock, NMHttp, Buttons;
  29.  
  30. type
  31.   TForm1 = class(TForm)
  32.     PageControl1: TPageControl;
  33.     TabSheet1: TTabSheet;
  34.     TabSheet2: TTabSheet;
  35.     NMHTTP1: TNMHTTP;
  36.     Panel1: TPanel;
  37.     StatusBar1: TStatusBar;
  38.     Edit1: TEdit;
  39.     Label1: TLabel;
  40.     Button1: TButton;
  41.     Memo1: TMemo;
  42.     Label2: TLabel;
  43.     Memo2: TMemo;
  44.     Label3: TLabel;
  45.     SpeedButton1: TSpeedButton;
  46.     Panel2: TPanel;
  47.     Label4: TLabel;
  48.     Edit2: TEdit;
  49.     Edit3: TEdit;
  50.     Label5: TLabel;
  51.     Button2: TButton;
  52.     Label6: TLabel;
  53.     Memo3: TMemo;
  54.     Label7: TLabel;
  55.     Memo4: TMemo;
  56.     SpeedButton2: TSpeedButton;
  57.     Label8: TLabel;
  58.     Label9: TLabel;
  59.     TabSheet3: TTabSheet;
  60.     Panel3: TPanel;
  61.     Label10: TLabel;
  62.     SpeedButton3: TSpeedButton;
  63.     Label11: TLabel;
  64.     Edit4: TEdit;
  65.     Button3: TButton;
  66.     Memo5: TMemo;
  67.     Label12: TLabel;
  68.     TabSheet4: TTabSheet;
  69.     Edit5: TEdit;
  70.     Edit6: TEdit;
  71.     Edit7: TEdit;
  72.     Edit8: TEdit;
  73.     Edit9: TEdit;
  74.     Label13: TLabel;
  75.     Label14: TLabel;
  76.     Label15: TLabel;
  77.     Label16: TLabel;
  78.     Label17: TLabel;
  79.     Edit10: TEdit;
  80.     Label18: TLabel;
  81.     Label19: TLabel;
  82.     CheckBox1: TCheckBox;
  83.     Label20: TLabel;
  84.     Edit11: TEdit;
  85.     Label21: TLabel;
  86.     Edit12: TEdit;
  87.     procedure NMHTTP1Connect(Sender: TObject);
  88.     procedure Button1Click(Sender: TObject);
  89.     procedure SpeedButton1Click(Sender: TObject);
  90.     procedure Button2Click(Sender: TObject);
  91.     procedure SpeedButton2Click(Sender: TObject);
  92.     procedure SpeedButton3Click(Sender: TObject);
  93.     procedure Button3Click(Sender: TObject);
  94.     procedure NMHTTP1PacketRecvd(Sender: TObject);
  95.     procedure NMHTTP1PacketSent(Sender: TObject);
  96.     procedure NMHTTP1Disconnect(Sender: TObject);
  97.     procedure NMHTTP1Failure(Cmd: CmdType);
  98.     procedure NMHTTP1HostResolved(Sender: TComponent);
  99.     procedure NMHTTP1Status(Sender: TComponent; Status: String);
  100.     procedure NMHTTP1Success(Cmd: CmdType);
  101.     procedure NMHTTP1ConnectionFailed(Sender: TObject);
  102.     procedure NMHTTP1InvalidHost(var handled: Boolean);
  103.   private
  104.     { Private declarations }
  105.   public
  106.     { Public declarations }
  107.   end;
  108.  
  109. var
  110.   Form1: TForm1;
  111.  
  112. implementation
  113.  
  114. {$R *.DFM}
  115.  
  116. procedure TForm1.NMHTTP1Connect(Sender: TObject);
  117. begin
  118.   StatusBar1.SimpleText := 'Connected'
  119. end;
  120.  
  121. procedure TForm1.Button1Click(Sender: TObject);
  122. begin
  123.   NMHTTP1.InputFileMode := FALSE;
  124.   NMHTTP1.OutputFileMode := FALSE;
  125.   NMHTTP1.ReportLevel := Status_Basic;
  126.   If CheckBox1.Checked then
  127.   Begin
  128.     NMHTTP1.Proxy := Edit11.Text;
  129.     NMHTTP1.ProxyPort := StrToInt(Edit12.Text);
  130.   End;
  131.   With NMHTTP1.HeaderInfo do
  132.   Begin
  133.     Cookie := Edit5.Text;
  134.     LocalMailAddress := Edit6.Text;
  135.     LocalProgram := Edit7.Text;
  136.     Referer := Edit8.Text;
  137.     UserID := Edit9.Text;
  138.     Password := Edit10.Text;
  139.   End;
  140.   NMHTTP1.Get(Edit1.Text);
  141.   Memo1.Text := NMHTTP1.Body;
  142.   Memo2.Text := NMHTTP1.Header;
  143.   If NMHTTP1.CookieIn <> '' then
  144.     ShowMessage('Cookie:'+#13#10+NMHTTP1.CookieIn);
  145. end;
  146.  
  147. procedure TForm1.SpeedButton1Click(Sender: TObject);
  148. begin
  149.   Memo1.Clear;
  150.   Memo2.Clear;
  151. end;
  152.  
  153.  
  154. procedure TForm1.Button2Click(Sender: TObject);
  155. begin
  156.   NMHTTP1.InputFileMode := FALSE;
  157.   NMHTTP1.OutputFileMode := FALSE;
  158.   NMHTTP1.ReportLevel := Status_Basic;
  159.   If CheckBox1.Checked then
  160.   Begin
  161.     NMHTTP1.Proxy := Edit11.Text;
  162.     NMHTTP1.ProxyPort := StrToInt(Edit12.Text);
  163.   End;
  164.   With NMHTTP1.HeaderInfo do
  165.   Begin
  166.     Cookie := Edit5.Text;
  167.     LocalMailAddress := Edit6.Text;
  168.     LocalProgram := Edit7.Text;
  169.     Referer := Edit8.Text;
  170.     UserID := Edit9.Text;
  171.     Password := Edit10.Text;
  172.   End;
  173.   NMHTTP1.Post(Edit2.Text, Edit3.Text);
  174.   Memo3.Text := NMHTTP1.Header;
  175.   Memo4.Text := NMHTTP1.Body;
  176. end;
  177.  
  178.  
  179.  
  180. procedure TForm1.SpeedButton2Click(Sender: TObject);
  181. begin
  182.   Memo3.Clear;
  183.   Memo4.Clear;
  184. end;
  185.  
  186.  
  187.  
  188. procedure TForm1.SpeedButton3Click(Sender: TObject);
  189. begin
  190.   Memo5.Clear;
  191. end;
  192.  
  193. procedure TForm1.Button3Click(Sender: TObject);
  194. begin
  195.   NMHTTP1.InputFileMode := FALSE;
  196.   NMHTTP1.OutputFileMode := FALSE;
  197.   NMHTTP1.ReportLevel := Status_Basic;
  198.   If CheckBox1.Checked then
  199.   Begin
  200.     NMHTTP1.Proxy := Edit11.Text;
  201.     NMHTTP1.ProxyPort := StrToInt(Edit12.Text);
  202.   End;
  203.   With NMHTTP1.HeaderInfo do
  204.   Begin
  205.     Cookie := Edit5.Text;
  206.     LocalMailAddress := Edit6.Text;
  207.     LocalProgram := Edit7.Text;
  208.     Referer := Edit8.Text;
  209.     UserID := Edit9.Text;
  210.     Password := Edit10.Text;
  211.   End;
  212.   NMHTTP1.Head(Edit4.Text);
  213.   Memo5.Text := NMHTTP1.Header;
  214. end;
  215.  
  216. procedure TForm1.NMHTTP1PacketRecvd(Sender: TObject);
  217. begin
  218.   StatusBar1.SimpleText := IntToStr(NMHTTP1.BytesRecvd)+' of '+IntToStr(NMHTTP1.BytesTotal)+' retrieved';
  219. end;
  220.  
  221. procedure TForm1.NMHTTP1PacketSent(Sender: TObject);
  222. begin
  223.   StatusBar1.SimpleText := IntToStr(NMHTTP1.BytesSent)+' of '+IntToStr(NMHTTP1.BytesTotal)+' sent';
  224. end;
  225.  
  226. procedure TForm1.NMHTTP1Disconnect(Sender: TObject);
  227. begin
  228.   If StatusBar1 <> nil then
  229.     StatusBar1.SimpleText := 'Disconnected';
  230. end;
  231.  
  232. procedure TForm1.NMHTTP1Failure(Cmd: CmdType);
  233. begin
  234.   Case Cmd of
  235.     CmdGET: StatusBar1.SimpleText := 'Get Failed';
  236.     CmdOPTIONS: StatusBar1.SimpleText := 'Options Failed';
  237.     CmdHEAD: StatusBar1.SimpleText := 'Head Failed';
  238.     CmdPOST: StatusBar1.SimpleText := 'Post Failed';
  239.     CmdPUT: StatusBar1.SimpleText := 'Put Failed';
  240.     CmdPATCH: StatusBar1.SimpleText := 'Patch Failed';
  241.     CmdCOPY: StatusBar1.SimpleText := 'Copy Failed';
  242.     CmdMOVE: StatusBar1.SimpleText := 'Move Failed';
  243.     CmdDELETE: StatusBar1.SimpleText := 'Delete Failed';
  244.     CmdLINK: StatusBar1.SimpleText := 'Link Failed';
  245.     CmdUNLINK: StatusBar1.SimpleText := 'UnLink Failed';
  246.     CmdTRACE: StatusBar1.SimpleText := 'Trace Failed';
  247.     CmdWRAPPED: StatusBar1.SimpleText := 'Wrapped Failed';
  248.   end;
  249. end;
  250.  
  251. procedure TForm1.NMHTTP1HostResolved(Sender: TComponent);
  252. begin
  253.   StatusBar1.SimpleText := 'Host Resolved';
  254. end;
  255.  
  256. procedure TForm1.NMHTTP1Status(Sender: TComponent; Status: String);
  257. begin
  258.   If StatusBar1 <> nil then
  259.   Begin
  260.     StatusBar1.SimpleText := status;
  261.     If NMHTTP1.ReplyNumber = 404 then
  262.       StatusBar1.SimpleText := 'Object Not Found';
  263.   End;
  264. end;
  265.  
  266. procedure TForm1.NMHTTP1Success(Cmd: CmdType);
  267. begin
  268.   Case Cmd of
  269.     CmdGET: StatusBar1.SimpleText := 'Get Succeeded';
  270.     CmdOPTIONS: StatusBar1.SimpleText := 'Options Succeeded';
  271.     CmdHEAD: StatusBar1.SimpleText := 'Head Succeeded';
  272.     CmdPOST: StatusBar1.SimpleText := 'Post Succeeded';
  273.     CmdPUT: StatusBar1.SimpleText := 'Put Succeeded';
  274.     CmdPATCH: StatusBar1.SimpleText := 'Patch Succeeded';
  275.     CmdCOPY: StatusBar1.SimpleText := 'Copy Succeeded';
  276.     CmdMOVE: StatusBar1.SimpleText := 'Move Succeeded';
  277.     CmdDELETE: StatusBar1.SimpleText := 'Delete Succeeded';
  278.     CmdLINK: StatusBar1.SimpleText := 'Link Succeeded';
  279.     CmdUNLINK: StatusBar1.SimpleText := 'UnLink Succeeded';
  280.     CmdTRACE: StatusBar1.SimpleText := 'Trace Succeeded';
  281.     CmdWRAPPED: StatusBar1.SimpleText := 'Wrapped Succeeded';
  282.   end;
  283. end;
  284.  
  285. procedure TForm1.NMHTTP1ConnectionFailed(Sender: TObject);
  286. begin
  287.   ShowMessage('Connection Failed');
  288. end;
  289.  
  290. procedure TForm1.NMHTTP1InvalidHost(var handled: Boolean);
  291. var
  292.   TmpStr: String;
  293. begin
  294.   If InputQuery('Invalid Host!', 'Specify a new host:', TmpStr) then
  295.   Begin
  296.     NMHTTP1.Host := TmpStr;
  297.     Handled := TRUE;
  298.   End;  
  299. end;
  300.  
  301. end.
  302.