HttpGet-TestUrlEncode-pas

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, ActnList, StdCtrls, ExtCtrls, MSHTML,
  mormot.net.http,
  mormot.net.server,
  mormot.net.client,
  mormot.core.buffers,
  mormot.core.base,
  mormot.core.text;

type
  TfrmMain = class(TForm)
    wbClient: TWebBrowser;
    btnServerSwitch: TButton;
    btnBrowserGet: TButton;
    btnHttpGet: TButton;
    ActionList: TActionList;
    actServerSwitch: TAction;
    actBrowserGet: TAction;
    actHttpGet: TAction;
    lbledtUriAddress: TLabeledEdit;
    procedure actBrowserGetExecute(Sender: TObject);
    procedure actHttpGetExecute(Sender: TObject);
    procedure actServerSwitchExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    fServer: THttpServer;
    function ServerResponse(Ctxt: THttpServerRequestAbstract): cardinal;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

function MakeUrl(aAddress: String; aDoEncode: Boolean = False): string;
begin
  if not aDoEncode then
    Result := 'http://127.0.0.1:8080/'+aAddress else
    Result := 'http://127.0.0.1:8080/'+UrlEncode(aAddress);
end;

function MakeResponse(aUrl: string): string;
begin
  result := '<html><body><p>Url:'+aUrl+'</p></body></html>';
end;

procedure TfrmMain.actBrowserGetExecute(Sender: TObject);
begin
  wbClient.Navigate(MakeUrl(lbledtUriAddress.Text));
end;

procedure TfrmMain.actHttpGetExecute(Sender: TObject);
var sResp: string;
begin
  sResp := HttpGet(MakeUrl(lbledtUriAddress.Text));

  if '' <> sResp then
    IHTMLDocument2(wbClient.Document).body.innerHTML := sResp;
end;

procedure TfrmMain.actServerSwitchExecute(Sender: TObject);
begin
  if actServerSwitch.Tag = 0 then
  begin
    fServer := THttpServer.Create('8080',nil,nil,'');
    fServer.OnRequest := ServerResponse;

    actServerSwitch.Caption := 'Server Started.';
    actServerSwitch.Tag := 1;
  end else
  begin
    fServer.OnRequest := nil;
    fServer.Free;

    actServerSwitch.Caption := 'Server Stoped.';
    actServerSwitch.Tag := 0;
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  actServerSwitch.Tag := 0;
end;

{ TfrmMain }

function TfrmMain.ServerResponse(Ctxt: THttpServerRequestAbstract): cardinal;
begin
  with Ctxt do
  begin
    OutContentType := HTML_CONTENT_TYPE;
    OutContent := MakeResponse(Url);
    Result := HTTP_SUCCESS;
  end;
end;

end.