{*
 * @(#) clrdsk.pas - Program for wiping (clearing) disk unused clusters.
 * (c) 1995 Ivan Maidanski <ivmai@chat.ru> http://ivmai.chat.ru
 * Freeware program source. All rights reserved.
 **
 * Language: Turbo Pascal
 * Tested with: Turbo Pascal v7.0
 * Last modified: 1995-05-07 13:45:00 GMT+04:00
 *}

program ClearDiskFreeClusters;

{$M 2048,0,65535}
var Disk: Byte;
var Buf,Fat: Pointer;
var Fat12: Boolean;
var UsePacket: Boolean;
var SectorsPerCluster: Byte;
var ClusterSize,SectorsPerFat: Word;
var SectorsBeforeFat,SectorsBeforeData: LongInt;
var TotalClusters: Word;
var Packet: array[1..10] of Byte;
procedure Hello;
 begin
   WriteLn('Clears disk free clusters.');
   WriteLn('Usage: CLRDSK drive');
   WriteLn;
   Halt(0)
 end;
procedure InvalidUsage;
 begin
   WriteLn(' Invalid Usage!');
   WriteLn;
   Halt(1)
 end;
procedure PrintErr(S: String);
 begin
   WriteLn(#13'Error: ',S,'!');
   WriteLn;
   Halt(2)
 end;
procedure GetMemory(var P: Pointer; Size: LongInt);
 begin
   if MaxAvail<Size
     then PrintErr('Out of memory');
   GetMem(P,Size)
 end;
function GetDosVersion: Word; assembler;
 asm
  mov ah,30h
  int 21h
 end;
function DiskRead(var Buf; Disk: Byte; Start: LongInt; Count: Word)
                 : Word; assembler;
 asm
   push ds
   push bp
   cmp [UsePacket],0
   jne @@Use
   lds bx,Buf
   mov dx,[word ptr Start]
   mov cx,[Count]
   jmp @@Skip
  @@Use:
   mov cx,0FFFFh
   mov ax,seg Packet
   mov ds,ax
   mov bx,offset Packet
   mov ax,[word ptr Start]
   mov [bx],ax
   mov ax,[word ptr Start+2]
   mov [bx+2],ax
   mov ax,[Count]
   mov [bx+4],ax
   mov ax,[word ptr Buf]
   mov [bx+6],ax
   mov ax,[word ptr Buf+2]
   mov [bx+8],ax
  @@Skip:
   mov al,[Disk]
   int 25h
   pop dx
   jc @@Exit
   xor ax,ax
  @@Exit:
   pop bp
   pop ds
 end;
function DiskWrite(var Buf; Disk: Byte; Start: LongInt; Count: Word)
                  : Word; assembler;
 asm
   push ds
   push bp
   cmp [UsePacket],0
   jne @@Use
   lds bx,Buf
   mov dx,[word ptr Start]
   mov cx,[Count]
   jmp @@Skip
  @@Use:
   mov cx,0FFFFh
   mov ax,seg Packet
   mov ds,ax
   mov bx,offset Packet
   mov ax,[word ptr Start]
   mov [bx],ax
   mov ax,[word ptr Start+2]
   mov [bx+2],ax
   mov ax,[Count]
   mov [bx+4],ax
   mov ax,[word ptr Buf]
   mov [bx+6],ax
   mov ax,[word ptr Buf+2]
   mov [bx+8],ax
  @@Skip:
   mov al,[Disk]
   int 26h
   pop dx
   jc @@Exit
   xor ax,ax
  @@Exit:
   pop bp
   pop ds
 end;
procedure TestDiskErr(Err: Word);
 begin
   case Hi(Err) of
       0: ;
       2: PrintErr('Common Error');
       3: PrintErr('Disk is write-protected');
       4: PrintErr('Sector not found');
       8: PrintErr('CRC error');
      16: PrintErr('Error in data');
      64: PrintErr('Seek error');
     128: PrintErr('Drive not ready')
     else PrintErr('')
   end
 end;
function GetByte(P: Pointer; Addr: Word): Byte;
 begin
   GetByte:=Mem[Seg(P^):Ofs(P^)+Addr]
 end;
procedure GetDiskInfo(Disk: Byte;
                      var TotalClusters,SectorSize: Word;
                      var SectorsPerCluster: Byte); assembler;
 asm
   push ds
   mov dl,[Disk]
   inc dx
   mov ah,1Ch
   int 21h
   lds bx,[TotalClusters]
   inc dx
   mov [bx],dx
   lds bx,[SectorsPerCluster]
   mov [bx],al
   lds bx,[SectorSize]
   mov [bx],cx
   pop ds
 end;
procedure TestBootSector;
 const StandardSectorSize= 512;
 var AmountOfFat: Byte;
 var SectorSize,RootEntries: Word;
 var ElementsPerFat: LongInt;
 begin
   GetMemory(Buf,StandardSectorSize);
   GetDiskInfo(Disk,TotalClusters,SectorSize,SectorsPerCluster);
   TestDiskErr(DiskRead(Buf^,Disk,0,1));
   {SectorSize:=GetByte(Buf,11)+GetByte(Buf,12)*256;}
   {SectorsPerCluster:=GetByte(Buf,13);}
   SectorsBeforeFat:=GetByte(Buf,14)+GetByte(Buf,15)*256;
   AmountOfFat:=GetByte(Buf,16);
   RootEntries:=GetByte(Buf,17)+GetByte(Buf,18)*256;
   {TotalSectors:=GetByte(Buf,19)+GetByte(Buf,20)*256;}
   SectorsPerFat:=GetByte(Buf,22)+GetByte(Buf,23)*256;
   FreeMem(Buf,StandardSectorSize);
   if (SectorSize=0) or (SectorsPerCluster=0) or
      (SectorsBeforeFat=0) or (AmountOfFat=0) or
      (RootEntries=0) or (TotalClusters=0) or (SectorsPerFat=0)
     then PrintErr('Invalid disk format');
   ClusterSize:=SectorSize*SectorsPerCluster;
   SectorsBeforeData:=SectorsBeforeFat+SectorsPerFat*AmountOfFat+
                      32*RootEntries div SectorSize;
   {MaxClusterNumber:=1+(TotalSectors-SectorsBeforeData)
                       div SectorsPerCluster;}
   Fat12:=TotalClusters<=4086;
   ElementsPerFat:=LongInt(SectorSize)*SectorsPerFat;
   if Fat12
     then ElementsPerFat:=2*(ElementsPerFat div 3)
     else ElementsPerFat:=ElementsPerFat div 2;
   if ElementsPerFat<TotalClusters+1
     then PrintErr('Invalid disk format')
 end;
procedure ReadFat;
 begin
   GetMemory(Fat,LongInt(ClusterSize) div SectorsPerCluster*SectorsPerFat);
   TestDiskErr(DiskRead(Fat^,Disk,SectorsBeforeFat,SectorsPerFat))
 end;
procedure ClearBuf; assembler;
 asm
   push es
   mov cx,[ClusterSize]
   shr cx,1
   les di,[Buf]
   xor ax,ax
   rep stosw
   pop es
 end;
procedure Init;
 var S: String[1];
 begin
   if ParamCount=0
     then Hello;
   if ParamCount<>1
     then InvalidUsage;
   S:=ParamStr(1);
   Disk:=Ord(UpCase(S[1]));
   if (Disk>=Ord('A')) and (Disk<=Ord('Z'))
     then Dec(Disk,Ord('A'))
     else InvalidUsage;
   UsePacket:=Lo(GetDosVersion)>=4;
   TestBootSector;
   ReadFat;
   GetMemory(Buf,ClusterSize);
   ClearBuf;
   WriteLn
 end;
function GetClusterStatus(Number: Word): Word;
 var B: Boolean;
 begin
   B:=Odd(Number);
   if Fat12
     then Number:=3*Number div 2
     else Number:=2*Number;
   Number:=GetByte(Fat,Number)+GetByte(Fat,Succ(Number))*256;
   if Fat12
     then if B
            then Number:=Number shr 4
            else Number:=Number and $0FFF;
   GetClusterStatus:=Number
 end;
function GetSectorNumber(Cluster: Word): LongInt;
 begin
   GetSectorNumber:=SectorsBeforeData+(Cluster-2)*SectorsPerCluster
 end;
procedure ShowPercentage(Cluster: Word);
 const Count: Word = 0;
 begin
   Inc(Count);
   Write('Procceded: ',(100*LongInt(Cluster) div LongInt(TotalClusters)):3,
         '% ',' ',' Cleared: ',Count,#13)
 end;
procedure Run;
 var Cluster: Word;
 var FatElement: Boolean;
 begin
   for Cluster:=2 to TotalClusters
     do if GetClusterStatus(Cluster)=0
          then begin
                 TestDiskErr
                   (DiskWrite(Buf^,Disk,
                              GetSectorNumber(Cluster),SectorsPerCluster));
                 ShowPercentage(Cluster)
               end;
   WriteLn('Operation completed.',' ':20)
 end;
begin
  Init;
  Run
end.