Operações Disks Drives em Delphi

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++.