home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
dskutl
/
reform16.arc
/
REFORMAT.IN5
< prev
next >
Wrap
Text File
|
1990-03-03
|
42KB
|
1,151 lines
{-------------------- REFORMAT.IN5 -------------------------------------------}
{Disk, FAT, directory, misc. routines}
{v1.6 Rewrote Check_DOS_Version to permit user override
of precautionary abort for DOS versions above v3.10
}
PROCEDURE ResetDisk;
{ flush buffers that weren't written }
BEGIN
(* In Turbo:
Register.ah := $0D;
msdos(Register);
*)
InLine(
$B4/$0D { mov ah,$0D ;reset disk}
/$CD/$21 { int $21}
);
END; { of ResetDisk }
PROCEDURE ResetSubdirectory;
{ DOS might not remember }
{
The directory information DOS provided us with does not contain the
driveletter, nor starts it with a backslash.
}
BEGIN
Move(CurrentDirectory[0], CurrentDirectory[3], 61);
CurrentDirectory[0] := DriveLetter;
CurrentDirectory[1] := ':';
CurrentDirectory[2] := '\';
(* in Turbo:
Register.ah := $3B;
Register.ds := Seg(CurrentDirectory);
Register.dx := Ofs(CurrentDirectory);
MSDos(Register);
*)
Inline(
$B4/$3B {mov ah,$3B}
/$BA/>CURRENTDIRECTORY {mov dx,>CurrentDirectory}
/$CD/$21 {int $21}
);
END; { of ResetSubDirectory }
{----------------------- general disk I/O routines -------------------------}
PROCEDURE Read_Write_Sectors(sectorNumber, numberOfSectors : Word; {v1.6 INTEGER;}
action : Disk_Activity);
VAR
intNr : INTEGER;
FUNCTION CarryFlag: BOOLEAN;
BEGIN
CarryFlag := Register.flags AND $01 <> 0;
END; { of CarryFlag }
BEGIN
WITH Register DO REPEAT
al := driveNumber;
cx := numberOfSectors;
dx := sectorNumber;
ds := Seg(DTAddress^);
bx := Ofs(DTAddress^);
IF action = reading
THEN BEGIN
intNr := $25;
NrStr := 'Error Reading Disk....';
END
ELSE BEGIN
intNr := $26;
NrStr := 'Error Writing Disk....';
AlreadyWritten := TRUE; { set it now because the first write
might succeed partially! }
END;
int2526(intNr); { 25H = read, 26H = write }
IF CarryFlag THEN BEGIN
S40 := 'Enter A (abort), R (retry)';
IF NOT AlreadyWritten THEN BEGIN
WriteWarning('No data lost!');
WriteError(NrStr);
Legals := 'AR';
END
ELSE BEGIN
WriteError('Probably loss of data!');
WriteDisaster(NrStr);
S40 := S40 + ', I(gnore)';
Legals := 'ARI';
END;
REPEAT
Getinput(S40,Instr);
UNTIL POS(Instr,Legals) <> 0;
IF Instr = 'A' THEN BEGIN
GotoXY(1,24); WRITELN; {leave the screen for him or her }
HALT;
END
ELSE BlankFields;
END;
UNTIL NOT CarryFlag;
END; { of Read_Write_Sectors }
PROCEDURE ReadCluster(clusterNumber: word);
VAR sectorNumber: word;
BEGIN
(* v1.6
sectorNumber := W_add(W_mul( clusterSize, clusterNumber - 2 ),
firstDataSector);
*)
sectorNumber := (clusterSize * (clusterNumber-2)) + firstDataSector; {v1.6}
Read_Write_Sectors(sectorNumber, clusterSize,reading);
END; { of ReadCluster }
PROCEDURE WriteCluster(clusterNumber: word);
VAR sectorNumber: word;
BEGIN
(* v1.6
sectorNumber := W_add(W_mul( clusterSize, clusterNumber - 2 ),
firstDataSector);
*)
sectorNumber := (clusterSize * (clusterNumber-2)) + firstDataSector; {v1.6}
Read_Write_Sectors(sectorNumber, clusterSize, writing);
END; { of WriteCluster }
{----------------------- disk information routines -------------------------}
PROCEDURE ReadBootSector(VAR DTArea: Buffer);
{
Read the bootsector from disk.
}
VAR
BootInfo: Boot Absolute DTArea;
BEGIN
WriteLog('Reading Bootsector.');
Read_Write_Sectors(0, 1, reading);
FOR count := 0 TO 7 DO
OEM[count] := Bootinfo.OEM[count];
totalSectors := Bootinfo.totalSectors;
trackSize := Bootinfo.trackSize;
hiddenSectors := Bootinfo.hiddenSectors;
END; { of ReadBootSector }
PROCEDURE GetInformation;
{
Ask DOS for information about the specified drive.
If we have an error return code from DOS we assume
that the disk specified was invalid.
We are using a number of DOS int 21H functions:
1) function 19H : returns current default drive in al: 0 = a, ..
2) function 32H : ! undocumented function !
returns a parameter table which is laid out
in the type Parameter_Table.
3) function 36H : several, but we only use the disk free space
4) function 47H : current working directory.
the remainder of the information we want to have or need, we find
in the disks bootrecord and in the FAT (bad space and used space).
}
VAR
ValidDrive: BOOLEAN;
Parms: Parms_32;
BEGIN
IF Instr = ' '
THEN GetInput('Enter drive letter',Instr);
WriteLog('Reading Disk Information');
{
get current disk: MS-DOS function call 19h
information is returned in AL: 0 = A, 1 = B, etc.
}
WITH Register DO BEGIN
(* in Turbo:
ah := $19; { DOS returns the default drive in al }
MSDos(Register); { as: 0 = A, 1 = B .... }
defaultDrive := al;
*)
Inline(
$B4/$19 {mov ah,$19}
/$CD/$21 {int $21}
/$A2/>DEFAULTDRIVE {mov [>defaultDrive],al}
);
ValidDrive := FALSE;
REPEAT { keep trying until a good letter }
IF ORD(Instr) < 64 THEN Instr := CHR($FF);
DriveLetter := UpCase(Instr);
driveNumber := ORD(DriveLetter) - 64; { A = 65, so A = 1, B = 2, ...... }
ah := $36;
dl := driveNumber; { must be 0 = default, 1 = A, 2 = B .. }
MSDos(Register);
IF ax <> $ffff THEN ValidDrive := TRUE
ELSE BEGIN
WriteWarning('Invalid driveletter!');
GetInput('Enter new letter',Instr);
WriteWarning(' ');
END;
UNTIL ValidDrive;
freeClusters := bx; { we can find that only here }
{
In case the drive to be reformatted has a current working directory
DOS may lose track of the current working directory. So we will get
the current working directory and will tell DOS what it is, when
we are done.
}
dl := driveNumber; { must be 0 = default, 1 = A, 2 = B .. }
ds := Seg(CurrentDirectory);
si := Ofs(CurrentDirectory);
ah := $47; { DOS returns current working directory}
MSDos(Register); { no error, drive checked before }
{
We now use the undocumented DOS function call 32H. It was described in the
May 86 PC Tech Journal article "Finding Disk Parameters" by
Glenn F. Roberts.
}
dl := driveNumber; { must be 0 = default, 1 = A, 2 = B .. }
ah := $32;
MSDos(Register);
Parms := Ptr( ds, bx);
sectorSize := Parms^.sectorSize;
media := Parms^.MediaDescriptor;
numberOfHeads := SUCC(Parms^.numberOfHeads_1);
reservedSectors := Parms^.reservedSectors;
rootDirSize := Parms^.rootDirSize;
numberOfFATs := Parms^.numberOfFATs;
fatSize := Parms^.fatSize;
clusterSize := SUCC(Parms^.clusterSize_1);
firstDataSector := Parms^.firstDataSector;
firstDirectorySector := Parms^.firstDirectorySector;
totalDataClusters := PRED(Parms^.totalDataClusters_1);
(* v1.6
BigFAT := W_cmp(totalDataClusters, Gt, 4086);
*)
BigFAT := (totalDataClusters > 4086); {v1.6}
END; {of with Register}
IF BigFAT THEN BEGIN
unused := $0000;
reservedMinimum := $FFF0;
reservedMaximum := $FFF6;
badCluster := $FFF7;
lastMinimum := $FFF8;
lastMaximum := $FFFF;
lastNormal := $FFFF;
END; { small FAT format was defined already }
deviceDriverAddress := Parms^.deviceDriverAddress;
assignedDisk := Parms^.assignedDisk;
altAD := Parms^.altAD;
firstFATSector := 1;
Dec(driveNumber); {INT 25H and 26H expect 0=A, 1=B, etc. v1.6}
{
The maximum array for the FAT we can allocate is 65521 bytes.
The length of the FAT is totalDataClusters + 2, so the largest
FAT we can proces has (65521 div 2 - 2 = 32758) totalDataClusters.
So we can use the totalDataClusters as an integer, once we have passed
this test.
The situation of more than 32758 totalDataClusters will probably never
occur, because DOS would have problems too with FATs larger than one
segment of 64Kb.
}
(* v1.6
IF W_cmp(totalDataClusters, Gt, 32758) THEN BEGIN
*)
IF totalDataClusters > 32758 THEN BEGIN {v1.6}
WriteError('Disk too big for this program...');
Exeunt(EnterStr);
END;
{
Now read the bootrecord, to collect the remaining information.
Use that procedure, makes things neater.
}
GetMem(DTAddress, sectorSize);
ReadBootSector(DTAddress^);
FreeMem(DTAddress, sectorSize);
END; { of GetInformation }
{------------------- FAT and file information reading ------------------------}
PROCEDURE ReadFat(VAR unscrambledFAT: IntArray; VAR scrambledFAT: Buffer);
{
Read and unscramble the FAT. Only the first FAT is processed.
The variable scrambledFAT is really our DTArea.
}
VAR
i, temp: word; {v1.6 INTEGER;}
BEGIN
WriteLog('Reading and unscrambling FAT.');
Read_Write_Sectors(firstFATSector, fatSize, reading);
IF BigFAT
THEN Move(scrambledFAT, unscrambledFAT,
(* v1.6 W_mul(totalDataClusters + 2 , 2)) *)
(totalDataClusters+2) ShL 1) {v1.6}
ELSE FOR i := 0 TO SUCC(totalDataClusters)
DO BEGIN
Move( scrambledFAT[3 * i ShR 1], temp, 2);
IF ODD(i) THEN temp := temp ShR 4 ELSE temp := temp AND $0FFF;
unscrambledFAT[i] := temp;
END;
END; { of ReadFat }
PROCEDURE ReadSubdirectory(VAR DTArea: Buffer;
VAR FATarea: INTArray;
VAR SubRoot: DirectoryPointer;
startingCluster: Word; {v1.6 INTEGER;}
hidden: Word {v1.6 INTEGER} );
{
Link subdirectory entries in a list. Build a tree (by calling this
routine recursively) if a subdirectory is found.
}
VAR
clusterNumber,
dirIndex: word; {v1.6 INTEGER;}
Present: DirectoryPointer;
EndSearch: BOOLEAN;
BEGIN
IF hidden <> 0 THEN
(*v1.6 hiddenDirectories := SUCC(hiddenDirectories); *)
Inc(hiddenDirectories); {v1.6}
(* v1.6 subdirectories := SUCC(subdirectories); *)
Inc(subdirectories); {v1.6}
clusterNumber := startingCluster;
Present := NIL;
SubRoot := NIL;
EndSearch := FALSE;
REPEAT
ReadCluster(clusterNumber);
dirIndex := 0;
REPEAT
IF NOT ( DTArea[dirIndex] IN [NEVERUSED, ERASED] )
THEN BEGIN
IF SubRoot = NIL THEN BEGIN
NEW(SubRoot);
Present := SubRoot;
END
ELSE BEGIN
NEW(Present^.next);
Present := Present^.next;
END;
Move(DTArea[dirIndex], Present^, 32);
IF (( Present^.attribute AND SUBDIRECTORY) <> 0 )
AND ( Present^.EntryName[0] <> '.' )
THEN BEGIN
ReadSubdirectory(DTArea, FATarea,Present^.subdirectory,
Present^.startingCluster,
Present^.attribute AND HIDDENFILE);
Readcluster(clusterNumber);
END
ELSE BEGIN
Present^.subdirectory := NIL;
IF Present^.Entryname[0] <> '.'
THEN BEGIN
(* v1.6
totalFiles := SUCC(totalFiles);
inSubdirectories := SUCC(inSubdirectories);
IF ( Present^.attribute AND HIDDENFILE ) <> 0
THEN hiddenFiles := SUCC(hiddenFiles);
*)
Inc(totalFiles); {v1.6}
Inc(inSubdirectories); {v1.6}
IF ( Present^.attribute AND HIDDENFILE ) <> 0
THEN Inc(hiddenFiles); {v1.6}
END;
END;
END
ELSE IF DTArea[dirIndex] = NEVERUSED
THEN EndSearch := TRUE;
(* v1.6 dirIndex := dirIndex + 32; *)
Inc(dirIndex,32); {v1.6}
(*v1.6UNTIL W_cmp(dirIndex, Ge, W_mul(sectorSize, clusterSize)) *)
UNTIL (dirIndex >= (sectorSize * clustersize)) {v1.6}
OR EndSearch;
clusterNumber := FATarea[clusterNumber];
(*v1.6UNTIL W_cmp(clusterNumber, Ge, reservedMinimum) OR EndSearch; *)
UNTIL (clusterNumber >= reservedMinimum) OR EndSearch; {v1.6}
IF Present <> NIL THEN Present^.next := NIL;
END; { of ReadSubDirectory }
PROCEDURE ReadDirectories(VAR DTArea: Buffer);
{
Read the Rootdirectory and whenever an entry for a subdirectory is
found call ReadSubdirectory. Link all directory entries dynamically
in a linked list. This list is actually a tree, because the lists
for subdirectories are linked to this list.
}
VAR
EndSearch: BOOLEAN;
sectorNumber,
dirIndex: word; {v1.6 INTEGER;}
Present: DirectoryPointer;
BEGIN
WriteLog('Reading Directory and Subdirectories.');
sectorNumber := firstDirectorySector;
RootDir := NIL;
Present := NIL;
EndSearch := FALSE;
REPEAT
dirIndex := 0;
Read_Write_Sectors(sectorNumber, 1, reading);
REPEAT
IF NOT ( DTArea[dirIndex] IN [NEVERUSED, ERASED] )
THEN BEGIN
IF RootDir = NIL THEN BEGIN
NEW(RootDir);
Present := RootDir;
END
ELSE BEGIN
NEW(Present^.next);
Present := Present^.next;
END;
Move(DTArea[dirIndex], Present^, 32);
IF (( Present^.attribute AND SUBDIRECTORY ) <> 0 )
AND ( Present^.EntryName[0] <> '.' )
THEN BEGIN
ReadSubdirectory(DTArea, OldFATaddress^,
Present^.subdirectory,
Present^.startingCluster,
Present^.attribute AND HIDDENFILE);
Read_Write_Sectors(sectorNumber, 1, reading);
END
ELSE BEGIN
Present^.subdirectory := NIL;
IF (( Present^.attribute AND VOLUMELABEL ) = 0 )
AND ( Present^.Entryname[0] <> '.' )
THEN BEGIN
(* v1.6
totalFiles := SUCC(totalFiles);
inRootDirectory := SUCC(inRootDirectory);
IF ( Present^.attribute AND HIDDENFILE ) <> 0
THEN hiddenFiles := SUCC(hiddenFiles);
*)
Inc(totalFiles); {v1.6}
Inc(inRootDirectory); {v1.6}
IF ( Present^.attribute AND HIDDENFILE ) <> 0
THEN Inc(hiddenFiles); {v1.6}
END
ELSE IF ( Present^.attribute AND VOLUMELABEL ) <> 0
THEN BEGIN
FOR count := 0 TO 10 DO
DiskLabel := DiskLabel +
Present^.EntryName[count];
diskCreationDate := Present^.dateLastUpdated;
diskCreationTime := Present^.timeLastUpdated;
END;
END;
END
ELSE IF DTArea[dirIndex] = NEVERUSED
THEN EndSearch := TRUE;
(* v1.6 dirIndex := dirIndex + 32; *)
Inc(dirIndex,32); {v1.6}
UNTIL (dirIndex >= sectorSize ) OR EndSearch;
(*v1.6sectorNumber := SUCC(sectorNumber); *)
Inc(sectorNumber); {v1.6}
UNTIL ( sectorNumber = firstDataSector ) OR EndSearch;
IF Present <> NIL THEN Present^.next := NIL;
END; { of ReadDirectories }
{-------------------------- reformatting routines ----------------------------}
PROCEDURE RemakeFAT(VAR oldFATarea, newFATarea, permutation: IntArray;
Root: DirectoryPointer;
parent, thisDir: Word {v1.6 INTEGER} );
{
This procedure is called recursively.
From the OldFAT and the directory entries we construct a NewFAT and
a permutation. The permutation is used by DoIt for moving the
clusters. This routine is called one extra time for the chain of
the empty clusters by LinkFreeDataClusters.
Recursion is used whenever we find an entry for a subdirectory, in
the following way: first call this routine for the remainder of the
current directory, then for the subdirectory.
The function nextFATindex is used to prevent accidental use of clusters
that were marked as bad or reserved clusters.
}
FUNCTION nextFATindex: Word; {v1.6 INTEGER;}
VAR
temp: Word; {v1.6 INTEGER;}
BEGIN
temp := SUCC(newFATindex);
(* v1.6
WHILE W_cmp( oldFATarea[temp], Ge, reservedMinimum ) AND
W_cmp( oldFATarea[temp], Le, badCluster ) AND
( temp <= SUCC(totalDataClusters) )
*)
WHILE (oldFATarea[temp] >= reservedMinimum) {v1.6}
AND (oldFATarea[temp] <= badCluster)
AND (temp <= SUCC(totalDataClusters))
DO BEGIN
newFATarea[temp] := oldFATarea[temp];
(* v1.6
temp := SUCC(temp);
badClusters := SUCC(badClusters);
*)
Inc(temp); {v1.6}
Inc(badClusters); {v1.6}
END;
nextFATindex := temp;
END; { of nextFATindex }
VAR
Present: DirectoryPointer;
Split: BOOLEAN;
temp: Word; {v1.6 INTEGER;}
BEGIN { RemakeFAT }
IF newFATindex = 1 THEN newFATindex := nextFATindex;
Present := Root;
Split := FALSE;
WHILE ( Present <> NIL ) AND NOT Split DO BEGIN
IF (( Present^.attribute AND VOLUMELABEL) = 0 )
AND ( Present^.startingCluster <> 0 )
AND ( Present^.Entryname[0] <> '.')
THEN BEGIN
IF Present^.subdirectory <> NIL THEN BEGIN
Split := TRUE;
RemakeFAT(oldFATarea, newFATarea, permutation,
Present^.next, parent, thisDir);
END;
oldFATindex := Present^.startingCluster;
Present^.newStartingCluster := newFATindex;
permutation[newFATindex] := oldFATindex;
(* v1.6 WHILE W_cmp( oldFATarea[oldFATindex], Lt, lastMinimum ) DO BEGIN *)
WHILE (oldFATarea[oldFATindex] < lastMinimum) DO BEGIN {v1.6}
temp := nextFATindex;
newFATarea[newFATindex] := temp;
newFATindex := temp;
oldFATindex := oldFATarea[oldFATindex];
permutation[newFATindex] := oldFATindex;
END;
newFATarea[newFATindex] := lastNormal;
newFATindex := nextFATindex;
IF Split
THEN RemakeFAT(oldFATarea, newFATarea, permutation,
Present^.subdirectory, thisDir,
Present^.newStartingCluster);
END
ELSE BEGIN
IF ( Present^.EntryName[0] = '.' )
AND ( Present^.EntryName[1] = '.' )
THEN Present^.newStartingCluster := parent
ELSE IF Present^.EntryName[0] = '.'
THEN Present^.newStartingCluster := thisDir
ELSE Present^.newStartingCluster := 0;
END;
Present := Present^.next;
END;
END; { of RemakeFAT }
PROCEDURE LinkFreeClusters(VAR oldFATarea, newFATarea: IntArray);
{
Link Free clusters in a chain, pointed to by Empty^.
Use RemakeFAT to fill permutation, but clean NewFAT after
this. This procedure will ensure that permutation is a
proper permutation, without double entries which might
cause DoIt to loop indefinitely or destroy our disk.
}
VAR
count,
next,
previous: Word; {v1.6 INTEGER;}
Empty: DirectoryPointer;
BEGIN
NEW(Empty);
Empty^.next := NIL;
Empty^.subdirectory := NIL;
Empty^.Entryname[0] := 'X';
Empty^.attribute := HIDDENFILE;
Empty^.startingCluster := 0;
count := 2;
WHILE ( count <= SUCC(totalDataClusters) )
AND ( oldFATarea[count] <> 0 )
(*v1.6DO count := SUCC(count); { find first zero FAT entry } *)
DO Inc(count); {find first zero FAT entry v1.6}
IF count <= SUCC(totalDataClusters)
THEN BEGIN
Empty^.startingCluster := count;
Previous := count;
WHILE count < SUCC(totalDataClusters)
DO BEGIN
(* v1.6 count := SUCC(count); *)
Inc(count); {v1.6}
IF oldFATarea[count] = 0
THEN BEGIN
oldFATarea[Previous] := count;
Previous := count;
END;
END;
oldFATarea[Previous] := lastNormal;
END;
IF Empty^.startingCluster <> 0 { plot free clusters in permutation }
THEN BEGIN
RemakeFAT(oldFATarea, newFATarea,
PermutationAddress^, Empty, 0, 0);
next := Empty^.newStartingCluster;
WHILE next <> lastNormal { clean NewFAT }
DO BEGIN
Previous := next;
next := newFATarea[Previous];
newFATarea[Previous] := 0;
END;
END;
END; { of LinkFreeClusters }
PROCEDURE DoIt(VAR permutation: IntArray; VAR DTArea, SaveArea: Buffer);
{
DoIt. This routine performs the actual reformatting of the disk.
The array permutation contains in every location [i] (starting
from 2) which cluster has to be moved to cluster location i.
Because we have a real permutation, this permutation can be
parsed into a number of cyclical permutations. We start at the
first cyclic permutation that is not identity. We save the first
cluster of this cyclical permutation, proceed through the cyclical
permutation, moving one cluster at a time, until we finish the
cycle. We than write the saved cluster to disk.
}
VAR
prior,
next,
lastStart: Word; {v1.6 INTEGER;}
BEGIN
WriteLog('Reformatting......');
lastStart := 2;
WHILE lastStart <= SUCC(totalDataClusters)
DO BEGIN
IF lastStart = permutation[lastStart]
(*v1.6THEN lastStart := SUCC(lastStart) *)
THEN Inc(lastStart) {v1.6}
ELSE BEGIN
ReadCluster(lastStart);
Move(DTArea, SaveArea, sectorSize * clusterSize);
prior := lastStart;
next := permutation[lastStart];
REPEAT
ReadCluster(next);
WriteCluster(prior);
(* v1.6 movedClusters := SUCC(movedClusters); *)
Inc(movedClusters); {v1.6}
STR(movedClusters:10,NrStr);
WriteF(movedFieldX, movedFieldY,NrStr);
permutation[prior] := prior;
prior := next;
next := permutation[next];
UNTIL next = lastStart;
Move(SaveArea, DTArea, sectorSize * clusterSize);
WriteCluster(prior);
(* v1.6 movedClusters := SUCC(movedClusters); *)
Inc(movedClusters); {v1.6}
STR(movedClusters:10,NrStr);
WriteF(movedFieldX, movedFieldY,NrStr);
permutation[prior] := prior;
END;
END;
WriteLog(' ');
END; { of DoIt }
{------------------- FAT and file information writing ------------------------}
PROCEDURE WriteFat(VAR unscrambledFAT: IntArray; VAR scrambledFAT: Buffer);
{
Write the FAT back to the disk. The FAT has to be scrambled before
writing. FAT entries on disk are 12 bits long. If there are
2 versions of the fat on disk, we write both fats.
}
VAR
i,
temp1,
temp2: Word; {v1.6 INTEGER;}
BEGIN
WriteLog('Writing FAT.');
IF BigFAT
THEN Move(unscrambledFAT, scrambledFAT,
(* v1.6 W_mul(totalDataClusters + 2, 2)) *)
(totalDataClusters+2) ShL 1 ) {v1.6}
ELSE FOR i := 0 TO SUCC(totalDataClusters)
DO BEGIN
Temp1 := unscrambledFAT[i];
Move( scrambledFAT[3 * i ShR 1 ], Temp2, 2);
{ACHING for inline here.}
IF ODD(i) THEN Temp1 := (Temp2 AND $000F) OR (Temp1 ShL 4)
ELSE Temp1 := (Temp2 AND $F000) OR Temp1;
Move( Temp1, scrambledFAT[3 * i ShR 1 ], 2);
END;
Read_Write_Sectors(firstFATSector, fatSize, writing);
IF numberOfFATs = 2
THEN Read_Write_Sectors(firstFATSector + fatSize, fatSize, writing);
END; { of WriteFat }
PROCEDURE WriteSubdirectory(VAR DTArea: Buffer; VAR oldFATarea: IntArray;
Root: DirectoryPointer;
start: Word {v1.6 INTEGER} );
{
Write subdirectories back to disk. Erased entries are removed
from the subdirectories. The subdirectories are written to their
old locations, because DoIt will take care of moving the clusters
to their new places. No effort is done to truncate a subdirectory
which would be longer than needed after removal of erased entries.
We will however set all remaining entries to 'NEVERUSED'.
This routine is used recursively.
}
VAR
start1,
clusterNumber,
dirIndex: Word; {v1.6 INTEGER;}
Present: DirectoryPointer;
BEGIN
Present := Root;
clusterNumber := Start;
WHILE Present <> NIL DO BEGIN
dirIndex := 0;
(*v1.6FillChar(DTArea, W_mul(clusterSize, sectorSize), $00); *)
FillChar(DTArea, (clusterSize * sectorSize), $00); {v1.6}
REPEAT
start1 := Present^.startingCluster;
Present^.startingCluster := Present^.newStartingCluster;
Move(Present^, DTArea[dirIndex], 32);
IF (( Present^.attribute AND SUBDIRECTORY ) <> 0 )
AND ( Present^.EntryName[0] <> '.' )
THEN BEGIN
WriteCluster(clusterNumber);
WriteSubdirectory(DTArea, oldFATarea,
Present^.subdirectory, start1);
ReadCluster(clusterNumber);
END;
Present := Present^.next;
(* v1.6 dirIndex := dirIndex + 32; *)
Inc(dirIndex,32); {v1.6}
(*v1.6UNTIL W_cmp(dirIndex, Ge, W_mul(clusterSize, sectorSize )) *)
UNTIL (dirIndex >= (clusterSize * sectorsize)) {v1.6}
OR ( Present = NIL );
WriteCluster(clusterNumber);
clusterNumber := oldFATarea[clusterNumber];
END;
(*v1.6IF W_cmp( clusterNumber, Lt, lastMinimum ) *)
IF clusterNumber < lastMinimum {v1.6}
THEN BEGIN
FillChar(DTArea, sectorSize * clusterSize, $00);
(*v1.6WHILE W_cmp( clusterNumber, Lt, lastMinimum ) DO BEGIN *)
WHILE clusterNumber < lastMinimum DO BEGIN {v1.6}
WriteCluster(clusterNumber);
clusterNumber := oldFATarea[clusterNumber];
END;
END;
END; { of WriteSubdirectory }
PROCEDURE WriteDirectories(VAR DTArea: Buffer);
{
Write rootdirectory back to disk. Erased entries are removed
from the directory. When we find a subdirectory entry, we first
process this subdirectory by calling WriteSubdirectories,
before we proceed with the root. All entries that are no in use
are set to 'NEVERUSED'.
}
VAR
Start,
sectorNumber,
dirIndex: Word; {v1.6 INTEGER;}
Present: DirectoryPointer;
BEGIN
WriteLog('Writing new Directory and Subdirectories.');
sectorNumber := firstDirectorySector;
Present := RootDir;
WHILE Present <> NIL DO BEGIN
dirIndex := 0;
FillChar(DTArea, sectorSize, $00);
REPEAT
Start := Present^.startingCluster;
Present^.startingCluster := Present^.newStartingCluster;
Move(Present^, DTArea[dirIndex], 32);
IF (( Present^.attribute AND SUBDIRECTORY ) <> 0 )
AND ( Present^.EntryName[0] <> '.' )
THEN BEGIN
Read_Write_Sectors(sectorNumber, 1, writing);
WriteSubdirectory(DTArea, OldFATaddress^,
Present^.subdirectory, Start);
Read_Write_Sectors(sectorNumber, 1, reading);
END;
Present := Present^.next;
(* v1.6 dirIndex := dirIndex + 32; *)
Inc(dirIndex,32); {v1.6}
UNTIL ( dirIndex >= sectorSize ) OR ( Present = NIL );
Read_Write_Sectors(sectorNumber, 1, writing);
(*v1.6sectorNumber := SUCC(sectorNumber); *)
Inc(sectorNumber); {v1.6}
END;
IF sectorNumber < firstDataSector
THEN BEGIN
FillChar(DTArea, sectorSize, $00);
WHILE sectorNumber < firstDataSector DO BEGIN
Read_Write_Sectors(sectorNumber, 1, writing);
(* v1.6 sectorNumber := SUCC(sectorNumber); *)
Inc(sectorNumber); {v1.6}
END;
END;
END; { of WriteDirectories }
{----------------------- disk integrety checking routines --------------------}
PROCEDURE CheckSubdirectory(VAR FAT: IntArray;
Root: DirectoryPointer;
parent, thisDir: Word {v1.6 INTEGER} );
{
This procedure is called recursively.
The SubDirectories are checked here. No attempt is made
to correct any errors found. If any errors are found, a message
is issued and the program stops. The users must first run CHKDSK from
DOS before we accept the disk.
}
VAR
Present: DirectoryPointer;
prior,
next: Word; {v1.6 INTEGER;}
BEGIN
Present := Root;
WHILE ( Present <> NIL ) AND ( errors = 0 ) DO BEGIN
IF (( Present^.attribute AND VOLUMELABEL ) = 0 )
AND ( Present^.startingCluster <> 0 )
AND ( Present^.Entryname[0] <> '.')
THEN BEGIN
next := Present^.startingCluster;
count := 0;
REPEAT; { first time never special value ! }
IF ( next > SUCC(totalDataClusters) )
OR ( next < 1 )
(* v1.6 THEN errors := SUCC(errors) *)
THEN Inc(errors) {v1.6}
ELSE BEGIN
prior := next;
next := FAT[prior];
FAT[prior] := 0;
IF next <> SUCC(prior)
(* v1.6 THEN count := SUCC(count); *)
THEN Inc(count); {v1.6}
END;
(* v1.6 UNTIL W_cmp( next, Ge, lastMinimum ) OR ( errors <> 0 ); *)
UNTIL (next >= lastMinimum) OR (errors <> 0); {v1.6}
IF count > 1
(* v1.6 THEN nonContiguousFiles := SUCC(nonContiguousFiles); *)
THEN Inc(nonContiguousFiles); {v1.6}
IF Present^.subdirectory <> NIL
THEN CheckSubdirectory(FAT, Present^.subdirectory,
thisDir, Present^.startingCluster);
END
ELSE BEGIN
IF ( Present^.EntryName[0] = '.' )
AND ( Present^.EntryName[1] = '.' )
THEN IF Present^.startingCluster <> parent
THEN Inc(errors) {v1.6 errors := SUCC(errors)}
ELSE
ELSE IF Present^.EntryName[0] = '.'
THEN IF Present^.startingCluster <> thisDir
THEN Inc(errors) {v1.6 errors := SUCC(errors)}
ELSE
ELSE IF Present^.startingCluster <> 0
THEN Inc(errors); {v1.6 errors := SUCC(errors);}
END;
Present := Present^.next;
END;
END; { of CheckSubdirectory }
PROCEDURE CheckDisk(VAR FAT: IntArray; Root: DirectoryPointer);
{
The FAT and the Directories are checked here. No attempt is made
to correct any errors found. If any errors are found, a message
is issued and the program stops. The users must first run CHKDSK from
DOS before we accept the disk.
}
BEGIN
WriteLog('Checking FAT....');
CheckSubdirectory(FAT, Root, 0, 0);
FOR count := 2 TO SUCC(totalDataClusters) DO
IF ( FAT[count] <> 0 ) AND
(* v1.6
( W_cmp( FAT[count], Lt, reservedMinimum )
OR W_cmp( FAT[count], Gt, badCluster) )
THEN lostClusters := SUCC(lostClusters);
*)
( ( FAT[count] < reservedMinimum) {v1.6}
OR (FAT[count] > badCluster) )
THEN Inc(lostClusters);
IF errors <> 0 THEN BEGIN
WriteError('Crosslinked clusters found. Run CHKDSK first.');
Exeunt(EnterStr);
END
ELSE IF lostClusters <> 0
THEN BEGIN
WriteError('Lost clusters found. Run CHKDSK first.');
Exeunt(EnterStr);
END;
END; { of CheckDisk }
{--------------------------- miscellaneous routines --------------------------}
PROCEDURE CountClustersToMove(VAR permutation: IntArray);
BEGIN
FOR count := 2 TO SUCC(totalDataClusters) DO
IF permutation[count] <> count
THEN Inc(clustersToMove); {v1.6 clustersToMove := SUCC(clustersToMove);}
END; { of CountClustersToMove }
PROCEDURE WriteStatistics;
BEGIN
usedClusters := totalDataClusters - badClusters - freeClusters;
toadY := 4;
IF DiskLabel <> '' THEN
WriteF(16, 0, 'Volume Label is . . . . . : ');
WRITE(DiskLabel);
WriteF(16, 0, 'Total # of files. . . . . :');
WRITE(totalFiles:10);
IF hiddenFiles <> 0
THEN WRITE(' (hidden:', hiddenFiles:3,')');
IF subdirectories = 0
THEN WriteF(16, 0, 'All files in Rootdirectory.')
ELSE BEGIN
WriteF(16, 0, ' in Root directory . . . :');
WRITE(inRootDirectory:10);
WriteF(16, 0, ' in Subdirectories . . . :');
WRITE(inSubdirectories:10);
WriteF(16, 0, '# of subdirectories . . . :');
WRITE(subdirectories:10);
IF hiddenDirectories <> 0
THEN WRITE(' (hidden:', hiddenDirectories:3,')');
END;
WriteF(16, 0, '# of noncontiguous files. :');
WRITE(nonContiguousFiles:10);
WriteF(16, 0, '# of clusters to be moved :');
WRITE(clustersToMove:10);
WriteF(16, 0, '# of clusters moved . . . :');
WRITE(movedClusters:10);
movedFieldX := 43;
movedFieldY := PRED(toadY);
STR(totalDataClusters:06, NrStr);
WriteF(05, SUCC(toadY),
'Total space . . :' + NrStr + ' clusters.');
STR(clusterSize:06, NrStr);
WriteF(43, PRED(toadY) {0}, 'clusterSize . . :' + NrStr + ' sectors.');
STR(freeClusters:6,NrStr);
WriteF(05, 0, 'Free space. . . :' + NrStr + ' clusters.');
STR(sectorSize:06, NrStr);
WriteF(43, PRED(toadY) {0}, 'sectorSize. . . :' + NrStr + ' bytes.');
STR(usedClusters:6,NrStr);
WriteF(05, 0, 'Used space. . . :' + NrStr + ' clusters.');
STR(firstDataSector:06, NrStr);
WriteF(43, PRED(toadY) {0}, 'DOS space . . . :' + NrStr + ' sectors.');
STR(badClusters:6,NrStr);
WriteF(05, 0, 'Bad space . . . :' + NrStr + ' clusters.');
(*v1.6toadY := PRED(toadY); { stay on same line } *)
Dec(toadY); { stay on same line v1.6}
NrStr := 'Disk type . . . :';
IF media = FIXEDDISK
THEN WriteF(43, 0, 'Disk type . . . : Fixed Disk.')
ELSE IF ( altAD = 0 ) AND ( assignedDisk <> 0 )
THEN WriteF(43, 0, 'Disk Type . . . : Virtual Disk.')
ELSE WriteF(43, 0, 'Disk Type . . . : Removable Disk.');
END; { of WriteStatistics }
PROCEDURE InitScreen;
BEGIN
NormVideo;
ClrScr;
Frame(1);
Frame(0);
color := $70; {inverse}
WriteF(0, 2,Header + Version);
color := LIGHTGRAY; {normal}
WriteF(3, inputFieldY ,'User Input Field :');
WriteF(3, 0 ,'Activity Logging :');
WriteF(3, 0 ,'Warning Messages:');
WriteF(3, 0 ,'Error Messages:');
WriteF(3, 0 ,'Disaster Messages:');
END; { of InitScreen }
PROCEDURE InitCounters;
BEGIN
(*
BigFAT := FALSE;
oldFATindex := 0;
newFATindex := 1;
errors := 0;
lostClusters := 0;
totalFiles := 0;
hiddenFiles := 0;
hiddenDirectories := 0;
inRootDirectory := 0;
inSubdirectories := 0;
nonContiguousFiles := 0;
subdirectories := 0;
movedClusters := 0;
clustersToMove := 0;
count := 0;
AlreadyWritten := FALSE;
DiskLabel := '';
badClusters := 0;
*)
Inline(
$31/$C0 {xor ax,ax ;get a zero}
/$A2/>BIGFAT {mov [>BigFAT],al ;boolean}
/$A3/>OLDFATINDEX {mov [>oldFATindex],ax}
/$A3/>ERRORS {mov [>errors],ax}
/$A3/>LOSTCLUSTERS {mov [>lostClusters],ax}
/$A3/>TOTALFILES {mov [>totalFiles],ax}
/$A3/>HIDDENFILES {mov [>hiddenFiles],ax}
/$A3/>HIDDENDIRECTORIES{mov [>hiddenDirectories],ax}
/$A3/>INROOTDIRECTORY {mov [>inRootDirectory],ax}
/$A3/>INSUBDIRECTORIES {mov [>inSubdirectories],ax}
/$A3/>NONCONTIGUOUSFILES{mov [>nonContiguousFiles],ax}
/$A3/>SUBDIRECTORIES {mov [>subdirectories],ax}
/$A3/>MOVEDCLUSTERS {mov [>movedClusters],ax}
/$A3/>CLUSTERSTOMOVE {mov [>clustersToMove],ax}
/$A3/>COUNT {mov [>count],ax}
/$A2/>ALREADYWRITTEN {mov [>AlreadyWritten],al ;boolean}
/$A2/>DISKLABEL {mov [>DiskLabel],al ;string}
/$A3/>BADCLUSTERS {mov [>badClusters],ax}
/$40 {inc ax ;1}
/$A3/>NEWFATINDEX {mov [>newFATindex],ax}
);
END; { of InitCounters }
PROCEDURE WriteDoc;
BEGIN
ClrScr;
Frame(2);
WriteF( 0, 2, Header);
WriteF( 0, 0, PDS);
WriteF( 0, SUCC(toadY), { skip a line }
'Makes all files on a floppy or fixed disk ' +
'contiguous again,');
WriteF( 0, 0, 'improving disk performance dramatically.');
WriteF( 0, 0, 'Either fixed disks or diskettes. Requires DOS 2.0 or up.');
WriteF( 0, 0, 'Register at the following address to be on my mailing ' +
'list for updates.');
WriteF( 0, SUCC(toadY), { skip a line }
'Jos Wennmacker');
WriteF( 0, 0, 'Universitair Rekencentrum');
WriteF( 0, 0, 'Geert Grooteplein Zuid 41');
WriteF( 0, 0, 'NL-6525 GA Nijmegen');
WriteF( 0, 0, 'The Netherlands');
WriteF( 0, SUCC(toadY), { skip a line }
'U015415@hnykun22.BITNET');
WriteF( 0, SUCC(toadY), { skip a line }
'Also comments, bugs, etc. are expected at this address.');
GetInput('Press enter to see next page',InStr);
ClrScr;
Frame(2);
WriteF( 0, 2, Header);
WriteF( 0, 0, PDS);
WriteF(32, SUCC(toadY), { skip a line }
'Use: Reformat d:');
WriteF(27, 0,
'where d: is a driveletter.');
WriteF( 0, SUCC(toadY),
'This program works for both fixed disks and floppies.');
color := color + BLINK;
WriteF( 0, toadY + 2, { skip 2 lines }
'* WARNING * WARNING * WARNING * WARNING * WARNING * WARNING *');
color := color - BLINK;
WriteF( 0, toadY + 2, { skip 2 lines }
'NEVER use this program on a disk that contains * PROTECTED * software');
WriteF( 0, 0,
'You might find these programs turned into an illegal copy');
WriteF( 0, 0,
'or even end up with a scrambled disk!!!!!!');
WriteF( 0, 0,
'Always *UNINSTALL* this kind of software before using REFORMAT!!');
WriteF( 0, 0,
'The program will prompt you to confirm this in case of a fixed disk');
WRITELN;
WRITELN;
END; { of WriteDoc}
PROCEDURE Check_DOS_Version;
{
********************************************************************
DOS_Versions DOS_Versions DOS_Versions DOS_Versions DOS_Versions
********************************************************************
Currently DOS 2.00 thru 3.10 are supported. Mainly because of the
use of the undocumented DOS function call 32H, other versions might
not be so. DOS function 30H returns the major version number in al,
and the minor version number in ah. Remember that the minor number
is a two digit number: DOS 3.1 is really DOS 3.10, DOS 3.2 really is
3.20
********************************************************************
DOS_Versions DOS_Versions DOS_Versions DOS_Versions DOS_Versions
********************************************************************
v1.6 Permitting a user override if higher than DOS 3.10.
On your own head be it!
}
VAR r : REAL;
BEGIN
WITH Register DO BEGIN
ah := $30;
MSDos(Register);
IF ( al < 2 ) OR (( al = 3 ) AND ( ah > 10 ))
THEN BEGIN
(* v1.6
WRITELN('Incorrect DOS version.');
HALT;
*)
r := al + (ah / 10); {convert to a real}
STR(r:1:2,NrStr);
S40 := 'Enter A (abort), C (continue)';
WriteWarning('Untested DOS version!');
WriteError('DOS ' + NrStr); {display DOS version}
Legals := 'AC';
REPEAT
Getinput(S40,Instr);
UNTIL POS(Instr,Legals) <> 0;
IF Instr = 'A' THEN BEGIN
GotoXY(1,24); WRITELN; {leave the screen for him or her }
HALT;
END
ELSE BlankFields;
END;
END;
END; { of Check_DOS_Version }