| Autor |
Beitrag |
Mashalla
Beiträge: 48
Windows 7 Professional
Delphi 7 Enterprise, Turbo Delphi Explorer 2006
|
Verfasst: Fr 12.06.09 18:47
Ich versuche gerade eine Anwendung zu programmieren, bei der ich angesteckte USB-Wechseldatenträger erkennen können muss. Dazu hab ich folgende Unit von Swissdelphicenter benutzt, die auch tadellos funktioniert. Einziges Problem ist, dass mein Programm sich leider einklinkt, bevor das Laufwerk einen Buchstaben zugewiesen bekommt. Mit folgender Funktion überprüfe ich auf Wechseldatenträger:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
| function TMainForm.GetRemovableDrives: TStringList;
const
DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;
var
r: LongWord;
Drives: array[0..128] of char;
pDrive: PChar;
begin
Result := TStringList.Create;
try
r := GetLogicalDriveStrings(SizeOf(Drives), Drives);
if r = 0 then Exit;
if r > SizeOf(Drives) then
raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));
pDrive := Drives;
while pDrive^ <> #0 do
begin
if GetDriveType(pDrive) = DRIVE_REMOVABLE then
Result.Add(pDrive);
Inc(pDrive, 4);
end;
except
FreeAndNil(Result);
end;
end; |
Diese Funktion funktioniert wunderbar und liefert mir, was ich brauche. Die nächste Funktion wird aufgerufen, wenn ein USB Gerät angesteckt wird. Leider bekomme ich immer eine leere Rückgabe, egal wie lange die Schleife läuft.
  Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
| function TMainForm.GetNewDrive: String;
var
NewList: TStringList;
I, P, Counter: Integer;
begin
Counter := 0;
NewList := GetRemovableDrives;
while (NewList.Count = IndexedDriveList.Count) and (Counter < 25) do begin
Sleep(500);
NewList := GetRemovableDrives;
Inc(Counter);
result := '';
end;
... |
Lässt es sich irgendwie einrichten, dass mein Programm erst darauf zugreift, wenn das Laufwerk einen Laufwerksbuchstaben hat? Weil ohne diesen komme ich leider nicht weit.
Gruß Mashalla
|
|
MaPsTaR
Beiträge: 90
Erhaltene Danke: 4
Win XP
Delphi 7 Enterprise
|
Verfasst: So 14.06.09 19:24
Hallo
Leider konnte ich mit dem kurzen Ausschnit deiner Function GetNewDrive nicht viel anfangen, geschweige denn einen Fehler suchen.
Dieser scheint aber definitiv dort zu liegen. Da ich außerdem nicht erfahren konnte wo und wie du IndexedDriveList mit Werten füllst.....
Auf das neue Laufwerk brauchst du übrigens nicht zu warten, da in deiner Klasse & meiner Prozedur "GetNewDrive" erst aufgerufen werden, wenn das Laufwerk bereits einen Buchstaben erhalten hat.
Ich würde es so machen, ist aber nur eine Idee:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
| procedure OnDeviceChange(var Msg: TMsg); message WM_DEVICECHANGE;
function GetRemovableDrives: TStringList;
function GetAllLogicalDrives: TStringList;
function GetNewDrive: String;
var
IndexedDriveList: TStringList;
const
DBT_DEVICEARRIVAL = $8000; DBT_DEVICEREMOVECOMPLETE = $8004;
function TForm1.GetNewDrive: String;
var
NewList: TStringList;
I, P: Integer;
begin
NewList := GetRemovableDrives;
for p := NewList.Count - 1 downto 0 do
begin
result := NewList[p];
for i := IndexedDriveList.Count - 1 downto 0 do
begin
if NewList[p] = IndexedDriveList[i]
then
begin
result := '';
break;
end;
end;
if result <> ''
then
break;
end;
end;
function TForm1.GetAllLogicalDrives: TStringList;
const
DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;
var
r: LongWord;
Drives: array[0..128] of char;
pDrive: PChar;
begin
Result := TStringList.Create;
try
r := GetLogicalDriveStrings(SizeOf(Drives), Drives);
if r = 0 then Exit;
if r > SizeOf(Drives) then
raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));
pDrive := Drives;
while pDrive^ <> #0 do
begin
Result.Add(pDrive);
Inc(pDrive, 4);
end;
except
FreeAndNil(Result);
end;
end;
function TForm1.GetRemovableDrives: TStringList;
const
DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;
var
r: LongWord;
Drives: array[0..128] of char;
pDrive: PChar;
begin
Result := TStringList.Create;
try
r := GetLogicalDriveStrings(SizeOf(Drives), Drives);
if r = 0 then Exit;
if r > SizeOf(Drives) then
raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));
pDrive := Drives;
while pDrive^ <> #0 do
begin
if GetDriveType(pDrive) = DRIVE_REMOVABLE then
Result.Add(pDrive);
Inc(pDrive, 4);
end;
except
FreeAndNil(Result);
end;
end;
procedure TForm1.OnDeviceChange(var Msg: TMsg);
var i: integer;
begin
if (Msg.message = DBT_DEVICEARRIVAL)
then
begin
ShowMessage(GetNewDrive);
IndexedDriveList := GetAllLogicalDrives;
end;
if (Msg.message = DBT_DEVICEREMOVECOMPLETE)
then
begin
IndexedDriveList := GetAllLogicalDrives;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i: integer;
begin
IndexedDriveList := GetAllLogicalDrives;
end;
end. |
Zumindest läuft es so bei mir.
PS: Beim nächsten Mal hätte ich gern mehr Code zum Fehler suchen. 
Gruß MaPsTaR
Moderiert von  Narses: Code- durch Delphi-Tags ersetzt
|
|
Mashalla 
Beiträge: 48
Windows 7 Professional
Delphi 7 Enterprise, Turbo Delphi Explorer 2006
|
Verfasst: Mo 15.06.09 00:00
Jo...der Codefehler wird mir hoffentlich nicht mehr unterlaufen. Im Nachhinein wunder ich mich selbst, wie man darauf ne Problemlösung ableiten soll, was ich gepostet hab *gg*
Ok, also mit deiner Änderung funktioniert das leider immer noch nicht so ganz zuverlässig. Wenn ich 2 Stick angeschlossen hab und das Programm starte, findet er beide, aber wenn ich während dem Betrieb einen ansteck, schnallt er es wieder nicht. Ich hab sicher irgendwas mit dem OnDeviceChange verrafft 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
| procedure TMainForm.FormCreate(Sender: TObject);
var
USBCheck: TComponentUSB;
begin
Application.ShowMainForm := false;
CreatePopupMenu;
ScanForDriveFiles(MainForm.TrayIcon);
USBCheck := TComponentUSB.Create(MainForm);
USBCheck.OnUSBArrival := NewUSBDrive;
USBCheck.OnUSBRemove := RemoveUSBDrive;
end;
procedure TMainForm.ScanForDriveFiles(Sender: TObject);
var
DriveList, FileList: TStringList;
DriveCount, FileCount, I, P: Integer;
FileName, FilePath, Dir, Mask: String;
begin
DriveList := TStringList.Create;
FileCount := 0;
Mask := '*.exe';
ResetPopupMenu;
try
DriveList := GetRemovableDrives;
DriveCount := DriveList.Count;
if DriveCount > 0 then begin
for I := 0 to DriveCount - 1 do begin
Dir := DriveList[I];
ShowMessage(Dir);
FileList := GetAllFiles(Dir, Mask);
FileCount := FileList.Count;
if FileCount > 0 then begin
for P := 0 to FileCount - 1 do begin
FileName := ExtractFileName(FileList[P]);
FilePath := ExtractFilePath(FileList[P]);
Pop.Items.Insert(2,CreatePopupItem(FileName, FilePath));
end;
end;
InsertDividerAtIndex(Pop, Pop.Items.Count - 1);
end;
end;
finally
DriveList.Free;
end;
end;
procedure TMainForm.NewUSBDrive(Sender: TObject);
var
Msg: TMsg;
begin
Msg.message := DBT_DEVICEARRIVAL;
OnDeviceChange(Msg);
end;
procedure TMainForm.RemoveUSBDrive(Sender: TObject);
var
Msg: TMsg;
begin
Msg.message := DBT_DEVICEREMOVECOMPLETE;
OnDeviceChange(Msg);
end;
procedure TMainForm.OnDeviceChange(var Msg: TMsg);
begin
if (Msg.message = DBT_DEVICEARRIVAL) or
(Msg.message = DBT_DEVICEREMOVECOMPLETE) then
ScanForDriveFiles(MainForm);
end; |
Das sollten alle relevanten Prozeduren sein...wie gesagt, beim Anstecken ist die StringList "DriveList" leer, das neue Laufwerk wird (noch) nicht erkannt. Beim Abziehen eines Wechseldatenträgers funktioniert nun alles, wie es sollte. Was mache ich falsch bzw was läuft hier falsch?
|
|
bis11
Beiträge: 1247
Erhaltene Danke: 2
Apple Mac OSX 10.11
|
Verfasst: Mo 15.06.09 06:14
Guten Morgen,
in meinem Programm SystemInfo benutze ich den folgenden Code um zu merken ob ein USB-Stick angeschlossen ist oder nicht, vielleicht hilft er Dir ja weiter.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
| procedure TMainForm.WMDeviceChange(var Msg: TMessage);
type
PDevBroadcastHdr = ^TDevBroadcastHdr;
TDevBroadcastHdr = packed record
dbcd_size, dbcd_devicetype, dbcd_reserved: DWORD;
end;
PDevBroadcastVolume = ^TDevBroadcastVolume;
TDevBroadcastVolume = packed record
dbcv_size, dbcv_devicetype, dbcv_reserved, dbcv_unitmask: DWORD;
dbcv_flags: Word;
end;
function GetDrive(pDBVol: PDevBroadcastVolume): string;
var
i: Byte; Maske: DWORD;
begin
if (pDBVol^.dbcv_flags and $0001) = $0001 then
begin
Maske := pDBVol^.dbcv_unitmask;
for i := 0 to 25 do
begin
if (Maske and 1) = 1 then
Result := Char(i + Ord('A')) + ': ';
Maske := Maske shr 1;
end;
end;
end;
begin
case Msg.wParam of
$8000:
if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = $0002 then
begin
end;
$8004:
if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = $0002 then
begin
end;
end;
end; |
Die auskommentierten Zeilen ersetze durch Deine Aktionen, die ausgeführt werden sollen.
|
|
MaPsTaR
Beiträge: 90
Erhaltene Danke: 4
Win XP
Delphi 7 Enterprise
|
Verfasst: Mo 15.06.09 14:53
Du rufst OnDeviceChange ja auch über eine andere Procedure auf.
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
| interface
type TForm1 = class(TForm)
private
procedure OnDeviceChange(var Msg: TMsg); message WM_DEVICECHANGE; function GetRemovableDrives: TStringList;
function GetAllLogicalDrives: TStringList;
function GetNewDrive: String;
end; |
Hast du an das message WM_DEVICECHANGE; im interface-Teil gedacht?
Dann wird die Funktion automatisch aufgerufen, wenn das Prorgamm die Message empfängt.
Und dann sollte es auch funktionieren, dass er im Betrieb deine Sticks erkennt.
Bei mir hat es mit 3 Sticks auf jeden Fall geklappt.
Viel Erfolg MaPsTaR
Moderiert von Narses: Code- durch Delphi-Tags ersetzt
|
|
Mashalla
Beiträge: 48
Windows 7 Professional
Delphi 7 Enterprise, Turbo Delphi Explorer 2006
|
Verfasst: Mo 15.06.09 16:45
@ Mapster:
Jo danke, der letzte Tipp half mir. Jetzt läuft es alles nach Plan. Großes Danke
@ Rolf:
Ich hab deinen Code jetzt nicht ausprobiert, aber danke fürs Posten. Möglicherweise greift jemand anders darauf zurück
|
|
Mashalla
Beiträge: 48
Windows 7 Professional
Delphi 7 Enterprise, Turbo Delphi Explorer 2006
|
Verfasst: So 12.07.09 23:50
Ok, neues "Problem":
Das Erkennen funktioniert aktuell wunderbar. Wenn ich jetzt im Windows Explorer dem Stick eine neue Bezeichnung gebe, erkennt er beim erneuten Einstecken den Stick nicht mehr, also die Message von WM_DEVICECHANGE ist weder DBT_DEVICEARRIVAL noch DBT_DEVICEREMOVALCOMPLETE beim Abziehen des Sticks. Kann mir das jemand erklären?
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
| procedure TMainForm.OnDeviceChange(var Msg: TMsg);
begin
if (Msg.message = DBT_DEVICEARRIVAL) then begin
NewDriveArrived := true;
ScanForDriveFiles(MainForm);
end;
if (Msg.message = DBT_DEVICEREMOVECOMPLETE) then begin
NewDriveArrived := false;
ScanForDriveFiles(MainForm);
end;
end; |
Er springt weder beim Anstecken noch beim Abziehen in einen if-Teil, sondern läuft einfach durch.
NACHTRAG:
Ähem...ich kanns aktuell leider nicht mehr reproduzieren, er erkennt jetzt auch den umbenannten Stick ... ich schiebs einfach mal auf die RC von Windows 7 
|
|
josejp1
Hält's aus hier
Beiträge: 2
|
Verfasst: Di 04.08.09 13:17
|
|
|
