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:

Type
  tVolumeInfo = Record
      Drive: Char;
      Name: String;
      SerialNumber: DWord;
      FileSystemName: String;
    End;

Function GetVolumeInfo (aDrive: Char): tVolumeInfo;
Var
  OldErrorMode: Integer;
  Dummy1, Dummy2: DWord;
  VolumeNameBuf,
  FileSystemNameBuf: Array [0..MAX_PATH] of Char;
  VolumenSerialNumber: pDWord;

  Info: tVolumeInfo;
Begin
  With Info Do
    Begin
      Drive := aDrive;
      Name := '';
      SerialNumber := 0;
      FileSystemName := '';
    End;

  OldErrorMode := SetErrorMode (SEM_FAILCRITICALERRORS);
  Try
    If GetVolumeInformation (
        pChar (aDrive + ':\'),
        VolumeNameBuf, SizeOf (VolumeNameBuf),
        VolumenSerialNumber, Dummy1, Dummy2,
        FileSystemNameBuf, SizeOf (FileSystemNameBuf)
      )
    Then
      Begin
        Info.Name := VolumeNameBuf;
        Info.SerialNumber := VolumenSerialNumber^;
        Info.FileSystemName := FileSystemNameBuf;
      End;
  Finally
    SetErrorMode (OldErrorMode);
  End;

  Result := Info;
End;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:

Procedure TForm1.Button1Click (Sender: TObject);
Var
  Info: tVolumeInfo;
  Str: String;
Begin
  Info := GetVolumeInfo ('d');

  Str := 'Informationen über Laufwerk' + #32 + Info.Drive;
  Str := Str + #13#10#32#32 + 'Name: ' + Info.Name;
  Str := Str + #13#10#32#32 + 'Serial: ' + IntToStr (Info.SerialNumber);
  Str := Str + #13#10#32#32 + 'System: ' + Info.FileSystemName;

  MessageDlg (Str, mtInformation, [mbOK], 0);
End;