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
freakTAB

Registriert seit: 21. Jan 2003
Ort: Neubrandenburg
56 Beiträge
 
Delphi 7 Enterprise
 
#1

Neu eingelegte CD erkennen

  Alt 24. Jul 2003, 10:30
wie kann ich mein Programmen erkennen lassen wenn der User eine neue CD eingelegt hat???
  Mit Zitat antworten Zitat
Benutzerbild von bixi400
bixi400

Registriert seit: 19. Mai 2003
179 Beiträge
 
Turbo Delphi für Win32
 
#2

Re: Neu eingelegte CD erkennen

  Alt 24. Jul 2003, 12:17
Versuchs mal mit: autorun.inf
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#3

Re: Neu eingelegte CD erkennen

  Alt 24. Jul 2003, 12:50
versuch dein Glück mal mit WM_DEVICECHANGE.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
freakTAB

Registriert seit: 21. Jan 2003
Ort: Neubrandenburg
56 Beiträge
 
Delphi 7 Enterprise
 
#4

Re: Neu eingelegte CD erkennen

  Alt 24. Jul 2003, 13:03
habs auch grad entdeckt, trotzdem danke Luckie
  Mit Zitat antworten Zitat
freakTAB

Registriert seit: 21. Jan 2003
Ort: Neubrandenburg
56 Beiträge
 
Delphi 7 Enterprise
 
#5

Re: Neu eingelegte CD erkennen

  Alt 24. Jul 2003, 13:26
Hmm, irgendwie schlägt er nicht an.
Mein Testprogrämmchen ( D7) :
Delphi-Quellcode:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
if Msg.message = WM_DEVICECHANGE then
begin
  Label1.Caption := 'Wechsel';
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
end;

end.
  Mit Zitat antworten Zitat
NicoDE
(Gast)

n/a Beiträge
 
#6

Re: Neu eingelegte CD erkennen

  Alt 24. Jul 2003, 17: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 03:19 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