Universal Agent on demond SDK --UASrvObjWizard(0分)

{******************************************************************************************}
{ }
{ Universal Agent on demond SDK }
{ }
{ }
{ COPYRIGHT }
{ ========= }
{ The UA SDK (software) is Copyright (C) 2001-2003, by vinson zeng(曾胡龙). }
{ All rights reserved. }
{ The authors - vinson zeng (曾胡龙), }
{ exclusively own all copyrights to the Advanced Application }
{ Controls (AppControls) and all other products distributed by Utilmind Solutions(R). }
{ }
{ LIABILITY DISCLAIMER }
{ ==================== }
{ THIS SOFTWARE IS DISTRIBUTED "AS IS" AND WITHOUT WARRANTIES AS TO PERFORMANCE }
{ OF MERCHANTABILITY OR ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
{ YOU USE IT AT YOUR OWN RISK. THE AUTHOR WILL NOT BE LIABLE FOR DATA LOSS, }
{ DAMAGES, LOSS OF PROFITS OR ANY OTHER KIND OF LOSS WHILE USING OR MISUSING THIS SOFTWARE.}
{ }
{ RESTRICTIONS }
{ ============ }
{ You may not attempt to reverse compile, modify, }
{ translate or disassemble the software in whole or in part. }
{ You may not remove or modify any copyright notice or the method by which }
{ it may be invoked. }
{******************************************************************************************}

unit UASrvObjWizard;
interface
uses
Windows,Toolsapi,Classes,uaSrvObjWizardForm;
type

TUASrvObjWizard = class(TNotifierObject,IOTAWizard,IOTARepositoryWizard,IOTAFormWizard
{$ifdef ver140},IOTARepositoryWizard60{$endif})
public
FForm:TSrvObjWizardForm;
// IOTAWizard
function GetIDString:string;
function GetName:string;
function GetState:TWizardState;
procedure Execute;
// IOTARepositoryWizard
function GetAuthor:string;
function GetComment:string;
function GetPage:string;
{$ifdef ver140} // Delphi 6+
function GetGlyph:Cardinal;
function GetDesigner:string;
{$else
} // Delphi -5
function GetGlyph:HICON;
{$endif}
end;

implementation
uses
Dialogs,Controls,SysUtils;
const
LF: string = #13#10;
type
TUASrvObjModuleCreator = class(TInterfacedObject,IOTACreator,IOTAModuleCreator)
private
FForm:TSrvObjWizardForm;
public
constructor Create(aForm:TSrvObjWizardForm);
// IOTACreator
function GetCreatorType:string;
function GetExisting:boolean;
function GetFileSystem:string;
function GetOwner:IOTAModule;
function GetUnnamed:boolean;
// IOTAModuleCreator
function GetAncestorName:string;
function GetImplFileName:string;
function GetIntfFileName:string;
function GetFormName:string;
function GetMainForm:boolean;
function GetShowForm:boolean;
function GetShowSource:boolean;
function NewFormFile(const FormIdent,AncestorIdent: string):IOTAFile;
function NewImplSource(const ModuleIdent,FormIdent,AncestorIdent:string):IOTAFile;
function NewIntfSource(const ModuleIdent,FormIdent,AncestorIdent:string):IOTAFile;
procedure FormCreated(const FormEditor:IOTAFormEditor);
end;

TUASrvObjSourceFile = class(TInterfacedObject,IOTAFile)
private
FSource: string;
public
function GetSource:string;
function GetAge:TDateTime;
constructor Create(const Source:string);
end;

function FindModuleInterface(AInterface:TGUID):IUnknown;
var
i:integer;
begin
Result:=nil;
with BorlandIDEServices as IOTAModuleServicesdo
for i:=0 to ModuleCount-1do
if (Modules.QueryInterface(AInterface,Result)=S_OK) then
break;
end;

function GetProjectGroup:IOTAProjectGroup;
begin
Result:=FindModuleInterface(IOTAProjectGroup) as IOTAProjectGroup;
end;

function GetCurrentProject:IOTAProject;
var
ProjectGroup:IOTAProjectGroup;
begin
ProjectGroup:=GetProjectGroup;
if Assigned(ProjectGroup) then
Result:=ProjectGroup.ActiveProject
else
Result:=FindModuleInterface(IOTAProject) as IOTAProject;
end;


{ TUASrvObjWizard }
procedure TUASrvObjWizard.Execute;
var
Project:IOTAProject;
// s:string;
begin

FForm:=TSrvObjWizardForm.Create(nil);
try
if FForm.ShowModal=mrCancel then
exit;
Project:=GetCurrentProject;
if Project=nil then
raise Exception.Create('No project is existing. Please create a project before creating UAServerObject.');
(BorlandIDEServices as IOTAModuleServices).CreateModule(TUASrvObjModuleCreator.Create(FForm));
{ s:= 'UASrvObj_'+FForm.edt_SrvObjName.Text+'.pas';
Project.AddFile(s,true);
}
finally
FForm.Free;
end;

end;

function TUASrvObjWizard.GetAuthor: string;
begin
Result:='vinson zeng/infocross studio';
end;

function TUASrvObjWizard.GetComment: string;
begin
Result:='UA SrvObj wizard';
end;

{$ifdef ver140}
function TUASrvObjWizard.GetDesigner: string;
begin
Result:=dAny;
end;
{$endif}
{$ifdef ver140}
function TUASrvObjWizard.GetGlyph: Cardinal;
{$else
}
function TUASrvObjWizard.GetGlyph: HICON;
{$endif}
begin
{$IFDEF LINUX}
Result := 0;
{$else
}
Result:=LoadIcon(hInstance, 'UASRVOBJWIZARD');
{$ENDIF}
end;

function TUASrvObjWizard.GetIDString: string;
begin
Result:='UA.SrvObjWizard';
end;

function TUASrvObjWizard.GetName: string;
begin
Result:='UA SrvObj wizard';
end;

function TUASrvObjWizard.GetPage: string;
begin
Result:='Universal Agent';
end;

function TUASrvObjWizard.GetState: TWizardState;
begin
Result:=[wsEnabled];
end;

{ TUASrvObjModuleCreator }
constructor TUASrvObjModuleCreator.Create(aForm: TSrvObjWizardForm);
begin

inherited Create;
FForm:=aForm;
end;

procedure TUASrvObjModuleCreator.FormCreated(
const FormEditor: IOTAFormEditor);
begin

end;

function TUASrvObjModuleCreator.GetAncestorName: string;
begin
Result:='';
end;

function TUASrvObjModuleCreator.GetCreatorType: string;
begin
Result:=sUnit;
// Result := sForm;
end;

function TUASrvObjModuleCreator.GetExisting: boolean;
begin
Result:=false;
end;

function TUASrvObjModuleCreator.GetFileSystem: string;
begin
Result:='';
end;

function TUASrvObjModuleCreator.GetFormName: string;
begin
Result:='';
end;

function TUASrvObjModuleCreator.GetImplFileName: string;
begin
// Result:= 'UASrvObj_'+FForm.edt_SrvObjName.Text + '.pas';
Result := '';
end;

function TUASrvObjModuleCreator.GetIntfFileName: string;
//var
// LProject:IOTAProject;
begin
// LProject := GetCurrentProject;
// LProject.
Result:='';
end;

function TUASrvObjModuleCreator.GetMainForm: boolean;
begin
Result:=false;
end;

function TUASrvObjModuleCreator.GetOwner: IOTAModule;
var
ModuleServices:IOTAModuleServices;
Module:IOTAModule;
NewModule:IOTAModule;
begin
Result:=nil;
ModuleServices:=(BorlandIDEServices as IOTAModuleServices);
Module:=ModuleServices.CurrentModule;
if Module<>nil then
begin
if Module.QueryInterface(IOTAProject,NewModule) = S_OK then
Result:=NewModule
{$ifdef ver140} // Delphi 6+
else
if Module.OwnerModuleCount>0 then
begin
NewModule:=Module.OwnerModules[0];
{$else
} // Delphi -5
else
if Module.GetOwnerCount>0 then
begin
NewModule:=Module.GetOwner(0);
{$endif}
if NewModule<>nil then
if NewModule.QueryInterface(IOTAProject,Result)<>S_OK then
Result := nil;
end;
end;

end;

function TUASrvObjModuleCreator.GetShowForm: boolean;
begin
Result:=false;
end;

function TUASrvObjModuleCreator.GetShowSource: boolean;
begin
Result:=true;
end;

function TUASrvObjModuleCreator.GetUnnamed: boolean;
begin
Result:=true;
end;

function TUASrvObjModuleCreator.NewFormFile(const FormIdent,
AncestorIdent: string): IOTAFile;
begin
Result:=nil;
end;

function TUASrvObjModuleCreator.NewImplSource(const ModuleIdent, FormIdent,
AncestorIdent: string): IOTAFile;
var
s:string;
UnitRemark:string;
UsesString:string;
SrvObjName:string;
sType:string;
sProc:string;
sInit:string;
sMaxIns:string;
sTimeOut:string;
sMgr:string;
sMgrProc:string;
begin

// Create public declarations.
if trim(FForm.edt_SrvObjName.Text)='' then
raise Exception.Create('SrvObj Name must be given.');
SrvObjName := trim(FForm.edt_SrvObjName.Text);
sMaxIns := IntToStr(FForm.sedt_MaxIns.Value);
sTimeOut := IntToStr(FForm.sedt_MaxTime.Value);
// Showmessage(ModuleIdent +'#'+ FormIdent +'#'+ AncestorIdent);
UnitRemark:='// ========================================================================='+LF+
'// UA - An advanced and extendable multi tier application development kit.'+LF+
'// by vinzon zeng (曾胡龙) (E_mail:vinson_zeng@tom.com)'+LF+
'// SrvObj generated by UA SrvObj wizard.'+LF+
'// Power by Borland Midas Tech.'+LF+
'// Create date time: '+ DateTimeToStr(Now()) + LF+
'//'+'========================================================================='+LF;

UsesString:= ' Windows, Messages, SysUtils, Classes,DBClient,StdVcl,'+ LF+
' {$ifdef ver140}Variants,{$endif}AdoDb,Contnrs,DB,'+ LF +
' uaSrvObj,UAServiceObjectPool,UADataPacket,UAUnits';
UsesString:=UsesString+';';
sType := 'type '+ LF+ LF+
' TUASrvObj'+SrvObjName+'= class(TuaServerObject)'+LF+
' private'+LF+
' { Private declarations }'+LF+
' protected'+LF+
' { Protected declarations }'+LF+
' procedure AfterTriggerForDataSet(TableName:string;SrcDS:TDataSet;DestDS:TDataSet;var bHandle:Boolean);override;
'+LF+
' procedure BeforeTriggerForDataSet(TableName:string;SrcDS:TDataSet;DestDS:TDataSet;var bHandle:Boolean);override;
'+LF+
' procedure BeforeUpdate(Sender:TObject;var bHandle:Boolean);override;
'+LF+
' procedure AfterUpdate(Sender:TObject;var bContinue:Boolean);override;
'+LF+
' procedure BeforeRequest(Sender:TObject;var bHandle:Boolean);override;
'+LF+
' procedure AfterRequest(Sender:TObject;var bContinue:Boolean);override;'+LF+
' procedure BeforeExecute(Sender:TObject;var bHandle:Boolean);override;'+LF+
' procedure AfterExecute(Sender:TObject;var bContinue:Boolean);override;'+LF+
' function RequestCustomData(ServiceName:WideString;vcInData:OleVariant;var vcOutData:OleVariant):integer;override;'+LF+
' function UpdateCustomDelta(ServiceName:WideString;vcInData:OleVariant;var vcOutData:OleVariant):integer;override;'+LF+
' procedure InitForRequest(var DataIn:OleVariant;var DataOut:OleVariant);override;
'+LF+
' procedure InitForUpdate (var DataIn:OleVariant;var DataOut:OleVariant);override;
'+LF+
' procedure InitForExecute(var DataIn:OleVariant;var DataOut:OleVariant);override;
'+LF+
' public' +LF+
' { Public declarations }'+LF+
' constructor Create;
override;
'+LF+
' destructor Destroy;
override;'+LF+
' procedure Request(ServiceName: WideString;
DataIn: OleVariant;var DataOut: OleVariant);
override;'+LF+
' procedure Update (ServiceName: WideString;
DataIn: OleVariant;var DataOut: OleVariant);
override;'+LF+
' procedure Execute(ServiceName: WideString;
DataIn: OleVariant;var DataOut: OleVariant);
override;'+LF+
' published '+LF+
' { Published declarations }'+LF+
' end;
';
sProc := '{ TSrvObj'+SrvObjName+' }'+LF+LF+
'procedure TUASrvObj'+SrvObjName+'.AfterTriggerForDataSet(TableName:string;SrcDS:TDataSet;DestDS:TDataSet;var bHandle:Boolean);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'procedure TUASrvObj'+SrvObjName+'.BeforeTriggerForDataSet(TableName:string;SrcDS:TDataSet;DestDS:TDataSet;var bHandle:Boolean);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'procedure TUASrvObj'+SrvObjName+'.AfterExecute(Sender: TObject;Var bContinue:Boolean);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'procedure TUASrvObj'+SrvObjName+'.AfterRequest(Sender: TObject;Var bContinue:Boolean);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'procedure TUASrvObj'+SrvObjName+'.AfterUpdate(Sender: TObject;Var bContinue:Boolean);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'procedure TUASrvObj'+SrvObjName+'.BeforeExecute(Sender: TObject;Var bHandle:Boolean);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+

'procedure TUASrvObj'+SrvObjName+'.BeforeRequest(Sender: TObject;Var bHandle:Boolean);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'procedure TUASrvObj'+SrvObjName+'.BeforeUpdate(Sender: TObject;Var bHandle:Boolean);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'constructor TUASrvObj'+SrvObjName+'.Create;'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'destructor TUASrvObj'+SrvObjName+'.Destroy;'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'procedure TUASrvObj'+SrvObjName+'.Execute(ServiceName: WideString;DataIn: OleVariant;Var DataOut: OleVariant);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'procedure TUASrvObj'+SrvObjName+'.Request(ServiceName: WideString;DataIn: OleVariant;Var DataOut: OleVariant);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'procedure TUASrvObj'+SrvObjName+'.Update(ServiceName: WideString;DataIn: OleVariant;Var DataOut: OleVariant);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+

'procedure TUASrvObj'+SrvObjName+'.InitForUpdate(var DataIn, DataOut: OleVariant);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'procedure TUASrvObj'+SrvObjName+'.InitForRequest(var DataIn, DataOut: OleVariant);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'procedure TUASrvObj'+SrvObjName+'.InitForExecute(var DataIn, DataOut: OleVariant);'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'function TUASrvObj'+SrvObjName+'.RequestCustomData(ServiceName:WideString;vcInData:OleVariant;var vcOutData:OleVariant):integer;'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
'+LF+LF+
'function TUASrvObj'+SrvObjName+'.UpdateCustomDelta(ServiceName:WideString;vcInData:OleVariant;var vcOutData:OleVariant):integer;'+LF+
'begin
'+LF+
' inherited;'+LF+
'// TODO ......'+LF+
'end;
';
sMgr := '//-----------------begin
SrvObj PoolManager declare-------------------//'+LF+
'const'+ LF+
' Srv_Obj_Name = ' + #39 + 'srvobj' +LowerCase(SrvObjName)+#39+';'+LF+
'type'+LF+
' TMgrSrvObj'+SrvObjName+' = class(TCustomPoolManager)'+LF+
' function InternalCreateNewInstance: TCustomPoolObject;
override;'+LF+
'end;
'+LF+
'var'+LF+
' aMgrSrvObj'+SrvObjName+': TMgrSrvObj'+SrvObjName+';'+LF +
'//------------------%% end of %% -------------------------------------//';
sMgrProc :=
'{ TMgrSrvObj'+SrvObjName+' }'+LF+
'function TMgrSrvObj'+SrvObjName+'.InternalCreateNewInstance: TCustomPoolObject;
'+LF+
'var '+LF+
' aSrvObj'+SrvObjName+':TUASrvObj'+SrvObjName+';'+LF+
'begin
'+LF+
' aSrvObj'+SrvObjName+' := TUASrvObj'+SrvObjName+'.Create;'+LF+
' Result := TCustomPoolObject(aSrvObj'+SrvObjName+');'+LF+
'end;
';

sInit := 'initialization' +LF+
' aMgrSrvObj'+ SrvObjName +':= TMgrSrvObj'+SrvObjName+'.Create('+sMaxIns +','+sTimeOut+');'+LF+
' RegisterPoolManager(Srv_Obj_Name, TCustomPoolManager(aMgrSrvObj'+SrvObjName+'));'+LF +
'finalization'+LF+
' aMgrSrvObj'+SrvObjName+'.Free;';
s:=
'unit '+ModuleIdent+';'+LF+LF+
UnitRemark+LF+LF+
'interface'+LF+
'uses'+LF+
UsesString+LF +
sType+LF+LF+
'implementation'+LF+LF+
sMgr+LF+LF+
sMgrProc+LF+LF+
sProc+LF+LF+
sInit+LF+
'end.
';
Result := TUASrvObjSourceFile.Create(s);

end;

function TUASrvObjModuleCreator.NewIntfSource(const ModuleIdent, FormIdent,
AncestorIdent: string): IOTAFile;
begin
Result:=nil;
end;

{ TUASrvObjSourceFile }
constructor TUASrvObjSourceFile.Create(const Source: string);
begin
FSource:=Source;
end;

function TUASrvObjSourceFile.GetAge: TDateTime;
begin
Result:=-1;
end;

function TUASrvObjSourceFile.GetSource: string;
begin
Result:=FSource;
end;

end.