Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 22 - Project DebugTest

Project Structure

DebugTest.dpr
program DebugTest;

{$APPTYPE GUI}

uses
  Forms,
  ComApp,
  TestForm in 'TestForm.pas' {Form1},
  TestDm in 'TestDm.pas' {WebModule2: TWebModule};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TWebModule2, WebModule2);
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
TestForm.pas
unit TestForm;

interface

uses
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses ComApp;

{$R *.DFM}

const
  CLASS_ComWebApp: TGUID = '{14831543-7FC0-4310-B037-FAF572EB322C}';

initialization
  TWebAppAutoObjectFactory.Create(Class_ComWebApp,
    'DebugTest', 'DebugTest Object');

end.
TestDm.pas
unit TestDm;

interface

uses
  SysUtils, Classes, HTTPApp;

type
  TWebModule2 = class(TWebModule)
    procedure WebModule2WebActionItem1Action(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModule2: TWebModule2;

implementation

uses WebReq;

{$R *.DFM}

procedure TWebModule2.WebModule2WebActionItem1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := '<h1>Hello</h1>';
end;

initialization
  WebRequestHandler.WebModuleClass := TWebModule2;

end.
TestForm.dfm
object Form1: TForm1
  Left = 192
  Top = 107
  Width = 215
  Height = 154
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
end
TestDm.dfm
object WebModule2: TWebModule2
  OldCreateOrder = False
  Actions = <
    item
      Default = True
      Name = 'WebActionItem1'
      PathInfo = '/test'
      OnAction = WebModule2WebActionItem1Action
    end>
  Left = 192
  Top = 107
  Height = 150
  Width = 215
end