Marco Web Center

[an error occurred while processing this directive]

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