Serveur et client en COM

Bonjour a tous

Je suis coincé sur un problème.
J'ai un serveur COM ecrit par un tiers en C dont je n'ai pas le code source (clarity.exe) qui me renvoie des informations meteorologiques.

j'ai ecrit un client COM, en generant le fichier TLB du clarity.exe, ce client (client_clarity.exe) marche tres bien, et questionne ce serveur COM dans un thread separé (grace a Coinitialize..)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Procedure TSchedBoltonCloudMonitor.Execute;
begin
  Try
  CoInitialize(nil);
 
  Try
  CloudSensor:=CoCloudSensor.create;
 
  While not Terminated do
  begin
 
   If Not Terminated then
   begin
    BoltonClMon.SkyState       :=TSkyState(CloudSensor.SkyCondition);
    BoltonClMon.LastInformation:=Now-CloudSensor.SecondsSinceGoodData/(3600*24);
 
    BoltonClMon.AmbiantTemp    :=CloudSensor.AmbientT;
    BoltonClMon.SkyTemp        :=CloudSensor.RelSkyT;
    BoltonClMon.SensorTemp     :=CloudSensor.SensorT;
   end;
 
   Event.WaitFor(INFINITE); // Attend le trig du timer!
   Event.ResetEvent;
 
   PostMessage(Form1.Handle,WM_TEST,0,0);
  end;
 
  CloudSensor:=Nil;
  Except
   On E:Exception do
   begin
    ErrorMessage:=E.Message;
    PostMessage(Form1.Handle,WM_ERR,0,0);
  end;
  End;
  Finally
  CoUnInitialize;
  End;
end;

Il récupère les valeurs de l'objet COM clarity.exe, ca marche TRES bien.

Maintenant, je voudrais faire un simulateur serveur en substituant le clarity.exe en C avec mon clarity.exe a moi en ecrit delphi.

La aussi je cree le TLB en fonction du TLB généré et je me suis aidé de l'utilitaire TLBview.exe qui aide bien a "documenter" l'interface du serveur.

Je lance mon serveur en delphi et il marche très bien avec un bête script en visual basic :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
dim TestCOM
 
set TestCOM = CreateObject("Clarity.CloudSensor")
 
msgbox TestCOM.SkyCondition  
msgbox TestCOM.RelSkyT       
msgbox TestCOM.AmbientT      
msgbox TestCOM.SensorT       
msgbox TestCOM.WetF          
msgbox TestCOM.HeatingF      
msgbox TestCOM.HeaterPercent 
msgbox TestCOM.CloudyThreshT 
msgbox TestCOM.VCloudyThreshT
msgbox TestCOM.Fahrenheit    
msgbox TestCOM.SecondsSinceGoodData

Par contre il ne marche plus avec mon soft client !!

Il me met le message sibyllin : "Interface not supported" alors que mon soft client marche tres bien avec le serveur d'origine !

J'ai passé pas mal de temps dessus, et je me doute que c'est qq chose lié au fait que l'interrogation ne se passe pas dans le thread principal (?) de mon appli client...

Merci de votre aide, je suis pres a passer tout les codes sources de mes projets je suis siys Delphi2007 win32.

--------------------------------------------------------------

Voici le source du serveur que j'ai écrit

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
unit Interface_Clarity;
 
{$WARN SYMBOL_PLATFORM OFF}
 
interface
 
uses
  ComObj, ActiveX, Clarity_TLB, StdVcl,Cloudsensor_vars;
 
type
  TCloudSensor = class(TAutoObject,_CloudSensor)
  protected
    function Get_RelSkyT(out Value: Double): HResult; stdcall;
    function Get_SkyCondition(out Value: SkyCond): HResult; stdcall;
    function Get_AmbientT(out Value: Double): HResult; stdcall;
    function Get_HeatingF(out Value: WordBool): HResult; stdcall;
    function Get_SensorT(out Value: Double): HResult; stdcall;
    function Get_WetF(out Value: WordBool): HResult; stdcall;
    function Get_HeaterPercent(out Value: Double): HResult; stdcall;
    function Get_CloudyThreshT(out Value: Double): HResult; stdcall;
    function Get_VCloudyThreshT(out Value: Double): HResult; stdcall;
    function Get_Fahrenheit(out Value: WordBool): HResult; stdcall;
    function Get_SecondsSinceGoodData(out Value: Integer): HResult; stdcall;
  end;
 
TAutoObjectFactoryEnhanced = class(TAutoObjectFactory)
  public
  procedure UpdateRegistry(Register: Boolean); override;
end;
 
Var AutoObjectFactoryEnhanced:TAutoObjectFactoryEnhanced;
 
implementation
 
uses ComServ,SysUtils;
 
function TCloudSensor.Get_RelSkyT(out Value: Double): HResult;
begin
  Result:=CloudSensorVars.RelSkyT;
end;
 
function TCloudSensor.Get_SkyCondition(out Value: SkyCond): HResult;
begin
  Result:=CloudSensorVars.SkyCondition;
end;
 
function TCloudSensor.Get_AmbientT(out Value: Double): HResult;
begin
  result:=CloudSensorVars.AmbientT;
end;
 
 
function TCloudSensor.Get_SensorT(out Value: Double): HResult;
begin
  result:=CloudSensorVars.SensorT;
end;
 
function TCloudSensor.Get_WetF(out Value: WordBool): HResult;
begin
  result:=CloudSensorVars.WetF;
end;
 
function TCloudSensor.Get_HeatingF(out Value: WordBool): HResult;
Begin
 result:=CloudSensorVars.HeatingF;
End;
 
function TCloudSensor.Get_HeaterPercent(out Value: Double): HResult;
Begin
 result:=CloudSensorVars.HeaterPercent;
End;
 
function TCloudSensor.Get_CloudyThreshT(out Value: Double): HResult;
Begin
 result:=CloudSensorVars.CloudyThreshT;
End;
 
function TCloudSensor.Get_VCloudyThreshT(out Value: Double): HResult;
Begin
 result:=CloudSensorVars.VCloudyThreshT;
End;
 
function TCloudSensor.Get_Fahrenheit(out Value: WordBool): HResult;
Begin
 result:=CloudSensorVars.Fahrenheit;
End;
 
function TCloudSensor.Get_SecondsSinceGoodData(
  out Value: Integer): HResult;
Begin
 result:=CloudSensorVars.SecondsSinceGoodData;
End;
 
//--------------------------
 
procedure TAutoObjectFactoryEnhanced.UpdateRegistry(Register: Boolean);
const ValueName = 'DateRegistered';
 
begin
   inherited;
   if register then
      CreateRegKey(ProgID, ValueName, DateTimeToStr(Now));
end;
 
 
 
initialization
 
  AutoObjectFactoryEnhanced:=
    TAutoObjectFactoryEnhanced.Create(ComServer, TCloudSensor, Class_CloudSensor,
                                      ciMultiInstance, tmApartment);
 
  AutoObjectFactoryEnhanced.UpdateRegistry(True);
 
end.