--PAGE_BREAK--
продолжение
--PAGE_BREAK--RootLock:Word; {Начало корневого каталога}
RootSize:Word; {Количество элементов каталога}
DataLock:Word; {Начальный сектор данных}
end;
{Список описателей диска}
PListDisk=^TListDisk;
TListDisk=record
DiskInfo:TDisk;
NextDisk:PListDisk
end;
var
Disk_Error:Boolean; {Флаг ошибки}
Disk_Status:Word; {Код ошибки}
const
Disks:PListDisk=NIL; {Начало списка описателей диска}
function ChangeDiskette(Disk:Byte):Boolean;
{Возвращает TRUE, если изменялось положение
запора на указанном проиводе гибкого диска}
procedure FreeListDisk(var List: PListDisk);
{Удаляет список описателей дисков}
procedure GetAbsSector(Disk,Head:Byte; CSec:Word; var Buf);
{Читает абсолютный дисковый сектор с помощью прерывания $13}
function GetCluster(Disk:Byte; Sector:Word):Word;
{Возвращает номер кластера по заданному номеру сектора}
function GetDefaultDrv:Byte;
{Возвращает номер диска по умолчанию}
procedure GetDirItem(FileName:String; var Item:Dir_Type);
{Возвращает элемент справочника для указанного файла}
procedure GetDirSector(Path:String; var Disk:Byte; var Dirs,DirSize:Word);
{Возвращает адрес сектора, в котором содержится
начало нужного каталога, или 0, если каталог не найден.
Вход:
PATH — полное имя каталога ('', если каталог текущий).
Выход:
DISK — номер диска;
DIRS — номер первого сектора каталога или 0;
DIRSIZE — размер каталога (в элементах DIR_TYPE).}
procedure GetDiskInfo(Disk:Byte; var DiskInfo:TDisk);
{Возвращает информацию о диске DISK}
function GetDiskNumber(c:Char):Byte;
{Преобразует имя диска A...Z в номер 0...26.
Если указано недействительное имя, возвращает 255}
function GetFATItem(Disk:Byte;Item:Word):Word;
{Возвращает содержимое указанного элемента FAT}
procedure GetIOCTLInfo(Disk:Byte; var IO:IOCTL_Type);
{Получить информацию об устройстве согласно общему выову IOCTL}
procedure GetListDisk(var List:PListDisk);
{Формирует список описателей дисков}
procedure GetMasterBoot(var Buf);
{Возвращает в переменную Buf главный загрузочный сектор}
function GetMaxDrv:Byte;
{Возвращает количество логических дисков}
function Getsector(Disk:Byte;Cluster:Word):Word;
{Преобразует номер кластера в номер сектора}
function PackCylSec(Cyl,Sec:Word):Word;
{Упаковывает цилиндр и сектор в одно слово для прерывания $13}
procedure ReadSector(Disk:Byte;Sec:LongInt;NSec:Word;var Buf);
{Читает сектор(секторы) на указанном диске}
procedure SetAbsSector(Disk,Head:Byte;CSec:Word;var Buf);
{Записывает абсолютный дисковый сектор с помощью прерывания $13}
procedure SetDefaultDrv(Disk:Byte);
{Устанавливает диск по умолчанию}
procedure SetFATItem(Disk:Byte;Cluster,Item:Word);
{Устанавливает содержимое ITEM в элемент CLUSTER таблицы FAT}
procedure SetMasterBoot(var Buf);
{Записывает в главный загрузочный сектор содержимое Buf}
procedure UnPackCylSec(CSec:Word;var Cyl,Sec:Word);
{Декодирует цилиндр и сектор для прерывания $13}
procedure WriteSector(Disk:Byte;Sec:LongInt;NSec:Word;var Buf);
{Записывает сектор(секторы) на указанный диск}
IMPLEMENTATION
uses DOS;
var
Reg:Registers;
procedure Output;
{Формирует значения Disk_Status и Disk_Error}
begin
with Reg do
begin
Disk_Error:=Flags and FCarry=1;
Disk_Status:=ax
end
end; {Output}
{----------------------}
function ChangeDiskette(Disk:Byte):Boolean;
{Возвращает TRUE, если изменялось положение
запора на указанном приводе гибкого диска}
begin
with Reg do
begin
AH:=$16;
DL:=Disk;
Intr($13,Reg);
Output;
ChangeDiskette:=Disk_Error and (AH=6)
end
end; {ChangeDiskette}
{----------------------}
procedure FreeListDisk(var List:PListDisk);
{Удаляет список дисковых описателей}
var
P:PListDisk;
begin
while ListNIL do
begin
P:=List^.NextDisk;
Dispose(List);
List:=P
end
end; {FreeListDisk}
{---------------------}
procedure GetAbsSector(Disk,Head:Byte;CSec:Word;var Buf);
{Читает абсолютный дисковый сектор с помощью прерывания $13}
begin
with Reg do
begin
ah:=2; {Операция чтения}
dl:=Disk; {Номер привода}
dh:=Head; {Номер головки}
cx:=CSec; {Цилиндр/сектор}
al:=1; {Читать один сектор}
es:=seg(Buf);
bx:=ofs(Buf);
Intr($13,Reg);
Output
end
end; {GetAbsSector}
{--------------------}
function GetCluster(Disk:Byte;Sector:Word):Word;
{Возвращает номер кластера по заданному номеру сектора}
var
DI:TDisk;
begin
GetDiskInfo(Disk,DI);
if not Disk_Error then with DI do
if(Sector-DataLock>=0) and (TotSecs-Sector>=0) then
GetCluster:= {Нормальное обращение}
(Sector-DataLock) div ClusSize+2
else
GetCluster:=0 {Неверный номер сектора}
else GetCluster:=0 {Неверный номер диска}
end; {GetCluster}
{----------------------}
function GetDefaultDrv:Byte;
{Возвращает номер диска по умолчанию}
begin
with Reg do
begin
AH:=$19;
MSDOS(Reg);
GetDefaultDrv:=AL
end
end; {GetDefaultDrv}
{---------------------}
procedure GetDirItem(FileName:String;var Item:Dir_Type);
{Возвращает элемент справочника для указанного файла}
var
Dir:array[1..16] of Dir_Type; {Буфер на 1 сектор каталога}
Path:DirStr; {Маршрут поиска}
NameF:NameStr; {Имя файла}
Ext:ExtStr; {Расширение файла}
Disk:Byte; {Номер диска}
Dirs:Word; {Номер сектора}
DirSize:Word; {Размер каталога}
Find:Boolean; {Флаг поиска}
j:Integer; {Номер элемента каталога}
{-----------}
procedure FindItem;
{Ищет нужный элемент в секторах каталога}
var
k,i:Integer;
m:array[1..11] of char; {Массив имени}
Clus:word; {Номер кластера}
DI:TDisk;
begin
GetDiskInfo(Disk,DI); {Получаем длину кластера}
ReadSector(Disk,Dirs,1,Dir); {Читаем первый сектор}
k:=0; {Количество просмотренных элементов}
j:=1; {Текущий элемент каталога}
{Готовим имя и расширение для поиска}
FillChar(m,11,' ');
Move(NameF[1],m[1],Length(NameF));
if ext'' then
Move(Ext[2],m[9],Length(ext)-1);
Find:=False;
{Цикл поиска}
repeat
if Dir[j].Name[1]=#0 then
exit; {Обнаружен конец поиска}
if (Dir[j].FAttr and $18)=0 then
begin {Проверяем очередное имя в каталоге}
Find:=True;
i:=1;
While Find and (i
begin
Find:=m[i]=Dir[j].NameExt[i];
inc(i)
end;
end;
if not Find then inc(j);
if j=17 then
begin
inc(k,16);
if k>=DirSize then
exit; {Дошли до конца каталога}
j:=1; {Продолжаем с первого элемента следующего сектора}
if (k div 16) mod DI.ClusSize=0 then
if succ(Dirs)
inc(Dirs) {Корневой каталог}
else
begin {Конец кластера}
{Новый кластер}
Clus:=GetFATItem(Disk,GetCluster(Disk,Dirs));
{Новый сектор}
Dirs:=GetSector(Disk,Clus)
end
else {Очередной сектор — в кластере}
inc(Dirs);
ReadSector(Disk,Dirs,1,Dir)
end
until Find
end; {FindItem}
{---------}
begin {GetDirItem}
{Готовим имя файла}
FileName:=FExpand(FileName);
FSplit(FileName,Path,NameF,Ext);
{Искать каталог}
GetDirSector(Path,Disk,Dirs,DirSize);
Find:=Dirs0; {Dirs=0 — ошибка в маршруте}
if Find then
FindItem; {Ищем нужный элемент}
if Find then
begin
{Переносим элемент каталога в Item}
Move(Dir[j],Item,SizeOf(Dir_Type));
{Сбросить ошибку}
Disk_Error:=False
end
else
begin {Файл не найден}
Disk_Error:=True;
Disk_Status:=$FFFF
end
end; {GetDirItem}
{------------------------}
Procedure GetDirSector(Path:String;var Disk:Byte;var Dirs,DirSize:Word);
{Возвращает адрес сектора, в котором содержится начало
нужного каталога, или 0, если каталог не найден.
Вход:
PATH — полное имя каталога ('', если каталог — текущий).
Выход:
DISK — номер диска;
DIRS — номер первого сектора каталога или 0;
DIRSIZE — размер каталога (в элементах DIR_TYPE).}
var
i,j,k:Integer; {Вспомогательные переменные}
Find:Boolean; {Признак поиска}
m:array[1..11] of Char; {Массив имени каталога}
s:string; {Вспомогательная переменная}
DI:TDisk; {Информация о диске}
Dir:array[1..16] of Dir_Type; {Сектор каталога}
Clus:Word; {Текущий кластер каталога}
label
err;
begin
{Начальный этап: готовим путь к каталогу и диск}
if Path='' then {Если каталог текущий,}
GetDir(0,Path); {дополняем маршрутом поиска}
if Path[2]':' then {Если нет диска,}
Disk:=GetDefaultDrv {берем текущий}
else
begin {Иначе проверяем имя диска}
Disk:=GetDiskNumber(Path[1]);
if Disk=255 then
begin {Недействительное имя диска}
Err: {Точка входа при неудачном поиске}
Dirs:=0; {Нет сектора}
Disk_Error:=True; {Флаг ошибки}
Disk_Status:=$FFFF; {Статус $FFFF}
exit
end;
Delete(Path,1,2) {Удаляем имя диска из пути}
end;
{Готовим цикл поиска}
if Path[1]='\' then {Удаляем символы \}
Delete(Path,1,1); {в начале}
if Path[Length(Path)]='\' then
Delete(Path,Length(Path),1); {и конце маршрута}
GetDiskInfo(Disk,DI);
with DI do
begin
Dirs:=RootLock; {Сектор с каталогом}
DirSize:=RootSize {Длина каталога}
end;
ReadSector(Disk,Dirs,1,Dir); {Читаем корневой каталог}
Clus:=GetCluster(Disk,Dirs); {Кластер начала каталога}
{Цикл поиска по каталогам}
Find:=Path=''; {Path='' — конец маршрута}
while not Find do
begin
{Получаем в S первое имя до символа \}
s:=Path;
if pos('\',Path)0 then
s[0]:=chr(pos('\',Path)-1);
{Удаляем выделенное имя из маршрута}
Delete(Path,1,Length(s));
if Path[1]='\' then
Delete(Path,1,1); {Удаляем разделитель \}
{Готовим массив имени}
FillChar(m,11,' ');
move(s[1],m,ord(s[0]));
{Просмотр очередного каталога}
k:=0; {Количество просмотренных элементов каталога}
j:=1; {Текущий элемент в Dir}
repeat {Цикл поиска в каталоге}
if Dir[j].Name[1]=#0 then {Если имя}
Goto Err; {Начинается с 0 — это конец каталога}
if Dir[j].FAttr=Directory then
begin
Find:=True;
i:=1;
while Find and (i
begin {Проверяем тип}
Find:=m[i]=Dir[j].NameExt[i];
inc(i)
end
end;
if not Find then inc(j);
if j=17 then
begin {Исчерпан сектор каталога}
j:=1; {Продолжаем с 1-го элемента следующего сектора}
inc(k,16); {k — сколько элементов просмотрели}
if k>=DirSize then
goto Err; {Дошли до конца каталога}
if (k div 16) mod DI.ClusSize=0 then
begin {Исчерпан кластер — ищем следующий}
{Получаем новый кластер}
Clus:=GetFATItem(Disk,Clus);
{Можно не проверять на конец цепочки,
т. к. каталог еще не исчерпан}
{Получаем новый сектор}
Dirs:=GetSector(Disk,Clus)
end
else {Очередной сектор — в текущем кластере}
inc(Dirs);
ReadSector(Disk,Dirs,1,Dir);
end
until Find;
{Найден каталог для очередного имени в маршруте}
Clus:=Dir[j].FirstC; {Кластер начала}
Dirs:=GetSector(Disk,Clus); {Сектор}
ReadSector(Disk,Dirs,1,Dir);
Find:=Path='' {Продолжаем поиск, если не исчерпан путь}
end {while not Find}
end; {GetDirSector}
{---------------}
procedure ReadWriteSector(Disk:Byte;
Sec:LongInt;Nsec:Word;var Buf;Op:Byte);forward;
procedure GetDiskInfo(Disk:Byte;var DiskInfo:TDisk);
{Возвращает информацию о диске DISK}
var
Boot:TBoot;
IO:IOCTL_Type;
p:PListDisk;
label
Get;
begin
Disk_Error:=False;
if (Disk
goto Get; {Не искать в списке, если дискета или нет списка}
{Ищем в списке описателей}
p:=Disks;
while (p^.DiskInfo.NumberDisk) and (p^.NextDiskNIL) do
p:=p^.NextDisk; {Если не тот номер диска}
if p^.DiskInfo.Number=Disk then
begin {Найден нужный элемент — выход}
DiskInfo:=p^.DiskInfo;
exit
end;
{Формируем описатель диска с птмощью вызова IOCTL}
Get:
IO.BuildBPB:=True; {Требуем построить ВРВ}
GetIOCTLInfo(Disk,IO); {Получаем информацию}
if Disk_Error then
exit;
with DiskInfo, IO do {Формируем описатель}
begin
Number:=Disk;
TypeD:=TypeDrv;
AttrD:=Attrib;
Cyls:=Cylindrs;
Media:=BPB.Media;
SectSize:=BPB.SectSiz;
TrackSiz:=Add.TrkSecs;
TotSecs:=BPB.TotSecs;
if TotSecs=0 then
begin
ReadWriteSector(Number,0,1,Boot,2); {Диск большой емкости}
TotSecs:=Boot.Add.LargSectors; {Читаем загрузочный сектор}
end;
Heads:=Add.HeadCnt;
Tracks:=(TotSecs+divd(TrackSiz)) div (TrackSiz*Heads);
ClusSize:=BPB.ClustSiz;
FATLock:=BPB.ResSecs;
FATCnt:=BPB.FatCnt;
FATSize:=BPB.FatSize;
RootLock:=FATLock+FATCnt*FATSize;
RootSize:=BPB.RootSiz;
DataLock:=RootLock+(RootSize*SizeOf(Dir_Type)) div SectSize;
MaxClus:=(TotSecs-DataLock) div ClusSize+2;
FAT16:=(MaxClus>4086) and (TotSecs>20790)
end
end; {GetDiskinfo}
{----------------}
function GetDiskNumber(c:Char):Byte;
{Преобразует имя диска A...Z в номер 0...26.
Если указано недействительное имя, возвращает 255}
var
DrvNumber:Byte;
begin
if UpCase(c) in ['A'..'Z'] then
DrvNumber:=ord(UpCase(c))-ord('A')
else
DrvNumber:=255;
if DrvNumber>GetMaxDrv then
DrvNumber:=255;
GetDiskNumber:=DrvNumber;
end; {GetDiskNumber}
{---------------------}
function GetFATItem(Disk:Byte;Item:Word):Word;
{Возвращает содержимое указанного элемента FAT}
var
DI:TDisk;
k,j,n:Integer;
Fat:record
case Byte of
0: (w:array[0..255] of Word);
1: (b:array[0..512*3-1] of Byte);
end;
begin
GetDiskInfo(Disk,DI);
if not Disk_Error then with DI do
begin
if (Item>MaxClus) or (Item
Item:=$FFFF {Задан ошибочный номер кластера}
else
begin
if FAT16 then
begin
k:=Item div 256; {Нужный сектор FAT}
j:=Item mod 256; {Смещение в секторе}
n:=1 {Количество читаемых секторов}
end
else
begin
k:=Item div 1024; {Нужная тройка секторов FAT}
j:=(3*Item) shr 1-k*1536; {Смещение в секторе}
n:=3 {Количество читаемых секторов}
end;
{Читаем 1 или 3 сектора FAT}
ReadSector(Disk,FATLock+k*n,n,Fat);
if not Disk_Error then
begin
if FAT16 then
Item:=Fat.w[j]
else
begin
n:=Item; {Старое значение Item для проверки четности}
Item:=Fat.b[j]+Fat.b[j+1] shl 8;
if odd(n) then
Item:=Item shr 4
else
Item:=Item and $FFF;
if Item>$FF6 then
Item:=$F000+Item
end;
GetFatItem:=Item
end
end
end
end; {GetFATItem}
{------------------}
procedure GetIOCTLInfo(Disk:Byte;var IO:IOCTL_Type);
{Получаем информацию об устройстве согласно общему вызову IOCTL}
begin
with Reg do
begin
ah:=$44; {Функция 44}
al:=$0D; {Общий вызов IOCTL}
cl:=$60; {Дать параметры устройства}
ch:=$8; {Устройство — диск}
bl:=Disk+1; {Диск 1=А,...}
bh:=0;
ds:=seg(IO);
dx:=ofs(IO);
Intr($21,Reg);
Output
end
end; {GetIOCTLInfo}
{-------------------}
procedure GetListDisk(var List:PListDisk);
{Формирует список дисковых описателей}
var
Disk:Byte;
DI:TDisk;
P,PP:PListDisk;
begin
Disk:=2; {Начать с диска С:}
List:=NIL;
repeat
GetDiskInfo(Disk,DI);
if not Disk_Error then
begin
New(P);
if List=NIL then
List:=P
else
PP^.NextDisk:=P;
with P^ do
begin
DiskInfo:=DI;
NextDisk:=NIL;
inc(Disk);
PP:=P
end
end
until Disk_Error;
Disk_Error:=False
end; {GetListDisk}
{---------------------}
procedure GetMasterBoot(var Buf);
{Возвращает в переменной Buf главный загрузочный сектор}
begin
GetAbsSector($80,0,1,Buf)
end; {GetMasterBoot}
{--------------------}
function GetMaxDrv:Byte;
{Возвращает количество логических дисков}
const
Max:Byte=0;
begin
if Max=0 then with Reg do
begin
ah:=$19;
MSDOS(Reg);
ah:=$0E;
dl:=al;
MSDOS(Reg);
Max:=al
end;
GetMaxDrv:=Max
end; {GetMaxDrv}
{-------------------}
function GetSector(Disk:Byte;Cluster:Word):Word;
{Преобразуем номер кластера в номер сектора}
var
DI:TDisk;
begin
GetDiskInfo(Disk,DI);
if not Disk_Error then with DI do
begin
Disk_Error:=(Cluster>MaxClus) or (Cluster
if not Disk_Error then
GetSector:=(Cluster-2)*ClusSize+DataLock
end;
if Disk_Error then
GetSector:=$FFFF
end; {GetSector}
{----------------------}
function PackCylSec(Cyl,Sec:Word):Word;
{Упаковывает цилиндр и сектор в одно слово для прерывания $13}
begin
PackCylSec:=Sec+(Cyl and $300) shr 2+(Cyl shl 8)
end; {PackCylSec}
procedure ReadWriteSector(Disk:Byte;
Sec:LongInt;NSec:Word; var Buf; Op:Byte);
{Читает или записывает сектор (секторы):
Ор = 0 — читать; 1 — записать (малый диск)
= 2 — читать; 3 — записать (большой диск)}
type
TBuf0=record
StartSec:LongInt;
Secs:Word;
AdrBuf:Pointer
end;
var
Buf0:TBuf0;
S:Word;
O:Word;
begin
if Op>1 then with Buf0 do
begin
{Готовим ссылочную структуру для большого диска}
продолжение
--PAGE_BREAK--