Project Structure

• AppSPlus.dpr
• AppSForm.pas
• AppSPlus_TLB.pas
• AppSRDM.pas
• AppSForm.dfm
• AppSRDM.dfm

program AppSPlus;

uses
  Forms,
  AppSForm in 'AppSForm.pas' {ServerForm},
  AppSPlus_TLB in 'AppSPlus_TLB.pas',
  AppSRDM in 'AppSRDM.pas' {AppServerPlus: TRemoteDataModule} {AppServerPlus: CoClass};

{$R *.TLB}

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TServerForm, ServerForm);
  Application.Run;
end.

unit AppSForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TServerForm = class(TForm)
    lbLog: TListBox;
  private
    { Private declarations }
  public
    procedure Add (strLog: string);
  end;

var
  ServerForm: TServerForm;

implementation

{$R *.DFM}

{ TServerForm }

procedure TServerForm.Add(strLog: string);
begin
  // add item and move to it
  lbLog.ItemIndex := lbLog.Items.Add (strLog);
end;

end.

unit AppSPlus_TLB;

// ************************************************************************ //
// WARNING                                                                    
// -------                                                                    
// The types declared in this file were generated from data read from a       
// Type Library. If this type library is explicitly or indirectly (via        
// another type library referring to this type library) re-imported, or the   
// 'Refresh' command of the Type Library Editor activated while editing the   
// Type Library, the contents of this file will be regenerated and all        
// manual modifications will be lost.                                         
// ************************************************************************ //

// PASTLWTR : $Revision:   1.126  $
// File generated on 5/13/2001 1:00:17 AM from Type Library described below.

// ************************************************************************  //
// Type Lib: C:\md6code\17\AppSPlus\AppSPlus.tlb (1)
// LIBID: {E31849A6-4A82-11D3-B9F1-00000100A27B}
// LCID: 0
// Helpfile: 
// DepndLst: 
//   (1) v1.0 Midas, (C:\WINDOWS\System32\midas.dll)
//   (2) v2.0 stdole, (C:\WINDOWS\System32\stdole2.tlb)
//   (3) v4.0 StdVCL, (C:\WINDOWS\system32\stdvcl40.dll)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}

interface

uses ActiveX, Classes, Graphics, Midas, StdVCL, Variants, Windows;



  // *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:        
//   Type Libraries     : LIBID_xxxx                                      
//   CoClasses          : CLASS_xxxx                                      
//   DISPInterfaces     : DIID_xxxx                                       
//   Non-DISP interfaces: IID_xxxx                                        
// *********************************************************************//
const
  // TypeLibrary Major and minor versions
  AppSPlusMajorVersion = 1;
  AppSPlusMinorVersion = 0;

  LIBID_AppSPlus: TGUID = '{E31849A6-4A82-11D3-B9F1-00000100A27B}';

  IID_IAppServerPlus: TGUID = '{E31849A7-4A82-11D3-B9F1-00000100A27B}';
  CLASS_AppServerPlus: TGUID = '{E31849A9-4A82-11D3-B9F1-00000100A27B}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary                    
// *********************************************************************//
  IAppServerPlus = interface;
  IAppServerPlusDisp = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library                       
// (NOTE: Here we map each CoClass to its Default Interface)              
// *********************************************************************//
  AppServerPlus = IAppServerPlus;


// *********************************************************************//
// Interface: IAppServerPlus
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {E31849A7-4A82-11D3-B9F1-00000100A27B}
// *********************************************************************//
  IAppServerPlus = interface(IAppServer)
    ['{E31849A7-4A82-11D3-B9F1-00000100A27B}']
    procedure Login(const Name: WideString; const Password: WideString); safecall;
  end;

// *********************************************************************//
// DispIntf:  IAppServerPlusDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {E31849A7-4A82-11D3-B9F1-00000100A27B}
// *********************************************************************//
  IAppServerPlusDisp = dispinterface
    ['{E31849A7-4A82-11D3-B9F1-00000100A27B}']
    procedure Login(const Name: WideString; const Password: WideString); dispid 1;
    function  AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant;
                               MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; dispid 20000000;
    function  AS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer;
                             Options: Integer; const CommandText: WideString;
                             var Params: OleVariant; var OwnerData: OleVariant): OleVariant; dispid 20000001;
    function  AS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; dispid 20000002;
    function  AS_GetProviderNames: OleVariant; dispid 20000003;
    function  AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; dispid 20000004;
    function  AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer;
                             var OwnerData: OleVariant): OleVariant; dispid 20000005;
    procedure AS_Execute(const ProviderName: WideString; const CommandText: WideString;
                          var Params: OleVariant; var OwnerData: OleVariant); dispid 20000006;
  end;

// *********************************************************************//
// The Class CoAppServerPlus provides a Create and CreateRemote method to          
// create instances of the default interface IAppServerPlus exposed by              
// the CoClass AppServerPlus. The functions are intended to be used by             
// clients wishing to automate the CoClass objects exposed by the         
// server of this typelibrary.                                            
// *********************************************************************//
  CoAppServerPlus = class
    class function Create: IAppServerPlus;
    class function CreateRemote(const MachineName: string): IAppServerPlus;
  end;

implementation

uses ComObj;

class function CoAppServerPlus.Create: IAppServerPlus;
begin
  Result := CreateComObject(CLASS_AppServerPlus) as IAppServerPlus;
end;

class function CoAppServerPlus.CreateRemote(const MachineName: string): IAppServerPlus;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_AppServerPlus) as IAppServerPlus;
end;

end.

unit AppSRDM;

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
  DBClient, AppSPlus_TLB, StdVcl, Db, Provider, DBTables, Variants;

type
  TAppServerPlus = class(TRemoteDataModule, IAppServerPlus)
    TableCustomer: TTable;
    TableCustomerCustNo: TFloatField;
    TableCustomerCompany: TStringField;
    TableCustomerAddr1: TStringField;
    TableCustomerAddr2: TStringField;
    TableCustomerCity: TStringField;
    TableCustomerState: TStringField;
    TableCustomerZip: TStringField;
    TableCustomerCountry: TStringField;
    TableCustomerPhone: TStringField;
    TableCustomerFAX: TStringField;
    TableCustomerTaxRate: TFloatField;
    TableCustomerContact: TStringField;
    TableCustomerLastInvoiceDate: TDateTimeField;
    Query: TQuery;
    TableOrders: TTable;
    DataSourceCust: TDataSource;
    ProviderCustomer: TDataSetProvider;
    ProviderQuery: TDataSetProvider;
    procedure ProviderQueryGetDataSetProperties(Sender: TObject;
      DataSet: TDataSet; out Properties: OleVariant);
    procedure ProviderCustomerUpdateData(Sender: TObject;
      DataSet: TCustomClientDataSet);
    procedure ProviderCustomerBeforeUpdateRecord(Sender: TObject;
      SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
      UpdateKind: TUpdateKind; var Applied: Boolean);
  private
    { Private declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure Login(const Name, Password: WideString); safecall;
  public
    { Public declarations }
  end;

implementation

uses AppSForm;

{$R *.DFM}

class procedure TAppServerPlus.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
  if Register then
  begin
    inherited UpdateRegistry(Register, ClassID, ProgID);
    EnableSocketTransport(ClassID);
    EnableWebTransport(ClassID);
  end else
  begin
    DisableSocketTransport(ClassID);
    DisableWebTransport(ClassID);
    inherited UpdateRegistry(Register, ClassID, ProgID);
  end;
end;

procedure TAppServerPlus.Login(const Name, Password: WideString);
begin
  // TODO: add actual login code...
  if Password <> Name then
    raise Exception.Create ('Wrong name/password combination received')
  else
    Query.Active := True;
  ServerForm.Add ('Login:' + Name + '/' + Password);
end;

procedure TAppServerPlus.ProviderQueryGetDataSetProperties(Sender: TObject;
  DataSet: TDataSet; out Properties: OleVariant);
begin
  Properties := VarArrayCreate([0,1], varVariant);
  Properties[0] := VarArrayOf(['Time', Now, True]);
  Properties[1] := VarArrayOf(['Param', Query.Params[0].AsString, False]);
end;

procedure TAppServerPlus.ProviderCustomerUpdateData(Sender: TObject;
  DataSet: TCustomClientDataSet);
begin
  ServerForm.Add ('ProviderCustomer.OnUpdateData');
end;

procedure TAppServerPlus.ProviderCustomerBeforeUpdateRecord(
  Sender: TObject; SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
  UpdateKind: TUpdateKind; var Applied: Boolean);
begin
  ServerForm.Add ('ProviderCustomer.UpdateRecord');
end;

initialization
  TComponentFactory.Create(ComServer, TAppServerPlus,
    Class_AppServerPlus, ciMultiInstance, tmApartment);
end.

object ServerForm: TServerForm
  Left = 267
  Top = 215
  Width = 416
  Height = 276
  Caption = 'AppServerPlus'
  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
  object lbLog: TListBox
    Left = 0
    Top = 0
    Width = 408
    Height = 249
    Align = alClient
    ItemHeight = 13
    TabOrder = 0
  end
end

object AppServerPlus: TAppServerPlus
  OldCreateOrder = False
  Left = 281
  Top = 200
  Height = 480
  Width = 696
  object TableCustomer: TTable
    Active = True
    DatabaseName = 'DBDEMOS'
    TableName = 'customer.db'
    Left = 120
    Top = 40
    object TableCustomerCustNo: TFloatField
      FieldName = 'CustNo'
    end
    object TableCustomerCompany: TStringField
      FieldName = 'Company'
      Size = 30
    end
    object TableCustomerAddr1: TStringField
      FieldName = 'Addr1'
      Size = 30
    end
    object TableCustomerAddr2: TStringField
      FieldName = 'Addr2'
      Size = 30
    end
    object TableCustomerCity: TStringField
      FieldName = 'City'
      Size = 15
    end
    object TableCustomerState: TStringField
      FieldName = 'State'
    end
    object TableCustomerZip: TStringField
      FieldName = 'Zip'
      Size = 10
    end
    object TableCustomerCountry: TStringField
      FieldName = 'Country'
    end
    object TableCustomerPhone: TStringField
      FieldName = 'Phone'
      Size = 15
    end
    object TableCustomerFAX: TStringField
      FieldName = 'FAX'
      Size = 15
    end
    object TableCustomerTaxRate: TFloatField
      FieldName = 'TaxRate'
    end
    object TableCustomerContact: TStringField
      FieldName = 'Contact'
    end
    object TableCustomerLastInvoiceDate: TDateTimeField
      FieldName = 'LastInvoiceDate'
    end
  end
  object Query: TQuery
    DatabaseName = 'DBDEMOS'
    SQL.Strings = (
      'select * from customer'
      '  where Country = :Country')
    Left = 112
    Top = 200
    ParamData = <
      item
        DataType = ftString
        Name = 'Country'
        ParamType = ptUnknown
        Value = ''
      end>
  end
  object TableOrders: TTable
    DatabaseName = 'DBDEMOS'
    IndexName = 'CustNo'
    MasterFields = 'CustNo'
    MasterSource = DataSourceCust
    TableName = 'ORDERS.DB'
    Left = 184
    Top = 112
  end
  object DataSourceCust: TDataSource
    DataSet = TableCustomer
    Left = 184
    Top = 40
  end
  object ProviderCustomer: TDataSetProvider
    DataSet = TableCustomer
    Constraints = True
    OnUpdateData = ProviderCustomerUpdateData
    BeforeUpdateRecord = ProviderCustomerBeforeUpdateRecord
    Left = 56
    Top = 40
  end
  object ProviderQuery: TDataSetProvider
    DataSet = Query
    Constraints = True
    OnGetDataSetProperties = ProviderQueryGetDataSetProperties
    Left = 48
    Top = 200
  end
end