1 | unit DriveInfoUnit;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | const
|
---|
6 | MinDriveNumber = 1;
|
---|
7 | MaxDriveNumber = 26;
|
---|
8 |
|
---|
9 | type
|
---|
10 | TDriveType =
|
---|
11 | (
|
---|
12 | dtNone,
|
---|
13 | dtFloppy,
|
---|
14 | dtHard,
|
---|
15 | dtCD,
|
---|
16 | dtNetwork,
|
---|
17 | dtRemovable
|
---|
18 | );
|
---|
19 |
|
---|
20 | // Drive numbers are one based
|
---|
21 |
|
---|
22 | Function IsFloppyDrive( DriveNumber: longint ): Boolean;
|
---|
23 |
|
---|
24 | Function GetLocalDriveType( DriveNumber: longint ): TDriveType;
|
---|
25 |
|
---|
26 | Function GetDriveType( DriveNumber: longint ): TDriveType;
|
---|
27 |
|
---|
28 | Function GetNetworkDriveRemotePath( DriveNumber: longint ): string;
|
---|
29 |
|
---|
30 | implementation
|
---|
31 |
|
---|
32 | uses
|
---|
33 | BseDos, OS2def, BseErr, BseDev,
|
---|
34 | SysUtils,
|
---|
35 | ACLUtility, ACLFileUtility, ACLStringUtility;
|
---|
36 |
|
---|
37 | imports
|
---|
38 | FUNCTION _DosQueryFSAttach( VAR pszDeviceName: CSTRING;
|
---|
39 | ulOrdinal: ULONG;
|
---|
40 | ulFSAInfoLevel:ULONG;
|
---|
41 | pfsqb: PFSQBUFFER2;
|
---|
42 | VAR pcbBuffLength: ULONG ): APIRET; APIENTRY;
|
---|
43 | 'DOSCALLS' index 277;
|
---|
44 | end;
|
---|
45 |
|
---|
46 | type
|
---|
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 |
|
---|
60 | Function IsFloppyDrive( DriveNumber: longint ): Boolean;
|
---|
61 | Var
|
---|
62 | bResult : Byte;
|
---|
63 | Begin
|
---|
64 | DosDevConfig( bResult, DEVINFO_FLOPPY );
|
---|
65 | Result := ( Abs( DriveNumber ) <= bResult);
|
---|
66 | End;
|
---|
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 | // -------------------------------------------------------------------------
|
---|
101 | Procedure QueryCDRoms(Var ulCDRomCount, ulFirstCDRomDiskNo: ULONG);
|
---|
102 |
|
---|
103 | Const cszDriverName : CSTRING = 'CD-ROM?$';
|
---|
104 |
|
---|
105 | Var 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 |
|
---|
126 | Begin (* 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 Einschrnkungen fr 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 |
|
---|
189 | End; (* uQueryCDRom *)
|
---|
190 |
|
---|
191 |
|
---|
192 | Function GetLocalDriveType( DriveNumber: longint ): TDriveType;
|
---|
193 | var
|
---|
194 | IOCtlParameters: Word;
|
---|
195 | rc: APIRET;
|
---|
196 | ParameterLength: longWord;
|
---|
197 | DataLength: longword;
|
---|
198 | DeviceData: TDeviceParameters;
|
---|
199 | Fixed: boolean;
|
---|
200 | FirstCDDrive: ULONG;
|
---|
201 | NumCDDrives: ULONG;
|
---|
202 | begin
|
---|
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;
|
---|
236 | end;
|
---|
237 |
|
---|
238 | // Takes a one-based drive number
|
---|
239 | Function GetDriveType( DriveNumber: longint ): TDriveType;
|
---|
240 | var
|
---|
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;
|
---|
248 | begin
|
---|
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 );
|
---|
305 | end;
|
---|
306 |
|
---|
307 | const
|
---|
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 |
|
---|
314 | type
|
---|
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 |
|
---|
342 | Var
|
---|
343 | Net32UseGetInfo: TNet32UseGetInfo;
|
---|
344 | hNetAPI32DLL: HMODULE;
|
---|
345 | TriedLoading: boolean;
|
---|
346 |
|
---|
347 | // 129 Net32UseGetInfo
|
---|
348 | Function GetNetworkDriveRemotePath( DriveNumber: longint ): string;
|
---|
349 | var
|
---|
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
|
---|
359 | begin
|
---|
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;
|
---|
402 | end;
|
---|
403 |
|
---|
404 | end.
|
---|