FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
function DriveType(Drive: String): String; 
begin 
  case GetDriveType(Pchar(Drive)) of 
  DRIVE_REMOVABLE : Result := 'Lecteur de disquette'; 
  DRIVE_FIXED     : Result := 'Lecteur de disque'; 
  DRIVE_REMOTE    : Result := 'Lecteur distant'; 
  DRIVE_CDROM     : Result := 'Lecteur de CD-ROM'; 
  DRIVE_RAMDISK   : Result := 'RamDisk' 
else 
  Result := 'Inconnu'; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
function DiskInDrive(const Drive: Char): Boolean; 
var 
  DrvNum: Byte; 
  EMode: Word; 
begin 
  Result := False; 
  DrvNum := Ord(Drive); 
  if DrvNum >= Ord('a') then 
    Dec(DrvNum, $20); 
  EMode := SetErrorMode(SEM_FAILCRITICALERRORS); 
  try 
    if DiskSize(DrvNum - $40) <> -1 then 
      Result := True 
  finally 
    SetErrorMode(EMode); 
  end; 
end;

mciSendCommand (mciId, uMessage, dwParm1, dwParam2 : Cardinal) : Cardinal

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
uses 
  MMSystem; 
  
function OpenCD(Drive: String): Boolean; 
var 
  OpenParm: TMCI_Open_Parms; 
  Flags: DWord; 
  DeviceID : Word; 
  Error: MciError; 
  ErrorText: PChar; 
  LenghtBuffer: Cardinal; 
begin 
  Result := False; 
  Flags := mci_Open_Type or mci_Open_Element; 
  with OpenParm do begin 
    dwCallback := 0; 
    lpstrDeviceType := 'CDAudio'; 
    lpstrElementName := PChar(Copy(Drive, 0, 2)); 
  end; 
  Error := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm)); 
  mciGetErrorString(Error, ErrorText, LenghtBuffer); 
  if Error = 0 then 
    DeviceID := OpenParm.wDeviceID 
  else 
    raise EAccessViolation.Create(ErrorText); 
  try 
    Error := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0); 
    mciGetErrorString(Error, ErrorText, LenghtBuffer); 
  finally 
    mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm)); 
  end; 
    if Error = 0 then 
      Result := True 
    else 
      raise EAccessViolation.Create(ErrorText); 
end;

1
2
3
4
function GetVolumeInformation(lpRootPathName: PChar; 
  lpVolumeNameBuffer: PChar; nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD; 
  var lpMaximumComponentLength, lpFileSystemFlags: DWORD; 
  lpFileSystemNameBuffer: PChar; nFileSystemNameSize: DWORD): BOOL; stdcall;

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TForm1.Button2Click(Sender: TObject); 
Var VolName     : Array[0..Max_Path]Of Char; 
    FileSysName : Array[0..Max_Path]Of Char; 
    VolSerial   : DWord; 
    FileMaxLen  : DWord; 
    FileFlags   : DWord; 
begin 
  If GetVolumeInformation('C:\',VolName,Max_Path,@VolSerial, 
    FileMaxLen, FileFlags,FileSysName,Max_Path) 
    Then ShowMessage('Nom du disque       :'+VolName 
+#13'Système de fichiers :'+FileSysName 
+#13'Numéro de série     :'+IntToStr(VolSerial)); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
procedure ListeLecteurs(Lecteurs: TStrings); 
var 
  Num: integer; 
  Bits: set of 0..25; 
begin                    
  integer(Bits) := GetLogicalDrives; 
  for Num := 0 to 25 do 
    begin 
    if Num in Bits then 
      Lecteurs.Append(Char(Num+Ord('A'))+':\') 
    end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
procedure TForm1.Button1Click(Sender: TObject); 
var 
  i: integer; 
  Lecteurs: TStrings; 
begin 
  Lecteurs := TStringList.Create; 
  ListeLecteurs(Lecteurs); 
  Memo1.Clear; 
  For i := 0 to Lecteurs.Count-1 do 
    Memo1.Lines.Append(Lecteurs[i]); 
  FreeAndNil(Lecteurs); 
end;