Form in ActiveX-Exe verbraucht 100% CPU-Zeit

[Carsten Bartholomae]

Hallo,
ich möchte in einer EXE-Datei ein Automatisierungsobject: Maske mit den Methoden SHow und Close zur Verfügung stellen.
Show zeit eine Form an (modeless) solange bis Sie explicit mit Close wieder geschlossen wird. Das alles klappr soweit ganz gut bis auf zwei Probleme:

1.)Exe-Datei wird in WInNT/Taskbar angezeigt
2.)Angezeigte Form verbaucht 100% CPU-Zeit.
Was mache ich Falsch ???

[Andreas Kosch]

Hallo,

zu 1. <br>
Das ist das normale Verhalten, wenn ein Automation-Server eine sichtbare Benutzeroberfläche hat.

zu 2. <br>
Das ist nicht normal - wie sieht die CPU-Auslastung aus, wenn die EXE regulär gestartet wird (und nicht als Automation-Server)? Wird dort das Ereignis <b>OnIdle</b> ausgewertet oder wird dort in einer Schleife etc. <b>ProcessMessages</b> aufgerufen

Was ich möchte ich folgendes: Ich möchte mit VB_Skript eine Form anzeigen lassen, irgendwas tun, dann wenn fertig Form wieder schliessen. Damit das geht muss ich modeless Forms verwenden.
Also Anwendung erzeugt, Automation Object hinzugefügt, eine Form hinzugefügt. im Projektsource, ShowMainForm=False, 2 Methoden in TypeLibrary erstellt: Show Close. Es soll nichts in der TaskLeiste zu sehen sein.
Ich mache nur Form := TForm.Create(Application); und Form.Show.
Ist das falsch, muss ich sonst noch was beachten ?

[Andreas Kosch]

Hallo,

warum muss das dann in einer EXE sein? Wenn nur das Formular benötigt wird, würde ich das in einen In-Process-Server (DLL) packen. Um die Anzeige in der Taskleiste zu unterdrücken, kann man dann folgendes machen:

a) <b>CreateParams</b> überschreiben: Params.ExStyle := WS_EX_PALETTEWINDOW sorgt dafür, dass die Fensterzeile eine kleinere Schriftart verwendet, das Systemmenü fehlt und das Fenster nicht in der Taskleiste aufgeführt wird. Außerdem bleibt der einmal aufgerufene Dialog bis zum Schließen immer StayOnTop (d.h. er wird von keinem anderen Fenster überdeckt).

b) <b>Application.Handle := hWndParent</b>-Parameter sorgt dafür, dass der modale Dialog wie ein normales Delphi-Formular aussieht, aber trotzdem nicht als Icon in der Taskleiste aufgeführt wird.

<pre>
unit FrmInCOMSrv_Impl;

interface

uses
ComObj, ActiveX, FrmInCOMSrv_TLB;

type
TFrmSrv = class(TAutoObject, IFrmSrv)
protected
procedure ShowForm(hWndParent: Integer); safecall;
procedure ShowFormResult(const MsgText: WideString;
out UserText: WideString); safecall;
{ Protected-Deklarationen }
end;

implementation

uses ComServ, FrmInCOMSrv_Frm, FrmInCOMSrv_Frm2, Controls, Windows, Forms;

procedure TFrmSrv.ShowForm(hWndParent: Integer);
begin
Application.Handle := hWndParent;
FormSrvDlg := TFormSrvDlg.Create(nil);
try
FormSrvDlg.ShowModal;
finally
FormSrvDlg.Release
end;
end;

procedure TFrmSrv.ShowFormResult(const MsgText: WideString;
out UserText: WideString);
begin
UserText := '(kein Kommentar)';
FormSrvDlg2 := TFormSrvDlg2.Create(nil);
try
if FormSrvDlg2.ShowModal = mrOK
then UserText := FormSrvDlg2.EditUserText.Text;
finally
FormSrvDlg2.Release
end;
end;

initialization
TAutoObjectFactory.Create(ComServer, TFrmSrv, Class_FrmSrv,
ciMultiInstance, tmApartment);
end.
</pre>
Die Formular-Unit sieht so aus:
<pre>
unit FrmInCOMSrv_Frm2;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, Buttons;

type
TFormSrvDlg2 = class(TForm)
StatusBarSrv2: TStatusBar;
Label1: TLabel;
EditUserText: TEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
procedure CreateParams(var Params: TCreateParams); override;
end;

var
FormSrvDlg2: TFormSrvDlg2;

implementation

{$R *.DFM}

{ TFormSrv2 }

procedure TFormSrvDlg2.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := WS_EX_PALETTEWINDOW;
end;

end.
</pre&gt

[Carsten Bartholomae]

Nach Form.Show habe ich mit showwindow das Fenster in der Taskbar abschalten können. Trotzdem bleibt immer noch die hohe CPU-Auslastung ~100% vom Anzeigen der Form bis zum Beenden der Form.
Gibt es eine Methode eine Form anzeigen zu lassen (modeless, damit andere Fesnter, wie z.B festplattenmanager benutzbar sind) ohne das die gesamte CPU-Zeit benötigt wird anzuzeigen ?

[Carsten Bartholomae]

Hallo, mein OLE-Automatisierungsobject ist eine Single Instance, kann das mein Problem sein ?

[Andreas Kosch]

Hallo,

nein - an Single Instance kann das nicht liegen. Ich habe bei meinem o.g. Beispiel die CPU-Auslastung kontrolliert, hier tritt der Effekt nicht auf. Ich würde daher zum Test den Show-Aufruf durch ShowModal austauschen. Wenn dann das Problem verschwindet, schaue ich mir das Ganze einmal selbst an, indem ich mein Beispiel auf Show umbaue (momentan bin ich anderweitig ausgelastet)

[Carsten Bartholomae]

Hallo,
wirklich, bei der Verwendung von Showmodal statt show ging die CPU-Last nach unten.
OS=Windows2000 Server
Startart Windows scriptinghost 2.

[Carsten Bartholomae]

WSH-Skript:
REM ----------------------------------------------------------------------------------------
REM Konstanten definieren
REM ----------------------------------------------------------------------------------------
Const ForReading = 1, ForWriting =2, ForAppending = 8
Const Paketname = "BASIS-Ueberwachung"
Const Version = "1.0"

REM ----------------------------------------------------------------------------------------
REM SHELL-Variable definieren
REM ----------------------------------------------------------------------------------------
Dim Shell 'Shell-Variable
Dim filesys 'Filesystem-Variable
Dim Protokoll, Error 'Alias-Namen
Dim LogDatei, ErrDatei
Dim Restart 'Arbeitsvariable
Dim geoeffnet 'Indikator ob Fehlerlog geoeffnet wurde
Dim Fehlerwert 'Indikator ob ein Fehler aufgetreten ist
Dim FehlerText 'Auszugebener Fehlertext
Dim Ist, Key, Wert, Typ 'Variable zum Ueberpruefen auf richtiges Schreiben in Registry
Dim MyDate, MyTime 'Variablen zum Datum und Uhrzeit
Dim Location, sLocation 'Pfad
Dim REG

REM ----------------------------------------------------------------------------------------
REM Shell-Objekt erzeugen
REM ----------------------------------------------------------------------------------------
Set Shell = WScript.CreateObject("WScript.Shell")
Set Dialog = WScript.CreateObject("UAS.GUI") 'Objekt für Anzeige

text = "01234567890123456789012345678901234567890"
Dialog.Show "testskript.vbs","1.0",text

for i = 1 to 12000000
next

Dialog.clos

[Carsten Bartholomae]

Projektdatei:
program uas;

uses
windows, Forms,
Unit1 in 'Unit1.pas' {Form1},
uas_TLB in 'uas_TLB.pas',
Unit2 in 'Unit2.pas' {gui: CoClass},
Unit3 in 'Unit3.pas' {Form3};

{$R *.TLB}

{$R *.RES}

begin
Application.Initialize;
Application.ShowMainForm := False;
Application.CreateForm(TForm1, Form1);
Application.Run;
end

[Carsten Bartholomae]

program uas;

uses
windows, Forms,
Unit1 in 'Unit1.pas' {Form1},
uas_TLB in 'uas_TLB.pas',
Unit2 in 'Unit2.pas' {gui: CoClass},
Unit3 in 'Unit3.pas' {Form3};

{$R *.TLB}

{$R *.RES}

begin
Application.Initialize;
Application.ShowMainForm := False;
Application.CreateForm(TForm1, Form1);
Application.Run;
end

[Carsten Bartholomae]

Unit1: Standard
Unit2:
unit Unit2;

interface

uses
ComObj, ActiveX, uas_TLB, StdVcl;

type
Tgui = class(TAutoObject, Igui)
protected
procedure close; safecall;
procedure show(Skript, Version, Text: OleVariant); safecall;
{ Protected declarations }

end;

implementation

uses windows,Forms, ComServ,Unit3,Unit1,Registry;

procedure Tgui.close;
begin
Form3.Free;
end;

procedure Tgui.show(Skript, Version, Text: OleVariant);
Var Reg:TRegistry;
Key,mVersion:String;
begin
Form3 := Tform3.Create(Nil);
// Ab hier wird der Screen parametrisiert
Reg := TRegistry.Create;
Reg.Rootkey := HKEY_LOCAL_MACHINE;
If Reg.KeyExists('SOFTWARE\UAS') then
begin
Reg.Openkey('Software\UAS',False);
If Reg.ValueExists('sBaseKey') then
begin
Key := Reg.ReadString('sBaseKey');
Reg.CloseKey;
Reg.Openkey(Key,False);
If Reg.ValueExists('Version') then
begin
mVersion := Reg.ReadString('Version');
end
else mVersion := 'Unbekannt';
end
else mVersion := 'Unbekannt';
end
else mVersion := 'Unbekannt';
Reg.Free;
Form3.Caption := mVersion;
Form3.Panel3.Caption := text;
Form3.Hint := Skript+'('+Version+')';
Form3.show;
ShowWindow(Application.Handle,SW_HIDE);
Application.ProcessMessages;
end;

initialization
TAutoObjectFactory.Create(ComServer, Tgui, Class_gui,
ciSingleInstance, tmApartment);
end

[Carsten Bartholomae]

unit3:
unit Unit3;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
jpeg, ExtCtrls, StdCtrls, ComCtrls;

type
TForm3 = class(TForm)
Image1: TImage;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form3: TForm3;

implementation

{$R *.DFM}

procedure TForm3.FormShow(Sender: TObject);
begin
Application.ProcessMessages;
end;

end

[Andreas Kosch]

Hallo,

wenn ShowModal das Problem beseitigt, wird der VCL-interne Mechanismus für das Auslesen der Botschafts-Warteschlange (Message Loop) der Grund für diese hohe CPU-Last sein. Man kann das jederzeit in einer normalen Anwendung simulieren, indem in einer Schleife ständig <b>Application.ProcessMessages</B> aufgerufen wird. Auch hier geht die CPU-Last hoch, da ständig "unnötige" Arbeiten erledigt werden. Da ich zur Zeit auf der Entwickler-Konferenz bin, wird es aber noch eine Woche dauern, bis ich mir den VCL-internen Unterschied zwischen Show und ShowModal anschauen kann. Bisher habe ich in derartigen Fällen die Aufrufe von Application.ProcessMessages durch <b>GetMessage</b> ersetzt (also so wie das ganz früher üblich war, ist aber mit Aufwand verbunden)

[Carsten Bartholomae]

<p>REM ----------------------------------------------------------------------------------------<br>
REM Konstanten definieren<br>
REM ----------------------------------------------------------------------------------------<br>
Const ForReading = 1, ForWriting =2, ForAppending = 8<br>
Const Paketname = "BASIS-Ueberwachung"<br>
Const Version = "1.0"<br>
<br>
REM ----------------------------------------------------------------------------------------<br>
REM SHELL-Variable definieren<br>
REM ----------------------------------------------------------------------------------------<br>
Dim Shell 'Shell-Variable<br>
Dim filesys 'Filesystem-Variable<br>
Dim Protokoll, Error 'Alias-Namen<br>
Dim LogDatei, ErrDatei&nbsp;<br>
Dim Restart 'Arbeitsvariable<br>
Dim geoeffnet 'Indikator ob Fehlerlog geoeffnet wurde<br>
Dim Fehlerwert 'Indikator ob ein Fehler aufgetreten ist<br>
Dim FehlerText 'Auszugebener Fehlertext<br>
Dim Ist, Key, Wert, Typ 'Variable zum Ueberpruefen auf richtiges Schreiben in Registry<br>
Dim MyDate, MyTime 'Variablen zum Datum und Uhrzeit<br>
Dim Location, sLocation 'Pfad<br>
Dim REG<br>
<br>
REM ----------------------------------------------------------------------------------------<br>
REM Shell-Objekt erzeugen<br>
REM ----------------------------------------------------------------------------------------<br>
Set Shell = WScript.CreateObject("WScript.Shell")<br>
Set Dialog = WScript.CreateObject("UAS.GUI") 'Objekt für Anzeige<br>
<br>
text = "01234567890123456789012345678901234567890"<br >
Dialog.Show "testskript.vbs","1.0",text<br>
<br>
for i = 1 to 12000000<br>
next<br>
<br>
<br>
Dialog.close</p>
<p>&nbsp;</p>
<p>dpr:</p>
<p>program uas;<br>
<br>
uses<br>
windows, Forms,<br>
Unit1 in 'Unit1.pas' {Form1},<br>
uas_TLB in 'uas_TLB.pas',<br>
Unit2 in 'Unit2.pas' {gui: CoClass},<br>
Unit3 in 'Unit3.pas' {Form3};<br>
<br>
{$R *.TLB}<br>
<br>
{$R *.RES}<br>
<br>
begin<br>
Application.Initialize;<br>
Application.ShowMainForm := False;<br>
Application.CreateForm(TForm1, Form1);<br>
Application.Run;<br>
end.<br>
</p>
<p>unit1:</p>
<p>unit Unit1;<br>
<br>
interface<br>
<br>
uses<br>
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;<br>
<br>
type<br>
TForm1 = class(TForm)<br>
private<br>
{ Private declarations }<br>
public<br>
{ Public declarations }<br>
end;<br>
<br>
var<br>
Form1: TForm1;<br>
<br>
implementation<br>
<br>
{$R *.DFM}<br>
<br>
<br>
<br>
end.<br>
</p>
<p>unit2:</p>
<p>unit Unit2;<br>
<br>
interface<br>
<br>
uses<br>
ComObj, ActiveX, uas_TLB, StdVcl;<br>
<br>
type<br>
Tgui = class(TAutoObject, Igui)<br>
protected<br>
procedure close; safecall;<br>
procedure show(Skript, Version, Text: OleVariant); safecall;<br>
{ Protected declarations }<br>
<br>
end;<br>
<br>
implementation<br>
<br>
uses windows,Forms, ComServ,Unit3,Unit1,Registry;<br>
<br>
procedure Tgui.close;<br>
begin<br>
Form3.Free;<br>
end;<br>
<br>
procedure Tgui.show(Skript, Version, Text: OleVariant);<br>
Var Reg:TRegistry;<br>
Key,mVersion:String;<br>
begin<br>
Form3 := Tform3.Create(Nil);<br>
// Ab hier wird der Screen parametrisiert<br>
Reg := TRegistry.Create;<br>
Reg.Rootkey := HKEY_LOCAL_MACHINE;<br>
If Reg.KeyExists('SOFTWARE\UAS') then<br>
begin<br>
Reg.Openkey('Software\UAS',False);<br>
If Reg.ValueExists('sBaseKey') then<br>
begin<br>
Key := Reg.ReadString('sBaseKey');<br>
Reg.CloseKey;<br>
Reg.Openkey(Key,False);<br>
If Reg.ValueExists('Version') then<br>
begin<br>
mVersion := Reg.ReadString