[Back to DRIVES SWAG index] [Back to Main SWAG index] [Original]
unit xdos;
Interface
function GetVolSerialNo(DriveNo:Byte): string;
Procedure PutVolSerialNo(DriveNo:Byte;SerialNo:longint);
Implementation
uses dos,crt;
type
SerNo_type =
record
case integer of
0: (SerNo1, SerNo2 : word);
1: (SerNo : longint);
end;
DiskSerNoInfo_type = record
Infolevel : word;
VolSerNo : SerNo_Type;
VolLabel : array[1..11] of char;
FileSys : array[1..8] of char;
end;
function HexDigit(N : Byte) : char;
begin
if n < 10 then HexDigit := Chr(Ord('0')+n)
else HexDigit := Chr(Ord('A') + (n - 10));
end;
function GetVolSerialNo(DriveNo:Byte): string;
var
ReturnArray : DiskSerNoInfo_type;
Regs : Registers;
begin
with regs do begin
AX := $440d;
BL := DriveNo;
CH := $08;
CL := $66;
DS := Seg(ReturnArray);
DX := Ofs(ReturnArray);
Intr($21,Regs);
if (Flags and FCarry)<>0 then GetVolSerialNo := '' else
with ReturnArray.VolSerNo do
GetVolSerialNo :=HexDigit(Hi(SerNo2) Div 16) + HexDigit(Hi(SerNo2) Mod 16)
+
HexDigit(Lo(SerNo2) Div 16) + HexDigit(Lo(SerNo2) Mod 16)
+
HexDigit(Hi(SerNo1) Div 16) + HexDigit(Hi(SerNo1) Mod 16)
+
HexDigit(Lo(SerNo1) Div 16) + HexDigit(Lo(SerNo1) Mod 16);
end;
end;
Procedure PutVolSerialNo(DriveNo:Byte;SerialNo:longint);
var
ReturnArray : DiskSerNoInfo_type;
Regs : Registers;
begin
with regs do begin
AX := $440d;
BL := DriveNo;
CH := $08;
CL := $66;
DS := Seg(ReturnArray);
DX := Ofs(ReturnArray);
Intr($21,Regs);
if (Flags and FCarry)=0 then begin
ReturnArray.VolSerNo.SerNo := SerialNo;
AH := $69;
BL := DriveNo;
AL := $01;
DS := Seg(ReturnArray);
DX := Ofs(ReturnArray);
Intr($21,Regs);
end;
end;
end;
end.
[Back to DRIVES SWAG index] [Back to Main SWAG index] [Original]