Как узнать серийный номер CD-диска

[oleg-ff]

Подскажите пожалуйста как я могу узнать серийный номер CD-диска в CD-Rom-е

[Kostyan]

Вот тебе пример, тут и серийник, и всё остальное:

Код: Выделить всё

Dim Nm As String, Ser As Long, C As Long, Flags As Long, FSys As String
Dim ret As Long

Nm = Space$(255): FSys = Space$(255)
ret = GetVolumeInformation(Drive1.Drive & "\", Nm, 255, Ser, C, Flags, FSys, 255)
If ret <> 0 Then
  Text1.Text = Text1.Text & "Имя диска: " & Trim$(Nm)
  Text1.Text = Text1.Text & vbCrLf & "Серийный номер: " & Hex$(Ser) & vbCrLf
  Text1.Text = Text1.Text & "Макс. длина имени файла: " & C & vbCrLf
  Text1.Text = Text1.Text & "Файловая система " & Trim$(FSys)
  Text1.Text = Text1.Text & vbCrLf
  If Flags And FS_CASE_IS_PRESERVED Then Text1.Text = Text1.Text & "Сохранение регистров в именах файлов" & vbCrLf
  If Flags And FS_CASE_SENSITIVE Then Text1.Text = Text1.Text & "Различие регистров в именах файлов" & vbCrLf
  If Flags And FS_UNICODE_STORED_ON_DISK Then Text1.Text = Text1.Text & "Имена файлов хранятся в Unicode" & vbCrLf
  If Flags And FS_PERSISTENT_ACLS Then Text1.Text = Text1.Text & "Поддержка списков управления доступом (ACL)" & vbCrLf
  If Flags And FS_FILE_COMPRESSION Then Text1.Text = Text1.Text & "Поддержка сжатия файлов" & vbCrLf
  If Flags And FS_VOL_IS_COMPRESSED Then Text1.Text = Text1.Text & "Том сжат" & vbCrLf
Else
  MsgBox "Нет доступа к устройству", vbCritical, "Ошибка"
End If


Drive1.Drive - это соответственно имя диска (без слеша), а в функцию нужно передовать обязательно со слешем.