|
Hardware
Determine a CD-Rom-Drive
Need help on overriding Sys Err
Hard disk serial number
System Ram / CMOS
Disk Serial Numbers
Reading a byte from the parallel port
Getting disk information
Setting PC Clock
Detecting Disk in Drive A:
Port and mem
Managing disk volume labels
How to check if a drive is ready
Detecting a Pentium processor
Determining drive type
Determine a CD-Rom-Drive
Question
Q:
How can i determine if a CD-ROM drive is on the machine. I tried using the WIN API GetDriveType but it return the same number (4) if it is a CD-ROM or a network drive.
Answer
A:
This should do the trick..
function IsCDROM(DriveNum: Integer): Boolean; assembler;
asm
MOV AX,1500h { look for MSCDEX }
XOR BX,BX
INT 2fh
OR BX,BX
JZ @Finish
MOV AX,150Bh { check for using CD driver }
MOV CX,DriveNum
INT 2fh
OR AX,AX
@Finish:
end;
BTW under Win32 GetDriveType properly returns a CD-ROM drive.
A:
Function IsCdRom(DriveNum : Word) : Boolean;
Var
F : WordBool;
Begin
asm
mov ax, 1500h { test for presence of MSCDEX }
xor bx, bx
int 2fh
mov ax, bx { if bx = zero, MSCDEX is not present }
or ax, ax { return FALSE }
jz @no_mscdex
mov ax, 150bh { MSCDEX drive check }
mov cx, DriveNum { cx contains drive }
int 2fh
@no_mscdex:
mov f,ax
end;
Result := F; { Assign function return value }
End;
Need help on overriding Sys Err
Question
Want the app. to read and recognize a drive not ready (i.e., user selects a
floppy drive with no disk in drive) - then want the app to display the error
box rather than Windows System Error display box.
Answer
A:
Here's a routine that will do the trick for diskette drives:
function DisketteDriveReady (DisketteDrive: char): boolean;
{----------------------------------------------------------------}
{ Returns true if specified Diskette drive [A/a or B/b] is ready }
{ with a diskette inserted, otherwise false. From a Delphi-Talk }
{ posting by Per Ola Svensson }
{----------------------------------------------------------------}
var
Drive: byte;
PrevInt24, DiscardReturnValue: word;
begin
DisketteDriveReady := false; {until proven otherwise}
case DisketteDrive of
'A', 'a': Drive := 1;
'B', 'b': Drive := 2;
else Exit;
end; {case}
PrevInt24 := SetErrorMode(SEM_FAILCRITICALERRORS);
if DiskFree(Drive) <> -1 then
DisketteDriveReady := true;
DiscardReturnValue := SetErrorMode(PrevInt24);
end; {DisketteDriveReady}
Hard disk serial number
Question
Is there anyone who knows how to obtain the hard disk serial number?
Answer
I have an unit to get the Hd Name and the Hd Serial number for Borland
Pascal 7.0. I don't know if it's working with Delphi and the other thing is
that it is in dutch and I don't have time to translate it in englisch. Mayby
you can use it, otherwise drop it out of the window.
Unit HardDisk;
INTERFACE
FUNCTION GetHardDiskNaam : STRING;
FUNCTION GetHardDiskSerieNummer : STRING;
FUNCTION GetHardDiskControlleNummer : STRING;
PROCEDURE GetHardDiskGegevens;
CONST
CodeerTabel : ARRAY[0..24] OF BYTE =
(3,1,2,1,4,1,3,2,6,4,6,5,1,2,6,4,2,6,3,4,6,2,4,1,2);
TYPE
CharArray = ARRAY[0..24] OF CHAR;
VAR
HardDiskGegevens : ARRAY[1..256] OF INTEGER;
HardDiskNaam : CharArray;
SerieNummer : CharArray;
ControlleNummer : CharArray;
C_HardDiskNaam : STRING;
C_HardDiskSerieNummer : STRING;
C_HardDiskControlleNummer : STRING;
C_LicentieNaam : STRING;
IMPLEMENTATION
FUNCTION GetHardDiskNaam : STRING;
VAR
Teller : INTEGER;
Lus : INTEGER;
BEGIN
GetHardDiskNaam := '';
Teller := 1;
FOR Lus := 1 TO 18 DO
BEGIN
HardDiskNaam[Teller] := CHR( ( HardDiskGegevens[27+Lus] DIV 256 ));
Inc(Teller);
HardDiskNaam[Teller] := CHR( ( HardDiskGegevens[27+Lus] MOD 256 ));
Inc(Teller);
END;
GetHardDiskNaam := HardDiskNaam;
END;
FUNCTION GetHardDiskSerieNummer : STRING;
VAR
Teller : INTEGER;
Lus : INTEGER;
BEGIN
GetHardDiskSerieNummer := '';
Teller := 1;
FOR Lus := 1 TO 8 DO
BEGIN
SerieNummer[Teller] := CHR( ( HardDiskGegevens[10+Lus] DIV 256 ));
Inc(Teller);
SerieNummer[Teller] := CHR( ( HardDiskGegevens[10+Lus] MOD 256 ));
Inc(Teller);
END;
GetHardDiskSerieNummer := SerieNummer;
END;
FUNCTION GetHardDiskControlleNummer : STRING;
VAR
Teller : INTEGER;
Lus : INTEGER;
BEGIN
GetHardDiskControlleNummer := '';
Teller := 1;
FOR Lus := 1 TO 3 DO
BEGIN
ControlleNummer[Teller] := CHR( ( HardDiskGegevens[23+Lus] DIV 256 ));
Inc(Teller);
ControlleNummer[Teller] := CHR( ( HardDiskGegevens[23+Lus] MOD 256 ));
Inc(Teller);
END;
GetHardDiskControlleNummer := ControlleNummer;
END;
PROCEDURE GetHardDiskGegevens;
VAR
Lus : INTEGER;
BEGIN
WHILE ( Port[$1f7] <> $50) DO ;
Port[$1F6] := $A0 ;
Port[$1F7] := $EC ;
WHILE ( Port[$1f7] <> $58 ) DO ;
FOR Lus := 1 TO 256 DO
BEGIN
HardDiskGegevens[Lus] := Portw[$1F0] ;
END;
END;
END.
A:
unit Chiunit4;
interface
function Chk...(ParamIn ... ,=20
ParamDatabaseNamePchar: pchar ): longint; export;
implementation
uses SysUtils, DBTables, ExtCtrls ;
const
ide_drive_C =3D $00A0;
ide_Data =3D $1F0;
ide_Error =3D $1F1;
ide_DriveAndHead =3D $1F6;
ide_Command =3D $1F7;
ide_command_readpar =3D $EC;
ide_Status =3D $1F7;
ide_status_busy =3D $80;
ide_status_ready =3D $40;
ide_status_error =3D $01;
ide_Fixed =3D $3F6;
ide_Fixed_Irq =3D $02;
IntervalleMinimum =3D 0.0000232;
{ 0.000011574 =3D 1 seconde (.0001 (hh.mmss) (->DEG=3D.0002777) / 24) }
{ .0000174 =3D 1 1/2 sec } { .0000232 =3D 2 sec }
type
tIdeRec =3D Record
rec : array[0..255] of word;
end;
var
ExitSave : Pointer;
IdeRec : tIdeRec;
function ConvertToString : string;
var
i,j : integer;
begin
FillChar( Result, 20, ' ' ); Result[0] :=3D #20;
for i :=3D 1 to 20 do
begin
j :=3D Trunc( (i-1) /2 ) +10 ;
if Lo(IdeRec.Rec[j]) =3D (0)
then Result[i]:=3D ' '
else
Result[i]:=3D Chr ( Lo( IdeRec.Rec[j] ) ) ;
i :=3D i +1;
if Hi(IdeRec.Rec[j]) =3D (0)
then Result[i]:=3D ' '
else
Result[i]:=3D Chr ( Hi( IdeRec.Rec[j] ) ) ;
end;
end;
function DoIt(Numero: string) : longint;
var
portchar :byte;
boo :Boolean;
i :integer;
S,S1 :String;
begin
Result:=3D 19 ; { fail per default }
FillChar( IdeRec.Rec, 512, ' ' ) ;
{ en premier lieu v=E9rifier l'=E9tat }
boo :=3D true;
{ poll DRQ wait }
i :=3D 5000 ;
repeat
i :=3D i -1;
portchar :=3D Lo(port[ide_status]) ; { get status }
until
( i < 1 ) or not
( ( portchar AND ide_status_busy ) =3D ide_status_busy ) ;
if i < 1 then
begin
{ Result:=3D 'status allways busy'; }
Result :=3D 180 ;
boo :=3D false;
end;
if boo then
try
{ premi=E8rement disable drive interrupts }
port[ide_Fixed] :=3D 0;
port[ide_DriveAndHead] :=3D ide_drive_C ; { set drive }
portchar :=3D Lo(port[ide_status]) ; { get status }
if portchar =3D $ff then begin
{ Result:=3D 'set drive status $ff'; }
Result :=3D 11 ;
boo :=3D false;
end;
if boo then
begin
{ poll DRQ wait }
i :=3D 1024 ;
repeat
i :=3D i -1;
portchar :=3D Lo(port[ide_status]) ;
until
( i < 1 ) or not
( ( portchar AND ide_status_busy ) =3D ide_status_busy ) ;
if i < 1 then
begin
{ Result:=3D 'status allways busy'; }
Result :=3D 181 ;
boo :=3D false;
end;
end;
if boo then
{ check if ready }
if ( portchar AND ide_status_ready ) =3D 0
then begin
{ Result:=3D 'set drive status not ready'; }
Result :=3D 12 ;
boo :=3D false;
end;
if boo then
{ ok now want to readIDE }
{ send ReadParameters command }
port[ide_Command] :=3D ide_command_readpar ;
{ poll DRQ wait }
i :=3D 5000 ;
repeat
i :=3D i -1;
portchar :=3D Lo(port[ide_status]) ;
until
( i < 1 ) or not
( ( portchar AND ide_status_busy ) =3D ide_status_busy ) ;
if i < 1 then
begin
{ Result:=3D 'status allways busy'; }
Result :=3D 182 ;
boo :=3D false;
end;
if boo then
{ check if no error}
if ( portchar AND ide_status_error ) =3D ide_status_error
then begin
{ Result:=3D 'drive status error after ReadPar'; }
Result :=3D 13 ;
boo :=3D false;
end;
if boo then
{ check if ready }
if ( portchar AND ide_status_ready ) =3D 0
then begin
{ Result:=3D 'after ReadPar drive status not ready'; }
Result :=3D 14 ;
boo :=3D false;
end;
if boo then
try
{ ok now read the buffer 256 word }
for i :=3D 0 to 255 do
begin
IdeRec.Rec[i] :=3D ( portw[ide_Data] ) ;
end;
except
on Exception do begin
{ ShowMessage( 'Erreur portw i=3D '+intToStr(i)=
) ; }
boo :=3D false;
Result :=3D 15 ;
end;
else begin
boo :=3D false;
Result :=3D 16 ;
raise;
end;
end;
if boo Then
begin
S :=3D ConvertToString;
if length(Numero) < 20 then S1:=3D Numero +' '
else S1:=3D Numero;
if CompareStr ( S, Copy(S1,1,20) ) =3D 0
then Result :=3D 10
else Result :=3D 17 ;
{ Result :=3D '('+S+')<>('+Copy(S1,1,20)+')' ; }
end;
finally
{ re-enable disk interrupts }
port[ide_Fixed] :=3D ide_Fixed_Irq ;
end;
END;
procedure MyExit; far;
{ reset disk parameters so other disk operations won't be desturbed in ca=
se
of program abort }
begin
ExitProc :=3D ExitSave; { restore previous exitproc }
{ Port[ide_Command]:=3D$10; { send command: reset current drive }
end;
function GetParam(ParamAlias: string): String;
var
i : integer ;
t : TTable ;
S : String ;
begin
Result :=3D '';
try
t :=3D nil;
t :=3D TTable.Create(nil);
t.DatabaseName :=3D ParamAlias;
t.TableName :=3D ...;
t.TableType :=3D ttPARADOX;
t.open;
...
finally
if Assigned(t) then t.free ;
end;
end;
function FixParam(ParamAlias: string): boolean;
var
i : integer ;
t : TTable ;
S : String ;
begin
Result :=3D False;
try
t :=3D nil;
t :=3D TTable.Create(nil);
t.DatabaseName :=3D ParamAlias;
t.TableName :=3D ;
t.TableType :=3D ttPARADOX;
t.open;
if=20
begin
... t.Edit;
t.setFields([nil, S]);
t.post;
end;
t.close;
Result :=3D True;
finally
if Assigned(t) then t.free ;
end;
end;
{----------------------------------------------------}
function Chk...(ParamIn: ;
ParamDatabaseNamePchar: pchar ): longInt ;
var
ParamString : String; =20
Temps : Real;
Ok : boolean;
i: integer;
S : string[20];
S6 : string[6];
r : longInt;
Label
Jump;
BEGIN
Result:=3D 0 ; { par d=E9faut }
if Ok then
i :=3D 0;
repeat
begin
i :=3D i +1 ;
r :=3D DoIt(Copy(ParamString,54,20)) ;
if r =3D 10 then begin
Ok :=3D True ;
break
end
else begin
Ok :=3D False ;
Result:=3D r;
Continue;
end;
end;
until i =3D 3 ;
If Ok
then begin
Ok :=3D FixParam(ParamDatabaseName) ;
If Ok then else { Result :=3D 'FixParam fail'; }
Result :=3D 2 ;
end;
If Ok then Result :=3D 1 ;
END;
Begin
ExitSave:=3D ExitProc;
ExitProc:=3D @MyExit;
end.
System Ram / CMOS
Question
Does anyone have any source code for extracting from the BIOS or any
other way the amount of RAM fitted to a system.
Answer
A:
You can try this... It will return the amount of extended mem from
the CMOS (Total K's minus the first Mb).
Function MyGetExt: Integer; Assembler;
asm
Mov AX,$3031;
Out $70,AL;
NOP;
IN AL,$71;
XCHG AH,AL;
Out $70,AL;
NOP;
IN AL,$71;
end;
A:
Attention CMOS-busters:
Here's what's happening for those not so sharp on their assembly language
directives.
To read from CMOS do the following:
write to port $70 with the address value to read or write.
write to port $71 with the new value or read the value of interest
from port $71.
CMOS is reasnably generic in some locations. Most noteable are the
locations $0-$F, (the time,date and timer settings) and the locations from
$10-$1F, (general system settings). The locations above $20 are usually
more subject to the whims of mfg's than the others which are reasonably
standard.
My example will be in C as ASM was just represented! I'll get to Delphi in
a minute.
write to port $70 (hex) with the address value of the CMOS memory location
that you are interested
outp(0x70,0x31); { tells CMOS we want to 'talk' to CMOS location 31hex }
next, read the desired value at port $71 or write a new value to the port.
outp(0x71, 0x10); { this writes the value 10 hex (16
dec) to CMOS location 31as previously defined }
OR
x = inp(0x71); { this reads the hex value from
CMOS location 31 as previously declared }
it is also good form to include a delay between the write to
port 70 and the read or write at port 71. This is more important in
assembly routines and maybe real fast cpu's then in higher level languages.
That's the purpose of the NOP in Leif's code example and also generally
recommended.
You will note that in Leif's ASM code two locations are stuffed into the
AX, 30 and 31. This is to allow for a quick load to search two addresses.
This code contains two instances, both CMOS reads. The memory values are
stored in two consecutive locations but I believe it's a case of most
significant byte last. And they also only concern the amount of memory
beyond 1 Mb as also stated below.
OK, ok, I know this is supposed to be Delphi but I'm a C programmer
reasonably new to Delphi and Pascal so to do this in Delphi probably
involves using Port or PortW but I haven't tried it yet so don't know exact
syntax. Probably pretty similar to C style though. Would be interested in
hearing from anyone that has done it that way. Couldn't really find an
example yet and haven't had time for exploring.
Of a rather important note, it should be pointed out that this method will
only read so much memory. Back in the old days, no one considered the vast
amounts of RAM available today system-wise and I believe that certain large
sizes of RAM will not be correctly loaded into CMOS. Therefore this is not
a cure-all concept. Some of this is caused by BIOS
shortcomings/short-sightings. Also, you will need a CMOS map to show what
locations are loaded for which system parameters. Some differences can
exist between different mfg's. This can be a rather messy job...
Here's the most important thing for budding CMOS editors to remember:
IF you edit a location between $10 and $2F then you WILL NEED to
calculate the NEW checksum by adding together all the location values from
$10-$2F and THEN WRITE the new value to $3E, $3F or YOU WILL GET A CMOS
CHECKSUM ERROR WHEN YOU REBOOT! GUARANTEED!!! THIS should concern you...
Also, don't try to test the values $0 - $1F. Time marches on, don't
you know...
A:
There is no way of getting from the BIOS the total amount fo memory. The
BIOS will only report you that if you have 640K or minus (i.e. 256K...).
Since the real memory is virtualized, expecially in Windows enviroment,
you can only test for the presence of EMS, XMS, or DPMI memory using the
interrupt calls of this services, that reports you the free mem for every
one of this. I don't know if there is a way of know the phisical memory
fitted in the system under Win. Don't result to me there is an API function
providing this; you can only test for the total virtualized memory
(including swap files, etc.). I think under Win95 there is a method.
If you want, I can send you interrupt protocols for obtaining EMS etc., but
I don't think it can be useful to you under Win.
Disk Serial Numbers
Question
It is a C++ Class for reading/writing disk volume labels and serial numbers.
Any C++ gurus out there that can convert to DELPHI?
Answer
A:
This is not a conversion, but here's a Delphi unit with a function
that reads them. To write them, you can change the AX value to $6901
and fill the buffer with your values before calling the interrupt.
DOS 4.00+ required.
unit Sernumu;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TMediaID = Record
InfoLevel : Word;
SerialNumber : LongInt;
VolumeLabel : Array[0..10] of Char;
SysName : Array[0..7] of Char;
End;
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
MediaID : TMediaID;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
type
DPMIRegisters =
record
DI : LongInt;
SI : LongInt;
BP : LongInt;
Reserved : LongInt;
BX : LongInt;
DX : LongInt;
CX : LongInt;
AX : LongInt;
Flags : Word;
ES : Word;
DS : Word;
FS : Word;
GS : Word;
IP : Word;
CS : Word;
SP : Word;
SS : Word;
end;
function RealIntr(IntNo : Byte; var Regs : DPMIRegisters) : Word; Assembler;
asm
xor bx,bx
mov bl,IntNo
xor cx,cx {StackWords = 0}
les di,Regs
mov ax,0300h
int 31h
jc @@ExitPoint
xor ax,ax
@@ExitPoint:
end;
function GetDiskInfo(Drive : Word; var MediaID : TMediaID) : Boolean;
type
tLong = Record
LoWord, HiWord : Word;
End;
var
Regs : DPMIRegisters;
dwAddress : LongInt;
Address : tLong absolute dwAddress;
begin
Result := False;
FillChar(MediaID, SizeOf(MediaID), 0);
dwAddress := GlobalDosAlloc(SizeOf(MediaID)); { two paragraphs of DOS memory }
if dwAddress = 0
then { address is zero if error occurred }
exit;
With Regs do
begin
bx := Drive;
cx := $66;
ds := Address.HiWord;
ax := $6900;
dx := 0;
es := 0;
flags := 0;
end;
If RealIntr($21, Regs) <> 0
Then
Exit;
Move(ptr(Address.LoWord, 0)^, MediaID, SizeOf(MediaID));
GlobalDosFree(Address.LoWord) { free DOS memory block }
Result := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
GetDiskInfo(1, MediaID);
With MediaID do
Begin
Label1.Caption := IntToHex(SerialNumber, 8);
Label2.Caption := VolumeLabel;
Label3.Caption := SysName;
End;
end;
end.
Reading a byte from the parallel port
Question
I needed to read a byte from the parallel port (0x379). I did it using inline
assemble language. I noticed their is no way of doing it using the Windows API.
I have a sensor attached to this port. It works fine but, is it safe to address
hardware directly in windows. Windows is intercepting the call anyway (I
think).
Var
BytesRead : BYTE;
begin
asm { Read port (LPT1) via Inline asm }
MOV dx,$379;
IN al,dx;
MOV BytesRead,al;
end;
BytesRead:=(BytesRead OR $07); { OR and then XOR the data }
BytesRead:=(BytesRead XOR $80); { to mask the unused bits }
Answer
It's no problem, use the Turbo Pascal command ...
value:=port[$379]; { read from port }
and
port[$379]:=value; { write to port }
The port command doesn't seem to be documented in online help, but it
certainly works!
Getting disk information
Question
I was tring to get the serial number of a disk using Delphi, but the code does
not seem to work. It works only on a DOS window.
Answer
A:
I didn't find info regarding function 69h but I wrote something using
4409h:
type
MIDPtr = ^MIDRec;
MIDRec = Record
InfoLevel: word;
SerialNum: LongInt;
VolLabel: Packed Array [0..10] of Char;
FileSysType: Packed Array [0..7] of Char;
end;
function GetDriveSerialNum(MID: MIDPtr; drive: Word): Boolean; assembler;
asm
push DS { Just for safety, I dont think its really needed }
mov ax,440Dh { Function Get Media ID }
mov bx,drive { drive no (0-Default, 1-A ...) }
mov cx,0866h { category and minor code }
lds dx,MID { Load pointeraddr. }
call DOS3Call { Supposed to be faster than INT 21H }
jc @@err
mov al,1 { No carry so return TRUE }
jmp @@ok
@@err:
mov al,0 { Carry set so return FALSE }
@@ok:
pop DS { Restore DS, were not supposed to change it }
end;
procedure TForm1.NrBtnClick(Sender: TObject);
var
Info: MIDRec;
begin
Info.InfoLevel:=0; { Information Level }
If GetDriveSerialNum(@Info,0) then { Do something with it... }
ListBox.Items.Add(IntToStr(Info.SerialNum)+' '+Info.VolLabel);
end;
Setting PC Clock
Question
Who can tell me how to SET the pc real time clock from a delphi program?
Answer
A:
{ SetDate sets the current date in the operating system. Valid }
{ parameter ranges are: Year 1980-2099, Month 1-12 and Day }
{ 1-31. If the date is not valid, the function call is ignored. }
procedure SetDate(Year, Month, Day: Word); assembler;
asm
MOV CX,Year
MOV DH,BYTE PTR Month
MOV DL,BYTE PTR Day
MOV AH,2BH
INT 21H
end;
{ SetTime sets the time in the operating system. Valid }
{ parameter ranges are: Hour 0-23, Minute 0-59, Second 0-59 and }
{ Sec100 (hundredths of seconds) 0-99. If the time is not }
{ valid, the function call is ignored. }
procedure SetTime(Hour, Minute, Second, Sec100: Word); assembler;
asm
MOV CH,BYTE PTR Hour
MOV CL,BYTE PTR Minute
MOV DH,BYTE PTR Second
MOV DL,BYTE PTR Sec100
MOV AH,2DH
INT 21H
end;
function SetSystemDateTime(Year, Month, Day, Hour, Minute, Second: word): integer; export;
begin
SetDate(Year, Month, Day);
SetTime(Hour, Minute + 1, Second, 0);
result := 1;
end;
Detecting Disk in Drive A:
Question
I am very new to delphi, so i apologize if this is an easy
question. What i need is to be able to detect if there is a disk in
drive A: and display a message if there is. Obviously, i do not want
the system to do anything if the drive is empty. Every way i have
tried this, i get a Windows Cancel/Retry message appearing when the
drive is empty.
Answer
This function should do the trick.
function DiskInDrive(Drive: Char): Boolean;
var
ErrorMode: word;
begin
if Drive in ['a'..'z'] then Dec(Drive, $20);
if not (Drive in ['A'..'Z']) then
raise EConvertError.Create('Not a valid drive ID');
ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
try
if DiskSize(Ord(Drive) - $40) = -1 then
Result := False
else
Result := True;
finally
SetErrorMode(ErrorMode);
end;
end;
Port and mem
Question
Does anyone knows how to access the port and mem arrays? The
documentation talks (very little) about them but don't say in what unit
they are.
Answer
For the ports in Delphi 2 I use
procedure OutPort( port :word; value :byte );
begin
asm
mov dx,port
mov al,value
out dx,al
end;
end;
function InPort( port :word ) :byte;
begin
asm
mov dx,port
in al,dx
mov result,al
end;
end;
Managing disk volume labels
Question
How to manage disk volume labels?
Answer
{
This document contains the source code for a unit that is useful for
getting, setting, and deleting volume labels from a floppy or hard disk.
The code for getting a volume label uses the Delphi FindFirst function,
and the code for setting and deleting volume labels involves calling DOS
interrupt 21h, functions 16h and 13h respectively. Since function 16h
isn't supported by Windows, it must be called through DPMI interrupt 31h,
function 300h.
}
unit VolLabel;
interface
uses Classes, SysUtils, WinProcs;
type
EInterruptError = class(Exception);
EDPMIError = class(EInterruptError);
Str11 = String[11];
procedure SetVolumeLabel(NewLabel: Str11; Drive: Char);
function GetVolumeLabel(Drive: Char): Str11;
procedure DeleteVolumeLabel(Drv: Char);
implementation
type
PRealModeRegs = ^TRealModeRegs;
TRealModeRegs = record
case Integer of
0: (
EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: Longint;
Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);
1: (
DI, DIH, SI, SIH, BP, BPH, XX, XXH: Word;
case Integer of
0: (
BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);
1: (
BL, BH, BLH, BHH, DL, DH, DLH, DHH,
CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));
end;
PExtendedFCB = ^TExtendedFCB;
TExtendedFCB = Record
ExtendedFCBflag : Byte;
Reserved1 : array[1..5] of Byte;
Attr : Byte;
DriveID : Byte;
FileName : array[1..8] of Char;
FileExt : array[1..3] of Char;
CurrentBlockNum : Word;
RecordSize : Word;
FileSize : LongInt;
PackedDate : Word;
PackedTime : Word;
Reserved2 : array[1..8] of Byte;
CurrentRecNum : Byte;
RandomRecNum : LongInt;
end;
procedure RealModeInt(Int: Byte; var Regs: TRealModeRegs);
{ procedure invokes int 31h function 0300h to simulate aa real mode }
{ interrupt from protected mode. }
var
ErrorFlag: Boolean;
begin
asm
mov ErrorFlag, 0 { assume success }
mov ax, 0300h { function 300h }
mov bl, Int { real mode interrupt to execute }
mov bh, 0 { required }
mov cx, 0 { stack words to copy, assume zero }
les di, Regs { es:di = Regs }
int 31h { DPMI int 31h }
jnc @@End { carry flag set on error }
@@Error:
mov ErrorFlag, 1 { return false on error }
@@End:
end;
if ErrorFlag then
raise EDPMIError.Create('Failed to execute DPMI interrupt');
end;
function DriveLetterToNumber(DriveLet: Char): Byte;
{ function converts a character drive letter into its numerical equiv. }
begin
if DriveLet in ['a'..'z'] then
DriveLet := Chr(Ord(DriveLet) -32);
if not (DriveLet in ['A'..'Z']) then
raise EConvertError.CreateFmt('Cannot convert %s to drive number',
[DriveLet]);
Result := Ord(DriveLet) - 64;
end;
procedure PadVolumeLabel(var Name: Str11);
{ procedure pads Volume Label string with spaces }
var
i: integer;
begin
for i := Length(Name) + 1 to 11 do
Name := Name + ' ';
end;
function GetVolumeLabel(Drive: Char): Str11;
{ function returns volume label of a disk }
var
SR: TSearchRec;
DriveLetter: Char;
SearchString: String[7];
P: Byte;
begin
SearchString := Drive + ':\*.*';
{ find vol label }
if FindFirst(SearchString, faVolumeID, SR) = 0 then begin
P := Pos('.', SR.Name);
if P > 0 then begin { if it has a dot... }
Result := ' '; { pad spaces between name }
Move(SR.Name[1], Result[1], P - 1); { and extension }
Move(SR.Name[P + 1], Result[9], 3);
end
else begin
Result := SR.Name; { otherwise, pad to end }
PadVolumeLabel(Result);
ennd;
end
else
Result := '';
end;
procedure DeleteVolumeLabel(Drv: Char);
{ procedure deletes volume label from given drive }
var
CurName: Str11;
FCB: TExtendedFCB;
ErrorFlag: WordBool;
begin
ErrorFlag := False;
CurName := GetVolumeLabel(Drv); { get current volume label }
FillChar(FCB, SizeOf(FCB), 0); { initialize FCB with zeros }
with FCB do begin
ExtendedFCBflag := $FF; { always }
Attr := faVolumeID; { Volume ID attribute }
DriveID := DriveLetterToNumber(Drv); { Drive number }
Move(CurName[1], FileName, 8); { must enter volume label }
Move(CurName[9], FileExt, 3);
end;
asm
push ds { preserve ds }
mov ax, ss { put seg of FCB (ss) in ds }
mov ds, ax
lea dx, FCB { put offset of FCB in dx }
mov ax, 1300h { function 13h }
Call DOS3Call { invoke int 21h }
pop ds { restore ds }
cmp al, 00h { check for success }
je @@End
@@Error: { set flag on error }
mov ErrorFlag, 1
@@End:
end;
if ErrorFlag then
raise EInterruptError.Create('Failed to delete volume name');
end;
procedure SetVolumeLabel(NewLabel: Str11; Drive: Char);
{ procedure sets volume label of a disk. Note that this procedure }
{ deletes the current label before setting the new one. This is }
{ required for the set function to work. }
var
Regs: TRealModeRegs;
FCB: PExtendedFCB;
Buf: Longint;
begin
PadVolumeLabel(NewLabel);
if GetVolumeLabel(Drive) <> '' then { if has label... }
DeleteVolumeLabel(Drive); { delete label }
Buf := GlobalDOSAlloc(SizeOf(PExtendedFCB)); { allocate real buffer }
FCB := Ptr(LoWord(Buf), 0);
FillChar(FCB^, SizeOf(FCB), 0); { init FCB with zeros }
with FCB^ do begin
ExtendedFCBflag := $FF; { required }
Attr := faVolumeID; { Volume ID attribute }
DriveID := DriveLetterToNumber(Drive); { Drive number }
Move(NewLabel[1], FileName, 8); { set new label }
Move(NewLabel[9], FileExt, 3);
end;
FillChar(Regs, SizeOf(Regs), 0);
with Regs do begin { SEGMENT of FCB }
ds := HiWord(Buf); { offset = zero }
dx := 0;
ax := $1600; { function 16h }
end;
RealModeInt($21, Regs); { create file }
if (Regs.al <> 0) then { check for success }
raise EInterruptError.Create('Failed to create volume label');
end;
end.
How to check if a drive is ready
Question
How to check if a drive is ready?
Answer
{
The following function accepts a drive letter as a parameter,
and it will return a boolean value that indicates whether
or not there is a disk in the drive.
}
function DiskInDrive(Drive: Char): Boolean;
var
ErrorMode: word;
begin
{ make it upper case }
if Drive in ['a'..'z'] then Dec(Drive, $20);
{ make sure it's a letter }
if not (Drive in ['A'..'Z']) then
raise EConvertError.Create('Not a valid drive ID');
{ turn off critical errors }
ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
try
{ drive 1 = a, 2 = b, 3 = c, etc. }
if DiskSize(Ord(Drive) - $40) = -1 then
Result := False
else
Result := True;
finally
{ restore old error mode }
SetErrorMode(ErrorMode);
end;
end;
Detecting a Pentium processor
Question
How to detect a Pentium processor?
Answer
{
Here is a Delphi unit to detect the CPU type, modified from Intel's
code. Use should be fairly obvious. If not, send me email, and I can
send you an example program. Because Delphi's assembler is 16-bit,
the code looks a little wierd. Try using a 32-bit disassembler to see
the 32-bit instructions (or read the comments).
}
unit CpuId;
{ This code comes from Intel, and has been modified for Delphi's
inline assembler. Since Intel made the original code freely
available, I am making my changes freely available.
Share and enjoy!
Ray Lischner
Tempest Software
6/18/95
}
interface
type
{ All the types currently known. As new types are created,
add suitable names, and extend the case statement in
CpuTypeString.
}
TCpuType = (cpu8086, cpu80286, cpu386, cpu486, cpuPentium);
{ Return the type of the current CPU }
function CpuType: TCpuType;
{ Return the type as a short string }
function CpuTypeString: String;
implementation
uses SysUtils;
function CpuType: TCpuType; assembler;
asm
push DS
{ First check for an 8086 CPU }
{ Bits 12-15 of the FLAGS register are always set on the }
{ 8086 processor. }
pushf { save EFLAGS }
pop bx { store EFLAGS in BX }
mov ax,0fffh { clear bits 12-15 }
and ax,bx { in EFLAGS }
push ax { store new EFLAGS value on stack }
popf { replace current EFLAGS value }
pushf { set new EFLAGS }
pop ax { store new EFLAGS in AX }
and ax,0f000h { if bits 12-15 are set, then CPU }
cmp ax,0f000h { is an 8086/8088 }
mov ax, cpu8086 { turn on 8086/8088 flag }
je @@End_CpuType
{ 80286 CPU check }
{ Bits 12-15 of the FLAGS register are always clear on the }
{ 80286 processor. }
or bx,0f000h { try to set bits 12-15 }
push bx
popf
pushf
pop ax
and ax,0f000h { if bits 12-15 are cleared, CPU=80286 }
mov ax, cpu80286 { turn on 80286 flag }
jz @@End_CpuType
{ To test for 386 or better, we need to use 32 bit instructions,
but the 16-bit Delphi assembler does not recognize the 32 bit opcodes
or operands. Instead, use the 66H operand size prefix to change
each instruction to its 32-bit equivalent. For 32-bit immediate
operands, we also need to store the high word of the operand immediately
following the instruction. The 32-bit instruction is shown in a comment
after the 66H instruction.
}
{ i386 CPU check }
{ The AC bit, bit #18, is a new bit introduced in the EFLAGS }
{ register on the i486 DX CPU to generate alignment faults. }
{ This bit can not be set on the i386 CPU. }
db 66h { pushfd }
pushf
db 66h { pop eax }
pop ax { get original EFLAGS }
db 66h { mov ecx, eax }
mov cx,ax { save original EFLAGS }
db 66h { xor eax,40000h }
xor ax,0h { flip AC bit in EFLAGS }
dw 0004h
db 66h { push eax }
push ax { save for EFLAGS }
db 66h { popfd }
popf { copy to EFLAGS }
db 66h { pushfd }
pushf { push EFLAGS }
db 66h { pop eax }
pop ax { get new EFLAGS value }
db 66h { xor eax,ecx }
xor ax,cx { can't toggle AC bit, CPU=Intel386 }
mov ax, cpu386 { turn on 386 flag }
je @@End_CpuType
{ i486 DX CPU / i487 SX MCP and i486 SX CPU checking }
{ Checking for ability to set/clear ID flag (Bit 21) in EFLAGS }
{ which indicates the presence of a processor }
{ with the ability to use the CPUID instruction. }
db 66h { pushfd }
pushf { push original EFLAGS }
db 66h { pop eax }
pop ax { get original EFLAGS in eax }
db 66h { mov ecx, eax }
mov cx,ax { save original EFLAGS in ecx }
db 66h { xor eax,200000h }
xor ax,0h { flip ID bit in EFLAGS }
dw 0020h
db 66h { push eax }
push ax { save for EFLAGS }
db 66h { popfd }
popf { copy to EFLAGS }
db 66h { pushfd }
pushf { push EFLAGS }
db 66h { pop eax }
pop ax { get new EFLAGS value }
db 66h { xor eax, ecx }
xor ax, cx
mov ax, cpu486 { turn on i486 flag }
je @@End_CpuType { if ID bit cannot be changed, CPU=486
}
{ without CPUID instruction functionality }
{ Execute CPUID instruction to determine vendor, family, }
{ model and stepping. The use of the CPUID instruction used }
{ in this program can be used for B0 and later steppings }
{ of the P5 processor. }
db 66h { mov eax, 1 }
mov ax, 1 { set up for CPUID instruction }
dw 0
db 66h { cpuid }
db 0Fh { Hardcoded opcode for CPUID instruction }
db 0a2h
db 66h { and eax, 0F00H }
and ax, 0F00H { mask everything but family }
dw 0
db 66h { shr eax, 8 }
shr ax, 8 { shift the cpu type down to the low byte }
sub ax, 1 { subtract 1 to map to TCpuType }
@@End_CpuType:
pop ds
end;
function CpuTypeString: String;
var
kind: TCpuType;
begin
kind := CpuType;
case kind of
cpu8086:
Result := '8086';
cpu80286:
Result := '80286';
cpu386:
Result := '386';
cpu486:
Result := '486';
cpuPentium:
Result := 'Pentium';
else
{ Try to be flexible for future cpu types, e.g., P6. }
Result := Format('P%d', [Ord(kind)]);
end;
end;
end.
Determining drive type
Question
How to determining drive types?
Answer
When dealing with multiple drives, it is helpful to know
whether a drive is associated with a is attached to a letter
(A, B, C, etc), and what its type is. This code uses the API
GetDriveType function to do that.
function ShowDriveType(DriveLetter: char): string;
var
i: word;
begin
if DriveLetter in ['A'..'Z'] then {Make it lower case.}
DriveLetter := chr(ord(DriveLetter) + $20);
i := GetDriveType(ord(DriveLetter) - ord('a'));
case i of
DRIVE_REMOVABLE: result := 'floppy';
DRIVE_FIXED: result := 'hard disk';
DRIVE_REMOTE: result := 'network drive';
else result := 'does not exist';
end;
end;
DISCLAIMER: You have the right to use this technical information
subject to the terms of the No-Nonsense License Statement that
you received with the Borland product to which this information
pertains.
|