Re: USB - Autostart dynamisch unterbinden
Hallo Schwedenbitter,
zwei Fragen seien gestattet: Betriebssystem und Delphi-Version? Das ganze wurde damals für D7 geschrieben. Gruß |
Re: USB - Autostart dynamisch unterbinden
@Alter Mann
Zitat:
Ich habe es jetzt - Dank Deiner Hilfe - tatsächlich geschafft, dass WMDeviceChange wegzurationalisieren und alles aus "WndProc" heraus zu erledigen. :-D 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:
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.
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; 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 |
Re: USB - Autostart dynamisch unterbinden
Zitat:
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 |
Re: USB - Autostart dynamisch unterbinden
Hast du es auch schon mit einem "richtigem" Message-Only-Window versucht?
|
Re: USB - Autostart dynamisch unterbinden
Danke für den Hinweis. Das kannte ich bislang nicht:
Zitat:
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 |
Re: USB - Autostart dynamisch unterbinden
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 :nerd: )
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 :gruebel: |
Re: USB - Autostart dynamisch unterbinden
Zitat:
Das wiederum wird vom BS offenbar nur dann "ernst genommen", wenn mein Fenster nicht minimiert und nicht im Hintergrund ist. Zitat:
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:
Gruß, Alex
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; |
Re: USB - Autostart dynamisch unterbinden
achsooo, hatte es so verstanden, daß diese Nachricht bei dir nur ankommt, wenn dein Fenster nicht minimiert ist. :oops:
[edit] via SetWindowLong |
Re: USB - Autostart dynamisch unterbinden
@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 |
Re: USB - Autostart dynamisch unterbinden
@soulies
Zitat:
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:
Das hier funktioniert leider nicht:
Delphi-Quellcode:
Was mache ich verkehrt? Bin streng nach zusammengesammeltem Beispielcode vorgegangen :lol:
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. Noch irgendwelche sonstigen Ideen? Gruß und Dank, Alex |
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:31 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz