AGB  ·  Datenschutz  ·  Impressum  







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

Festplattennamen ermitteln

Ein Thema von Sidores · begonnen am 17. Sep 2003 · letzter Beitrag vom 19. Sep 2003
Antwort Antwort
Seite 1 von 2  1 2      
Sidores

Registriert seit: 17. Sep 2003
Ort: Oldenburg
107 Beiträge
 
Delphi 7 Professional
 
#1

Festplattennamen ermitteln

  Alt 17. Sep 2003, 11:39
Hi,

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

Danke im voraus
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

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

Re: Festplattennamen ermitteln

  Alt 17. Sep 2003, 11:45
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).
Angehängte Dateien
Dateityp: dpr sysinfotest.dpr (10,1 KB, 19x aufgerufen)
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Sidores

Registriert seit: 17. Sep 2003
Ort: Oldenburg
107 Beiträge
 
Delphi 7 Professional
 
#3

Re: Festplattennamen ermitteln

  Alt 17. Sep 2003, 11:56
Danke
  Mit Zitat antworten Zitat
Chewie

Registriert seit: 10. Jun 2002
Ort: Deidesheim
2.886 Beiträge
 
Turbo Delphi für Win32
 
#4

Re: Festplattennamen ermitteln

  Alt 17. Sep 2003, 12:11
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.
Martin Leim
Egal wie dumm man selbst ist, es gibt immer andere, die noch dümmer sind
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

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

Re: Festplattennamen ermitteln

  Alt 17. Sep 2003, 12:17
Er wollte den Hersteller der Festplatte, nicht die Labels der Partitionen.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Chewie

Registriert seit: 10. Jun 2002
Ort: Deidesheim
2.886 Beiträge
 
Turbo Delphi für Win32
 
#6

Re: Festplattennamen ermitteln

  Alt 17. Sep 2003, 13:47
Ups, ich hab das in der Klammer nicht gelesen
Martin Leim
Egal wie dumm man selbst ist, es gibt immer andere, die noch dümmer sind
  Mit Zitat antworten Zitat
Sidores

Registriert seit: 17. Sep 2003
Ort: Oldenburg
107 Beiträge
 
Delphi 7 Professional
 
#7

Re: Festplattennamen ermitteln

  Alt 17. Sep 2003, 16:16
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?
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

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

Re: Festplattennamen ermitteln

  Alt 17. Sep 2003, 17:59
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.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Sidores

Registriert seit: 17. Sep 2003
Ort: Oldenburg
107 Beiträge
 
Delphi 7 Professional
 
#9

Re: Festplattennamen ermitteln

  Alt 19. Sep 2003, 10:01
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
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

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

Re: Festplattennamen ermitteln

  Alt 19. Sep 2003, 10:05
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%)
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


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:15 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