Project APPSPLUS
Project Structure
APPSPLUS.DPR
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.
APPSFORM.PAS
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.
APPSPLUS_TLB.PAS
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.84 $
// File generated on 8/4/99 5:16:01 PM from Type Library described below.
// *************************************************************************//
// NOTE:
// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties
// which return objects that may need to be explicitly created via a function
// call prior to any access via the property. These items have been disabled
// in order to prevent accidental use from within the object inspector. You
// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively
// removing them from the $IFDEF blocks. However, such items must still be
// programmatically created via a method of the appropriate CoClass before
// they can be used.
// ************************************************************************ //
// Type Lib: C:\md5code\Part5\21\AppSPlus\AppSPlus.tlb (1)
// IID\LCID: {E31849A6-4A82-11D3-B9F1-00000100A27B}\0
// Helpfile:
// DepndLst:
// (1) v2.0 stdole, (C:\WINDOWS\SYSTEM\STDOLE2.TLB)
// (2) v4.0 StdVCL, (C:\WINDOWS\SYSTEM\STDVCL40.DLL)
// (3) v1.0 Midas, (C:\WINDOWS\SYSTEM\MIDAS.DLL)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
interface
uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL,
MIDAS;
// *********************************************************************//
// 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;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TAppServerPlus
// Help String : AppServerPlus Object
// Default Interface: IAppServerPlus
// Def. Intf. DISP? : No
// Event Interface:
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TAppServerPlusProperties= class;
{$ENDIF}
TAppServerPlus = class(TOleServer)
private
FIntf: IAppServerPlus;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TAppServerPlusProperties;
function GetServerProperties: TAppServerPlusProperties;
{$ENDIF}
function GetDefaultInterface: IAppServerPlus;
protected
procedure InitServerData; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: IAppServerPlus);
procedure Disconnect; override;
function AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant;
MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant;
function AS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer;
Options: Integer; const CommandText: WideString;
var Params: OleVariant; var OwnerData: OleVariant): OleVariant;
function AS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant;
function AS_GetProviderNames: OleVariant;
function AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant;
function AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer;
var OwnerData: OleVariant): OleVariant;
procedure AS_Execute(const ProviderName: WideString; const CommandText: WideString;
var Params: OleVariant; var OwnerData: OleVariant);
procedure Login(const Name: WideString; const Password: WideString);
property DefaultInterface: IAppServerPlus read GetDefaultInterface;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TAppServerPlusProperties read GetServerProperties;
{$ENDIF}
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TAppServerPlus
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TAppServerPlusProperties = class(TPersistent)
private
FServer: TAppServerPlus;
function GetDefaultInterface: IAppServerPlus;
constructor Create(AServer: TAppServerPlus);
protected
public
property DefaultInterface: IAppServerPlus read GetDefaultInterface;
published
end;
{$ENDIF}
procedure Register;
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;
procedure TAppServerPlus.InitServerData;
const
CServerData: TServerData = (
ClassID: '{E31849A9-4A82-11D3-B9F1-00000100A27B}';
IntfIID: '{E31849A7-4A82-11D3-B9F1-00000100A27B}';
EventIID: '';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TAppServerPlus.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
Fintf:= punk as IAppServerPlus;
end;
end;
procedure TAppServerPlus.ConnectTo(svrIntf: IAppServerPlus);
begin
Disconnect;
FIntf := svrIntf;
end;
procedure TAppServerPlus.DisConnect;
begin
if Fintf <> nil then
begin
FIntf := nil;
end;
end;
function TAppServerPlus.GetDefaultInterface: IAppServerPlus;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TAppServerPlus.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TAppServerPlusProperties.Create(Self);
{$ENDIF}
end;
destructor TAppServerPlus.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TAppServerPlus.GetServerProperties: TAppServerPlusProperties;
begin
Result := FProps;
end;
{$ENDIF}
function TAppServerPlus.AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant;
MaxErrors: Integer; out ErrorCount: Integer;
var OwnerData: OleVariant): OleVariant;
begin
Result := DefaultInterface.AS_ApplyUpdates(ProviderName, Delta, MaxErrors, ErrorCount, OwnerData);
end;
function TAppServerPlus.AS_GetRecords(const ProviderName: WideString; Count: Integer;
out RecsOut: Integer; Options: Integer;
const CommandText: WideString; var Params: OleVariant;
var OwnerData: OleVariant): OleVariant;
begin
Result := DefaultInterface.AS_GetRecords(ProviderName, Count, RecsOut, Options, CommandText,
Params, OwnerData);
end;
function TAppServerPlus.AS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant;
begin
Result := DefaultInterface.AS_DataRequest(ProviderName, Data);
end;
function TAppServerPlus.AS_GetProviderNames: OleVariant;
begin
Result := DefaultInterface.AS_GetProviderNames;
end;
function TAppServerPlus.AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant;
begin
Result := DefaultInterface.AS_GetParams(ProviderName, OwnerData);
end;
function TAppServerPlus.AS_RowRequest(const ProviderName: WideString; Row: OleVariant;
RequestType: Integer; var OwnerData: OleVariant): OleVariant;
begin
Result := DefaultInterface.AS_RowRequest(ProviderName, Row, RequestType, OwnerData);
end;
procedure TAppServerPlus.AS_Execute(const ProviderName: WideString; const CommandText: WideString;
var Params: OleVariant; var OwnerData: OleVariant);
begin
DefaultInterface.AS_Execute(ProviderName, CommandText, Params, OwnerData);
end;
procedure TAppServerPlus.Login(const Name: WideString; const Password: WideString);
begin
DefaultInterface.Login(Name, Password);
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TAppServerPlusProperties.Create(AServer: TAppServerPlus);
begin
inherited Create;
FServer := AServer;
end;
function TAppServerPlusProperties.GetDefaultInterface: IAppServerPlus;
begin
Result := FServer.DefaultInterface;
end;
{$ENDIF}
procedure Register;
begin
RegisterComponents('Servers',[TAppServerPlus]);
end;
end.
APPSRDM.PAS
unit AppSRDM;
interface
uses
Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
DBClient, AppSPlus_TLB, StdVcl, Db, Provider, DBTables;
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;
ProviderOrders: TProvider;
DataSourceCust: TDataSource;
ProviderCustomer: TDataSetProvider;
ProviderQuery: TDataSetProvider;
procedure ProviderCustomerUpdateData(Sender: TObject;
DataSet: TClientDataSet);
procedure ProviderCustomerBeforeUpdateRecord(Sender: TObject;
SourceDS: TDataSet; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind;
var Applied: Boolean);
procedure ProviderQueryGetDataSetProperties(Sender: TObject;
DataSet: TDataSet; out Properties: OleVariant);
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.ProviderCustomerUpdateData(Sender: TObject;
DataSet: TClientDataSet);
begin
ServerForm.Add ('ProviderCustomer.OnUpdateData');
end;
procedure TAppServerPlus.ProviderCustomerBeforeUpdateRecord(
Sender: TObject; SourceDS: TDataSet; DeltaDS: TClientDataSet;
UpdateKind: TUpdateKind; var Applied: Boolean);
begin
ServerForm.Add ('ProviderCustomer.UpdateRecord');
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;
initialization
TComponentFactory.Create(ComServer, TAppServerPlus,
Class_AppServerPlus, ciMultiInstance, tmApartment);
end.
APPSFORM.DFM
object ServerForm: TServerForm
Left = 297
Top = 237
Width = 696
Height = 480
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 = 688
Height = 453
Align = alClient
ItemHeight = 13
TabOrder = 0
end
end
APPSRDM.DFM
object AppServerPlus: TAppServerPlus
OldCreateOrder = False
Left = 279
Top = 157
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 = 176
Top = 96
end
object ProviderOrders: TProvider
DataSet = TableOrders
Constraints = True
Left = 120
Top = 96
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
|
Home:
Code Repository:
Mastering Delphi 5