PROGRAM Serial;
CONST
  HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';
TYPE
  InfoBuffer = RECORD
    InfoLevel  : Word; {should be zero}
    Serial     : LongInt;
    VolLabel   : ARRAY[0..10] OF Char;
    FileSystem : ARRAY[0..7] OF Char;
  END;
  SerString = String[9];

VAR
  IB        : InfoBuffer;
  N         : Word;
  let       : Char;
  param     : String[10];
  IsSet     : Boolean;
  NewSerial : LongInt;
  code      : Integer;

  FUNCTION SerialStr(L : LongInt) : SerString;
  VAR Temp : SerString;
  BEGIN
    Temp[0] := #9;
    Temp[1] := HexDigits[L SHR 28];
    Temp[2] := HexDigits[(L SHR 24) AND $F];
    Temp[3] := HexDigits[(L SHR 20) AND $F];
    Temp[4] := HexDigits[(L SHR 16) AND $F];
    Temp[5] := '-';
    Temp[6] := HexDigits[(L SHR 12) AND $F];
    Temp[7] := HexDigits[(L SHR 8) AND $F];
    Temp[8] := HexDigits[(L SHR 4) AND $F];
    Temp[9] := HexDigits[L AND $F];
    SerialStr := Temp;
  END;

  FUNCTION GetSerial(DiskNum : Byte;
    VAR I : InfoBuffer) : Word; Assembler;
  ASM
    MOV AH, 69h
    MOV AL, 00h
    MOV BL, DiskNum
    PUSH DS
    LDS DX, I
    INT 21h
    POP DS
    JC @Bad
    XOR AX, AX
    @Bad:
  END;

  FUNCTION SetSerial(DiskNum : Byte;
    VAR I : InfoBuffer) : Word; Assembler;
  ASM
    MOV AH, 69h
    MOV AL, 01h
    MOV BL, DiskNum
    PUSH DS
    LDS DX, I
    INT 21h
    POP DS
    JC @Bad
    XOR AX, AX
    @Bad:
  END;

  PROCEDURE ErrorOut(err : Byte);
  BEGIN
    CASE err OF
      5   : BEGIN
              WriteLn('Either the disk in ',let,': is write-',
                'protected or it lacks an extended BPB.');
              WriteLn('If the disk is not write-protected, ',
                'reformat with DOS 4 or higher.');
            END;
      15  : WriteLn('Not a valid drive letter.');
      255 : BEGIN
              WriteLn('SYNTAX: "Serial d: ########"');
              WriteLn('  where d: is the drive letter ',
                      'and ######## is the eight-digit');
              WriteLn('  hexadecimal serial number.');
              WriteLn('EXAMPLE: "Serial 1234ABCD"');
            END;
      ELSE WriteLn('DOS ERROR #',N);
    END;
    Halt(1);
  END;

BEGIN
  IF ParamCount < 1 THEN ErrorOut(255);
  IF ParamCount > 2 THEN ErrorOut(255);
  Param := ParamStr(1);
  CASE length(Param) OF
    1 : ; {ok}
    2 : IF Param[2] <> ':' THEN ErrorOut(255);
    ELSE ErrorOut(255);
  END;
  Let := UpCase(Param[1]);
  IF (Let < 'A') OR (Let > 'Z') THEN ErrorOut(15);
  IF ParamCount < 2 THEN IsSet := FALSE
  ELSE
    BEGIN
      IsSet := TRUE;
      Param := '$'+ParamStr(2);
      Val(Param, NewSerial, Code);
      IF Code <> 0 THEN ErrorOut(255);
    END;
  N := GetSerial(Ord(Let)-Ord('@'), IB);
  IF N = 0 THEN
    BEGIN
      WITH IB DO
        BEGIN
          WriteLn('Serial number is "', SerialStr(Serial),'"');
          IF IsSet THEN
            BEGIN
              Serial := NewSerial;;
              N := SetSerial(Ord(Let)-Ord('@'), IB);
              IF N = 0 THEN
                WriteLn('Successfully changed serial to "',
                        SerialStr(NewSerial),'"')
              ELSE ErrorOut(N);
            END;
        END;
    END
  ELSE ErrorOut(N);
END.