AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Neu eingelegte CD erkennen

Ein Thema von freakTAB · begonnen am 24. Jul 2003 · letzter Beitrag vom 24. Jul 2003
Antwort Antwort
NicoDE
(Gast)

n/a Beiträge
 
#1

Re: Neu eingelegte CD erkennen

  Alt 24. Jul 2003, 16:45
Die Nachricht wird nicht versendet, wenn die Benachrichtung über Laufwerksänderungen deaktiviert wurde (ich nehmen an, dass Du sie deaktiviert hast).
Versuche folgendes (nur Windows):

Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, Classes, Controls, Forms, StdCtrls, SysUtils, ExtCtrls;

type
  PWmDeviceChange = ^TWmDeviceChange;
  TWmDeviceChange = packed record
    Msg : UINT;
    Event : WPARAM;
    Data : LPARAM;
    Result: LRESULT;
  end;

type
  PVolumeInfo = ^TVolumeInfo;
  TVolumeInfo = packed record
    Type_ : UINT;
    Name : array [0..4095] of Char;
    Serial: DWORD;
  end;
  PVolumeInfoArray = ^TVolumeInfoArray;
  TVolumeInfoArray = array ['C'..'Z'] of TVolumeInfo;

type
  TMainForm = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure DefaultHandler(var Message); override;
    procedure WmDeviceChange(var Message: TWmDeviceChange);
      message WM_DEVICECHANGE;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    WM_QUERY_CANCEL_AUTOPLAY: UINT;
    VolumeInfos: TVolumeInfoArray;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  WM_QUERY_CANCEL_AUTOPLAY := 0;
  ZeroMemory(@VolumeInfos, SizeOf(VolumeInfos));
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
  Memo1.Clear();
end;

////////////////////////////////////////////////////////////////////////////////
// AutoPlay

procedure TMainForm.DefaultHandler(var Message);
begin
  // Shell version >= 4.70, AutoPlay enabled, and Form1 is the foreground window
  if (WM_QUERY_CANCEL_AUTOPLAY = 0) then
      WM_QUERY_CANCEL_AUTOPLAY := RegisterWindowMessage('QueryCancelAutoPlay');
  if (WM_QUERY_CANCEL_AUTOPLAY = TMessage(Message).Msg) then
  begin
    TMessage(Message).Result := S_FALSE; // S_OK = cancel AutoPlay
    Memo1.Lines.Add('[AutoPlay]');
  end;
  inherited;
end;

////////////////////////////////////////////////////////////////////////////////
// DeviceChange

procedure TMainForm.WmDeviceChange(var Message: TWmDeviceChange);
const
  DBT_DEVICEARRIVAL = $8000; // system detected a new device
  DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
begin
  case Message.Event of
    DBT_DEVICEARRIVAL:
      Memo1.Lines.Add('[DeviceChange] DBT_DEVICEARRIVAL');
    DBT_DEVICEREMOVECOMPLETE:
      Memo1.Lines.Add('[DeviceChange] DBT_DEVICEARRIVAL');
  else
    Memo1.Lines.Add('[DeviceChange] ' + IntToHex(Message.Event, 8));
  end;
  Message.Result := LRESULT(TRUE); // BROADCAST_QUERY_DENY = deny the request
  inherited;
end;

////////////////////////////////////////////////////////////////////////////////
// Timer

procedure TMainForm.Timer1Timer(Sender: TObject);
var
  PrevErrorMode: UINT;
  RootPathName: array [0..4] of Char;
  CurrentDrive: Char;
  VolumeInfo: TVolumeInfo;
  MaxCompLen: DWORD;
  FSystFlags: DWORD;
begin
  Timer1.Enabled := False;
  PrevErrorMode := UINT(-1);
  try
    PrevErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
    SetErrorMode(PrevErrorMode or SEM_FAILCRITICALERRORS);
    RootPathName := '_:\'#0;
    for CurrentDrive := 'Cto 'Zdo // Char(Low|High(TVolumeInfo.Name))
    begin
      RootPathName[0] := CurrentDrive;
      ZeroMemory(@VolumeInfo, SizeOf(VolumeInfo));
      VolumeInfo.Type_ := GetDriveType(RootPathName);
      GetVolumeInformation(RootPathName, VolumeInfo.Name,
        SizeOf(VolumeInfo.Name) div SizeOf(VolumeInfo.Name[0]),
        @VolumeInfo.Serial, MaxCompLen, FSystFlags, nil, 0);
      if (VolumeInfo.Type_ <> VolumeInfos[CurrentDrive].Type_) or
        (StrComp(VolumeInfo.Name, VolumeInfos[CurrentDrive].Name) <> 0) or
        (VolumeInfo.Serial <> VolumeInfos[CurrentDrive].Serial)then
      begin
         Memo1.Lines.Add('[Timer] ' + RootPathName + ', ' + VolumeInfo.Name +
           ', ' + IntToHex(VolumeInfo.Serial, 8));
      end;
      VolumeInfos[CurrentDrive] := VolumeInfo;
    end;
  finally
    if (PrevErrorMode <> UINT(-1)) then
      SetErrorMode(PrevErrorMode);
    if (Timer1.Tag = 0) then
      Timer1.Enabled := True;
  end;
end;

Gruss Nico
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 18:07 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz