type
TScsiPorts =
array of string;
TTargetIDArray =
array of string;
TLogicalUnitIDs =
array of string;
function GetScsiPorts: TScsiPorts;
var
hReg,
sReg : HKEY;
retCode : integer;
szBuffer :
array[0..MAX_PATH]
of Char;
dwlen : DWORD;
i,
j : integer;
begin
SetLength(Result,0);
if(RegOpenKeyEx(HKEY_LOCAL_MACHINE,pchar(REGDRIVESPATH[
WinNT]),
0,KEY_READ,hReg) = ERROR_SUCCESS)
then
try
if(
WinNT)
then begin
i := 0;
repeat
ZeroMemory(@szBuffer,sizeof(szBuffer));
dwlen := sizeof(szBuffer);
retCode := RegEnumKeyEx(hReg,i,szBuffer,dwlen,
nil,
nil,
nil,
nil);
if(retCode = ERROR_SUCCESS)
then begin
SetLength(Result,length(Result) + 1);
Result[length(Result)-1] :=
string(szBuffer);
end;
inc(i);
until(retCode = ERROR_NO_MORE_ITEMS);
end else begin
for j := 1
to length(ROOTPATH_9x)
do begin
if(RegOpenKeyEx(hReg,pchar(ROOTPATH_9x[j]),0,KEY_READ,
sReg) = ERROR_SUCCESS)
then
try
i := 0;
repeat
ZeroMemory(@szBuffer,sizeof(szBuffer));
dwlen := sizeof(szBuffer);
retCode := RegEnumKeyEx(sReg,i,szBuffer,dwlen,
nil,
nil,
nil,
nil);
if(retCode = ERROR_SUCCESS)
then begin
SetLength(Result,length(Result) + 1);
Result[length(Result)-1] := ROOTPATH_9x[j] + '
\' +
string(szBuffer);
end;
inc(i);
until(retCode = ERROR_NO_MORE_ITEMS);
finally
RegCloseKey(sReg);
end;
end;
end;
finally
RegCloseKey(hReg);
end;
end;
function GetTargetIDs(ScsiPort:
string): TTargetIDArray;
const
szRegPath :
array[boolean]
of string =
('
%s\%s','
%s\%s\Scsi Bus 0');
var
hReg : HKEY;
retCode : integer;
szBuffer :
array[0..MAX_PATH]
of Char;
dwlen : DWORD;
i : integer;
begin
SetLength(Result,0);
if(RegOpenKeyEx(HKEY_LOCAL_MACHINE,
pchar(Format(szRegPath[
WinNT],[REGDRIVESPATH[
WinNT],ScsiPort])),0,
KEY_READ,hReg) = ERROR_SUCCESS)
then
try
i := 0;
repeat
ZeroMemory(@szBuffer,sizeof(szBuffer));
dwlen := sizeof(szBuffer);
retcode := RegEnumKeyEx(hReg,i,szBuffer,dwlen,
nil,
nil,
nil,
nil);
if(retcode = ERROR_SUCCESS)
then begin
if((
WinNT)
and (pos('
Target',
string(szBuffer)) = 1))
or
(
not WinNT)
then
begin
SetLength(Result,length(Result)+1);
Result[length(Result)-1] := Format(szRegPath[
WinNT] + '
\%s',
[REGDRIVESPATH[
WinNT],ScsiPort,
string(szBuffer)]);
end;
end;
inc(i);
until(retcode = ERROR_NO_MORE_ITEMS);
finally
RegCloseKey(hReg);
end;
end;
function GetLogicalUnitIDs(TargetID:
string): TLogicalUnitIDs;
var
hReg : HKEY;
retCode : integer;
szBuffer :
array[0..MAX_PATH]
of char;
dwlen : DWORD;
i : integer;
begin
SetLength(Result,0);
// unter Win 98 bin ich schon am Ziel;
// also nur ein bisschen "so tun als ob ...", um
// die Programmstruktur nicht ändern zu müssen
// :o)
if(
not WinNT)
then begin
SetLength(Result,length(Result) + 1);
Result[length(Result)-1] := TargetID;
end else begin
if(RegOpenKeyEx(HKEY_LOCAL_MACHINE,pchar(TargetId),0,KEY_READ,
hReg) = ERROR_SUCCESS)
then
try
i := 0;
repeat
ZeroMemory(@szBuffer, sizeof(szBuffer));
dwlen := sizeof(szBuffer);
retCode := RegEnumKeyEx(hReg,i,szBuffer,dwlen,
nil,
nil,
nil,
nil);
if(retCode = ERROR_SUCCESS)
and
(lstrlen(szBuffer) > 0)
then
begin
SetLength(Result,length(Result) + 1);
Result[length(Result)-1] := TargetID + '
\' +
string(szBuffer);
end;
Inc(i);
until(retCode = ERROR_NO_MORE_ITEMS);
finally
RegCloseKey(hReg);
end;
end;
end;
function GetDrivesFromReg(RegPath:
string):
string;
const
szTypeString :
array[boolean]
of string =
('
Class','
Type');
szIdString :
array[boolean]
of string =
('
DeviceDesc','
Identifier');
var
hReg : HKEY;
sDriveType :
string;
szBuffer :
array[0..255]
of char;
cbData : integer;
lpType : DWORD;
begin
if(RegOpenKeyEx(HKEY_LOCAL_MACHINE,pchar(RegPath),0,KEY_READ,
hReg) = ERROR_SUCCESS)
then
try
lpType := REG_SZ;
cbData := 0;
if(RegQueryValueEx(hReg,pchar(szTypeString[
WinNT]),
nil,
@lpType,
nil,@cbData) = ERROR_SUCCESS)
and (cbData > 0)
then
begin
SetLength(sDriveType,cbData);
if(RegQueryValueEx(hReg,pchar(szTypeString[
WinNT]),
nil,
@lpType,@sDriveType[1],@cbData) = ERROR_SUCCESS)
then
SetLength(sDriveType,cbData - 1)
else
sDriveType := '
';
if(pos('
DISK',uppercase(sDriveType)) = 1)
then
sDriveType := '
Festplatte'
else if(pos('
CDROM',uppercase(sDriveType)) = 1)
then
sDriveType := '
CD-ROM'
else if(pos('
Tape',uppercase(sDriveType)) = 1)
then
sDriveType := '
Bandlaufwerk';
end;
ZeroMemory(@szBuffer,sizeof(szBuffer));
lpType := REG_SZ;
cbData := 0;
if(RegQueryValueEx(hReg,pchar(szIdString[
WinNT]),
nil,
@lpType,
nil,@cbData) = ERROR_SUCCESS)
and (cbData > 0)
then
RegQueryValueEx(hReg,pchar(szIdString[
WinNT]),
nil,
@lpType,@szBuffer,@cbData);
finally
RegCloseKey(hReg);
end;
if(lstrlen(szBuffer) > 0)
then
Result := Format('
%s (%s)'+#13#10,[TrimSpaces(szBuffer),sDriveType])
else
Result := '
';
end;
...
var
wv: TOSVersionInfo;
scsiport: TScsiPorts;
tid: TTargetIDArray;
logU: TLogicalUnitIDs;
v, u:
string;
h, i, j: integer;
begin
SetLength(scsiport, 0);
SetLength(tid, 0);
SetLength(logU, 0);
scsiport := GetScsiPorts;
if (length(scsiport) > 0)
then
for h := 0
to length(scsiport) - 1
do
begin
tid := GetTargetIDs(scsiport[h]);
if (length(tid) > 0)
then
for i := 0
to length(tid) - 1
do
begin
logU := GetLogicalUnitIDs(tid[i]);
if (length(logU) > 0)
then
for j := 0
to length(logU) - 1
do
u := u + GetDrivesFromReg(logU[j]);
end;
end;
SetLength(logU, 0);
SetLength(tid, 0);
SetLength(scsiport, 0);
if (u <> '
')
then
u := #13#10#13#10 + '
Laufwerke:' + #13#10 + u;