DCOM og TThread

har du et com object for klient på serveren?

Kan du bruge oplysningerne her:

http://www.borland.com/techpubs/delphi/delphi5/dg/threads.html

/per

her er en udemærket artikel om Multithreading og com: http://www.thedelphimagazine.com/samples/comthread/comthreading.htm

For at undgå problemet kan du vel bare lave et event der kaldes når tråden er færdig med requestet, og så lade hovedtråden sende det til klienten. Jeg kan forestille mig at det er hovedtråden der opretter klientobjekterne, og det er det der er problemet, da man ikke umidelbart kan bruge et comobject der er oprettet i en anden tråd.

Endnu et godt link:

http://des.tstu.ru/ftp/pub/mirror/Doc/Internet/nps.vnet.ee/ftp/Docs/Delphi/D5/dg/buildap.html

/per

com objektet på serversiden, modtager en instans af en

TU_klient = class(TAutoIntfObject, IU_klient) som instantieres på klienten....

via Connect

serveren

TU_server = class(TAutoObject, IU_server)
private
    FKlient:IU_klient;
protected
    procedure Funktion(nr: Integer; data: PChar); safecall;
    procedure Connect(const U_klient: IU_klient); safecall;
  public
    property Klient:TDCOMKlient read FKlient write FKlient;
end;

Er det bedre at bruge blocking sockets?

nico22, hvafor et event? Hvis jeg skal aktivere hoved (windows tråden) fra min arbejds tråde bliver det vel gennbem in windowsmessage?

På forhånd tak.....

Uhhh, det skulle være

property Klient:IU_klient read FKlient write FKlient;

det jeg mente var at du kunne lave dit eget event f.eks.

type
  TMyEvent = procedure (Sender: TObject; const Param1, Param2: string) of object;

TMyThread = class(TThread)
private
  FOnMyEvent: TMyEvent;
  procedure DoEvent;
protected
  procedure Execute; override;
public
  property OnMyEvent: TMyEvent read FOnMyEvent write FOnMyEvent;
end;

procedure TMyThread.Execute;
begin
  Synchronize(DoEvent);
end;

procedure TMyThread.DoEvent;
begin
  if Assigned(FOnMyEvent) then
    FOnMyEvent(Self, \'test\', \'et eller andet\');
end;

men det virker ikke, da man ikke bare lige kan kalde et com object i en anden tråd

Her er der beskrevet en fornuftig løsning:

http://www.eksperten.dk/spm/58612

/per

Her er et eksempel

Client:

unit ClientMain;

interface

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

type
  TCallback = class(TAutoIntfObject, ICallback)
  protected
    procedure Reply(const Str: WideString); safecall;
  public
    constructor Create;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FTest: ITestThread;
    Cb: TCallback;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  ActiveX;

{$R *.DFM}

constructor TCallback.Create;
var
  ifTypeLib: ITypeLib;
begin
  OleCheck(LoadRegTypeLib(LIBID_ComThread, 1, 0, 0, ifTypeLib));
  inherited Create(ifTypeLib, ICallback);

  _AddRef;
end;

procedure TCallback.Reply(const Str: WideString);
begin
  ShowMessage(Str);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CB := TCallback.Create;
  FTest := CoTestThread.Create;
  FTest.Connect(CB as ICallback);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FTest.Spawn;
end;

end.



Server:

unit CTImpl;

interface

uses
  ComObj, ActiveX, ComThread_TLB, Classes;

type
  TDoneEvent = procedure (const Str: string) of object;

  TRequest = class(TThread)
  private
    FStr: string;
    FStream: IStream;
    procedure DoDone;
  protected
    procedure Execute; override;
  public
    constructor Create(hGlob: Cardinal);
  end;

  TTestThread = class(TAutoObject, ITestThread)
  private
    FCallback: ICallback;
  protected
    procedure Connect(const Callback: ICallback); safecall;
    procedure Spawn; safecall;
    procedure Reply(const str: WideString); safecall;
    { Protected declarations }
  end;

implementation

uses ComServ;

constructor TRequest.Create(hGlob: Cardinal);
begin
  inherited Create(True);
  OleCheck(CreateStreamOnHGlobal(hGlob, False, FStream));
end;

procedure TRequest.Execute;
begin
  FreeOnTerminate := True;
  FStr := \'Test\';
  DoDone;
end;

procedure TRequest.DoDone;
var
  Test: ITestThread;
begin
  OleCheck(ComObj.CoInitializeEx(nil, COINIT_MULTITHREADED));
  OleCheck(CoUnmarshalInterface(FStream, ITestThread, Test));

  Test.Reply(FStr);

  CoUninitialize;
end;

procedure TTestThread.Connect(const Callback: ICallback);
begin
  FCallback := Callback;
end;

procedure TTestThread.Spawn;
var
  Stream: IStream;
  hGlob: Cardinal;
begin
  OleCheck(CreateStreamOnHGlobal(0, False, Stream));

  OleCheck(CoMarshalInterface(Stream, ITestThread, Self as IUnknown,
          MSHCTX_DIFFERENTMACHINE, nil, MSHLFLAGS_NORMAL));

  OleCheck(GetHGlobalFromStream(Stream, hGlob));
  Stream := nil;

  with TRequest.Create(hGlob) do
    Resume;
end;

procedure TTestThread.Reply(const str: WideString);
begin
  FCallback.Reply(Str);
end;

initialization
  TAutoObjectFactory.Create(ComServer, TTestThread, Class_TestThread,
    ciMultiInstance, tmFree);
end.


Type Library

unit ComThread_TLB;

interface

uses Windows, ActiveX, Classes, Graphics, OleCtrls, StdVCL;

const
  LIBID_ComThread: TGUID = \'{90ED84AB-1798-4501-ADD4-F6506F524BE5}\';
  IID_ITestThread: TGUID = \'{9BCD6521-6457-4B89-A1CF-7A9260EDD8ED}\';
  CLASS_TestThread: TGUID = \'{DC3BE869-3174-4023-B376-8E221C7C6600}\';
  IID_ICallback: TGUID = \'{849381EE-63B5-4BBD-9CD4-C74D09FBBEA7}\';
type

  ITestThread = interface;
  ITestThreadDisp = dispinterface;
  ICallback = interface;
  ICallbackDisp = dispinterface;

  TestThread = ITestThread;

  ITestThread = interface(IDispatch)
    [\'{9BCD6521-6457-4B89-A1CF-7A9260EDD8ED}\']
    procedure Spawn; safecall;
    procedure Connect(const Callback: ICallback); safecall;
    procedure Reply(const str: WideString); safecall;
  end;

  ITestThreadDisp = dispinterface
    [\'{9BCD6521-6457-4B89-A1CF-7A9260EDD8ED}\']
    procedure Spawn; dispid 1;
    procedure Connect(const Callback: ICallback); dispid 2;
    procedure Reply(const str: WideString); dispid 3;
  end;

  ICallback = interface(IUnknown)
    [\'{849381EE-63B5-4BBD-9CD4-C74D09FBBEA7}\']
    procedure Reply(const Str: WideString); safecall;
  end;

  ICallbackDisp = dispinterface
    [\'{849381EE-63B5-4BBD-9CD4-C74D09FBBEA7}\']
    procedure Reply(const Str: WideString); dispid 1;
  end;

  CoTestThread = class
    class function Create: ITestThread;
    class function CreateRemote(const MachineName: string): ITestThread;
  end;

implementation

uses ComObj;

class function CoTestThread.Create: ITestThread;
begin
  Result := CreateComObject(CLASS_TestThread) as ITestThread;
end;

class function CoTestThread.CreateRemote(const MachineName: string): ITestThread;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_TestThread) as ITestThread;
end;

end.

hoejrup>>Dette eksempel kan ikke bruges som det er, da der tale om multithreading, hvilket er et mareridt at have med at gøre i com sammenhæng. Ovenstående eksempel viser hvordan man kan kalde en metode på et com object i en anden tråd, ved kalde CoInitializeEx, og marshalle interfacet. Desuden skal threading model sættes til Free

Det ser godt ud nico22, jeg laver lige nogle forsøg....

Mht.

http://www.thedelphimagazine.com/samples/comthread/comthreading.htm#Delphi4AndCoInitFlags

skal jeg så placerere

CoInitFlags := COINIT_MULTITHREADED

før
Appliation.Initialize? Jeg bruger delphi 4.

/vender tilbage

I dettte eksempel har jeg ikke brugt CoInitFlags, og jeg ved ikke om det gør nogen forskel? men jeg forstår det sådan at den skal stå før initialize. For øvrigt har jeg ikke haft mulighed for at teste eksemplet med DCom, men det burde stadig virke - held og lykke med det.

CoInitFlags bliver automatisk sat til COINIT_MULTITHREADED, hvis din threading model er free eller both

nico,

Løsningen er lidt eksotisk men virker upåklageligt, så pointene skulle være hjemme.

Mht. til spørgsmål nummer to, kan nogen hjælpe?

På for hånd tak

du kan bruge SendMessage til at sende en besked

feks.

type
  WM_MYMESSAGE = WM_USER + 1;

type
  TMyClass = class
  private
    procedure MyMessage(var Message: TMessage); message WM_MYMESSAGE;


....

procedure TMyClass.EtEllerAndet...
begin
  SendMessage(Handle, MY_MESSAGE, 0, 0);
end;

procedure TMyClass.MyMessage(var Message: TMessage);
begin
  //kode
end;