ShellExtension & Instanzen

[RB]

Hallo,

ich habe eine ShellExtension programmiert die Daten in eine Datenbank importieren soll. Das ganze funktioniert auch schon sehr gut! Wenn ich aber diesen Aufruf ein zweites Mal starte dann scheint es so zu sein als wenn die erste Instanz gar nicht mehr aktiv ist. Ich kann Sie auch nicht beenden! Wie kann ich es erreichen das ich pro Aufruf der Extension eine eigene Instanz starte, oder ist das gar nicht möglich weil ich die ganzen Aufrufe von meiner permanent geladenen DLL (die ShellExtension) ausführe?

Danke für jeden Tipp!

Gruß Rb

[Andreas Kosch]

Hallo,

>Wie kann ich es erreichen das ich pro Aufruf der Extension eine eigene Instanz starte...

die Antwort auf diese Frage hängt davon ab, in welcher Konfiguration die Class Factory dieses COM-Objekts betrieben wird.
<pre>
<b>initialization</b>
TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
<font color="#9933CC">''</font>, <font color="#9933CC">'Delphi Context Menu Shell Extension Example'</font>, ciMultiInstance,
tmApartment);
</pre>
Der Eintrag <b>ciMultiInstance</b> bedeutet, dass jeder Aufrufer eine <b>neue</b> Objektinstanz bekommt, aber alle Objektinstanzen im gleichen Modul (DLL) ausgeführt werden. Somit teilen sich alle Instanzen die gleichen globalen Variablen, solange die DLL im Adressraum geladen bleibt.

&gt;Ich kann Sie auch nicht beenden!

Nur das COM-Subsystem ist für das Festlegen der Lebensdauer einer COM-Objektinstanz zuständig. Ein Objekt wird in der Regel immer dann automatisch abgeräumt, wenn der letzte Client seinen setzten Interface-Zeiger auf diese Objektinstanz freigibt.
&#10

[RB]

Hallo Herr Kosch,

danke für die Antwort. Ich habe es mit ciSingleInstance probiert und mir die ganze Geschichte auch noch mal in Ihrem Buch nachgelesen .

Leider führte das nicht zum Erfolg. Deswegen versuche ich es nochmal genauer zu beschreiben. Evtl. fällt Ihnen auf wo das Problem seien könnte.

<PRE>
function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
begin
Result := E_FAIL;

Try
{ Make sure we are not being called by an application }
if (HiWord(Integer(lpici.lpVerb)) <> 0) then
Exit;

if (LoWord(lpici.lpVerb) = 0) then { Extension #1 }
Begin
With TImportFile.Create do
Try
ImportFiles(False, FFileNames);
Result := NOERROR; { return correct result }
Finally
Free;
End;
End
Else
if (LoWord(lpici.lpVerb) = 1) then { Extension #2 }
Begin
With TImportFile.Create do
Try
ImportFiles(True, FFileNames);
Result := NOERROR; { return correct result }
Finally
Free;
End;
End
Else
Begin { Make sure we aren't being passed an invalid argument number }
Result := E_INVALIDARG;
Exit;
End;
Finally
FFileNames.Free;
End;
end;
</PRE>

TImportFiles ist das Objekt, das für das Importieren der Daten zuständig ist. TImportFiles ruft ein Fenster zur Anzeige mit einer Statusbar auf. Wenn ich jetzt den Import ein zweites Mal starte während der erste noch aktiv ist hört der erste Import sofort auf. Das ganze passiert sofort nachdem das "InvokeCommand" aufgerufen wird, selbst dann wenn noch nicht Mal eine Aktion durchgelaufen ist.

Lasse ich den zweiten Aufrufs des Imports durchlaufen dann gibt die Extension auf einmal 2 Mal alle Objekte frei. Hier noch der Quellcode der eigentlichen Import Prozedur.

<PRE>
procedure TImportFile.ImportFiles(Const cDoPlay: Boolean; FItemList: TStringList);

function IsFileAvailableInArchiv(Const cFileName: String): Integer;
begin
Result := -1;
Try
FTableMP3.IndexName := cPreIndex + 'V1Filename';

If FTableMP3.FindKey( [ cFileName ] ) then
Result := FTableMP3.FieldByName ( 'ID' ).AsInteger;
Finally
FTableMP3.IndexName := '';
End;
end;

function ImportFileAndResultID(Const cFileName: String): Integer;
Var
fFilePosID: Integer;
begin
fFilePosId := IsFileAvailableInArchiv(ExtractFileName(cFileName) );
Result := fFilePosID;

If (fFilePosID = -1) then
Begin
ImportOneFile(cFileName);
Result := FTableMP3.FieldByName( 'ID' ).AsInteger;
End;
end;

Var
fPlayID,
fResultID,
fValidItems,
i: Integer;
fM3LList : TStringList;
fFirst : Boolean;
Begin
If FDoNothing then
Exit;

fM3LList := TStringList.Create;
fFirst := True;
fPlayID := 0;
fValidItems := 0;
FGesamt := 0;

If NOT Assigned(FItemList) then
Exit;

Try
for i := 0 to FItemList.Count -1 do
if (ExtractFileExt(FItemList.Strings[i]) = cValidM3LExt) or
(ExtractFileExt(FItemList.Strings[i]) = cValidMP3Ext) then
inc(fValidItems);

FormImport := TFormImport.Create(nil);
FormImport.JvProgressBarGesamt.Max := fValidItems;
FTimer.Enabled := True;

for i := 0 to FItemList.Count -1 do
Begin
FormImport.JvProgressBarEinzel.Position := 0;
FormImport.JvProgressBarEinzel.Max := 1;

{ *.m3l Dateien sammeln }
If (Lowercase(ExtractFileExt(FItemList.Strings[i])) = cValidM3LExt) then
fM3LList.Add(FItemList.Strings[i]);

{ *.mp3 Dateien importieren }
If (Lowercase(ExtractFileExt(FItemList.Strings[i])) = cValidMP3Ext) then
Begin
FormImport.Caption := cShellExtStatusImport + ExtractFileName(FItemList.Strings[i]);
fResultID := ImportFileAndResultID(FItemList.Strings[i]);

If fFirst then
fPlayID := fResultID;

fFirst := False;

FormImport.JvProgressBarEinzel.StepIt;
FormImport.JvProgressBarGesamt.StepIt;
{ Nur dazu da um bei einen längeren Import den gesamten Status
einzutragen }
Inc(FGesamt);
ProcessMessages;
End;

If FormImport.fAbbrechen then
Break;
End;

{ *.m3l Dateien importieren }
for i := 0 to fM3LList.Count -1 do
Begin
FormImport.Caption := cShellExtStatusImport + ExtractFileName(fM3LList.Strings[i]);
ImportArchiv(fM3LList.Strings[i]);

If FormImport.fAbbrechen then
Break;

FormImport.JvProgressBarGesamt.StepIt;
End;
Finally
{ HINWEIS: Wenn der zweite Import durchgelaufen ist werden alle Variabeln des ersten Imports 2 mal freigegeben }

If Assigned(fM3LList) then
fM3LList.Free;

If Assigned(FormImport) then
FormImport.Release;

ClearDataBase;

If FormImport.fAbbrechen then
MessageDlg(cShellExtStatusCancel, mtError, [mbOK], 0)
Else
If cDoPlay then
Launcher(IncludeTrailingBackslash(GetInstallPath) + cExeFile, cPlay + cSpace + IntToStr(fPlayID))
Else
If ShowAppAfterImp then
Launcher(IncludeTrailingBackslash(GetInstallPath) + cExeFile, cImport + cSpace + IntToStr(fPlayID));

SendToWindow(IncludeTrailingBackslash(GetInstallPa th) + cExeFile, cRefresh);
End;
End;
</PRE>

Wie erreiche ich es nun das 2 Imports gleichzeitig laufen bzw. das 2 Instanzen völlig seperat von einander laufen?

Gruß Raine

[Andreas Kosch]

Hallo,

&gt;.. es mit ciSingleInstance probiert...

diese Einstellung ist bei einem In-Process-Server (als DLL verpacktes COM-Objekt) wirkungslos.

&gt;..ein zweites Mal starte während der erste noch aktiv ist hört der erste Import sofort auf..

Die Class Factory des COM-Objekts meldet über <b>tmApartment</b> ein STA (Singled-threaded Apartment) an. Somit werden beide Objektinstanzen im gleichen Thread ausgeführt - wobei aber immer nur ein Programmausführungspfad aktiv sein kann.

&gt;..Wie erreiche ich es nun das 2 Imports gleichzeitig laufen ..

In der Methode InvokeCommand muss für die "Nutzfunktion" (ImportFiles) ein neuer Thread abgespaltet werden, so dass die Methode InvokeCommand sofort an den Aufrufer zurückkehrt. Das STA gilt nur für die COM-Zugriffe über dieses Interface, der separate Thread muss daher völlig autonom sein

[RB]

Hallo Herr Kosch,

vielen Dank für Ihre Antwort!

Ich habe folgendes in InvokeCommand implementiert:

<PRE>
function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
begin
Result := E_FAIL;

Try
{ Make sure we are not being called by an application }
if (HiWord(Integer(lpici.lpVerb)) <> 0) then
Exit;

if (LoWord(lpici.lpVerb) = 0) then { Extension #1 }
Begin
With TMyWorkerThread.CreateMyThread(False, FFileNames) do
Begin
Result := NOERROR; { return correct result }
End;
End
Else
if (LoWord(lpici.lpVerb) = 1) then { Extension #2 }
Begin
With TMyWorkerThread.CreateMyThread(True, FFileNames) do
Begin
Result := NOERROR; { return correct result }
End;
End
Else
Begin { Make sure we aren't being passed an invalid argument number }
Result := E_INVALIDARG;
Exit;
End;
Finally
FFileNames.Free;
End;
end;
</PRE>

Der Thread (TMyWorkerThread) dazu sieht wie folgt aus:

<PRE>
TMyWorkerThread = class(TThread)
private
FDoPlay : Boolean;
FItems : TStringList;
protected
Procedure Execute; override;
public
Constructor CreateMyThread(Const cDoPlay: Boolean; FItemList: TStringList);
Destructor Destroy; override;
End;

constructor TMyWorkerThread.CreateMyThread(const cDoPlay: Boolean;
FItemList: TStringList);
Var
i : Integer;
begin
Inherited Create(True);
FreeOnTerminate := True;
FDoPlay := cDoPlay;
FItems := TStringList.Create;

for i := 0 to FItemList.Count -1 do { Items kopieren }
FItems.Add(FItemList.Strings[i]);
Suspended := False;
end;

destructor TMyWorkerThread.Destroy;
begin
FItems.Free;
inherited Destroy;
end;

procedure TMyWorkerThread.Execute;
Var
FInternalItems : TStringList;
i : Integer;
begin
FInternalItems := TStringList.Create;
Try
With TImportFile.Create do
Try
ImportFiles(FDoPlay, FITems);
Finally
Free;
End;
Finally
FInternalItems.Free;
End;
Terminate;
end;
</PRE>

Also ein Problem haben wir mit dem Thread gelöst. Es kommt nicht mehr zu einer Schutzverletzung wenn ich beide Fenster frei gegeben werden.

Allerdings habe ich immer noch das Problem das in ImportFiles ein Fenster erscheint. Dieses Fenster wird hat keine funktion mehr wenn ein weiters Mail InvokeCommand aufgerufen wird.
Ich habe ein Beispiel darüber <a href="http://www.speed-soft.de/shellext.htm" target="_blank">hier</a> abgelegt. Während des Imports greife ich auf zwei StatusBars zurück. Wenn ich InvokeCommand das zweite Mal aufrufe benutzt es auch definitiv das zweite Fenster. Ich sehe es daran das durch den ersten Aufruf die Statusbar fortgeschrittener ist als beim zweiten Aufruf von InvokeCommmand. Dadurch sieht man ein Flackern indem er zwischen den ersten und 2ten Import hin- und herspringt.

Habe Sie dazu noch eine Idee??

Gruß Raine

[Andreas Kosch]

Hallo,

die Methode <i>ImportFiles</i> wird in der TThread-Methode <i>Execute</i> aufgerufen (also im Kontext des neuen Threads). Und in <i>ImportFiles</i> wird die Formular-Instanz über <i>FormImport := TFormImport.Create(nil);</i> erzeugt. Somit ist der separate Thread dafür zuständig, dass die Botschaftswarteschlange für diesen Thread regelmässig ausgelesen wird. Die VCL-Methode <i>ProcessMessages</i> kümmert sich nur um den primären Thread der VCL.

Ich befürchte, dass man erst dann ein sauberes Verhalten erreicht, wenn die Fenster nicht über die VCL, sondern nur direkt über die nativen API-Funktionen erzeugt werden und die TThread-Methode Execute in einer Schleife die Botschaftswarteschlange ausliest.

Oder das Fenster wird nicht in Execute, sondern in Create (also noch im Kontext des primären Threads) erzeugt. Die Threads schicken dann ihre Status-Informationen über die Win32-API-Funktion <i>PostThreadMessage</i> zum primären Thread der VCL, damit dort die Benutzeroberfläche den aktuellen Stand anzeigt.

&#10

[RB]

Hallo Herr Kosch,

danke für Ihre Antwort.

Die Methode ProcessMessages ist keine direkte VCL Methode. Sie sieht wie folgt aus:

<PRE>
procedure TImportFile.ProcessMessages;
Var
Msg : TMsg;
begin
While PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
</PRE>

Ich musste sie selber schreiben da ProcessMessage das TApplication Objekt benötigt. Leider gibt es das bei dem COM Objekt nicht bzw. ich sehe da im Moment keine Möglichkeit es anders zu gestalten. Liegt das Problem evtl. direkt an "meiner" ProcessMessage Methode?

Gruß Raine