marcocantu.com - Code Repository

Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 23 - Project IeFirst

Project Structure

IeFirst.dpr
IeFirstDm.pas
IeFirstDm.dfm

IeFirst.dpr

program IeFirst;

{$APPTYPE CONSOLE}

uses
  WebBroker,
  CGIApp,
  IeFirstDm in 'IeFirstDm.pas' {WebModule1: TWebModule};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TWebModule1, WebModule1);
  Application.Run;
end.

IeFirstDm.pas

unit IeFirstDm;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, MidItems, Db, DBClient,
  MConnect, SConnect, CompProd, PagItems, MidProd, XMLBrokr, HTTPProd,
  WebComp, DBXpress, FMTBcd, Provider, SqlExpr, DBTables;

type
  TWebModule1 = class(TWebModule)
    XMLBroker1: TXMLBroker;
    PageProducer1: TPageProducer;
    DataSetProvider1: TDataSetProvider;
    InetXPageProducer1: TInetXPageProducer;
    DataForm1: TDataForm;
    DataNavigator1: TDataNavigator;
    Table1: TTable;
    DataGrid1: TDataGrid;
    EmpNo: TTextColumn;
    LastName: TTextColumn;
    FirstName: TTextColumn;
    PhoneExt: TTextColumn;
    HireDate: TTextColumn;
    Salary: TTextColumn;
    StatusColumn1: TStatusColumn;
    procedure XMLBroker1GetResponse(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModule1: TWebModule1;

implementation

{$R *.DFM}

procedure TWebModule1.XMLBroker1GetResponse(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := '<h1>Updated</h1><p>' + InetXPageProducer1.Content;
  Handled := True;
end;

end.

IeFirstDm.dfm

object WebModule1: TWebModule1
  OldCreateOrder = False
  Actions = <
    item
      Default = True
      Name = 'WebActionItem1'
      PathInfo = '/default'
      Producer = InetXPageProducer1
    end>
  Left = 236
  Top = 131
  Height = 289
  Width = 339
  object XMLBroker1: TXMLBroker
    Params = <>
    ProviderName = 'DataSetProvider1'
    WebDispatch.MethodType = mtAny
    WebDispatch.PathInfo = 'XMLBroker1'
    ReconcileProducer = PageProducer1
    OnGetResponse = XMLBroker1GetResponse
    Left = 64
    Top = 144
  end
  object PageProducer1: TPageProducer
    HTMLDoc.Strings = (
      '<h1>Update Errors</h1>'
      ''
      '<p>Something went wrong in your udpate request....'
      '<p>Get back to previous page.'
      ''
      ''
      '')
    Left = 136
    Top = 152
  end
  object DataSetProvider1: TDataSetProvider
    DataSet = Table1
    Constraints = True
    Left = 64
    Top = 88
  end
  object InetXPageProducer1: TInetXPageProducer
    IncludePathURL = '/jssource/'
    HTMLDoc.Strings = (
      '<HTML>'
      '<HEAD>'
      '<title>IeFirst</title>'
      '</HEAD>'
      '<BODY>'
      '<h1>Internet Express First Demo (IeFirst.exe)</h1>'
      ''
      '<#INCLUDES><#STYLES><#WARNINGS><#FORMS><#SCRIPT>'
      ''
      '</BODY>'
      '</HTML>')
    Left = 64
    Top = 192
    object DataForm1: TDataForm
      object DataNavigator1: TDataNavigator
        XMLComponent = DataGrid1
        Custom = 'align="center"'
      end
      object DataGrid1: TDataGrid
        XMLBroker = XMLBroker1
        DisplayRows = 5
        TableAttributes.BgColor = 'Silver'
        TableAttributes.CellSpacing = 0
        TableAttributes.CellPadding = 2
        HeadingAttributes.BgColor = 'Aqua'
        object EmpNo: TTextColumn
          DisplayWidth = 10
          FieldName = 'EmpNo'
        end
        object LastName: TTextColumn
          DisplayWidth = 20
          FieldName = 'LastName'
        end
        object FirstName: TTextColumn
          DisplayWidth = 15
          FieldName = 'FirstName'
        end
        object PhoneExt: TTextColumn
          DisplayWidth = 4
          FieldName = 'PhoneExt'
        end
        object HireDate: TTextColumn
          DisplayWidth = 18
          FieldName = 'HireDate'
        end
        object Salary: TTextColumn
          DisplayWidth = 10
          FieldName = 'Salary'
        end
        object StatusColumn1: TStatusColumn
          Caption = '*'
        end
      end
    end
  end
  object Table1: TTable
    DatabaseName = 'DBDEMOS'
    TableName = 'employee.db'
    Left = 64
    Top = 32
  end
end