home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-387-Vol-3of3.iso
/
m
/
msh_ut11.zip
/
FORMUNIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-05-10
|
9KB
|
291 lines
unit Formunit; {Formatierroutinen für Standardformate}
{ This unit is from the german magazine c't #2/90 }
interface
const {Laufwerkstabellen für Standardformate}
tab36 : array[1..11] of byte
= ($df,$02,$25,$02,$09,$2a,$ff,$50,$f6,$0f,$08);
tab12 : array[1..11] of byte
= ($df,$02,$25,$02,$0f,$1b,$ff,$54,$f6,$0f,$08);
tab14 : array[1..11] of byte
= ($af,$02,$25,$02,$12,$1b,$ff,$6c,$f6,$0f,$08);
form36 : array[1..4] of byte
{Mediabyte, Sektoren pro Cluster}
= ($fd,2,$70,2);
{Einträge Hauptverzeichnis, Sektoren pro FAT}
form72 : array[1..4] of byte
= ($f9,2,$70,3);
form12 : array[1..4] of byte
= ($f9,1,$e0,7);
form14 : array[1..4] of byte
= ($f0,1,$e0,9);
versuche = 5; {Zahl der Versuche bei Fehlern}
type
tabelle = array[1..4] of byte;
var
laufwerka, laufwerkb : byte; {Art der Laufwerke}
tabalt, tabneu : pointer; {Zeiger auf Laufwerkstabelle}
formtab : ^tabelle; {Zeiger auf Diskformate}
einzelschritt : boolean; {Einzelstep}
procedure diskreset; {Reset bei Fehlern}
function config(drive : byte) : byte; {Laufwerkskonfiguration}
procedure einzelstep; {720 KB in 5.25 MF-Laufwerk}
procedure schreibrate(art, kap, drive : byte);
{Schreibrate wählen}
{Procedure Schreibrate immer vor Laufwerkstabneu aufrufen !}
procedure laufwerkstabneu; {neuer DPB}
procedure laufwerkstabalt;
function readwriteverify(was, spur, seite, sektor,
anzahl, drive : byte;
var buffer) : byte;
function spurformat(spur, seite, sektor,
anzahl, drive : byte) : byte;
implementation
uses dos;
{************************************************************}
procedure diskreset;
var
cpu : registers;
zaehler : byte;
begin
zaehler:=versuche;
repeat
cpu.ah:=0; {Diskreset}
cpu.dl:=0; {Reset für alle Laufwerke}
intr($13, cpu);
dec(zaehler,1);
until (zaehler=0) or (cpu.flags and fcarry=0) or (cpu.ah=0);
if einzelschritt then einzelstep; {Wichtig}
{Nach jedem Reset umschalten auf Einzelstep !}
end;
{************************************************************}
function config(drive : byte) : byte;
var { 0 : Kein Laufwerk}
cpu : registers; { 1 : 360 KB}
zaehler : byte; { 2 : 1.2 MB}
{ 3 : 720 KB}
{ 4 : 1.44 MB}
begin
zaehler:=versuche;
repeat
cpu.ah:=8; {Feststellen des Laufwerkstyps}
cpu.dl:=drive; {Nummer des Laufwerks}
intr($13, cpu);
dec(zaehler,1);
until (zaehler=0) or (cpu.flags and fcarry=0) or (cpu.ah=0);
if zaehler=0 then
begin {Funktion nicht vorhanden, dann XT oder ähnlich}
case drive of
0: begin
intr($11, cpu); {Feststellung der Konfiguration}
config:=(cpu.al and $01) ; {1 = Drive A da}
end;{Equipmentword IPL-Bit, überhaupt Diskette da?}
1: begin
intr($11, cpu); {Feststellung der Konfiguration}
zaehler:=(cpu.al and $C0) shr 6;
if zaehler=0 then {kein Laufwerk B}
config:=0
else
config:=1 {Laufwerk B da}
end; {Equipmentword Drive-Zähler, 00=1 Drive, 01=2}
else
config:=0; {alle anderen Anforderungen abweisen}
end;
end
else
config:=cpu.bl; {Art des Laufwerks}
end;
{************************************************************}
procedure einzelstep; {720 KB in 5.25 MF-Laufwerk}
var
inhalt : byte;
begin
inhalt:=mem[$0040:$0090]; {Controllerbyte}
inhalt:=inhalt and $DF;
mem[$0040:$0090]:=inhalt; {Einzelstep für Laufwerk A}
inhalt:=mem[$0040:$0091];
inhalt:=inhalt and $DF;
mem[$0040:$0091]:=inhalt; {Einzelstep für Laufwerk B}
end;
{************************************************************}
procedure schreibrate(art, kap, drive : byte);
var
cpu : registers;
form, zaehler : byte;
ax : word;
begin
if art=1 then
begin
form:=1; {360 KB Laufwerk}
tabneu:=@tab36; {360 KB Laufwerkstabelle}
if kap=2 THEN
formtab:=@form72 {720 KB Diskettenformat}
ELSE
formtab:=@form36; {360 KB Diskettenformat}
cpu.ax:=$1828; cpu.cx:=$2709; {Parameter für 18h}
end
else
if art=2 then {1.2 MB MF-Laufwerk}
if kap<=2 then
begin
form:=2;
tabneu:=@tab36; {360 KB oder 720 KB in 5,25 MF-Drive}
cpu.ax:=$1828; cpu.cx:=$2709;
if kap=1 then formtab:=@form36 else formtab:=@form72;
end
else
begin
form:=3;
tabneu:=@tab12; {1.2 MB in 1.2 MB-Laufwerk}
formtab:=@form12;
cpu.ax:=$1850; cpu.cx:=$4f0f;
end
else
if art>=3 then {720 KB oder 1.44 MB Laufwerk}
if kap<=2 then
begin
form:=4;
tabneu:=@tab36;
formtab:=@form72; {720 KB}
cpu.ax:=$1850; cpu.cx:=$4f09;
end
else
begin
form:=3;
tabneu:=@tab14;
formtab:=@form14; {1.44 MB}
cpu.ax:=$1850; cpu.cx:=$4f12;
end;
zaehler:=versuche;
ax:=cpu.ax; {AX-Register wird durch Funktion verändert}
repeat
cpu.ax:=ax;
cpu.dl:=drive; {Nummer des Laufwerks}
intr($13, cpu); {Funktion Nr. 18h aufrufen}
if cpu.flags and fcarry=1 then
begin
diskreset; {Fehler aufgetreten}
dec(zaehler);
end;
until (cpu.flags and fcarry=0) or (zaehler=0) or (cpu.ah=0);
if (zaehler=0) then {Funktion 18h nicht vorhanden}
begin
zaehler:=versuche; {letzte Rettung}
repeat {Funktion Nr. 17h, falls 18h nicht vorhanden}
cpu.ah:=$17; {Schreibrate setzen}
cpu.al:=form;
cpu.dl:=drive; {Welches Laufwerk formatieren}
intr($13, cpu);
if cpu.flags and fcarry=1 then
begin
diskreset; {Fehler aufgetreten}
dec(zaehler);
end;
until (cpu.flags and fcarry=0) or (zaehler=0) or (cpu.ah=0);
end;
if (art=2) and (kap=2) then
begin {720 KB in 5,25}
einzelstep;
einzelschritt:=true; {Merker für Einzelstep eingeschaltet}
end
else {anderes Format gewählt}
einzelschritt:=false; {Kein Einzelschritt eingeschaltet}
end;
{************************************************************}
procedure laufwerkstabneu;
begin
getintvec($1e,tabalt);
setintvec($1e,tabneu);
end;
{************************************************************}
procedure laufwerkstabalt;
begin
setintvec($1e,tabalt);
end;
{************************************************************}
function readwriteverify(was, spur, seite, sektor,
anzahl, drive : byte;
var buffer) : byte;
var
cpu : registers;
zaehler : byte;
begin {was=2 : Sektoren von Diskette lesen}
zaehler:=versuche; {was=3 : Sektoren auf Diskette schreiben}
repeat {was=4 : Sektoren verifizieren}
cpu.ah:=was;
cpu.dl:=drive;
cpu.dh:=seite;
cpu.ch:=spur;
cpu.cl:=sektor;
cpu.al:=anzahl;
cpu.es:=seg(buffer);
cpu.bx:=ofs(buffer);
intr($13, cpu);
readwriteverify:=cpu.ah; {Rückgabe des Fehlercodes}
if cpu.flags and fcarry=1 then
begin
readwriteverify:=cpu.ah; {Fehlercode}
diskreset;
end;
dec(zaehler);
until (zaehler=0) or (cpu.flags and fcarry=0) or (cpu.ah=0);
end;
{************************************************************}
function spurformat(spur, seite, sektor,
anzahl, drive : byte) : byte;
type
formrec = record
trackdisk, seitedisk, sektordisk, zahlbyte : byte;
end;
var
cpu : registers;
formattab : array[1..18] of formrec; {Max. 18 Sektoren}
zaehler : byte;
sekzahl : byte;
begin
zaehler:=versuche;
for sekzahl:=1 to anzahl do
begin
formattab[sekzahl].trackdisk:=spur;
formattab[sekzahl].seitedisk:=seite;
formattab[sekzahl].sektordisk:=sekzahl;
formattab[sekzahl].zahlbyte:=2;
end;
repeat
cpu.ah:=5; {Spur formatieren}
cpu.dl:=drive;
cpu.dh:=seite;
cpu.ch:=spur;
cpu.al:=anzahl;
cpu.es:=seg(formattab);
cpu.bx:=ofs(formattab);
intr($13, cpu);
spurformat:=cpu.ah; {Rückgabe des Fehlercodes}
if cpu.flags and fcarry=1 then
begin
spurformat:=cpu.ah;
diskreset;
end;
dec(zaehler);
until (zaehler=0) or (cpu.flags and fcarry=0) or (cpu.ah=0);
end;
{********************Hauptprogramm der Unit******************}
begin
laufwerka:=config(0);
laufwerkb:=config(1); {Art von Laufwerk A und B}
end.