source: branches/2.19.1/Components/DriveInfoUnit.PAS@ 265

Last change on this file since 265 was 15, checked in by RBRi, 19 years ago

+ components stuff

  • Property svn:eol-style set to native
File size: 13.8 KB
Line 
1unit DriveInfoUnit;
2
3interface
4
5const
6 MinDriveNumber = 1;
7 MaxDriveNumber = 26;
8
9type
10 TDriveType =
11 (
12 dtNone,
13 dtFloppy,
14 dtHard,
15 dtCD,
16 dtNetwork,
17 dtRemovable
18 );
19
20// Drive numbers are one based
21
22Function IsFloppyDrive( DriveNumber: longint ): Boolean;
23
24Function GetLocalDriveType( DriveNumber: longint ): TDriveType;
25
26Function GetDriveType( DriveNumber: longint ): TDriveType;
27
28Function GetNetworkDriveRemotePath( DriveNumber: longint ): string;
29
30implementation
31
32uses
33 BseDos, OS2def, BseErr, BseDev,
34 SysUtils,
35 ACLUtility, ACLFileUtility, ACLStringUtility;
36
37imports
38FUNCTION _DosQueryFSAttach( VAR pszDeviceName: CSTRING;
39 ulOrdinal: ULONG;
40 ulFSAInfoLevel:ULONG;
41 pfsqb: PFSQBUFFER2;
42 VAR pcbBuffLength: ULONG ): APIRET; APIENTRY;
43 'DOSCALLS' index 277;
44end;
45
46type
47 TWord = Record // Bytes of a Word
48 LoByte, HiByte : Byte;
49 End;
50
51 TBPB = Array[0..30] Of Byte; // Puffer fuer BPB-Struktur
52
53 TDeviceParameters = Record
54 BPB: TBPB;
55 Cylinders: word;
56 DeviceType: Byte;
57 Attributes: Word;
58 End;
59
60Function IsFloppyDrive( DriveNumber: longint ): Boolean;
61Var
62 bResult : Byte;
63Begin
64 DosDevConfig( bResult, DEVINFO_FLOPPY );
65 Result := ( Abs( DriveNumber ) <= bResult);
66End;
67
68// -------------------------------------------------------------------------
69// Funktion/Function: QueryCDRoms()
70//
71// Beschreibung:
72// Die Funktion QueryCDRom ermittelt ueber eine nicht dokumentierte
73// Schnittstelle die Anzahl der CDRom-Laufwerke und den ersten, fuer
74// ein CDRom-Laufwerk, vergebenen UnitIdentifier.
75// Der Treiber OS2CDROM.DMD stellt dem System zwei Devices (CD-ROM1$
76// und CD-ROM2$) zur Verfuegung. Die beiden Devices unterscheiden sich
77// durch DeviceAttribute. Beide Devices unterstuetzen (zumindest unter
78// Warp) den undokumentierten Generic IOCtl 0x82/0x60, welcher Infor-
79// mationen ueber die angeschlossenen CDRom-Laufwerke liefert.
80//
81// Description:
82// This Functions finds out how many CD-Rom Drives are present in System
83// and which Drive Letter is the first occupied by a CD-Rom. It uses an
84// undocumented Interface to OS2CDROM.DMD.
85// OS2CDROM.DMD presents two Devices (CD-ROM1$ and CD-ROM2$). These De-
86// vices are distinguished by their Device-Attributes. Both Devices sup-
87// port (under Warp) the undocumented generic IOCtl-Call 0x82/0x60 which
88// deliver some Information about the connected CD-Rom Drives.
89//
90// Parameter:
91// Var ulCDRomCount ULONG Anzahl CD-Rom Laufwerke im System
92// Number of CD-Rom Drives in System
93//
94// Var ulFirstCDRomDiskNo ULONG erste Laufwerksnummer, die an ein
95// CD-Rom vergeben ist
96// first Drive-Letter occupied by a
97// CD-Rom Drive
98//
99// Rueckgabe/Returnvalue: keine/none
100// -------------------------------------------------------------------------
101Procedure QueryCDRoms(Var ulCDRomCount, ulFirstCDRomDiskNo: ULONG);
102
103Const cszDriverName : CSTRING = 'CD-ROM?$';
104
105Var cCurDriver : Char; // Indexvariable fuer aktuell bearbeites Device (1 oder 2)
106 // Index for current Device (1 or 2)
107
108 hDevHandle : HFILE; // Handle fuer Device
109 // Device handle
110
111 ulAction : ULONG; // Aktionscode (DosOpen())
112 // Actioncode (DosOpen())
113
114 ulParams : ULONG; // Anzahl Bytes von IOCtl gelieferter Parameterdaten
115 // Number of Bytes for delivered Parameterdata
116
117 ulData : ULONG; // Anzahl Bytes von IOCtl gelieferter Daten
118 // Number of Bytes delivered by IOCtl
119
120 rCDInfo : Record // Ergebnisstruktur der IOCtl-Funktion (s.o.)
121 // Record for Results of IOCtl-Call (see above)
122 usCDRomCount : USHORT; // Anzahl CD-Roms / Number of CD-Rom Drives
123 usFirstUnitNo: USHORT; // erste vergebene Laufwerksnummer / first Driver Letter
124 End;
125
126Begin (* uQueryCDRom *)
127 /************************************
128 * Vorbelegungen
129 *
130 * initial assignments
131 ************************************/
132 ulCDRomCount := 0;
133 ulFirstCDRomDiskNo := 0;
134
135 ulParams := 0;
136
137 /************************************
138 * die beiden Devices abarbeiten
139 *
140 * accessing both Devices
141 ************************************/
142 For cCurDriver := '1' To '2' Do
143 Begin
144 /************************************
145 * Device oeffnen
146 *
147 * open Device
148 ************************************/
149 cszDriverName[6] := cCurDriver;
150 If (DosOpen(cszDriverName, // Devicename
151 hDevHandle, // Handle
152 ulAction, // Aktionscode
153 0, // DateigrӇe
154 FILE_NORMAL, // Attribute: read/write
155 OPEN_ACTION_OPEN_IF_EXISTS, // OpenFlag: ”ffnen, wenn vorhanden
156 OPEN_FLAGS_FAIL_ON_ERROR Or // Modus: Fehlermeldung per Returncode
157 OPEN_SHARE_DENYNONE Or // keine Einschr„nkungen fr Dritte
158 OPEN_ACCESS_READONLY, // nur lesender Zugriff
159 NIL)=NO_ERROR) Then // keine EA
160 Begin
161 /************************************
162 * IOCtl-Funktion aufrufen
163 *
164 * Call to IOCtl
165 ************************************/
166 If (DosDevIOCtl(hDevHandle, // Handle / Handle
167 $82, // Kategorie / Category
168 $60, // Funktion / Function
169 NIL, // keine Parameterliste / No Parameterlist
170 0, // Laenge Parameterliste / Length of Parameterlist
171 ulParams, // Groesse der gelieferten Parameterdaten
172 // / Number of Bytes for Parameterdata
173 rCDInfo, // Puffer fuer gelieferte Daten
174 // / Buffer for returned Data
175 SizeOf(rCDInfo), // Groesse des Datenpuffers
176 // / Size of Databuffer
177 ulData)=NO_ERROR) Then // Groesse der gelieferten Daten
178 // / Number of Bytes for returned Data
179 Begin
180 ulCDRomCount := rCDInfo.usCDRomCount;
181 ulFirstCDRomDiskNo := Succ(rCDInfo.usFirstUnitNo);
182 End;
183
184 DosClose(hDevHandle);
185 End;
186
187 End; (* For *)
188
189End; (* uQueryCDRom *)
190
191
192Function GetLocalDriveType( DriveNumber: longint ): TDriveType;
193var
194 IOCtlParameters: Word;
195 rc: APIRET;
196 ParameterLength: longWord;
197 DataLength: longword;
198 DeviceData: TDeviceParameters;
199 Fixed: boolean;
200 FirstCDDrive: ULONG;
201 NumCDDrives: ULONG;
202begin
203
204 TWord( IOCtlParameters ).LoByte := 0; // BPB of physical Device
205 TWord( IOCtlParameters ).HiByte := DriveNumber - 1; // drive number, zero base
206
207 ParameterLength := SizeOf( IOCtlParameters ); // input length of parameters
208 DataLength := 0; // input length of data (none)
209
210 rc := DosDevIOCTL( HFILE(-1), // Open Device (not a file)
211 IOCTL_DISK, // Category
212 DSK_GETDEVICEPARAMS, // Function
213 IOCtlParameters, // Parameters
214 SizeOf( IOCtlParameters ), // (max) size of parameters
215 ParameterLength, // parameters length
216 DeviceData, // results
217 SizeOf( DeviceData ), // (max) size of data block
218 DataLength ); // data block length
219
220 Fixed := ( DeviceData.Attributes and 1 ) > 0; // bit 0 indicates fixed (1) or removable (0)
221 if not Fixed then
222 begin
223 result := dtRemovable;
224
225 QueryCDRoms( FirstCDDrive,
226 NumCDDrives );
227
228 if ( DriveNumber >= FirstCDDrive )
229 and ( DriveNumber < FirstCDDrive + NumCDDrives ) then
230 result := dtCD;
231
232 exit;
233 end;
234
235 result := dtHard;
236end;
237
238// Takes a one-based drive number
239Function GetDriveType( DriveNumber: longint ): TDriveType;
240var
241 szDrive: CString;
242
243 FSData: array[ 0..sizeof( FSQBuffer) + 3*_MAX_PATH ] of char;
244 pBuffer: PFSQBUFFER2;
245 FSDataLength: ULONG;
246
247 rc: APIRET;
248begin
249 assert( DriveNumber >= 1 );
250 assert( DriveNumber <= 26 );
251
252 if ( DriveNumber >=1 ) and ( DriveNumber <= 2 ) then
253 begin
254 if IsFloppyDrive( DriveNumber ) then
255 begin
256 result := dtFloppy;
257 exit;
258 end;
259
260 result := dtNone; // don't let OS/2 try a fake B: drive
261 exit;
262 end;
263
264 DosErrorAPI( FERR_DISABLEHARDERR );
265
266 szDrive := DriveNumberToLetter( DriveNumber ) + ':';
267 FSDataLength := sizeof( FSData );
268 pBuffer := Addr( FSData );
269 rc := _DosQueryFSAttach( szDrive,
270 0, // ignored
271 FSAIL_QUERYNAME,
272 pBuffer,
273 FSDataLength );
274
275 if rc = 0 then
276 begin
277 case pBuffer^.iType of
278 FSAT_REMOTEDRV:
279 result := dtNetwork;
280
281 FSAT_LOCALDRV:
282 // Figure out what kind of local drive it is...
283 result := GetLocalDriveType( DriveNumber );
284
285 else
286 begin
287 // should never happen
288 result := dtNone;
289 exit;
290 end;
291 end;
292 end
293 else if rc = ERROR_NOT_READY then
294 begin
295 // No media?
296 // Have a look for a local disk anyway.
297 result := GetLocalDriveType( DriveNumber );
298 end
299 else
300 begin
301 result := dtNone;
302 end;
303
304 DosErrorAPI( FERR_ENABLEHARDERR );
305end;
306
307const
308 DEVLEN = 8;
309 CNLEN = 15; // Computer name length
310 UNCLEN = (CNLEN+2); // UNC computer name length
311 NNLEN = 12; // 8.3 Net name length (share name length)
312 RMLEN = (UNCLEN+1+NNLEN); // Maximum remote name length
313
314type
315 use_info_0 = record
316 ui0_local: cstring[ DEVLEN ]; // note this is of size DEVLEN + 1
317 ui0_pad_1: char;
318 ui0_remote: pchar;
319 space: array[ 0..RMLEN ] of char; // remote path is written to somewhere in here
320 end;
321
322 use_info_1 = record
323 ui0_local: cstring[ DEVLEN ];
324 ui0_pad_1: char;
325 ui0_remote: pchar; // address of a buffer to hold remote path
326 ui1_password: pchar; //
327 ui1_status: USHORT;
328 ui1_asg_type: SHORT;
329 ui1_refcount: USHORT;
330 ui1_usecount: USHORT;
331 space: array[ 0..RMLEN ] of char; // remote path is written to somewhere in here
332 end;
333
334 TNet32UseGetInfo = Function( pszServer: pchar;
335 pszUseName: pchar; // e.g. drive x:
336 ulLevel: ULONG;
337 pbBuffer: pointer; // pointer to output buffer
338 ulBuffer: ULONG; // size of output in buffer
339 Var pulTotalAvail: ULONG )
340 : word; CDecl;
341
342Var
343 Net32UseGetInfo: TNet32UseGetInfo;
344 hNetAPI32DLL: HMODULE;
345 TriedLoading: boolean;
346
347// 129 Net32UseGetInfo
348Function GetNetworkDriveRemotePath( DriveNumber: longint ): string;
349var
350 ErrorName: array[ 0..255 ] of char;
351 dummy: cstring;
352 rc: word;
353 UseName: array[ 0..255 ] of char;
354 UseInfo: use_info_0;
355 pUseInfo: pointer;
356 TotalBytesNeeded: ULONG;
357 RemotePath: array[ 0..255 ] of char;
358 Dummy2: array[ 0..4096 ] of char; // try to fix stack probs
359begin
360 Result := '';
361
362 if not TriedLoading then
363 begin
364 TriedLoading := true;
365 rc := DosLoadModule( ErrorName,
366 sizeof( ErrorName ),
367 'NETAPI32',
368 hNetAPI32DLL );
369 if rc = NO_ERROR then
370 begin
371 // NetAPI32.DLL loaded OK
372 rc := DosQueryProcAddr( hNetAPI32DLL,
373 129,
374 dummy,
375 pointer( Net32UseGetInfo ) );
376 if rc <> 0 then
377 Net32UseGetInfo := nil;
378 end;
379 end;
380
381 if Assigned( Net32UseGetInfo ) then
382 begin
383 UseName[ 0 ] := DriveNumberToLetter( DriveNumber );
384 UseName[ 1 ] := ':';
385 UseName[ 2 ] := #0;
386
387 RemotePath[ 0 ] := #0;
388// UseInfo.ui0_remote := Addr( RemotePath );
389
390 pUseInfo := Addr( UseInfo );
391 rc := Net32UseGetInfo( nil, // server - always nil
392 Addr( UseName ),
393 0, // info level 0
394 pUseInfo,
395 sizeof( UseInfo ),
396 TotalBytesNeeded );
397
398 if rc = 0 then
399 Result := StrPas( UseInfo.ui0_remote );
400
401 end;
402end;
403
404end.
Note: See TracBrowser for help on using the repository browser.