unit M2AddonImp;

interface

uses
	Windows, ActiveX, Classes, Forms, ComObj, ComServ, M2Addon, AClasses;

type
	TM2CustomAddon = class;

	TM2AddonFactory = class(TComObjectFactory)
	private
		FAddon: TM2CustomAddon;
	public
		constructor Create(anAddon: TM2CustomAddon);
		destructor Destroy; override;

		procedure UpdateRegistry(aRegister: Boolean); override;

		property Addon: TM2CustomAddon read FAddon;
	end;

	TM2AddonProxy = class(TComObject, IM2Addon)
	private
		FAddon: TM2CustomAddon;

		function SetException(const aMsg: string): HResult;
	public
		procedure Initialize; override;

		{From IM2Addon}
		function i_GetAttrs(out AnAttrs: TM2AddOnAttrs): HResult; stdcall;
		function i_Initialize(const AManager: IM2AddOnManager): HResult; stdcall;
		function i_Uninitialize: HResult; stdcall;
		function i_GetMacroList(out AList: IM2MacroAttrsList): HResult; stdcall;
		function i_ExecuteMacro(ACommand: Longint; const AParams: TM2String): HResult; stdcall;
		function i_Notify(AnAdvise: TM2Notify; const AParams: IM2ParamsList): HResult; stdcall;
		function i_GetBitmap(const aStm: IStream; aBitmap: Longint): HResult; stdcall;

		property Addon: TM2CustomAddon read FAddon;
	end;

	TM2CustomAddon = class
	private
		FAttrs: TM2AddonAttrs;
		FFactory: TM2AddonFactory;
		FConnected: Boolean;
		FForms: TList;

		FAddonManager: TM2AddonManager;
		FGISDatabase: TM2GISDatabase;
		FMapProject: TM2MapProject;
		FMapObjects: TM2MapObjects;
		FMapView: TM2MapView;
		FGeometryLib: TM2GeometryLib;
		FPreferences: TM2Preferences;

		function GetFormCount: Integer;
		function GetForm(i: Integer): TCustomForm;
	public
		constructor Create(const AClsID: TCLSID; const AName: TM2Name;
				const AHint: TM2Hint; AnOptions: TM2AddOnOptions);
		destructor Destroy; override;

		procedure GetAttrs(out AnAttrs: TM2AddOnAttrs); virtual;
		procedure Initialize(const AManager: IM2AddonManager); virtual;
		procedure Uninitialize; virtual;
		function GetMacroList: IM2MacroAttrsList; virtual;
		procedure ExecuteMacro(ACommand: Longint; const AParams: TM2String); virtual;
		procedure Notify(AnAdvise: TM2Notify; const AParams: IM2ParamsList); virtual;
		function GetBitmap(const aStm: IStream; aBitmap: Longint): Boolean; virtual;

		procedure AddForm(aForm: TCustomForm);
		procedure RemoveForm(aForm: TCustomForm);
		procedure DestroyForms;

		property FormCount: Integer read GetFormCount;
		property Forms[i: Integer]: TCustomForm read GetForm;
		property Connected: Boolean read FConnected;

		property AddonManager: TM2AddonManager read FAddonManager;
		property GISDatabase: TM2GISDatabase read FGISDatabase;
		property MapProject: TM2MapProject read FMapProject;
		property MapObjects: TM2MapObjects read FMapObjects;
		property MapView: TM2MapView read FMapView;
		property GeometryLib: TM2GeometryLib read FGeometryLib;
		property Preferences: TM2Preferences read FPreferences;
	end;

	function M2DllRegisterAddOn(aSubKey: PChar; anActive: BOOL): HResult; stdcall;

implementation

uses
	SysUtils, Registry, DllForm, M2AddonD, InSysUtils, AddonDllForm;

exports
	ComServ.DllGetClassObject name 'DllGetClassObject',
	ComServ.DllCanUnloadNow name 'DllCanUnloadNow',
	ComServ.DllRegisterServer name 'DllRegisterServer',
	ComServ.DllUnregisterServer name 'DllUnregisterServer',
	M2AddonImp.M2DllRegisterAddOn name 'M2DllRegisterAddOn';

var
	AddonList: TList = nil;

function M2DllRegisterAddOn(aSubKey: PChar; anActive: BOOL): HResult;
var
	anAddon: TM2CustomAddon;
	aReg: TRegistry;
	anAttrs: TM2AddonAttrs;
	aBranch, s: string;
	i: Integer;
begin
	try
		for i := 0 to AddonList.Count-1 do begin
			if (aSubKey = nil) or (aSubKey^ = #0) then
				aBranch := kregAddOns
			else
				aBranch := MakePath([kregAppliedAddOns, string(aSubKey)]);
			anAddon := AddonList[i];
			anAddon.GetAttrs(anAttrs);
			aBranch := MakePath([aBranch, GUIDToString(anAttrs.ClsID)]);

			aReg := TRegistry.Create;
			try
				aReg.RootKey := HKEY_LOCAL_MACHINE;
				aReg.LazyWrite := False;
				if aReg.OpenKey(aBranch, True) then begin
					aReg.WriteString('', anAttrs.Hint);
					if anActive then
						s := '1'
					else
						s := '0';
					aReg.WriteString('Active', s);
				end
				else
					raise Exception.Create('Ошибка при регистрации расширения');
			finally
				aReg.Free;
			end;
		end;
		Result := S_OK;
	except
		Result := E_FAIL;
	end;
end;

procedure RegisterM2Addon(anAddon: TM2CustomAddon);
begin
	AddonList.Add(anAddon);
end;

procedure UnregisterM2Addon(anAddon: TM2CustomAddon);
begin
	if Assigned(AddonList) then
		AddonList.Remove(anAddon);
end;

{ TM2AddonFactory }

constructor TM2AddonFactory.Create(anAddon: TM2CustomAddon);
begin
	inherited Create(ComServ.ComServer, TM2AddonProxy, anAddon.FAttrs.ClsID,
			'', anAddon.FAttrs.Hint, ciMultiInstance);
	FAddon := anAddon;
end;

destructor TM2AddonFactory.Destroy;
begin
	if Assigned(FAddon) then begin
		FAddon.FFactory := nil;
		FAddon.Free;
	end;
	inherited Destroy;
end;

procedure TM2AddonFactory.UpdateRegistry(aRegister: Boolean);
var
	aSubKey, anActive: string;
begin
	if ComServ.ComServer.IsInprocServer or
			(ComServ.ComServer.StartMode in [smRegServer, smUnregServer]) then begin
		inherited UpdateRegistry(aRegister);
		if not ComServ.ComServer.IsInprocServer and (ComServ.ComServer.StartMode =
				smRegServer) and FindCmdLineParam('active', anActive) then begin
			FindCmdLineParam('id', aSubKey);
			if Failed(M2DllRegisterAddOn(PChar(aSubKey), anActive <> '0')) then
				raise Exception.Create('Произошла ошибка при регистрации сервера '+FAddon.FAttrs.Hint);
		end;
	end;
end;

{ TM2AddonProxy }

procedure TM2AddonProxy.Initialize;
begin
	inherited Initialize;
	FAddon := (Factory as TM2AddonFactory).Addon;
end;

function TM2AddonProxy.i_GetAttrs(out AnAttrs: TM2AddOnAttrs): HResult;
begin
	try
		FAddOn.GetAttrs(AnAttrs);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function TM2AddonProxy.i_Initialize(const AManager: IM2AddonManager): HResult;
begin
	try
		FAddOn.Initialize(AManager);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function TM2AddonProxy.i_Uninitialize: HResult;
begin
	try
		FAddOn.Uninitialize;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function TM2AddonProxy.i_GetMacroList(out AList: IM2MacroAttrsList): HResult;
begin
	try
		AList := FAddOn.GetMacroList;
		Result := S_OK;
	except
		on e: Exception do begin
			AList := nil;
			Result := SetException(e.Message);
		end;
	end;
end;

function TM2AddonProxy.i_ExecuteMacro(ACommand: Longint; const AParams: TM2String): HResult;
begin
	try
		FAddOn.ExecuteMacro(ACommand, AParams);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function TM2AddonProxy.i_Notify(AnAdvise: TM2Notify; const AParams: IM2ParamsList): HResult;
begin
	try
		FAddOn.Notify(AnAdvise, AParams);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function TM2AddonProxy.i_GetBitmap(const aStm: IStream; aBitmap: Longint): HResult;
begin
	try
		if FAddOn.GetBitmap(aStm, aBitmap) then
			Result := S_OK
		else
			Result := S_FALSE;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function TM2AddonProxy.SetException(const aMsg: string): HResult;
begin
	Result := RaiseM2Exception(aMsg, FAddOn.FAttrs.Hint);
end;

{ TM2CustomAddon }

constructor TM2CustomAddon.Create(const AClsID: TCLSID; const AName: TM2Name;
		const AHint: TM2Hint; AnOptions: TM2AddOnOptions);
begin
	inherited Create;
	FAttrs.ClsID := AClsID;
	FAttrs.Name := AName;
	FAttrs.Hint := AHint;
	FAttrs.Options := AnOptions;
	FAttrs.SDKVersion := kSDKVersion;

	RegisterM2Addon(Self);
	FForms := TList.Create;
	SetAddonForDllForms(Self);

	FFactory := TM2AddonFactory.Create(Self);
end;

destructor TM2CustomAddon.Destroy;
begin
	if Assigned(FFactory) then
		FFactory.FAddon := nil; //!
	DestroyForms;
	SetAddonForDllForms(nil);
	FForms.Free;
	UnregisterM2Addon(Self);
	inherited Destroy;
end;

procedure TM2CustomAddon.GetAttrs(out AnAttrs: TM2AddOnAttrs);
begin
	AnAttrs := FAttrs;
end;

procedure TM2CustomAddon.Initialize(const AManager: IM2AddonManager);
var
	aTitle: array [0..1024] of Char;
begin
	gErrorInfo := AManager as IM2ErrorInfo;
	FAddonManager.OleObject := AManager as IM2AddonManager;
	FGISDatabase.OleObject := AManager as IM2GISDatabase;
	FMapProject.OleObject := AManager as IM2MapProject;
	FMapObjects.OleObject := AManager as IM2MapObjects;
	FMapView.OleObject := AManager as IM2MapView;
	FGeometryLib.OleObject := AManager as IM2GeometryLib;
	FPreferences.OleObject := AManager as IM2Preferences;
	Application.Handle := FAddonManager.GetAppDesktop;
	if IsLibrary or ModuleIsLib then begin
		GetWindowText(Application.Handle, aTitle, sizeof(aTitle));
		Application.Title := aTitle;
	end;

	InitDllForms(FAddonManager.GetMainWindow);

	FConnected := True;
	SetAddonForDllForms(Self);
end;

procedure TM2CustomAddon.Uninitialize;
begin
	DestroyForms;
	FConnected := False;

	InitDllForms(0);
	Application.Handle := 0;

	FAddonManager.OleObject := nil;
	FGISDatabase.OleObject := nil;
	FMapProject.OleObject := nil;
	FMapObjects.OleObject := nil;
	FMapView.OleObject := nil;
	FGeometryLib.OleObject := nil;
	FPreferences.OleObject := nil;
	gErrorInfo := nil;
end;

function TM2CustomAddon.GetMacroList: IM2MacroAttrsList;
begin
	Result := IM2MacroAttrsListImp.Create;
end;

procedure TM2CustomAddon.ExecuteMacro(ACommand: Longint; const AParams: TM2String);
begin
end;

procedure TM2CustomAddon.Notify(AnAdvise: TM2Notify; const AParams: IM2ParamsList);
begin
end;

function TM2CustomAddon.GetBitmap(const aStm: IStream; aBitmap: Longint): Boolean;
begin
	Result := False;
end;

function TM2CustomAddon.GetFormCount: Integer;
begin
	Result := FForms.Count;
end;

function TM2CustomAddon.GetForm(i: Integer): TCustomForm;
begin
	Result := FForms[i];
end;

procedure TM2CustomAddon.AddForm(aForm: TCustomForm);
begin
	FForms.Add(aForm);
end;

procedure TM2CustomAddon.RemoveForm(aForm: TCustomForm);
begin
	FForms.Remove(aForm);
end;

procedure TM2CustomAddon.DestroyForms;
begin
	ClearObjectList(FForms);
end;

var
	gSaveInitProc: Pointer = nil;
	gOleInitialized: Boolean = False;

procedure InitM2AddonServer;
begin
	if gSaveInitProc <> nil then
		TProcedure(gSaveInitProc);
	gOleInitialized := Succeeded(OleInitialize(nil));
	if ComServ.ComServer.StartMode = smAutomation then
		Application.ShowMainForm := False;
end;

initialization
	AddonList := TList.Create;
	if not ModuleIsLib then begin
		gSaveInitProc := InitProc;
		InitProc := @InitM2AddonServer;
	end;
finalization
	AddonList.Free;
	AddonList := nil;
	if gOleInitialized then begin
		CoFreeUnusedLibraries;
		OleUninitialize;
	end;
end.
