Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
1 | daniel-mar | 1 | unit ZMDrv19; |
2 | |||
3 | (* |
||
4 | ZMDrv19.pas - drive details |
||
5 | Copyright (C) 2009, 2010 by Russell J. Peters, Roger Aelbrecht, |
||
6 | Eric W. Engler and Chris Vleghert. |
||
7 | |||
8 | This file is part of TZipMaster Version 1.9. |
||
9 | |||
10 | TZipMaster is free software: you can redistribute it and/or modify |
||
11 | it under the terms of the GNU Lesser General Public License as published by |
||
12 | the Free Software Foundation, either version 3 of the License, or |
||
13 | (at your option) any later version. |
||
14 | |||
15 | TZipMaster is distributed in the hope that it will be useful, |
||
16 | but WITHOUT ANY WARRANTY; without even the implied warranty of |
||
17 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||
18 | GNU Lesser General Public License for more details. |
||
19 | |||
20 | You should have received a copy of the GNU Lesser General Public License |
||
21 | along with TZipMaster. If not, see <http://www.gnu.org/licenses/>. |
||
22 | |||
23 | contact: problems@delphizip.org (include ZipMaster in the subject). |
||
24 | updates: http://www.delphizip.org |
||
25 | DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip |
||
26 | |||
27 | modified 2010-03-18 |
||
28 | ---------------------------------------------------------------------------*) |
||
29 | |||
30 | interface |
||
31 | |||
32 | uses |
||
33 | Classes, Windows; |
||
34 | |||
35 | type |
||
36 | //1 Provides details of drive |
||
37 | TZMWorkDrive = class(TObject) |
||
38 | private |
||
39 | fDiskName: string; |
||
40 | fDiskReadOnly: Boolean; |
||
41 | fDiskSerial: cardinal; |
||
42 | FDriveIsFloppy: Boolean; |
||
43 | fDriveLetter: Char; |
||
44 | fDriveStr: string; |
||
45 | fDriveType: Integer; |
||
46 | fLastDrive: string; |
||
47 | fVolumeFreeClusters: DWORD; |
||
48 | fVolumeSecSize: Cardinal; |
||
49 | fVolumeSectorsPerCluster: DWORD; |
||
50 | fVolumeSize: Int64; |
||
51 | fVolumeSpace: Int64; |
||
52 | fVolumeTotalClusters: DWORD; |
||
53 | function GetDriveIsFixed: Boolean; |
||
54 | procedure SetDrive(const path: string); |
||
55 | procedure SetDriveStr(const Value: string); |
||
56 | procedure SetExSizes(fields: Integer); |
||
57 | public |
||
58 | constructor Create; |
||
59 | procedure AfterConstruction; override; |
||
60 | procedure AssignFrom(const src: TZMWorkDrive); |
||
61 | procedure Clear; |
||
62 | function HasMedia(UnformOk: boolean): Boolean; |
||
63 | function RenameDisk(const NewName: string): Boolean; |
||
64 | procedure VolumeRefresh; |
||
65 | property DiskName: string read fDiskName; |
||
66 | property DiskReadOnly: Boolean read fDiskReadOnly; |
||
67 | property DiskSerial: cardinal read fDiskSerial; |
||
68 | property DriveIsFixed: Boolean read GetDriveIsFixed; |
||
69 | property DriveIsFloppy: Boolean read FDriveIsFloppy; |
||
70 | property DriveLetter: Char read fDriveLetter; |
||
71 | property DriveStr: string read fDriveStr write SetDriveStr; |
||
72 | property DriveType: Integer read fDriveType; |
||
73 | property VolumeFreeClusters: DWORD read fVolumeFreeClusters; |
||
74 | property VolumeSecSize: Cardinal read fVolumeSecSize; |
||
75 | property VolumeSectorsPerCluster: DWORD read fVolumeSectorsPerCluster; |
||
76 | property VolumeSize: Int64 read fVolumeSize; |
||
77 | property VolumeSpace: Int64 read fVolumeSpace; |
||
78 | property VolumeTotalClusters: DWORD read fVolumeTotalClusters; |
||
79 | end; |
||
80 | |||
81 | implementation |
||
82 | |||
83 | uses |
||
84 | SysUtils, ZMXcpt19, ZMMsg19; |
||
85 | |||
86 | Const |
||
87 | MAX_REMOVABLE = 10 * 1024 * 1024; |
||
88 | |||
89 | constructor TZMWorkDrive.Create; |
||
90 | begin |
||
91 | inherited; |
||
92 | end; |
||
93 | |||
94 | procedure TZMWorkDrive.AfterConstruction; |
||
95 | begin |
||
96 | inherited; |
||
97 | Clear; |
||
98 | end; |
||
99 | |||
100 | procedure TZMWorkDrive.AssignFrom(const src: TZMWorkDrive); |
||
101 | begin |
||
102 | if (self <> src) then |
||
103 | begin |
||
104 | fDiskName := src.DiskName; |
||
105 | fDiskReadOnly := src.DiskReadOnly; |
||
106 | fDiskSerial := src.DiskSerial; |
||
107 | fDriveIsFloppy := src.DriveIsFloppy; |
||
108 | fDriveLetter := src.DriveLetter; |
||
109 | fDriveStr := src.DriveStr; |
||
110 | fDriveType := src.DriveType; |
||
111 | fVolumeFreeClusters := src.VolumeFreeClusters; |
||
112 | fVolumeSecSize := src.VolumeSecSize; |
||
113 | fVolumeSectorsPerCluster := src.VolumeSectorsPerCluster; |
||
114 | fVolumeSize := src.VolumeSize; |
||
115 | fVolumeSpace := src.VolumeSpace; |
||
116 | fVolumeTotalClusters := src.VolumeTotalClusters; |
||
117 | end; |
||
118 | end; |
||
119 | |||
120 | procedure TZMWorkDrive.Clear; |
||
121 | begin |
||
122 | fDiskName := ''; |
||
123 | fLastDrive := ''; |
||
124 | fDiskReadOnly := false; |
||
125 | fDiskSerial := 0; |
||
126 | fDriveIsFloppy := False; |
||
127 | fDriveLetter := #0; |
||
128 | fDriveStr := ''; |
||
129 | fDriveType := 0; |
||
130 | fVolumeSecSize := 512; |
||
131 | fVolumeSectorsPerCluster := 4; |
||
132 | fVolumeSize := 0; |
||
133 | fVolumeSpace := 0; |
||
134 | fVolumeTotalClusters := 0; |
||
135 | end; |
||
136 | |||
137 | function TZMWorkDrive.GetDriveIsFixed: Boolean; |
||
138 | begin |
||
139 | Result := not DriveIsFloppy; |
||
140 | end; |
||
141 | |||
142 | function TZMWorkDrive.HasMedia(UnformOk: boolean): Boolean; |
||
143 | //const |
||
144 | // _FILE_READ_ONLY_VOLUME = $00080000; |
||
145 | var |
||
146 | Bits: set of 0..25; |
||
147 | err: cardinal; |
||
148 | NamLen: Cardinal; |
||
149 | Num: Integer; |
||
150 | OldErrMode: DWord; |
||
151 | SysFlags: DWord; |
||
152 | SysLen: DWord; |
||
153 | VolNameAry: array[0..255] of Char; |
||
154 | begin |
||
155 | NamLen := 255; |
||
156 | SysLen := 255; |
||
157 | fVolumeSize := 0; |
||
158 | fVolumeSpace := 0; |
||
159 | fDiskName := ''; |
||
160 | fDiskSerial := 0; |
||
161 | VolNameAry[0] := #0; |
||
162 | Result := False; |
||
163 | |||
164 | if DriveLetter <> #0 then // Only for local drives |
||
165 | begin |
||
166 | if (DriveLetter < 'A') or (DriveLetter > 'Z') then |
||
167 | raise EZipMaster.CreateResStr( DS_NotaDrive, DriveStr); |
||
168 | |||
169 | Integer(Bits) := GetLogicalDrives(); |
||
170 | Num := Ord(DriveLetter) - Ord('A'); |
||
171 | if not (Num in Bits) then |
||
172 | raise EZipMaster.CreateResStr( DS_DriveNoMount, DriveStr); |
||
173 | end; |
||
174 | |||
175 | OldErrMode := SetErrorMode(SEM_FAILCRITICALERRORS); // Turn off critical errors: |
||
176 | |||
177 | // Since v1.52c no exception will be raised here; moved to List() itself. |
||
178 | // 1.72 only get Volume label for removable drives |
||
179 | if (not GetVolumeInformation(Pchar(DriveStr), VolNameAry, |
||
180 | NamLen, @fDiskSerial, SysLen, SysFlags, Nil, 0)) then |
||
181 | begin |
||
182 | // W'll get this if there is a disk but it is not or wrong formatted |
||
183 | // so this disk can only be used when we also want formatting. |
||
184 | err := GetLastError(); |
||
185 | if (err = 31) and (UnformOk) then |
||
186 | Result := True; |
||
187 | end//; |
||
188 | else |
||
189 | begin |
||
190 | fDiskName := VolNameAry; |
||
191 | fDiskReadOnly := false; |
||
192 | { get free disk space and size. } |
||
193 | SetExSizes(7); // RCV150199 |
||
194 | end; |
||
195 | |||
196 | SetErrorMode(OldErrMode); // Restore critical errors: |
||
197 | |||
198 | // -1 is not very likely to happen since GetVolumeInformation catches errors. |
||
199 | // But on W95(+OSR1) and a UNC filename w'll get also -1, this would prevent |
||
200 | // opening the file. !!!Potential error while using spanning with a UNC filename!!! |
||
201 | if (DriveLetter = #0) or ((DriveLetter <> #0) and |
||
202 | (VolumeSize <> -1)) then |
||
203 | Result := True; |
||
204 | end; |
||
205 | |||
206 | function TZMWorkDrive.RenameDisk(const NewName: string): Boolean; |
||
207 | begin |
||
208 | Result := false; |
||
209 | if DriveIsFloppy and HasMedia(false) and not DiskReadOnly and |
||
210 | SetVolumeLabel(PChar(DriveStr), PChar(NewName)) then |
||
211 | begin |
||
212 | HasMedia(false); // get new name |
||
213 | Result := True; |
||
214 | end; |
||
215 | end; |
||
216 | |||
217 | procedure TZMWorkDrive.SetDrive(const path: string); |
||
218 | var |
||
219 | s: string; |
||
220 | begin |
||
221 | s := Uppercase(ExtractFileDrive(ExpandUNCFileName(path)) + '\'); |
||
222 | if s <> fLastDrive then |
||
223 | begin |
||
224 | Clear; |
||
225 | if (length(s) = 3) and (s[2] = ':') then |
||
226 | begin |
||
227 | // a local drive |
||
228 | fDriveLetter := s[1]; |
||
229 | fDriveType := GetDriveType(Pchar(s)); |
||
230 | if DriveType = DRIVE_REMOVABLE then |
||
231 | begin |
||
232 | if (DriveLetter = 'A') or (DriveLetter = 'B') then |
||
233 | fDriveIsFloppy := True; |
||
234 | end; |
||
235 | end |
||
236 | else |
||
237 | Clear; |
||
238 | fLastDrive := s; |
||
239 | fDriveStr := s; |
||
240 | end; |
||
241 | end; |
||
242 | |||
243 | procedure TZMWorkDrive.SetDriveStr(const Value: string); |
||
244 | begin |
||
245 | if Value <> fDriveStr then |
||
246 | SetDrive(Value); |
||
247 | end; |
||
248 | |||
249 | procedure TZMWorkDrive.SetExSizes(fields: Integer); |
||
250 | var |
||
251 | BytesPSector: DWORD; |
||
252 | LDiskFree: Int64; |
||
253 | LSizeOfDisk: Int64; |
||
254 | SSize: cardinal; |
||
255 | begin |
||
256 | LDiskFree := -1; |
||
257 | LSizeOfDisk := -1; |
||
258 | SSize := 0; |
||
259 | if GetDiskFreeSpace(Pchar(DriveStr), fVolumeSectorsPerCluster, BytesPSector, |
||
260 | fVolumeFreeClusters, fVolumeTotalClusters) then |
||
261 | begin |
||
262 | SSize := BytesPSector; |
||
263 | end; |
||
264 | if not GetDiskFreeSpaceEx(Pchar(DriveStr), LDiskFree, LSizeOfDisk, Nil) then |
||
265 | begin |
||
266 | LDiskFree := -1; |
||
267 | LSizeOfDisk := -1; |
||
268 | if SSize <> 0 then |
||
269 | begin |
||
270 | LDiskFree := Int64(BytesPSector) * VolumeSectorsPerCluster * |
||
271 | VolumeFreeClusters; |
||
272 | LSizeOfDisk := Int64(BytesPSector) * VolumeSectorsPerCluster * |
||
273 | VolumeTotalClusters; |
||
274 | end; |
||
275 | end; |
||
276 | if (fields and 1) <> 0 then |
||
277 | fVolumeSpace := LDiskFree; |
||
278 | if (fields and 2) <> 0 then |
||
279 | fVolumeSize := LSizeOfDisk; |
||
280 | if (fields and 4) <> 0 then |
||
281 | fVolumeSecSize := SSize; |
||
282 | end; |
||
283 | |||
284 | procedure TZMWorkDrive.VolumeRefresh; |
||
285 | begin |
||
286 | SetExSizes(7); |
||
287 | end; |
||
288 | |||
289 | end. |
||
290 |