Rotinas para Manipulação de DiskDrives
Continuando nossa série de artigos, relacionados à criação de bibliotecas com rotinas padrão em Delphi, damos inicio a Operações com DisksDrives.
· Tratamento de arquivos;
· Operações com DisksDrives; ß estamos aqui!
· Operações de Hardware;
· Operações com Mouse;
· Operações com o Sistema;
· Operações com Strings;
Então.. mãos na massa. Crie um arquivo e dê o nome de “DskDrv”, no seu Delphi.
1: unit DskDrv;
2:
3: interface
4:
5: uses Windows, SysUtils;
6:
7: type
8: TtbDriveType = (dtUnknown, dtNotExist, dtRemovable, dtFixed,
9: dtRemote, dtCdRom, dtRamDisk, dtError);
10:
11: TtbVolInfo = record
12: Name: string;
13: Serial: Cardinal;
14: IsCompressed: boolean;
15: MaxCompLen: Cardinal;
16: FileSysName: string;
17: end;
18:
19: { Retorna o número do drive: A=1, B=2, C=3, etc. }
20: function tbDriveByte(const Drive: Char): byte;
21: { Retorna true se o drive existe }
22: function tbDriveExists(const Drive: Char): boolean;
23: { Retorna true se o drive está preparado }
24: function tbDriveIsOk(const Drive: Char): boolean;
25: { Retorna uma string contendo as letras de unidades de existentes }
26: function tbDriveLetters: string;
27: { Retorna o tipo do drive. Veja TtbDriveType }
28: function tbDriveType(const Drive: Char; Path: PChar): TtbDriveType;
29: { Retorna o nome de volume de uma unidade }
30: function tbVolName(const Drive: Char; Path: PChar): string;
31: { Retorna o número serial de uma unidade }
32: function tbVolSerial(const Drive: Char; Path: PChar): Cardinal;
33: { Retorna informações diversas sobre uma unidade. Veja TtbVolInfo }
34: function tbVolInfo(const Drive: Char; Path: PChar): TtbVolInfo;
35:
36: implementation
37:
38: { *** Drives *** }
39: function tbDriveByte(const Drive: Char): byte;
40: { Uso: X := tbDriveByte('C') }
41: begin
42: if Drive = #0 then
43: Result := 0
44: else
45: Result := Ord(UpCase(Drive)) - 64;
46: end;
47:
48: function tbDriveExists(const Drive: Char): boolean;
49: { Uso: if tbDriveExists('A') then ... }
50: begin
51: Result := Pos(UpCase(Drive), tbDriveLetters) > 0;
52: end;
53:
54: function tbDriveIsOk(const Drive: Char): boolean;
55: { Uso: if tbDriveIsOk('A') then ... }
56: begin
57: Result := SysUtils.DiskSize(tbDriveByte(Drive)) >= 0;
58: end;
59:
60: function tbDriveLetters: string;
61: { Uso: S := tbDriveLetters; - retorna 'ACD' se existir as unidades
62: A:, C: e D: }
63: var
64: Drives: LongWord;
65: I: byte;
66: begin
67: Result := '';
68: Drives := GetLogicalDrives;
69: if Drives <> 0 then
70: for I := 65 to 90 do
71: if ((Drives shl (31 - (I - 65))) shr 31) = 1 then
Unit1.pas 10/06/2010 22:12:14 Page 2 of 3
72: Result := Result + Char(I);
73: end;
74:
75: function tbDriveType(const Drive: Char; Path: PChar): TtbDriveType;
76: { Uso: T := tbDriveType; --- T é do tipo TtbDriveType }
77: begin
78: if Path = nil then
79: Path := PChar(Drive + ':\');
80:
81: case Windows.GetDriveType(PChar(Path)) of
82: 0: Result := dtUnknown;
83: 1: Result := dtNotExist;
84: DRIVE_REMOVABLE: Result := dtRemovable;
85: DRIVE_FIXED: Result := dtFixed;
86: DRIVE_REMOTE: Result := dtRemote;
87: DRIVE_CDROM: Result := dtCdRom;
88: DRIVE_RAMDISK: Result := dtRamDisk;
89: else
90: Result := dtError;
91: end;
92: end;
93:
94: function tbVolName(const Drive: Char; Path: PChar): string;
95: { Uso: S := tbVolName('A', nil); ou
96: S := tbVolName(#0, '\\computador\c\'); }
97: var
98: MaxCompLen, FileSysFlag, PrevErrorMode: Cardinal;
99: begin
100: if Path = nil then
101: Path := PChar(Drive + ':\');
102:
103: SetLength(Result, 255);
104:
105: PrevErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
106: try
107: if GetVolumeInformation( PChar(Path), PChar(Result), 255,
108: nil, MaxCompLen, FileSysFlag, nil, 0) then
109: Result := string(PChar(Result))
110: else
111: Result := '';
112: finally
113: SetErrorMode(PrevErrorMode);
114: end;
115: end;
116:
117: function tbVolSerial(const Drive: Char; Path: PChar): Cardinal;
118: { Uso: S := tbVolSerial('A', nil); ou
119: S := tbVolSerial(#0, '\\computador\c\'); }
120: var
121: MaxCompLen, FileSysFlag, PrevErrorMode: Cardinal;
122: begin
123: if Path = nil then
124: Path := PChar(Drive + ':\');
125:
126: PrevErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
127: try
128: if not GetVolumeInformation(PChar(Path), nil, 0,
129: @Result, MaxCompLen, FileSysFlag, nil, 0) then
130: Result := 0;
131: finally
132: SetErrorMode(PrevErrorMode);
133: end;
134: end;
135:
136: function tbVolInfo(const Drive: Char; Path: PChar): TtbVolInfo;
137: { Uso: Info := tbVolInfo('A', nil); ou
138: Info := tbVolInfo(#0, '\\computador\c\'); }
139: const
140: cVolNameLen = 255;
141: cSysNameLen = 255;
142: var
Unit1.pas 10/06/2010 22:12:14 Page 3 of 3
143: Flags, PrevErrorMode: Cardinal;
144: begin
145: if Path = nil then
146: Path := PChar(Drive + ':\');
147:
148: SetLength(Result.Name, cVolNameLen);
149: SetLength(Result.FileSysName, cSysNameLen);
150:
151: PrevErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
152: try
153: if GetVolumeInformation(Path, PChar(Result.Name), cVolNameLen,
154: @Result.Serial, Result.MaxCompLen, Flags,
155: PChar(Result.FileSysName), cSysNameLen) then
156: begin
157: Result.Name := string(PChar(Result.Name));
158: Result.FileSysName := string(PChar(Result.FileSysName));
159: Result.IsCompressed := (Flags and FS_VOL_IS_COMPRESSED) > 0;
160: end else begin
161: Result.Name := '';
162: Result.Serial := 0;
163: Result.IsCompressed := false;
164: Result.MaxCompLen := 0;
165: Result.FileSysName := '';
166: end;
167: finally
168: SetErrorMode(PrevErrorMode);
169: end;
170: end;
171:
172: end.
Até o próximo artigo, nos vemos no artigo de bibliotecas de hardware, abraços++.
