Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 22 - Project WSnapMD

Project Structure

WSnapMD.dpr
program WSnapMD;

{$APPTYPE GUI}

uses
  Forms,
  ComApp,
  mainform in 'mainform.pas' {Form1},
  home_dm in 'home_dm.pas' {HomePage: TWebAppPageModule} {*.html},
  datamod in 'datamod.pas' {WDataMod: TWebDataModule};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
mainform.pas
unit mainform;

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 = '{F765A7C3-A7F9-4783-9AAB-5093BB22A168}';

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

end.
home_dm.pas

unit home_dm;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, WebModu, HTTPProd, ReqMulti,
  WebAdapt, DBAdapt, WebDisp, WebComp, CompProd, PagItems, SiteProd,
  MidItems, WebForm;

type
  THomePage = class(TWebAppPageModule)
    AdapterPageProducer: TAdapterPageProducer;
    WebAppComponents: TWebAppComponents;
    ApplicationAdapter: TApplicationAdapter;
    PageDispatcher: TPageDispatcher;
    AdapterDispatcher: TAdapterDispatcher;
    AdapterForm1: TAdapterForm;
    AdapterFieldGroup1: TAdapterFieldGroup;
    AdapterCommandGroup1: TAdapterCommandGroup;
    AdapterGrid1: TAdapterGrid;
    CmdFirstRow: TAdapterActionButton;
    CmdPrevRow: TAdapterActionButton;
    CmdNextRow: TAdapterActionButton;
    CmdLastRow: TAdapterActionButton;
    ColEMP_NO: TAdapterDisplayColumn;
    ColFIRST_NAME: TAdapterDisplayColumn;
    ColLAST_NAME: TAdapterDisplayColumn;
    ColDEPT_NO: TAdapterDisplayColumn;
    ColJOB_CODE: TAdapterDisplayColumn;
    ColJOB_COUNTRY: TAdapterDisplayColumn;
    ColSALARY: TAdapterDisplayColumn;
    FldDEPARTMENT: TAdapterDisplayField;
    FldDEPT_NO: TAdapterDisplayField;
    FldHEAD_DEPT: TAdapterDisplayField;
    FldLOCATION: TAdapterDisplayField;
    FldBUDGET: TAdapterDisplayField;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function HomePage: THomePage;

implementation

{$R *.dfm}  {*.html}

uses WebReq, WebCntxt, WebFact, Variants, datamod;

function HomePage: THomePage;
begin
  Result := THomePage(WebContext.FindModuleClass(THomePage));
end;

initialization
  if WebRequestHandler <> nil then
    WebRequestHandler.AddWebModuleFactory(TWebAppPageModuleFactory.Create(THomePage, TWebPageInfo.Create([wpPublished {, wpLoginRequired}], '.html'), caCache));

end.
datamod.pas

unit datamod;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, WebModu, DBXpress, FMTBcd,
  DB, SqlExpr, Provider, DBClient, DBLocal, DBLocalS, WebAdapt, DBAdapt,
  WebComp;

type
  TWDataMod = class(TWebDataModule)
    ibConnection: TSQLConnection;
    dsDepartment: TDataSource;
    cdsDepartment: TSQLClientDataSet;
    cdsEmployee: TSQLClientDataSet;
    dsaDepartment: TDataSetAdapter;
    AdaptDEPARTMENT: TDataSetAdapterField;
    AdaptDEPT_NO2: TDataSetAdapterField;
    AdaptHEAD_DEPT: TDataSetAdapterField;
    AdaptLOCATION: TDataSetAdapterField;
    AdaptBUDGET: TDataSetAdapterField;
    dsaEmployee: TDataSetAdapter;
    AdaptEMP_NO: TDataSetAdapterField;
    AdaptFIRST_NAME: TDataSetAdapterField;
    AdaptLAST_NAME: TDataSetAdapterField;
    AdaptDEPT_NO: TDataSetAdapterField;
    AdaptJOB_CODE: TDataSetAdapterField;
    AdaptJOB_COUNTRY: TDataSetAdapterField;
    AdaptSALARY: TDataSetAdapterField;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function WDataMod: TWDataMod;

implementation

{$R *.dfm}

 uses WebReq, WebCntxt, WebFact, Variants;

function WDataMod: TWDataMod;
begin
  Result := TWDataMod(WebContext.FindModuleClass(TWDataMod));
end;

initialization
  if WebRequestHandler <> nil then
    WebRequestHandler.AddWebModuleFactory(TWebDataModuleFactory.Create(TWDataMod, crAlways, caCache));

end.
mainform.dfm
object Form1: TForm1
  Left = 238
  Top = 149
  Width = 226
  Height = 129
  Caption = 'WSnapMD'
  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
home_dm.dfm
object HomePage: THomePage
  OldCreateOrder = False
  PageProducer = AdapterPageProducer
  AppServices = WebAppComponents
  Left = 654
  Top = 118
  Height = 281
  Width = 329
  object AdapterPageProducer: TAdapterPageProducer
    HTMLDoc.Strings = (
      '<html>'
      '<head>'
      '</head>'
      '<body>'
      '<#STYLES><#WARNINGS><#SERVERSCRIPT>'
      '</body>'
      '</html>')
    Left = 200
    Top = 32
    object AdapterForm1: TAdapterForm
      Custom =
         'Border="1" CellSpacing="0" CellPadding="10" BgColor="Silver" ali' +
        'gn="center"'
      object AdapterCommandGroup1: TAdapterCommandGroup
        DisplayComponent = AdapterFieldGroup1
        Custom = 'Align="Center"'
        object CmdFirstRow: TAdapterActionButton
          ActionName = 'FirstRow'
          Caption = '   First   '
        end
        object CmdPrevRow: TAdapterActionButton
          ActionName = 'PrevRow'
          Caption = ' Previous '
        end
        object CmdNextRow: TAdapterActionButton
          ActionName = 'NextRow'
          Caption = '   Next   '
        end
        object CmdLastRow: TAdapterActionButton
          ActionName = 'LastRow'
          Caption = '   Last   '
        end
      end
      object AdapterFieldGroup1: TAdapterFieldGroup
        Custom = 'BgColor="Silver" '
        Adapter = WDataMod.dsaDepartment
        AdapterMode = 'Browse'
        object FldDEPARTMENT: TAdapterDisplayField
          DisplayWidth = 25
          FieldName = 'DEPARTMENT'
        end
        object FldDEPT_NO: TAdapterDisplayField
          DisplayWidth = 3
          FieldName = 'DEPT_NO'
        end
        object FldHEAD_DEPT: TAdapterDisplayField
          DisplayWidth = 3
          FieldName = 'HEAD_DEPT'
        end
        object FldLOCATION: TAdapterDisplayField
          DisplayWidth = 15
          FieldName = 'LOCATION'
        end
        object FldBUDGET: TAdapterDisplayField
          DisplayWidth = 16
          FieldName = 'BUDGET'
        end
      end
      object AdapterGrid1: TAdapterGrid
        TableAttributes.BgColor = 'Silver'
        TableAttributes.CellSpacing = 0
        TableAttributes.CellPadding = 3
        HeadingAttributes.BgColor = 'Gray'
        Adapter = WDataMod.dsaEmployee
        AdapterMode = 'Browse'
        object ColEMP_NO: TAdapterDisplayColumn
          FieldName = 'EMP_NO'
          HideOptions = []
        end
        object ColFIRST_NAME: TAdapterDisplayColumn
          FieldName = 'FIRST_NAME'
          HideOptions = []
        end
        object ColLAST_NAME: TAdapterDisplayColumn
          FieldName = 'LAST_NAME'
          HideOptions = []
        end
        object ColDEPT_NO: TAdapterDisplayColumn
          FieldName = 'DEPT_NO'
          HideOptions = []
        end
        object ColJOB_CODE: TAdapterDisplayColumn
          FieldName = 'JOB_CODE'
          HideOptions = []
        end
        object ColJOB_COUNTRY: TAdapterDisplayColumn
          FieldName = 'JOB_COUNTRY'
          HideOptions = []
        end
        object ColSALARY: TAdapterDisplayColumn
          FieldName = 'SALARY'
          HideOptions = []
        end
      end
    end
  end
  object WebAppComponents: TWebAppComponents
    PageDispatcher = PageDispatcher
    AdapterDispatcher = AdapterDispatcher
    ApplicationAdapter = ApplicationAdapter
    Left = 48
    Top = 16
  end
  object ApplicationAdapter: TApplicationAdapter
    ApplicationTitle = 'WSnap Master/Detail'
    Left = 48
    Top = 64
    object TAdapterDefaultActions
    end
    object TAdapterDefaultFields
    end
  end
  object PageDispatcher: TPageDispatcher
    Left = 48
    Top = 112
  end
  object AdapterDispatcher: TAdapterDispatcher
    Left = 48
    Top = 160
  end
end
datamod.dfm
object WDataMod: TWDataMod
  OldCreateOrder = False
  Left = 631
  Top = 320
  Height = 354
  Width = 356
  object ibConnection: TSQLConnection
    Connected = True
    ConnectionName = 'IBLocal'
    DriverName = 'Interbase'
    GetDriverFunc = 'getSQLDriverINTERBASE'
    LibraryName = 'dbexpint.dll'
    LoginPrompt = False
    Params.Strings = (
      'BlobSize=-1'
      'CommitRetain=False'

              'Database=c:\program files\interbase corp\interbase6\examples\dat' +
        'abase\employee.gdb'
      'DriverName=Interbase'
      'Password=masterkey'
      'RoleName=RoleName'
      'ServerCharSet=ASCII'
      'SQLDialect=1'
      'Interbase TransIsolation=ReadCommited'
      'User_Name=sysdba'
      'WaitOnLocks=True')
    VendorLib = 'GDS32.DLL'
    Left = 40
    Top = 24
  end
  object dsDepartment: TDataSource
    DataSet = cdsDepartment
    Left = 128
    Top = 72
  end
  object cdsDepartment: TSQLClientDataSet
    Active = True
    CommandText =
       'select DEPARTMENT, DEPT_NO, HEAD_DEPT, LOCATION, BUDGET from DEP' +
      'ARTMENT'
    Aggregates = <>
    Options = [poAllowCommandText]
    ObjectView = True
    Params = <>
    DBConnection = ibConnection
    Left = 48
    Top = 88
  end
  object cdsEmployee: TSQLClientDataSet
    Active = True
    CommandText =
       'select EMP_NO, FIRST_NAME, LAST_NAME, DEPT_NO, JOB_CODE, JOB_COU' +
      'NTRY, SALARY from EMPLOYEE'
    Aggregates = <>
    IndexFieldNames = 'DEPT_NO'
    MasterFields = 'DEPT_NO'
    MasterSource = dsDepartment
    Options = [poAllowCommandText]
    ObjectView = True
    PacketRecords = 0
    Params = <
      item
        DataType = ftString
        Name = 'DEPT_NO'
        ParamType = ptInput
        Value = '000'
      end>
    DBConnection = ibConnection
    Left = 48
    Top = 144
  end
  object dsaDepartment: TDataSetAdapter
    DataSet = cdsDepartment
    Left = 216
    Top = 32
    object TAdapterDefaultActions
    end
    object TAdapterDefaultFields
      object AdaptDEPARTMENT: TDataSetAdapterField
        DataSetField = 'DEPARTMENT'
      end
      object AdaptDEPT_NO2: TDataSetAdapterField
        DataSetField = 'DEPT_NO'
      end
      object AdaptHEAD_DEPT: TDataSetAdapterField
        DataSetField = 'HEAD_DEPT'
      end
      object AdaptLOCATION: TDataSetAdapterField
        DataSetField = 'LOCATION'
      end
      object AdaptBUDGET: TDataSetAdapterField
        DataSetField = 'BUDGET'
      end
    end
  end
  object dsaEmployee: TDataSetAdapter
    DataSet = cdsEmployee
    MasterAdapter = dsaDepartment
    Left = 216
    Top = 96
    object TAdapterDefaultActions
    end
    object TAdapterDefaultFields
      object AdaptEMP_NO: TDataSetAdapterField
        DataSetField = 'EMP_NO'
      end
      object AdaptFIRST_NAME: TDataSetAdapterField
        DataSetField = 'FIRST_NAME'
      end
      object AdaptLAST_NAME: TDataSetAdapterField
        DataSetField = 'LAST_NAME'
      end
      object AdaptDEPT_NO: TDataSetAdapterField
        DataSetField = 'DEPT_NO'
      end
      object AdaptJOB_CODE: TDataSetAdapterField
        DataSetField = 'JOB_CODE'
      end
      object AdaptJOB_COUNTRY: TDataSetAdapterField
        DataSetField = 'JOB_COUNTRY'
      end
      object AdaptSALARY: TDataSetAdapterField
        DataSetField = 'SALARY'
      end
    end
  end
end