Biblioteka DLL (COM) z obsługą interfejsu

Rejestracja:prawie 13 lat
Ostatnio:prawie 2 lata
Postów:196

Witam,

Metoda pluginów zrobiona na podstawie:
https://4programmers.net/Delphi/Artyku%C5%82y/Wtyczki_(Plugin)_w_oparciu_o_interfejsy

mam interfejs pluginu DLL, który wygląda następująco:

Kopiuj

unit implPluginMobile;

interface

type
  TPluginMobile = class(TComObject, IPlug, IPluginMobile)
  private
    pMalloc: IMalloc;
    Fwind: TfrmMobile;
  public
    //IPlug
    function FreePlug: HRESULT; stdcall;
    function GetName(var Desc: PWideChar): HRESULT; stdcall;
    function Init(ap: IPlugsApplication; TabH: HWND;
      ACliHandle: Pointer = nil): HRESULT; stdcall;
    //IPluginMobile
    function RegisterWorkshop(AEncodedJSONstring: string;
      out AMsg: string): TJSONObject; stdcall;
    procedure UnregisterWorkshop(AWorkshopName: string; out AMsg: string); stdcall;
    function IsRegistered(AWorkshopName: string;
      out AMsg: string): TJSONObject; stdcall;
    procedure StartSynchro(AWorkshopName: string); stdcall;
    procedure StopSynchro; stdcall;
  public
    procedure Initialize; override;
    destructor Destroy; override;

  end;

destructor TPluginMobile.Destroy;
begin
  if Assigned(ClientModule1) then
    FreeAndNil(ClientModule1);

  if Assigned(frmDM) then
    FreeAndNil(frmDM);

  if Fwind <> nil then
    FreeAndNil(Fwind);

  DB := nil;
  PlugMobile := nil;
  pMalloc := nil;
  inherited;
end;

procedure TPluginMobile.Initialize;
begin
  //Tu tworzymy potrzebne elementy

  if not Assigned(frmDM) then
    Application.CreateForm(TfrmDM, frmDM);

  if DB = nil then
    DB := TDatabase.Create;

  if not Assigned(ClientModule1) then
    Application.CreateForm(TClientModule1, ClientModule1);

  if not Assigned(PlugMobile) then
    PlugMobile := TPluginMobile.Create; // PRZEZ TO SIĘ ZAPĘTLA - CIĄGLE WYWOŁUJE INITIALIZE;

  Fwind := nil;
  //IMalloc to wygodny interfejs do nawigacji pamiecia w interfejsach
  SHGetMalloc(pMalloc);
  inherited;
end;

oraz fabrykę klas:

Kopiuj

type
  TMobileFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

procedure TMobileFactory.UpdateRegistry(Register: Boolean);
var
  ClassID: string;
begin
  if Register then
  begin
    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(CLSID_PluginMobile);
    with TRegistry.Create do
      try
        RootKey := HKEY_CURRENT_USER;
        OpenKey(szWtyczki + ClassID,True);
        CloseKey;
      finally
        Free;
      end;
  end
  else
  begin
     with TRegistry.Create do
       try
         RootKey := HKEY_CURRENT_USER;
         ClassID := GUIDToString(CLSID_PluginMobile);
         DeleteKey(szWtyczki + ClassID);
       finally
         Free;
       end;
    inherited UpdateRegistry(Register);
  end;
end;

initialization
  CoInitialize(nil);
  TMobileFactory.Create(ComServer, TPluginMobile, CLSID_PluginMobile, '',
    'Aplikacja Mobilna', ciMultiInstance, tmApartment);

finalization
  CoUnInitialize;

end.

Problem polega na tym, że nie wiem w jaki sposób w pluginie odwoływać się do jego interfejsu IPluginMobile, bo każde wywołanie

Kopiuj

PlugMobile := TPluginMobile.Create;

powoduje przejście do wywołania procedury

Kopiuj

procedure TPluginMobile.Initialize;

z kolei ta powinna wykonać się tylko raz przy wczytaniu jej z okna rodzica. Jeżeli nie utworzę zmiennej interfejsu PlugMobile := TPluginMobile.Create, to dostaję accessy.
W jaki sposób mam odwoływać się do metod interfejsu, bez ciągłej inicjalizacji.

Próbowałem tworzyć PlugMobile := TPluginMobile.Create w innym miejscu, już po zainicjalizowaniu, ale wtedy jest problem przy zwalnianiu utworzonych form - access violation przy

Kopiuj

destructor TPluginMobile.Destroy;
begin
  if Assigned(ClientModule1) then
    FreeAndNil(ClientModule1); // Access violation

domyślam się, że to przez to, iż ten moduł został utworzony 2 razy. 1 raz przy włączaniu biblioteki, a drugi w momencie tworzenia PlugMobile poza procedurą Initialize.

Poniżej cały kod XE10.1 updt 2:

Kopiuj

unit implPluginMobile;

interface

uses Forms, JSON, SysUtils, intfPlugins, Windows, ActiveX, ComObj, ShlObj, Messages,
  Registry, MobileForm, Classes, IdCoderMIME, IdGlobal, System.SyncObjs,
  FireDAC.Comp.DataSet, FireDACJSONReflect, FireDAC.Stan.StorageBin;

type
  TPluginMobile = class(TComObject, IPlug, IPluginMobile)
  private
    pMalloc: IMalloc;
    Fwind: TfrmMobile;
  public
    //IPlug
    function FreePlug: HRESULT; stdcall;
    function GetName(var Desc: PWideChar): HRESULT; stdcall;
    function Init(ap: IPlugsApplication; TabH: HWND;
      ACliHandle: Pointer = nil): HRESULT; stdcall;
    //IPluginMobile
    function RegisterWorkshop(AEncodedJSONstring: string;
      out AMsg: string): TJSONObject; stdcall;
    procedure UnregisterWorkshop(AWorkshopName: string; out AMsg: string); stdcall;
    function IsRegistered(AWorkshopName: string;
      out AMsg: string): TJSONObject; stdcall;
    procedure StartSynchro(AWorkshopName: string); stdcall;
    procedure StopSynchro; stdcall;
  public
    procedure Initialize; override;
    destructor Destroy; override;

  end;

type
  TMobileSynchro = class(TThread)
    private
      FConnecting: boolean;
      FCriticalSection: TCriticalSection;
    public
      WorkshopName: string;
      destructor Destroy; override;
    protected
      procedure Execute; override;
  end;

var
  PlugMobile: IPluginMobile;

const
  CLSID_PluginMobile: TGUID = '{0514B943-B587-414F-BFF8-AB708B0B8381}';
  SynchroDeelay = 15000;

implementation

uses ClientModuleUnit1, ComServ, implDB, intfCrypt, implCrypt,
  DM, DLLThreadAntiFreeze;

{ TPluginMobile }

var
  SynchroThread: TMobileSynchro;

destructor TPluginMobile.Destroy;
begin
  if Assigned(ClientModule1) then
    FreeAndNil(ClientModule1);

  if Assigned(SynchroThread) then
  begin
    if not SynchroThread.Terminated then
      SynchroThread.Terminate;

    SynchroThread := nil;
  end;

  if Assigned(frmDM) then
    FreeAndNil(frmDM);

  if Fwind <> nil then
    FreeAndNil(Fwind);

  DB := nil;
  PlugMobile := nil;
  pMalloc := nil;
  inherited;
end;

function TPluginMobile.FreePlug: HRESULT;
begin
  Fwind.Close;
  result := S_OK;
end;

function TPluginMobile.GetName(var Desc: PWideChar): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TPluginMobile.Init(ap: IPlugsApplication; TabH: HWND;
  ACliHandle: Pointer): HRESULT;
var
  AMsg: string;
begin
  if ap = nil then
  begin
    result := E_FAIL;
    Exit;
  end;

  Fwind := TfrmMobile.CreateP(TabH, ap);
  Fwind.top := 10;
  Fwind.left := 10;
  Fwind.show;

  result := S_OK;

  Fwind.GetWorkshopData(IsRegistered(ap.LicenseOwner, AMsg), AMsg);
end;

procedure TPluginMobile.Initialize;
begin
  //Tu tworzymy potrzebne elementy

  if not Assigned(frmDM) then
    Application.CreateForm(TfrmDM, frmDM);

  if DB = nil then
    DB := TDatabase.Create;

  if not Assigned(ClientModule1) then
    Application.CreateForm(TClientModule1, ClientModule1);

  if not Assigned(PlugMobile) then
    PlugMobile := TPluginMobile.Create;

  Fwind := nil;
  //IMalloc to wygodny interfejs do nawigacji pamiecia w interfejsach
  SHGetMalloc(pMalloc);
  inherited;
end;

function TPluginMobile.IsRegistered(AWorkshopName: string;
  out AMsg: string): TJSONObject;
var
  Crypt: ICrypt;
begin
  try
    Crypt := TCrypt.Create;
    try
      AWorkshopName := TIdEncoderMIME.EncodeString(AWorkshopName, IndyTextEncoding_UTF8);
      AWorkshopName := Crypt.EncodeX2000(AWorkshopName);

      Result := ClientModule1.ServerMethods1Client.IsRegistered(AWorkshopName, AMsg);
    finally
      Crypt := nil;
    end;
  except
    on e:exception do
    begin
      AMsg := 'RegisterWorkshop Exception' + #13#13 + AMsg;
    end;
  end;
end;

function TPluginMobile.RegisterWorkshop(AEncodedJSONstring: string;
  out AMsg: string): TJSONObject; stdcall;
var
  Crypt: ICrypt;
begin

  try
    Crypt := TCrypt.Create;
    try
      AEncodedJSONstring := TIdEncoderMIME.EncodeString(AEncodedJSONstring, IndyTextEncoding_UTF8);
      AEncodedJSONstring := Crypt.EncodeX2000(AEncodedJSONstring);

      Result := ClientModule1.ServerMethods1Client.RegisterWorkshop(AEncodedJSONstring, AMsg);
    finally
      Crypt := nil;
    end;
  except
    on e:exception do
    begin
      AMsg := 'RegisterWorkshop Exception' + #13#13 + e.Message;
    end;
  end;
end;

procedure TPluginMobile.StartSynchro(AWorkshopName: string);
var
  Crypt: ICrypt;
begin
  if not fWind.WorkshopRegistered then
    exit;

  Crypt := TCrypt.Create;

  if Assigned(SynchroThread) then
    if not SynchroThread.Terminated then
      SynchroThread.Terminate;

  try
    AWorkshopName := TIdEncoderMIME.EncodeString(AWorkshopName, IndyTextEncoding_UTF8);
    AWorkshopName := Crypt.EncodeX2000(AWorkshopName);

    SynchroThread := TMobileSynchro.Create(True); // utworz watek

    SynchroThread.WorkshopName := AWorkshopName;
    SynchroThread.FreeOnTerminate := True;
    SynchroThread.Resume;
  finally
    Crypt := nil;
  end;
end;

procedure TPluginMobile.StopSynchro;
begin
  if Assigned(SynchroThread) then
    if not SynchroThread.Terminated then
      SynchroThread.Terminate;
end;

procedure TPluginMobile.UnregisterWorkshop(AWorkshopName: string; out AMsg: string);
var
  Crypt: ICrypt;
begin
  Crypt := TCrypt.Create;
  try
    try
      AWorkshopName := TIdEncoderMIME.EncodeString(AWorkshopName, IndyTextEncoding_UTF8);
      AWorkshopName := Crypt.EncodeX2000(AWorkshopName);

      ClientModule1.ServerMethods1Client.UnregisterWorkshop(AWorkshopName, AMsg);
    finally
      Crypt := nil;
    end;
  except
    AMsg := 'Nie udało się wyrejestrować warsztatu!';
  end;
end;

{ TMobileSynchro }

destructor TMobileSynchro.Destroy;
begin
  FCriticalSection.Free;
  inherited;
end;

procedure TMobileSynchro.Execute;
var
  LDataSetList: TFDJSONDataSets;
  LDataSet: TFDDataSet;
begin
  FCriticalSection := TCriticalSection.Create;
  FCriticalSection.Acquire;
  while not Terminated do
  begin
    Sleep(SynchroDeelay);

    if not FConnecting and not Terminated then
    begin
      FConnecting := True;
      try
        try
          LDataSetList := ClientModule1.ServerMethods1Client.CheckForRequests(WorkshopName);
          LDataSet := TFDJSONDataSetsReader.GetListValueByName(LDataSetList, 'CheckForRequests');

          // Update UI
          TThread.Synchronize(nil, procedure
            begin
              frmDM.FDMemTable_NewVisits.IndexFieldNames := 'Nazwa_Warsztatu';
              frmDM.FDMemTable_NewVisits.Active := False;
              frmDM.FDMemTable_NewVisits.AppendData(LDataSet);
            end);

        except
          on e: exception do
          begin
            TThread.Synchronize(nil, procedure
              begin

              end);
          end;
        end;
      finally
        FConnecting := False;
      end;
    end;
  end;
  FCriticalSection.Release;
end;

type
  TMobileFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

procedure TMobileFactory.UpdateRegistry(Register: Boolean);
var
  ClassID: string;
begin
  if Register then
  begin
    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(CLSID_PluginMobile);
    with TRegistry.Create do
      try
        RootKey := HKEY_CURRENT_USER;
        OpenKey(szWtyczki + ClassID,True);
        CloseKey;
      finally
        Free;
      end;
  end
  else
  begin
     with TRegistry.Create do
       try
         RootKey := HKEY_CURRENT_USER;
         ClassID := GUIDToString(CLSID_PluginMobile);
         DeleteKey(szWtyczki + ClassID);
       finally
         Free;
       end;
    inherited UpdateRegistry(Register);
  end;
end;

initialization
  CoInitialize(nil);
  TMobileFactory.Create(ComServer, TPluginMobile, CLSID_PluginMobile, '',
    'Aplikacja Mobilna', ciMultiInstance, tmApartment);

finalization
  CoUnInitialize;

end.

access.png (62 KB) - ściągnięć: 94

edytowany 3x, ostatnio: user322 2017-01-16 14:38

Sadam2

2017-01-16 17:25

Sadam22017-01-16 17:25

A może by tak przenieść kod z Initialize do Init?

user322

2017-01-16 19:42

user3222017-01-16 19:42

Rejestracja:prawie 13 lat
Ostatnio:prawie 2 lata
Postów:196

Tak właśnie zrobiłem co prawda udało mi się to ogarnąć i błędu już nie ma, ale nie jestem pewny co do tego rozwiązania. Chciałbym to zrozumieć - w jaki sposób i kiedy mogę odwoływać się do interfejsu wtyczki IPlugMobile, skoro za każdym Create jest wywoływane Initialize

Sadam2

2017-01-17 05:53

Sadam22017-01-17 05:53

W moim Delphi jest:

Kopiuj

constructor TComObject.Create;
begin
  FNonCountedObject := True;
  CreateFromFactory(ComClassManager.GetFactoryFromClass(ClassType), nil);
end;

constructor TComObject.CreateAggregated(const Controller: IUnknown);
begin
  FNonCountedObject := True;
  CreateFromFactory(ComClassManager.GetFactoryFromClass(ClassType), Controller);
end;

constructor TComObject.CreateFromFactory(Factory: TComObjectFactory;
  const Controller: IUnknown);
begin
  FRefCount := 1;
  FFactory := Factory;
  FController := Pointer(Controller);
  if not FNonCountedObject then FFactory.ComServer.CountObject(True);
  Initialize;
  Dec(FRefCount);
end;

Czyli metoda Initialize jest wołana pośrednio z Create. A dokładnie, jak widać, z CreateFromFactory. Zobacz, jak jest w Twoim. W moim Delphi w metodzie Initialize jeszcze nie ma instancji tworzonego w Create obiektu. Czyli sprawdzenie, Assigned(PlugMobile) zwraca zawsze, że (jeszcze) nie.
Nigdy nie robiłem wtyczek. Nie miałem potrzeby. Ale gdybym musiał coś z tym zrobić, to spróbowałbym nadpisać ObjAddRef .

edytowany 1x, ostatnio: flowCRANE 2017-01-17 13:40

Liczba odpowiedzi na stronę

Zarejestruj się i dołącz do największej społeczności programistów w Polsce.

Otrzymaj wsparcie, dziel się wiedzą i rozwijaj swoje umiejętności z najlepszymi.

Utwórz konto

Biblioteka DLL (COM) z obsługą interfejsu

user322

Sadam2

user322

Sadam2

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami