Модуль для работы с дисковыми драйверами (На уровне FAT)

Previous  Top  Next

    
 

 

                       FAT/FAT16/FAT32

            Модуль для работы с дисковыми драйверами

 

                     Автор  : NikNet

                     E-MAIL : NikNet@Yandex.ru

                     Сайт   : NikNet.narod.ru [Скоро будет :)]

                            2006г

                   Версия 4.00 (Win9x/NT)

 

 

 

 

 

 

                  Файловая система FAT фирмы Microsoft

 

 

                  FAT12/FAT16                 FAT32

 

              Загрузочный сектор        Загрузочный сектор

 

                    FAT 1                Структура FSInfo

 

                    FAT 2                     FAT 1

                                                                   Системная

               Корнивой каталог               FAT 2                область

 

                Область данных            Область данных

 

Code:

unit uFAT;

erface

 

 

 

 

Uses Windows,SysUtils,DISK,CLASSES;

TYPE

{----------- Структура загрузочного сектора для FAT12 и FAT16 ---------------}

PBoot  = ^TBoot;

TBoot           {                                                             }= packed record

bsJmpBoot      { Переход на код загрузки                                     }: array[1..3] of byte;

bsOemname      { Имя пройзводителя                                           }: array[1..8] of char;

bsBytePerSec   { Число байт в секторе                                        }: word;

bsSecPerClus   { Число секторов в сластере                                   }: byte;

bsRsvdSecCnt   { Начала FAT1 в секторах                                      }: word;

bsNumFATs      { Число копий FAT                                             }: byte;

bsRootEntCnt   { Количество элементов в корне                                }: word;

bsToolSec12    { Общее количество секторов на диске                          }: word;

bsMedia        { Тип носителя                                                }: byte;

bsFATSz16      { Количество в одной  FAT                                     }: word;

bsSecPerTrk    { Число секторов на одной дорожки                             }: word;

bsNumHeads     { Число головок на одной дорожки                              }: word;

bsNumHideSec   { Количество "скрытых" секторов                               }: LongInt;

bsToolSec16    { Общее количество секторов на диске                          }: LongInt;

bsDrvNum       { Номер дискавода                                             }: byte;

bsReserved1    { Резервировано для WinNT                                     }: byte;

bsBootSig      { Признак расширеной загрузочной записи (24h)                 }: byte;

bsVolID        { Серийны номер диска                                         }: LongInt;

bsVolLab       { Метка тома диска                                            }: array[1..11] of char;

bsFSType       { Тип файловой системы                                        }: array[1..8of char;

bsBoot         { Загрузочный код                                             }: array[1..448]of Byte;

bsTrailSig     { Сигнатура AA55h                                             }: array[1..2] of char;

end;

 

{--------------- Структура загрузочного сектора для FAT32 -------------------}

PBoot32 = ^TBoot32;

TBoot32         {                                                             }packed record

bsJmpBoot      { Переход на код загрузки                                     }: array[1..3] of byte;

bsOemname      { Имя пройзводителя                                           }: array[1..8] of char;

bsBytePerSec   { Число байт в секторе                                        }: word;

bsSecPerClus   { Число секторов в сластере                                   }: byte;

bsRsvdSecCnt   { Начала FAT1 в секторах                                      }: word;

bsNumFATs      { Число копий FAT                                             }: byte;

bsRootEntCnt   { Количество элементов в корне                                }: word;

bsToolSec16    { Зарезервировано                                             }: word;

bsMedia        { Тип носителя                                                }: byte;

bsFATz16       { Зарезервировано                                             }: word;

bsSecPerTrk    { Число секторов на одной дорожки                             }: word;

bsNumHeads     { Число головок на одной дорожки                              }: word;

bsHiddSec      { Число скрытых секторов                                      }: Longint;

bsTolSec32     { Общее количество секторов на диске                          }: LongInt;

bsFATSz32      { Количество сектаров для одной FAT                           }: LongInt;

bsExtFlags     { Номер активой FAT                                           }: word;

bsFSVer        { Номер версии: старший байт номер версии,младши номер ревизи }: word;

bsRootClus     { Первый кластер обычно имеет номер 2                         }: LongInt;

bsFSInfo       { Номер сектора структуры FSINFO                              }: word;

bsBkBootSec    { Номер BootSector(Копия) обычно имеет номер 2                }: word;

bsReserved     { Облость резервированная                                     }: array[1..12] of byte;

bsDrvNum       { Номер дискавода                                             }: byte;

bsReserved1    { Резервировано для WinNT                                     }: byte;

bsBootSig      { Признак расширеной загрузочной записи (24h)                 }: byte;

bsVolID        { Серийны номер диска                                         }: LongInt;

bsVolLab       { Метка тома диска                                            }: array[1..11] of char;

bsFSType       { Тип файловой системы                                        }: array[1..8of char;

bsBoot         { Загрузочный код                                             }: array[1..420]of byte;

bsTrailSig     { Сигнатура AA55h                                             }: array[1..2] of char;

end;

 

{-------------------------> Типы носителей информации <------------------------}const

MediaType       {                                                             }:array[1..7] of byte= (

$F0            { Гибкий диск, 2 стороны, 18 секторов на дорожке              },

$F8            { Жесткий диск                                                },

$F9            { Гибкий диск, 2 стороны, 15 секторов на дорожке              },

$FC            { Гибкий диск, 1 стороны, 09 секторов на дорожке              },

$FD            { Гибкий диск, 2 стороны, 09 секторов на дорожке              },

$FE            { Гибкий диск, 1 стороны, 08 секторов на дорожке              },

$FF            {  Гибкий диск, 2 стороны, 08 секторов на дорожке             } );

 

{----- Структура сектора FSInfo и резервного загрузочного сектора FAT32 -----}Type

PFsInfo = ^TFsInfo;

TFsInfo         {                                                             }= Record

fsLeadSig      { Сигнатура 41615252h                                         }:LongInt;

fsReserved1    { Зарезервировано                                             }:array[1..480] of byte;

fsStrucSig     { Сигнатура 61417272h                                         }:LongInt;

fsFree_Count   { Количество свободных кластеров                              }:LongInt;

fsNxt_Free     { Обычно номер 2                                              }:LongInt;

fsReserved2    { Зарезервировано                                             }:array[1..12] of byte;

fsTrailSig     { Сигнатура AA550000h                                         }:array[1..4] of byte;

end;

{------------ Вид начальных фрагментов для FAT различных типов --------------}{

 

Байт   00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23

FS12 - FF 8F FF 00 30 04 00 5F FF 00 7F FF FF F0 0A 00 BF FF 00 D0 0E FF FF FF

FS16 - FF F8 FF FF 00 03 00 04 00 05 FF FF 00 07 FF FF FF FF 00 0A 00 0B FF FF

FS32 - 0F FF FF F8 0F FF FF FF 00 00 00 03 00 00 00 04 00 00 00 05 0F FF FF FF

 

         Резервные файлы                                          Конечный

                                                                   кластер

                                                                   файла

 

{---------------- Значения специальных кодов элементов FAT ------------------}{

 

     Значение кода               FAT12      FAT16          FAT32

     Свободный кластер           0          0              0

     Дефектный кластер           $FF7       $FFF7         $FFFFFF7

     Последний кластер в списке  $FF8-$FFF $FFF8-$FFFF $FFFFFF8-$FFFFFFF}

 

const

FAT_Available    = 0;

FAT_Reserved_Min = $FFFFFFF0;

FAT_Reserved_Max = $FFFFFFF6;

FAT_BAD          = $FFFFFFF7;

FAT_EOF_Min      = $FFFFFFF8;

FAT_EOF_Max      = $FFFFFFFF;

 

FAT_MASK_12      = $FFF;

FAT_MASK_16      = $FFFF;

FAT_MASK_32      = $FFFFFFF;

 

const

ATTR_ARCHIVE     = $20// Архивный

ATTR_DIRECTORY   = $10// Директория

ATTR_VOLUME      = $08// Метка тома

ATTR_SYSTEM      = $04// Системный

ATTR_HIDDEN      = $02// Скрытый

ATTR_READONLY    = $01// Только для чтение

 

TYPE

{----------------------- Структура элемента каталога ------------------------}

   PDIRENTRY = ^TDIRENTRY;

   TDIRENTRY = record

     Name         { Имя файла или директори                                     }:array[1..8] of char;

     EXT          { Расширение файла                                            }:array[1..3] of char;

     Attr         { Атрибуты файла                                              }:BYTE;

     NTRes        { Поле зарезервировано для WinNT должно содержать 0           }:BYTE;

     CrtTimeTenth { Поле, уточняющее время создание файла в милисикундах        }:BYTE;

     CrtTime      { Время создание файла                                        }:WORD;

     CrtDate      { Дата создание файла                                         }:WORD;

     LstAccDate   { Дата последнего обращения к файлу для I/O данных            }:WORD;

     FSIClasHi    { Старшее слово номера первого кластера файла                 }:WORD;

     WrtTime      { Время выпонения последней операции записи в файл            }:WORD;

     WrtDate      { Дата выпонения последней операции записи в файл             }:WORD;

     FSIClasLo    { Младшее слово номера первого кластера файла                 }:WORD;

     Size         { Размер файла в байтах (   32-разрядное  число   )           }:LONGINT;

   end;

 

{--- Структура элемента каталога, хранящего фрагмент длинного имени файла ---}

   PLONGDIRENTRY = ^TLONGDIRENTRY;

   TLONGDIRENTRY = record

     Counter      { Номер фрагмента                                             }:Byte;

     LFN1         { Первый участок фрагмента имени                              }:array[1..5]of Wchar;

     Attr         { Атрибуты файла                                              }:BYTE;

     Flags        { Байт флагов                                                 }:BYTE;

     ChkSum       { Контроляная сумма << короткого имени >>                     }:BYTE;

     LFN2         { Второй участок фрагмента имени                              }:array[1..6]of Wchar;

     FirstClus    { Номер первого кластера ( должен быть равен 0 )              }:Word;

     LFN3         { Третий участок фрагмента имени                              }:array[1..2]of Wchar;

   end;

 

 

 

{------------------------------------------------------------------------------}

(******************************************************************************)

{------------------------------------------------------------------------------}

(******************************************************************************)

{------------------------------------------------------------------------------}

 

TYPE

TFSType = (fsNone, fsFAT12, fsFAT16, fsFAT32);

TDIR_Entry = record

     Name            : String;

     LongName        : String;

     Ext             : String;

     Attr            : Byte;

     StartCluster    : Longint;

     CreateTime      : Longint;

     CreateDate      : Longint;

     WriteLastDate   : Longint;

     WriteLastTime   : Longint;

     FileSize        : Longint;

     LastAccessDate  : Longint;

     Erased          : Boolean;

     CurrentSector   : Int64;

     StartByteNamePerSec : Integer;

   end;

PDIR_Entry = ^TDIR_Entry;

 

 

VAR

PhysicalVolume    : word  = 0;              // Номер текущего Физичиского диска

Volume            : Byte  = 0;              // Текущий логический диск

VolumeSerial      : DWord = 0;              // Серийный номер тома

BytesPerSector    : DWORD = 0;              // Количество байт в одном секторе

LogicalSectors    : Int64 = 0;              // Количество секторов на лог. диске

 

SectorsPerCluster : DWORD = 0;              // Количество секторов в одном кластере

RootDirSector     : Int64 = 0;              // Начало корневого каталога

RootDirCluster    : Int64 = 0;              // Начальный кластер корневого каталога

RootDirEntries    : Int64 = 0;              // Количество элементов в корневом каталоге

DataAreaSector    : Int64 = 0;              // Текущий кластер

 

FATCount          : Byte  = 0;              // Количество копий FAT (Обычно 2)

SectorsPerFAT     : Int64 = 0;              // Количеств секторов в одной FAT

FATSize           : Int64 = 0;              // Размер FAT в кластерах

FATSector         : Pointer = nil;          // Начало FAT

FAT               : Pointer = nil;          // Буфер для файловых элементов

ActiveFAT         : word;

EndingCluster     : Int64 = 0;              // Последний кластер для одной FAT

 

 

VolumeName        : array[1..11] of char;   // Метка тома

FSName            : array [1..8] of Char;   // Название файловой системы

FSType            : TFSType = fsNone;       // Тип файловой системы

 

 

Function Init         (Drive:byte):Boolean;

Function ReadSector  (Sector: Int64; Count: Word; Var Buffer; nSize:DWORD): Boolean;

Function WriteSector (Sector: Int64; Count: Word; Var Buffer; nSize:DWORD): Boolean;

Function GetFATCluster(FATIndex: LongInt): LongInt;

Function GetFATEntry  (Cluster: Int64): Longint;

Procedure SetFATEntry  (Cluster: Int64; Value: Longint);

 

Function GetCluster(Sector: Int64):Int64;

Function ReadCluster  (Cluster: Int64; var Buffer; BufferSize: Longint): Boolean;

Function WriteCluster (Cluster: Int64; var Buffer; BufferSize: Longint): Boolean;

Function WriteClusterChain(StartCluster: Longint; Buffer: Pointer; BufferSize: Longint): Boolean;

Function ReadClusterChain(StartCluster: Int64; var Buffer: Pointer; var BufferSize: Longint): Boolean;

Function SeekForChainStart(Cluster: Int64): Longint;

Function ValidCluster (Cluster: Int64): Boolean;

function ReadDIR(Cluster: Longint; var DIR: PDIR_Entry; var Entries: Longint): Boolean;

Procedure Done;

  // Дополнение...

procedure ParseDOSTime (Time: Word; var Hour, Minute, Second: Word);

procedure ParseDOSDate (Date: Word; var Day, Month, Year: Word);

function GetShortName (Name: String): String;

function FormatDiskSize (Value: TLargeInteger): string;

function DosToWin(St: string): string;

 

implementation

 

 

function ReadDIR(Cluster: Longint; var DIR: PDIR_Entry; var Entries: Longint): Boolean;

label

   NextSector,

   LongNameComponent,

   ElementNotUsed,

   EndDIR;

 

var P: Pointer;

   P1: PDIREntry;

   PL: PLONGDIRENTRY;

   Dir_Entry: TDIR_Entry;

   Size: Longint;

   ADIR: TMemoryStream;

   J: DWORD;

   s,s1,sTmp: String;

   L:DWORD;

   LFNErase:Boolean;

begin

   s1:='';

  LFNErase:=False;

  Entries:=0;

  Result := False;

  if FSType = fsNone then Exit;

  if FAT = NIL then Exit;

  if FATSize = 0 then Exit;

  // Читаем ципочку кластеров в FAT пока не встретим $FFF

  Result := ReadClusterChain(Cluster, P, Size);

  // проверим нет ли ошибки с диском

  if not Result then Exit;

  // установим количество каталогов

  Size := Size div 32;

  // создаем поточный объект в памяти

  ADIR := TMemoryStream.Create;

  // P = начало каталога

  P1 := P;

NextSector:

   s:='';

    FillChar(DIR_Entry, SizeOf(DIR_Entry), 0);

   // Проверить признак конца каталога

   if (Byte(Pointer(Longint(P1)+$00)^) = $00then

//      if (Byte(Pointer(Longint(P1)+$0B)^) = $00)  then

     goto EndDir;

 

   // Проверить наличие данных в элементе каталга

    if Byte(Pointer(P1)^) = $e5 then

       DIR_Entry.Erased := True else

       DIR_Entry.Erased := False;

 

    // Обычный элемент или компонента длинного имени?

    if (Byte(Pointer(Longint(P1)+$0b)^) = $0F) then

    Begin

          Inc(Longint(P1), SizeOf(TDIRENTRY));

          Goto NextSector;

     end;

{     if ((Byte(Pointer(P1)^) and $3F) = 37) then

    Begin

          Inc(Longint(P1), SizeOf(TDIRENTRY));

          Goto NextSector;

    end

    else

    Goto LongNameComponent;}

 

    // Проверить признак метки если "True" пропустим его...

    if Byte(Pointer(Longint(P1)+$0b)^) = ATTR_VOLUME then

    Begin

       Inc(Longint(P1), SizeOf(TDIRENTRY));

       Goto NextSector;

    end;

 

    Begin

    // Обрабатываем короткое имя

       if ((Byte(Pointer(Longint(P1)+$0b)^) and ATTR_DIRECTORY) = 0) and

       (P1^.Ext[1] <> chr($20))then

       s:=P1^.Name+'.'+P1^.Ext else

       s:=P1^.Name;

       for j:=1 to Length(s) do

         if (s[j] <> chr($20)) then

         Dir_Entry.Name:=Dir_Entry.Name+s[j];

       for j:=1 to 3 do

       Dir_Entry.Ext:=Dir_Entry.Ext+P1^.Ext[j];

       s:='';

   end;

   Goto ElementNotUsed;

 

LongNameComponent:

       PL:=PLONGDIRENTRY(P1);

        if (PL.LFN1[1] <> WideChar(0)) and (PL.LFN1[1] <> WideChar($FFFF)) then

          For j:=1 to 5 do if (PL.LFN1[j]  <> #0) then s:=s+PL.LFN1[j];

        if (PL.LFN2[1] <> WideChar(0)) and (PL.LFN2[1] <> WideChar($FFFF)) then

          For j:=1 to 6 do if (PL.LFN2[j] <> #0) then s:=s+PL.LFN2[j];

        if (PL.LFN3[1] <> WideChar(0)) and (PL.LFN3[1] <> WideChar($FFFF)) then

          For j:=1 to 2 do if (PL.LFN3[j] <> #0) then s:=s+PL.LFN3[j];

        s1:=s+s1;

 

 

        if ((Byte(Pointer(P1)^) and $3F) <> 01) then

        Begin

          Inc(Longint(P1), SizeOf(TDIRENTRY));

          Goto NextSector;

        end;

 

      Inc(Longint(P1), SizeOf(TDIRENTRY));

       Dir_Entry.Name:=s1;

       LFNErase:=False;

      s1:='';

      s:='';

 

ElementNotUsed:

      // Сохраним текущий сектор и смещение текущего элемента

      // Он будет нужен в будущем...

       Dir_Entry.CurrentSector:=(LongInt(P1)-LongInt(P)) div 512;

       l:=(LongInt(P1)-LongInt(P));

       l:=l-(512*Dir_Entry.CurrentSector);

       Dir_Entry.StartByteNamePerSec:=l;

       if Cluster <> 0 then

        Dir_Entry.CurrentSector:=Dir_Entry.CurrentSector+((Cluster-2)*

        SectorsPerCluster)+DataAreaSector else

        Dir_Entry.CurrentSector:=Dir_Entry.CurrentSector+RootDirSector;

       DIR_Entry.Attr := P1^.Attr;

       if FSType = fsFAT32 then

       begin

        DIR_Entry.StartCluster  := P1^.FSIClasHi;

        DIR_Entry.StartCluster  := DIR_Entry.StartCluster shl 16;

        DIR_Entry.StartCluster  := DIR_Entry.StartCluster+P1^.FSIClasLo;

       end else

       DIR_Entry.StartCluster   := P1^.FSIClasLo;

       DIR_Entry.CreateTime     := P1^.CrtTime;

       DIR_Entry.CreateDate     := P1^.CrtDate;

       DIR_Entry.FileSize       := P1^.Size;

       DIR_Entry.LastAccessDate := P1^.LstAccDate;

       DIR_Entry.WriteLastTime := P1^.WrtTime;

       DIR_Entry.WriteLastDate := P1^.WrtDate;

 

       Inc(Longint(P1), SizeOf(TDIRENTRY));

       ADIR.Write(DIR_Entry, SizeOf(DIR_Entry));

       inc(Entries);

Goto NextSector;

 

EndDir:

  FreeMem(P);

  GetMem(DIR, ADIR.Size);

  ADIR.Seek(0, 0);

  ADIR.Read(DIR^, ADIR.Size);

  ADIR.Free;

  Result := True;

end;

 

 

 

function ReadSector  (Sector: Int64; Count: Word; Var Buffer; nSize:DWORD): Boolean;

Var

  F:TMemoryStream;

  P:Pointer;

Begin

  FillChar(Buffer, nSize, 0);

  Result:=False;

  if Volume = 0 Then Exit;

  F := TMemoryStream.Create;

  F.SetSize(Count*BytesPerSector);

  P:=F.Memory;

  Result:=ReadLogicalSector(Volume, Sector, Count,P^);

  F.Seek(0, 0);

  if nSize > F.Size then

  F.Read(Buffer, F.Size) else

  F.Read(Buffer, nSize);

  F.Free;

end;

 

function WriteSector (Sector: Int64; Count: Word; Var Buffer; nSize:DWORD): Boolean;

Var

  F:TMemoryStream;

  P:Pointer;

Begin

  Result:=False;

  if Volume = 0 Then Exit;

  F := TMemoryStream.Create;

  F.SetSize(Count*BytesPerSector);

  F.Seek(0, 0);

  F.Write(Buffer, F.Size);

  P := F.Memory;

  Result:=WriteLogicalSector(Volume, Sector, Count, P^);

  F.Seek(0, 0);

  if nSize > F.Size then F.Read(Buffer, F.Size)

                    else F.Read(Buffer, nSize);

  F.Free;

end;

 

function GetFATCluster(FATIndex: LongInt): LongInt;

begin

    Result := 0;

    if FATCount=0 then Exit;

    if FATIndex<1 then FATIndex := 1;

    if FATIndex>FATCount then FATIndex := FATCount;

    Result := Longint(Pointer(Longint(FATSector)+(FATIndex-1)*4)^);

end;

 

Function Init(Drive:byte):Boolean;

Var

   NumFreeClusters   : DWORD;   // количество свободных кластеров на диске

   TotalClusters     : DWORD;   // Количество кластеров}

var

   P, P1, P2: Pointer;

   I, J: Longint;

   B1, B2: Byte;

   W: Word;

   L: Longint;

Begin

 

Result:=False;

Volume := Drive;

GetDiskFreeSpace(PChar(chr(drive+64)+':\'), SectorsPerCluster,BytesPerSector, NumFreeClusters, TotalClusters);

 

GetMem(P, BytesPerSector);

if not ReadLogicalSector(Volume,0,1,P^) then

begin

   FreeMem(P);

   Exit;

end;

 

if PBoot32(P)^.bsFATz16 = 0 Then

with PBoot32(P)^ do

Begin

   for I := 1 to 8 do FSName[I] := bsFSType[I];

   for I := 1 to 11 do VolumeName[I] := bsVolLab[I];

   FSType            := fsFAT32;

   VolumeSerial      := bsVolID;

   PhysicalVolume    := bsDrvNum;

   LogicalSectors    := bsTolSec32;

   SectorsPerCluster := bsSecPerClus;

   BytesPerSector    := bsBytePerSec;

   FATCount          := bsNumFATs;

   GetMem(FATSector, FATCount*4);

   SectorsPerFAT     := bsFATSz32;

   I                 := bsRsvdSecCnt;

   If bsExtFlags and (1 shl 7) <> 0 Then

   ActiveFAT         := bsExtFlags and $F;

   RootDirCluster    := bsRootClus;

   DataAreaSector    := bsRsvdSecCnt + FATCount * SectorsPerFAT;

   RootDirSector     := DataAreaSector + (RootDirCluster-2) * SectorsPerCluster;

end else

Begin

  with PBoot(P)^ do

   Begin

   for I := 1 to 8 do FSName[I] := bsFSType[I];

   for I := 1 to 11 do VolumeName[I] := bsVolLab[I];

   if (TotalClusters > 4086) or (bsToolSec12 = 0) then

    Begin

     FSType := fsFAT16;

     LogicalSectors    := bsToolSec16;

    end else

    Begin

     FSType := fsFAT12;

     LogicalSectors    := bsToolSec12;

    end;

   VolumeSerial      := bsVolID;

   PhysicalVolume    := bsDrvNum;

   SectorsPerCluster := bsSecPerClus;

   BytesPerSector    := bsBytePerSec;

   FATCount          := bsNumFATs;

   GetMem(FATSector, FATCount*4);

   SectorsPerFAT     := bsFATSz16;

   I                 := bsRsvdSecCnt;

   ActiveFAT         := 0;

   RootDirEntries    := bsRootEntCnt;

   RootDirSector     := bsRsvdSecCnt+SectorsPerFAT*FATCount;

   RootDirCluster    := 0;

   DataAreaSector    := RootDirSector+((RootDirEntries*32+BytesPerSector-1) div BytesPerSector);

   end;

end;

   // Заполняем адреса файловых структур 1/2

   // в FATSector

   Longint(FATSector^) := I;

   P1 := FATSector;

   Inc(Longint(P1), 4);

   if FATCount>1 then

   for J := 2 to FATCount do

   begin

     I := I+SectorsPerFAT;

     Longint(P1^) := I;

     Inc(Longint(P1), 4);

   end;

 

  dsBytePerSector:=BytesPerSector;

  EndingCluster :=((LogicalSectors-DataAreaSector) div SectorsPerCluster)+1;

  FreeMem(P);

  if FSType = fsNone then Exit;

 

  GetMem(P, SectorsPerFAT*FATCount*BytesPerSector);

  if not ReadSector(GetFATCluster(1), SectorsPerFAT*FATCount,

  P^, SectorsPerFAT*FATCount*BytesPerSector) then

     begin

        FreeMem(P);

        Exit;

     end;

  FATSize := EndingCluster-1;

  GetMem(FAT, FATSize*FATCount*4);

  FillChar(FAT^, FATSize*FATCount*4, 0);

  P2:= FAT;

  if FSType = fsFAT12 then

     begin

        for J := 0 to FATCount-1 do

            begin

               P1 := Pointer(Longint(P)+J*SectorsPerFAT*BytesPerSector+3);

               for I := 1 to FATSize div 2 do

                   begin

                      B1 := Byte(P1^); Inc(Longint(P1));

                      B2 := Byte(P1^) and $0F;

                      W := B2; W := (W shl 8) or B1;

                      L := W;

                      Longint(P2^) := L and FAT_MASK_12;

                      Inc(Longint(P2), 4);

                      B1 := Byte(P1^) and $F0; Inc(Longint(P1));

                      B2 := Byte(P1^); Inc(Longint(P1));

                      W := B2; W := (W shl 4) or (B1 shr 4);

                      L := W;

                      Longint(P2^) := L and FAT_MASK_12;

                      Inc(Longint(P2), 4);

                   end;

               if Odd(FATSize) then

                  begin

                     B1 := Byte(P1^); Inc(Longint(P1));

                     B2 := Byte(P1^) and $0F;

                     W := B2; W := (W shl 8) or B1;

                     L := W;

                     Longint(P2^) := L and FAT_MASK_12;

                  end;

            end;

     end else

  if FSType = fsFAT16 then

     begin

        for J := 0 to FATCount-1 do

            begin

               P1 := Pointer(Longint(P)+J*SectorsPerFAT*BytesPerSector+4);

               for I := 1 to FATSize do

                   begin

                      L := Word(P1^); Inc(Longint(P1), 2);

                      Longint(P2^) := L and FAT_MASK_16;

                      Inc(Longint(P2), 4);

                   end;

            end;

     end else

       if FSType = fsFAT32 then

     begin

        for J := 0 to FATCount-1 do

            begin

               P1 := Pointer(Longint(P)+J*SectorsPerFAT*BytesPerSector+8);

               for I := 1 to FATSize do

                   begin

                      L := Longint(P1^);

                      Inc(Longint(P1), 4);

                      Longint(P2^) := L and FAT_MASK_32;

                      Inc(Longint(P2), 4);

                   end;

            end;

     end;

  FreeMem(P);

end;

 

 

function GetFATEntry(Cluster: Int64): Longint;

Var

CopyOfFAT:Byte;

begin

  Result := -1;

  if FSType = fsNone then Exit;

  if FAT = NIL then Exit;

  if FATSize = 0 then Exit;

  if ActiveFAT = 0 then

  CopyOfFAT := FATCount else

  CopyOfFAT := ActiveFAT;

  Cluster := Cluster-2;

  CopyOfFAT := CopyOfFAT-1;

  Result := Longint(Pointer(Longint(FAT)+CopyOfFAT*FATSize*4+Cluster*4)^);

  if FSType = fsFAT12 then Result := Result and FAT_MASK_12 else

  if FSType = fsFAT16 then Result := Result and FAT_MASK_16 else

     Result := Result and FAT_MASK_32;

end;

 

procedure SetFATEntry(Cluster: Int64; Value: Longint);

Var

CopyOfFAT:Byte;

begin

  if FSType = fsNone then Exit;

  if FAT = NIL then Exit;

  if FATSize = 0 then Exit;

  if ActiveFAT = 0 then CopyOfFAT := FATCount else

  CopyOfFAT := ActiveFAT;

//   if Cluster < 2 then Cluster := 2;

//   if Cluster > EndingCluster then Cluster := EndingCluster;

  Cluster := Cluster-2;

  CopyOfFAT := CopyOfFAT-1;

  if FSType = fsFAT12 then Value := Value and FAT_MASK_12 else

  if FSType = fsFAT16 then Value := Value and FAT_MASK_16 else

     Value := Value and FAT_MASK_32;

  Longint(Pointer(Longint(FAT)+CopyOfFAT*FATSize*4+Cluster*4)^) := Value;

end;

 

 

FUNCTION GetCluster(Sector: Int64):Int64;

BEGIN

     if (Sector - DataAreaSector >= 0) and (LogicalSectors -Sector >= 0) then

     GetCluster :=(Sector-DataAreaSector) div SectorsPerCluster

     else

     Result := 0;

END;

 

function ReadCluster(Cluster: Int64; var Buffer; BufferSize: Longint): Boolean;

var P: Pointer;

   I: Int64;

begin

  Result := False;

  if Cluster < 1 then Cluster := RootDirCluster;

  Cluster := Cluster-2;

  GetMem(P, BytesPerSector*SectorsPerCluster);

  I := DataAreaSector + (SectorsPerCluster*Cluster);

  Result := ReadSector(I, SectorsPerCluster, Buffer,

  BytesPerSector*SectorsPerCluster);

  FreeMem(P);

end;

 

function WriteCluster(Cluster: Int64; var Buffer; BufferSize: Longint): Boolean;

var P: Pointer;

   I: Int64;

begin

  Result := False;

  if FSType = fsNone then Exit;

  if FATSize = 0 then Exit;

  if Cluster < 1 then Cluster := RootDirCluster;

  Cluster := Cluster-2;

  GetMem(P, BytesPerSector*SectorsPerCluster);

  FillChar(P^, BytesPerSector*SectorsPerCluster, 0);

  if BufferSize > BytesPerSector * SectorsPerCluster then

  BufferSize := BytesPerSector*SectorsPerCluster;

  Move(Buffer, P^, BufferSize);

  I := DataAreaSector+SectorsPerCluster*Cluster;

  Result := WriteSector(I, SectorsPerCluster, P^,

  BytesPerSector*SectorsPerCluster);

  FreeMem(P);

end;

 

 

function WriteClusterChain(StartCluster: Longint; Buffer: Pointer; BufferSize: Longint): Boolean;

var ClusterSize: Longint;

   I: Int64;

begin

  Result := False;

  if FSType = fsNone then Exit;

  if FAT = NIL then Exit;

  if FATSize = 0 then Exit;

  if StartCluster < 1 then StartCluster := RootDirSector;

  ClusterSize := BytesPerSector*SectorsPerCluster;

  I := StartCluster;

  while ValidCluster(I) do

    begin

       if BufferSize<ClusterSize then

          begin

             Result := WriteCluster(I, Buffer^, BufferSize);

             Break;

          end else Result := WriteCluster(I, Buffer^, ClusterSize);

       if not Result then Break;

       Longint(Buffer) := Longint(Buffer)+ClusterSize;

       BufferSize := BufferSize-ClusterSize;

       I := GetFATEntry(I);

    end;

end;

 

function ReadClusterChain(StartCluster: Int64; var Buffer: Pointer; var BufferSize: Longint): Boolean;

var I, J:Int64;

   P: Pointer;

   F: TMemoryStream;

   B: Boolean;

begin

  Result := False;

  if FSType = fsNone then Exit;

  if FAT = NIL then Exit;

  if FATSize = 0 then Exit;

  if StartCluster < 1 then StartCluster := RootDirCluster;

  I := StartCluster;

  J := BytesPerSector*SectorsPerCluster;

  GetMem(P, J);

  F := TMemoryStream.Create;

  repeat

    if not ValidCluster(I) then Break;

    B := ReadCluster(I, P^, J);

    if not B then

       begin

          Result := False;

          Break;

       end;

    Result := True;

    F.Write(P^, J);

    I := GetFATEntry(I);

  until False;

  FreeMem(P);

  Buffer := NIL;

  BufferSize := 0;

  if Result then

     begin

        BufferSize := F.Size;

        GetMem(Buffer, BufferSize);

        F.Seek(0, 0);

        F.Read(Buffer^, BufferSize);

     end;

  F.Free;

end;

 

function SeekForChainStart(Cluster: Int64): Longint;

var I: DWORD;

   J:LongInt;

   B: Boolean;

begin

  Result := -1;

  if FSType = fsNone then Exit;

  if FAT = NIL then Exit;

  if FATSize = 0 then Exit;

  if Cluster < 1 then Cluster := RootDirCluster;

  J := -1;

  repeat

    B := False;

    for I := 2 to EndingCluster do

        if GetFATEntry(I) = Cluster then

           begin

              J := I;

              Cluster := I;

              B := True;

              Break;

           end;

  until not B;

  Result := J;

end;

 

 

function ValidCluster(Cluster: Int64): Boolean;

begin

  Result := (Cluster>=2) and (Cluster<=EndingCluster);

end;

 

 

 

 

 

 

Procedure Done;

Begin

  if FATSector <> NIL then FreeMem(FATSector);

  if FAT <> NIL then FreeMem(FAT);

end;

 

 

(******************************************************************************)

 

procedure ParseDOSTime(Time: Word; var Hour, Minute, Second: Word);

begin

Second := (Time and $001f)*2;

Minute := (Time and $07e0) shr 5;

Hour := (Time and $f800) shr 11;

end;

 

procedure ParseDOSDate(Date: Word; var Day, Month, Year: Word);

begin

Day := Date and $001f;

Month := (Date and $01e0) shr 5;

Year := ((Date and $fe00) shr 9) + 1980;

end;

 

 

function GetShortName(Name: String): String;

var S: String;

   I: Longint;

begin

  SetLength(S, 10000);

  I := GetShortPathName(PChar(Name), @S[1], 10000);

  SetLength(S, I);

  Result := S;

end;

 

 

function FormatDiskSize (Value: TLargeInteger): string;

const

SizeUnits: array[1..5] of string = (' Bytes', ' KB', ' MB', ' GB', 'TB');

var

SizeUnit: Integer;

Temp: TLargeInteger;

Size: Integer;

begin

SizeUnit := 1;

if Value < 1024 then

   Result := IntToStr(Value)

else begin

   Temp := Value;

   while (Temp >= 1000*1024) and (SizeUnit <= 5) do begin

     Temp := Temp shr 10; //div 1024

     Inc(SizeUnit);

   end;

   Inc(SizeUnit);

   Size := (Temp shr 10); //div 1024

   Temp := Temp - (Size shl 10);

   if Temp > 1000 then

     Temp := 999;

   if Size > 100 then

     Result := IntToStr(Size)

   else if Size > 10 then

     Result := Format('%d%s%.1d', [Size, DecimalSeparator, Temp div 100])

   else

     Result := Format('%d%s%.2d', [Size, DecimalSeparator,

       Temp div 10])

end;

Result := Result + SizeUnits[SizeUnit];

end;

 

 

function DosToWin(St: string): string;

var

Ch: PChar;

begin

Ch := StrAlloc(Length(St) + 1);

OemToAnsi(PChar(St), Ch);

Result := Ch;

StrDispose(Ch)

end;

 

 

end.