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<=11) do
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<2) or (Disks=NIL) then
goto Get; {Не искать в списке, если дискета или нет списка}
{Ищем в списке описателей}
p:=Disks;
while (p^.DiskInfo.Number<>Disk) and (p^.NextDisk<>NIL) 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+pred(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<2) then
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<2);
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
{Готовим ссылочную структуру для большого диска}
AdrBuf:=Ptr(Seg(Buf),Ofs(Buf));
StartSec:=Sec;
Secs:=NSec;
S:=Seg(Buf0);
O:=Ofs(Buf0);
asm
mov CX,$FFFF
mov AL,Op
shr AX,1
mov AL,Disk
push DS
push BP
mov BX,O
mov DS,S
jc @1
int 25H
jmp @2
@1: int 26H
@2: pop DX
pop BP
pop DS
mov BX,1
jc @3
mov Bx,0
xor AX,AX
@3: mov Disk_Error,BL
mov Disk_Status,AX
end
end
else {Обращение к диску малой емкости}
asm
mov DX,Word Ptr Sec {DX:=Sec}
mov CX,NSec {CX:=NSec}
push DS {Сохраняем DS - он будет испорчен}
push BP {Сохраняем BP}
lds BX,Buf {DS:BX - адрес буфера}
mov AL,Op {AL:=Op}
shr AX,1 {Переносим младший бит Oр в CF}
mov AL,Disk {AL:=Disk}
jc @Write {Перейти, если младший бит Ор<>0}
int 25H {Читаем данные}
jmp @Go {Обойти запись}
@WRITE:
int 26H {Записываем данные}
@GO:
pop DX {Извлекаем флаги из стека}
pop BP {Восстанавливаем BP}
pop DS {Восстанавливаем DS}
mov BX,1 {BX:=True}
jc @Exit {Перейти, если была ошибка}
mov BX,0 {BX:=False}
xor AX,AX {Обнуляем код ошибки}
@EXIT:
mov Disk_Error,BL {Флаг ошибки взять из BX}
mov Disk_Status,AX {Код ошибки взять из AX}
end
end; {ReadWriteSector}
{------------------------}
procedure ReadSector(Disk:Byte;Sec:LongInt;NSec:Word;var Buf);
{Читает сектор(секторы) на указанном диске}
var
DI:TDisk;
begin
GetDiskInfo(Disk,DI);
if DI.TotSecs>$FFFF then {Дискбольшойемкости?}
ReadWriteSector(Disk,Sec,Nsec,Buf,2) {-Да: операция 2}
else
ReadWriteSector(Disk,Sec,Nsec,Buf,0) {-Нет: операция 0}
end; {ReadSector}
{------------------------}
procedure SetAbsSector(Disk,Head:Byte;CSec:Word;var Buf);
{Записывает абсолютный дисковый сектор с помощью прерывания $13}
begin
with Reg do
begin
ah:=3; {Операциязаписи}
dl:=Disk; {Номер привода}
dh:=Head; {Номер головки}
cx:=CSec; {Цилиндр/сектор}
al:=1; {Читаем один сектор}
es:=seg(Buf);
bx:=ofs(Buf);
Intr($13,Reg);
Output
end
end; {SetAbsSector}
{------------------}
procedure SetDefaultDrv(Disk:Byte);
{Устанавливаетдискпоумолчанию}
begin
if Disk<=GetMaxDrv then with Reg do
begin
AH:=$E;
DL:=Disk;
MSDOS(Reg)
end
end;
{---------------------}
procedure SetFATItem(Disk:Byte;Cluster,Item:Word);
{Устанавливаем содержимое ITEM в элемент CLUSTER таблицы 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 (Cluster<=MaxClus) and (Cluster>=2) then
begin
if FAT16 then
begin
k:=Cluster div 256; {Нужныйсектор FAT}
j:=Cluster mod 256; {Смещение в секторе}
n:=1
end
else
begin
k:=Cluster div 1024; {Нужнаятройкасекторов FAT}
j:=(3*Cluster) shr 1-k*1536;
n:=3
end;
ReadSector(Disk,FatLock+k*n,n,Fat);
if not Disk_Error then
begin
if FAT16 then
Fat.w[j]:=Item
else
begin
if odd(Cluster) then
Item:=Item shl 4+Fat.b[j] and $F
else
Item:=Item+(Fat.b[j+1] and $F0) shl 12;
Fat.b[j]:=Lo(Item);
Fat.b[j+1]:=Hi(Item)
end;
if not FAT16 then
begin {Проверяем "хвост" FAT}
k:=k*n; {к - смещение сектора}
while k+n>FatSize do dec(n)
end;
inc(FATLock,k); {FATLock - номерсекторав FAT}
{Записываем изменение в FatCnt копий FAT}
for k:=0 to pred(FatCnt) do
WriteSector(Disk,FATLock+k*FatSize,n,Fat)
end
end
end
end; {SetFATItem}
{----------------------}
procedure SetMasterBoot(var Buf);
{Записываемвглавныйзагрузочныйсекторсодержимое Buf}
begin
with Reg do
begin
ah:=3; {Операциязаписи}
al:=1; {Кол-во секторов}
dl:=$80; {1-й жесткий диск}
dh:=0; {Головка 0}
cx:=1; {1-й сектор 0-й дорожки}
es:=seg(Buf);
bx:=ofs(Buf);
Intr($13,Reg);
Disk_Error:=(Flags and FCarry<>0);
if Disk_Error then
Disk_Status:=ah
else
Disk_Status:=0
end
end; {SetMasterBoot}
{---------------------}
procedure UnpackCylSec(CSec:Word;var Cyl,Sec:Word);
{Декодируем цилиндр и сектор для прерывания $13}
begin