My attempt at a concurrent floppy disk formatter. I don't think this works though. I'm not even sure if it's possible with NEC's FDD protocol.

scf.pas

{ SSG's Concurrent Formatter 0.1 beta }

{$M $800,0,0}

uses

Dos,XStr,Disk,XIO;

type

  TFormatRec = record
    name     : string[4];
    tracks   : byte;
    sectors  : byte;
    desc     : string[40];
  end;

const

  sVersion : string[10] = '0.1 beta';

  maxCaps = 4;
  Caps : array[1..maxCaps] of TFormatRec = (
    (Name:'DD' ; Tracks: 80; Sectors: 9 ;desc: 'Double-density'),
    (Name:'HD' ; Tracks: 80; Sectors:18 ;desc: 'High-density'),
    (Name:'SD' ; Tracks: 82; Sectors:21 ;desc: 'Safe-density'),
    (Name:'MAX'; Tracks: 82; Sectors:22 ;desc: 'Maximum-density'));

var

  drive:byte;
  formattype:byte;
  drivetype,drivecount:byte;
  beep:boolean;
  old13:pointer;
  old8:pointer;

function Installed(adrive:byte):boolean;assembler;
asm
  mov ah,76h
  mov al,adrive
  int 13h
  xor al,al
  cmp ah,adrive
  jne @Fuck
  inc al
@Fuck:
end;

procedure CheckParams;
var
  f:string[70];
  i:integer;
begin
  f := ParamStr(1);
  drive := byte(upcase(f[1]))-65;
  GetDisketteParams(drive,drivetype,drivecount);
  if not (drivetype in [3,4,5]) then XAbort('unsupported drive');
  if Installed(drive) then XAbort('SCF has been already installed for drive '+char(drive+65));
  formattype := 0;
  if drivetype = 3 then begin
    formattype := 1;
    writeln('Forced to drive caps');
  end else begin
    i := XIsParam('F');
    if i = 0 then formattype := 2 else begin
      f := XGetParamStr(i);
      Strip(f);
      FastUpper(f);
      for i := 1 to maxCaps do if Caps[i].Name = f then begin
        formattype := i;
        break;
      end;
      if formattype = 0 then XAbort('invalid format specified');
    end;
  end;
  with Caps[formattype] do writeln(desc,' mode specified');
  beep := XisParam('BEEP') > 0;
end;

begin
  XAppInit('SSG''s Concurrent Disk Formatter',sVersion,'SSG',1,'drive [/F:capacity] [/BEEP]');
  CheckParams;
  asm
    jmp   @Init

  @Old13:
    dd    0
  @New13:
    cmp   ah,5
    ja    @GoOld13
    push  ds
    push  ax
    mov   ax,seg @Data
    mov   ds,ax
    cmp   drive,dl
    pop   ax
    pop   ds
    jne   @GoOld13
    stc
    mov   ah,80
    iret
  @GoOld13:
    jmp   dword ptr cs:@Old13

  @Old8:
    dd    0
  @in8:
    db    0
  @Tracks:
    db    0
  @Sectors:
    db    0
  @New8:
    pusha
    mov   al,byte ptr cs:@in8
    or    al,al
    jne   @GoOld8
    inc   byte ptr @in8

  @GoOld8:
    popa
    jmp   dword ptr cs:@Old8
  @Init:
    push  ds
    mov   ax,3513h
    int   21h
    mov   word ptr cs:@Old13,bx
    mov   word ptr cs:@Old13+2,es
    mov   ax,3508h
    int   21h
    mov   word ptr cs:@Old8,bx
    mov   word ptr cs:@Old8+2,es
    push  cs
    pop   ds
    mov   dx,offset @New13
    mov   ax,2513h
    int   21h
    push  cs
    pop   ds
    mov   dx,offset @New8
    mov   ax,2508h
    int   21h
    pop   ds
  end;
  writeln('Installed');
  keep(0);
end.