Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Festplattennamen ermitteln (https://www.delphipraxis.net/9039-festplattennamen-ermitteln.html)

Sidores 17. Sep 2003 10:39


Festplattennamen ermitteln
 
Hi,

wie kann ich den Festplattennamen (z.b.:Maxtor 6Y80...)
anhand der Seriennummer oder Bezeichnung(C:\)
ermitteln?

Danke im voraus

Luckie 17. Sep 2003 10:45

Re: Festplattennamen ermitteln
 
Liste der Anhänge anzeigen (Anzahl: 1)
Unter 2000 steht es in der Registry.

Delphi-Quellcode:
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;
In u sollten dann die physischen Laufwerke stehen.

Im Anhang noch mal das ganze Programm (nonVCL).

Sidores 17. Sep 2003 10:56

Re: Festplattennamen ermitteln
 
Danke

Chewie 17. Sep 2003 11:11

Re: Festplattennamen ermitteln
 
Wieso nicht den Weg über GetVolumeInformation? Ist weniger Tipparbeit und berücksichtigt den evtl. unterschiedlichen Speicherort in der Registry bei verschiedenen Windows-Versionenn, geht folglich auch unter 9x/ME und ab NT.

Luckie 17. Sep 2003 11:17

Re: Festplattennamen ermitteln
 
Er wollte den Hersteller der Festplatte, nicht die Labels der Partitionen. :!:

Chewie 17. Sep 2003 12:47

Re: Festplattennamen ermitteln
 
Ups, ich hab das in der Klammer nicht gelesen :oops:

Sidores 17. Sep 2003 15:16

Re: Festplattennamen ermitteln
 
gut ich weiß jetzt wie sie heist
aber wie kann ich jetzt sagen wie groß die Festplatte ist.
Weil nur gucken wie groß C,D,E.... ist hilft mir ja auch net weiter ich will ja wissen wie groß jede einzelne Festplatte groß ist.
Das ich am schluss sagen kann Maxtor 6Y080... ist 80 GB groß
Maxtor 54654... ist 20 GB groß.
wisst ihr was ich mein?

Luckie 17. Sep 2003 16:59

Re: Festplattennamen ermitteln
 
Kuck dir meine SysInfo an www.luckie-online.de . Diese Implemantation ist nir für NT ff. man kann es aber auch für 9x machen, darauf habeich allerdings verzichtet.

Du brauchst aber noch Header-Übersetzungen der Jedi's. Die dafür benötigten sind im Zip mit drin.

Sidores 19. Sep 2003 09:01

Re: Festplattennamen ermitteln
 
tja das ist ja so weit so gut, doch du guckst ja nur wo du raufschreiben kannst und dann sagst du wo du schreiben kannst das ist z.b:Festplatte 0

Ich weiss wie die Festplatte heißt und auf welchem SCSI Port liegt.
Aber wie kann ich jetzt anhand dieser Informationen den einzelnen Festplatte die richtige Größe zuordnen :?:

Luckie 19. Sep 2003 09:05

Re: Festplattennamen ermitteln
 
Was glaubst du, was "Kapazität" angibt?

Code:
Festplatte: 0
   Zylinder           : 7476
   Spuren pro Zylinder : 255
   Sektoren pro Spur  : 63
   Bytes pro Sektor   : 512
   Kapazität          : 61492193280 Bytes (58643 MB)

Partition: C
   Offset         : 32256
   Länge          : 15734928384 Bytes
   Festplatte     : 0
   Label          : SYSTEM
   Dateisystem    : NTFS
   Kapazität      : 15006.00 MB
   freier Speicher : 10174.85 MB (67%)

Partition: D
   Offset         : 15734992896
   Länge          : 5247696384 Bytes
   Festplatte     : 0
   Label          : DATEIEN
   Dateisystem    : NTFS
   Kapazität      : 5004.59 MB
   freier Speicher : 4762.49 MB (95%)

Partition: E
   Offset         : 20982721536
   Länge          : 10487199744 Bytes
   Festplatte     : 0
   Label          : SOFTWARE
   Dateisystem    : NTFS
   Kapazität      : 10001.37 MB
   freier Speicher : 6577.83 MB (65%)

Partition: F
   Offset         : 31469953536
   Länge          : 10487199744 Bytes
   Festplatte     : 0
   Label          : IMAGES
   Dateisystem    : NTFS
   Kapazität      : 10001.37 MB
   freier Speicher : 7400.29 MB (73%)

Partition: G
   Offset         : 41957185536
   Länge          : 10487199744 Bytes
   Festplatte     : 0
   Label          : TEMP
   Dateisystem    : NTFS
   Kapazität      : 10001.37 MB
   freier Speicher : 9676.38 MB (96%)

Partition: H
   Offset         : 52444417536
   Länge          : 9047775744 Bytes
   Festplatte     : 0
   Label          : LINUX
   Dateisystem    : FAT32
   Kapazität      : 8620.20 MB
   freier Speicher : 8620.04 MB (99%)


Alle Zeitangaben in WEZ +1. Es ist jetzt 08:08 Uhr.
Seite 1 von 2  1 2      

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