USB - Autostart dynamisch unterbinden

[Alter Mann]

Hallo Schwedenbitter,

zwei Fragen seien gestattet:

Betriebssystem und Delphi-Version?

Das ganze wurde damals für D7 geschrieben.

Gruß

[Schwedenbitter]

@Alter Mann

Zitat von Alter Mann:

Betriebssystem und Delphi-Version?

Die Rechner laufen alle mit Win XP Prof. und ich nutze TurboDelphi.

Ich habe es jetzt - Dank Deiner Hilfe - tatsächlich geschafft, dass WMDeviceChange wegzurationalisieren und alles aus "WndProc" heraus zu erledigen. Case klappt leider nicht, weil WM_AutoPlay keine Konstante ist. Da meckert bei mir der Compiler. Aber das lässt sich ja lösen:

Delphi-Quellcode:

Type
   TForm1            = Class(TForm)
                              CheckListBox1   : TCheckListBox;
                              Label1         : TLabel;
                              Procedure ReadRoot;
                              Procedure FormCreate(Sender: TObject);
                           Private
                              Procedure WMHandleUSB(Var Msg: TMessage);
                       End;

Var
   Form1         : TForm1;
   DVR         : Boolean;
   Root         : String;
   WM_AutoPlay   : Cardinal;

[...]

Procedure ShowMe(Value: HWND);
Var
   Th1,Th2      : Cardinal;
Begin
   Th1:=GetCurrentThreadId;
   Th2:=GetWindowThreadProcessId(GetForegroundWindow,nil);
   AttachThreadInput(Th2,Th1,True);
   Try
      SetForegroundWindow(Value);
   Finally
      AttachThreadInput(Th2,Th1,False);
   End;
End;

[...]

Procedure TForm1.FormCreate(Sender: TObject);
Begin
   ReadRoot;
   WM_AutoPlay:=RegisterWindowMessage('QueryCancelAutoPlay');
   Self.WindowProc:=WMHandleUSB;
End;

Procedure TForm1.WMHandleUSB(Var Msg: TMessage);
Begin
   If Msg.Msg = WM_DeviceChange Then
   Begin
      Case Msg.WParam Of
      $8000   :   If PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype=$00000002 Then
               Begin
                  ReadRoot;
                  If DVR Then
                  Begin
                     Application.Restore;
                     ShowMe(Application.Handle);
                  End;
               End;
     $8004   :   If PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype=$00000002 Then
               Begin
                  ReadRoot;
               End;
      End;
   End
   Else
   If Msg.Msg = WM_AutoPlay Then
   Begin
      If DVR Then
      Begin
         Msg.Result:=1;   //disable autoplay
         DVR:=False;
      End
      Else
         Msg.Result:=0;   // enable autoplay
   End
   Else
     Inherited WndProc(Msg);
End;

In ReadRoot suche ich alle Wechseldatenträger, prüfe ob ein Medium eingelegt und mein Spezialverzeichnis vorhanden ist. Falls alles passt, habe ich meinen Digital Voice Recorder. Danke für die super Hilfe. PID und VID wäre vermutlich eleganter. Aber ich brauche es so nicht und das Binary ist damit am Ende auch kleiner, weil nicht zig fette Units gelinkt sind.

Jetzt habe ich nur noch ein einziges Problem:

Das mit dem Unterdrücken des AutoPlay/Autostart (... wie auch immer) klappt nur, wenn das Fenster im Vordergrund ist. Darauf wiesen die Autoren ja auch schon selbst hin. Aus diesem Grunde nutze ich die Procedure ShowMe();, um das zum machen. Manchmal klappt das auch. Manchmal ist aber ShowMe() zu langsam für das Autostart, so dass der Explorer trotzdem kommt.

Kann ich da noch bitte einen Tipp haben, wie ich sicher stellen kann, dass mein Fenster immer vor dem Autostart Restored und OnTop ist?

Gruß, Alex

[Schwedenbitter]

Zitat von Schwedenbitter:

Jetzt habe ich nur noch ein einziges Problem:
Das mit dem Unterdrücken des AutoPlay/Autostart (... wie auch immer) klappt nur, wenn das Fenster im Vordergrund ist.

Leider muss es offensichtlich das MainForm sein.
Da ich aber in meinem Programm aus mehreren Gründen genau das nicht öffnen kann, habe ich es mit allen möglichen Message-Boxen aus der Unit Dialogs und mit Hilfsforms probiert. Leider alles ohne Erfolg. Selbst wenn ich dann mit unheimlichen Aufwand das MainForm benutze, dann ist das nicht mehr schnell genug (Siehe oben).

Gibt es wirklich keine andere Möglichkeit, das Einblenden des Explorer-Fensters mit den Mitteln von Delphi zu unterbinden?

Gruß, Alex

[himitsu]

Hast du es auch schon mit einem "richtigem" Message-Only-Window versucht?

[Schwedenbitter]

Danke für den Hinweis. Das kannte ich bislang nicht:

Zitat von himitsu:

Hast du es auch schon mit einem "richtigem" Message-Only-Window versucht?

Ich kann mit dem Hinweis nur nichts anfangen.
Zunächst habe ich mir die Suchergebnisse angesehen. Das ist nichts, was ich schon einmal gemacht hätte und auch die zahlreichen Beispielcodes laufen bei mir nicht.
Aber was ist dann der Sinn. Die Messages kommen ja an. Die werden - wenn ich das richtig deute - vom System gebroadcastet. Außerdem klappt mein Test-Code ja schon dann nicht mehr, wenn das Fenster neben einem weiteren im Hintergrund ist.

Falls Du mir das zumindest etwas genauer erklären würdest, dann könnte ich mit meinem bescheidenen Wissen vielleicht abschätzen, ob es sich lohnt, dass ich mich in die Materie einarbeite.

Gruß, Alex

[himitsu]

Ein Message-Only-Window ist quasi wie ein MainWindow, nur daß es unsichtbar ist und praktisch nur zum Empfangen von Nachrichten da ist und dort sollten auch alle globalen Nachichten ankommen, egal ob es im Vordergrund ist oder nicht (abgesehn davon, daß dieses eh nie im Vordergrund ist )

Dann (ich weiß allerding grad nicht genau wie diese heißen) sendet Windows doch erstmal eine "Darf ich runterfahren"-Nachricht an alle Hauptfenster, welche man mit Nein beantworten könnte.
Und erst danach sollte die "So, ich fahr dann mal runter und du kannst da jetzt nix mehr dran ändern"-Nachricht

[Schwedenbitter]

Zitat von himitsu:

... und dort sollten auch alle globalen Nachichten ankommen, egal ob es im Vordergrund ist oder nicht (abgesehn davon, daß dieses eh nie im Vordergrund ist )

Das ist ja nicht mein Problem. Die Nachricht kommt ja bei mir an. Selbst wenn mein Programm im Tray liegt. Ich muss aber die Nachricht "beantworten", indem ich Msg.Result:=1 mitgebe, wenn das AutoPlay unterbunden und Msg.Result:=0 wenn es erlaubt werden soll.
Das wiederum wird vom BS offenbar nur dann "ernst genommen", wenn mein Fenster nicht minimiert und nicht im Hintergrund ist.

Zitat von himitsu:

Dann (ich weiß allerding grad nicht genau wie diese heißen) sendet Windows doch erstmal eine "Darf ich runterfahren"-Nachricht an alle Hauptfenster, welche man mit Nein beantworten könnte.
Und erst danach sollte die "So, ich fahr dann mal runter und du kannst da jetzt nix mehr dran ändern"-Nachricht

Das verstehe ich jetzt nicht.
Mir geht es nicht darum, dass Runterfahren zu unterbinden. Ich möchte das AutoPlay ein für alle Male weghaben. Und zwar unabhängig davon, ob mein Programmfenster sichtbar, minimiert oder sonstwas ist.

Evtl. klappt es ja tatsächlich mit einem Message-Only-Window. Das bekomme ich jetzt so hin. Aber auch ich muss leider die Frage stellen, wie kann ich dem Fenster eine WindowProc zuweisen?

Delphi-Quellcode:

Var
   Form1            : TForm1;
   MessageWindow   :hWnd;

Implementation

{$R *.dfm}

Function InstallMessageWindow: hWnd;
Var
   S            : String;
   Ver         : TOSVersionInfoA;
Begin
   Ver.dwOSVersionInfoSize:=SizeOf(TOSVersionInfoA);
   If GetVersionEx(Ver) And (Ver.dwMajorVersion >= 5) Then
      S:='Message'
   Else
      S:='STATIC';
   Result:=CreateWindowExA(0, PChar(S), nil, WS_POPUP, 0, 0, 0, 0, 0, 0, GetCurrentProcessID, nil);
End;

Procedure TForm1.FormCreate(Sender: TObject);
Begin
   MessageWindow:=InstallMessageWindow;
   If MessageWindow <> Invalid_Handle_Value Then
      ShowMessage('OK');
End;

Gruß, Alex

[himitsu]

achsooo, hatte es so verstanden, daß diese Nachricht bei dir nur ankommt, wenn dein Fenster nicht minimiert ist.

[edit]
via SetWindowLong

[soulies]

@Schwedenbitter

hoi,

ich konnte noch nicht so ganz rausfinden um was für ein 'USB Gerät' es sich handelt ...

Vllt gibt's anderen Lösungen für das Problem.


cya

[Schwedenbitter]

@soulies

Zitat von soulies:

ich konnte noch nicht so ganz rausfinden um was für ein 'USB Gerät' es sich handelt ...

Es ist ein digitales Diktiergerät von Olympus. Ich bin aber weder mit dem Gerät noch mit der mitgelieferten Software zufrieden. Also muss/will ich selbst ran Ich erweitere mal so ganz nebenbei das Ding um ein paar Features.

Die von Olympus haben das mit dem AutoPlay aber irgendwie hinbekommen. Denn wenn deren DeviceDetector(tm) geladen ist, dann kümmert der und eben nur der sich um das im übrigen als USBSTOR geführte Gerät/Laufwerk. Ist das Programm nicht geladen, bekommt man wieder das "heiß geliebte" Explorer-Fenster. Es muss also gehen.
Die Frage ist daher nicht ob, sonder "nur" wie?

Zitat von soulies:

Vllt gibt's anderen Lösungen für das Problem.

Da fällt mir nur gpedit.msc und dann ... ein. Das nervt aber, wenn man das auf zig Rechnern machen muss und elegant ist es eben auch nicht.

Das hier funktioniert leider nicht:

Delphi-Quellcode:

Type
   PDevBroadcastHdr   = ^TDevBroadcastHdr;
   TDevBroadcastHdr   = Packed Record
                              dbcd_size: DWORD;
                              dbcd_devicetype: DWORD;
                              dbcd_reserved: DWORD;
                       End;

   TForm1      = Class(TForm)
                     CheckBox1   : TCheckBox;
                     Procedure FormCreate(Sender: TObject);
                     Procedure CheckBox1Click(Sender: TObject);
                 End;

Var
   Form1            : TForm1;
   WM_AutoPlay      : Cardinal;
   Erlauben         : Boolean = False;   
   MsgWindow      : hWnd;

Implementation

{$R *.dfm}

Function InstallMessageWindow: hWnd;
Var
   S            : String;
   Ver         : TOSVersionInfoA;
Begin
   Ver.dwOSVersionInfoSize:=SizeOf(TOSVersionInfoA);
   If GetVersionEx(Ver) And (Ver.dwMajorVersion >= 5) Then
      S:='Message'
   Else
      S:='STATIC';
   Result:=CreateWindowExA(0, PChar(S), nil, WS_POPUP, 0, 0, 0, 0, 0, 0, GetCurrentProcessID, nil);
End;

Procedure WindowProcedure(Var Msg: TMessage);
Begin
   If Msg.Msg = WM_DeviceChange Then
   Begin
      Case Msg.WParam Of
      $8000   :   If PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype=$00000002 Then
               Begin
                  Application.Restore;
                  ShowMe(Application.Handle);   // auf Teufel komm raus nach vorn zwingen
               End;
      $8004   :   If PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype=$00000002 Then
               Begin
                  Application.Minimize;
               End;
      End;
   End
   Else If Msg.Msg=WM_AutoPlay Then
   Begin
      If Erlauben Then
         Msg.Result := 0 //enable auto-play
      Else
         Msg.Result := 1; //disable
   End;
//   Else Inherited WndProc(Msg);   // Wie hier weiter???
End;


procedure TForm1.CheckBox1Click(Sender: TObject);
begin
   Erlauben:=CheckBox1.Checked;
end;

Procedure TForm1.FormCreate(Sender: TObject);
Begin
   WM_AutoPlay:=RegisterWindowMessage('QueryCancelAutoPlay');
   MsgWindow:=InstallMessageWindow;
   If MsgWindow <> Invalid_Handle_Value Then
   Begin
      If SetWindowLongA(MsgWindow, GWL_WNDPROC, Integer(@WindowProcedure)) <> 0 Then
      ShowMessage('OK');
   End;
End;

End.

Was mache ich verkehrt? Bin streng nach zusammengesammeltem Beispielcode vorgegangen

Noch irgendwelche sonstigen Ideen?

Gruß und Dank, Alex