Program DiskOutputing;{Shurik Compilier, 2002/2003}
{v3.23}{ 19.10[oct].2003 }
{$G+,D-}
Uses DOS, CRT, Graph, F_Disk;
type
BT = array[1..512] of Byte;
Track = array[0..512*18-1] of Byte;
const
NSecRead : Byte = 1;
var
Info : array [0..1, 0..79, 1..18] of Boolean;
Disk : TDisk;
TrackBuffer : Track;
Buffer : BT absolute TrackBuffer;
NumRS : Word;
NErr : Word;
IOR : Word;
LLL : Longint;
DStat : Byte;
ND : Byte;
Sg : String;
f : file of BT;
ff : file of Track;
Mode : Boolean;
Tr : Boolean;
d, e, m : Integer;
i, h, x, y, j : Word;
c, k, s, cs : Word;
Col : Byte;
Percent : Real;
Label L, L1;
Procedure CursorOff;Assembler;
asm
mov ah, 1
mov ch, $20
int $10
end;
{------------------}
Procedure CursorOn;Assembler;
asm
mov ah, 1
mov ch, 6
mov cl, 7
int $10
end;
{=================}
Function SetAbsSector(Disk,Head: Byte; CSec: Word; var Buf) : Boolean;
var
R : Registers; {Записывает абсолютный дисковый сектор с помощью прерывания $13}
begin
with R do
begin
ah := 3; {Операция записи}
dl := Disk; {Номер привода}
dh := Head; {Номер головки}
cx := CSec; {Цилиндр/сектор}
al := NSecRead; {Читаем один NSECREAD секторов}
es := seg(Buf);
bx := ofs(Buf);
Intr($13,R);
SetAbsSector:=(Flags and FCarry) = 0
end
end; {SetAbsSector}
Function ReadAbsSector(Disk,Head:Byte;CylSec:Word;var Buf):Boolean;
var
R:Registers;
begin
with R do
begin
ah:=2;
al:=NSecRead;
dl:=Disk;
dh:=Head;
cx:=CylSec;
es:=seg(Buf);
bx:=ofs(Buf);
Intr($13,R);
ReadAbsSector:=(Flags and FCarry) = 0
end
end;{ReadAbsSector}
{---------------}
Function PackCylSec(Cyl,Sec:Word):Word;
begin
PacKCylSec:=Sec+(Cyl and $300) shr 2+(Cyl shl 8)
end;
{---------------}
Procedure Pause(var k : Word);
var
C:Char;
begin
SetColor(DarkGray);
Circle(576, 25, 20);
C:=ReadKey;
if C = #0 then ReadKey;
SetColor(Yellow);
Circle(576, 25, 20);
if c = #27 then
begin
CloseGraph;
CursorOn;
Halt;
end;
k:=0;
end;
{---------------}
Procedure PauseT(var k : Word);
var
Ch:Char;
begin
GoToXY(1,25);
Write('Head: ',h,' Cyl: ', C,' Sec: ', S,' NErr: ', NErr, ' ');
Ch:=ReadKey;
if Ch = #0 then ReadKey;
if ch = #27 then Halt;
k:=1;
end;
{---------------}
Procedure NextXY(var x,y : Word);
begin
x:=x+1;
if x>511 then
begin
if x mod 4 = 0 then
begin
SetColor(Black);
OutTextXY( 513, 310,'ЫЫЫЫЫЫЫ' );
SetColor(LightBlue);
Str(s, Sg);
OutTextXY( 513, 310, Sg);
end;
x:=0;
y:=y+1;
end;
if ((y mod 20) = 0) and (X=0) then
begin
SetColor(Black);
OutTextXY( 513, 100,'ЫЫЫЫЫЫЫ' );
OutTextXY( 513, 180,'ЫЫЫЫЫЫЫ' );
OutTextXY( 513, 430,'ЫЫЫЫЫЫЫ' );
SetColor(LightBlue);
Str(h, Sg);
OutTextXY( 513, 100, Sg);
Str(c, Sg);
OutTextXY( 513, 180, Sg);
Str(NErr, Sg);
OutTextXY( 513, 430, Sg);
end;
if y>479 then Pause(y);
end;
{----------------}
Procedure PutChr(C:Byte;Col : Byte);
begin
asm
mov ah, $09
mov bh, 0
mov bl, Byte Ptr Col
mov al, Byte ptr C
mov cx, 1
int $10
end;
end;
{----------------}
Procedure TextView;
begin
PauseT(y);
NErr:=0;
ClrScr;
Col := 1;
X := 1;
Y := 1;
if Mode then
for c:=0 to 79 do
for h:=0 to 1 do
for s:=1 to 18 do
begin
cs:=PackCylSec(c,s);
inc(Col);
if Col > 6 then Col := 1;
if not ReadAbsSector(0,h,cs,Buffer)
then
begin
Col := 7;
end;
for i:=1 to 512 do
begin
GotoXY(x,y);
PutChr(Buffer[i],Col);
inc(x);
if x = 81 then
begin
inc(y);
x :=1;
end;
if y =25 then PauseT(y);
end;
end
else
for h:=0 to 1 do
for c:=0 to 79 do
for s:=1 to 18 do
begin
cs:=PackCylSec(c,s);
inc(Col);
if Col > 6 then Col := 1;
if not ReadAbsSector(0,h,cs,Buffer)
then
begin
Col := 7;
end;
for i:=1 to 512 do
begin
GotoXY(x,y);
PutChr(Buffer[i],Col);
inc(x);
if x = 81 then
begin
inc(y);
x :=1;
end;
if y =25 then PauseT(y);
end;
end;
PauseT(Y);
end;
{---------------------}
Function DiskStatus : Byte;Assembler;
asm
mov ah, 1
mov dl, 0
int $13
end;
{---------------------}
Procedure GraphView;
begin
d:= Detect;
InitGraph(D,M,'');
E := GraphResult;
if E <> grOk then
begin
WriteLn(GraphErrorMsg(e));
CursorOn;
Halt;
end;
x:=0;
y:=0;
NErr:=0;
SetColor(Blue);
OutTextXY(513, 70, 'Head:');
OutTextXY(513, 150, 'Cylindr:');
OutTextXY(513, 280, 'Sector:');
OutTextXY(513, 400, 'BadSec:');
Pause(k);
if Mode then
for c:=0 to 79 do
for h:=0 to 1 do
for s:=1 to 18 do
begin
cs:=PackCylSec(c,s);
if not ReadAbsSector(0,h,cs,Buffer)
then Info[ h, c, s ] := True;
for i:=1 to 512 do
begin
Col:=Buffer[i] shr 4;
PutPixel(x,y,Col);
NextXY(x,y);
Col:=Buffer[i] - Col shl 4;
PutPixel(x,y,Col);
NextXY(x,y);
end;
end
else
for h:=0 to 1 do
for c:=0 to 79 do
for s:=1 to 18 do
begin
cs:=PackCylSec(c,s);
if not ReadAbsSector(0,h,cs,Buffer)
then Info[ h, c, s ] := True;
for i:=1 to 512 do
begin
Col:=Buffer[i] shr 4;
PutPixel(x,y,Col);
NextXY(x,y);
Col:=Buffer[i] - Col shl 4;
PutPixel(x,y,Col);
NextXY(x,y);
end;
end;
Pause(x);
CloseGraph;
end;
{-----------------}
Procedure View;
begin
WriteLn('Н е п р о ч и т а н о секторов:',NErr);
if NErr <> 0 then
begin
NErr := 0;
WriteLn('Головка | Цилиндр | Сектор');
for i:=0 to 1 do
for j:=0 to 79 do
for k:=1 to 18 do
if Info [i, j, k] = True then
begin
inc(NErr);
if (NErr mod 23 = 0) then
begin
ReadKey;
GotoXY(1, 3);
end;
WriteLn(i : 1, j : 16, k : 15);
end;
end;
ReadKey;
CursorOn;
Halt;
end;
{-----------------}
Procedure CheckView;
begin
NErr := 0;
if Mode then
for c:=0 to 79 do
for h:=0 to 1 do
for s:=1 to 18 do
begin
cs:=PackCylSec(c,s);
if not ReadAbsSector(0,h,cs,Buffer)
then
begin
NErr:=Nerr+1;
Info[ h, c, s ] := True;
end;
GotoXY(1,25);
Write('Head: ',h,' Cyl: ', C,' Sec: ', S,' NErr: ', NErr,' ');
if KeyPressed then View;
end
else
for h:=0 to 1 do
for c:=0 to 79 do
for s:=1 to 18 do
begin
cs:=PackCylSec(c,s);
if not ReadAbsSector(0,h,cs,Buffer)
then
begin
NErr:=Nerr+1;
Info[ h, c, s ] := True;
end;
GotoXY(1,25);
Write('Head: ',h,' Cyl: ', C,' Sec: ', S,' NErr: ', NErr,' ');
if KeyPressed then View;
end;
View;
end;
{------------------}
Procedure FileWrDSec;
Label L;
var
Q : Boolean;
begin
ClrScr;
WriteLn('Запись в файл или восстановление из него дискеты?(W/R) - З/В');
L : case ReadKey of
#0:
begin
Readkey;
Goto L;
end;
'W','w': Q:=False;
'R','r': Q:=True;
else Goto L;
end;
if Q then WriteLn('Восстановление содержимого дискеты по файлу')
else WriteLn('Сохранение содержимого дискеты в файл');
if Mode then Write('{ IMG } |') else Write('{ DST } |');
Write('S| ');
Repeat
Write('Введите имя файла (| - выход): ');
ReadLn(Sg);
if Sg='|' then Exit;
Until Sg<>'';
{$I-}
Assign(f, Sg);
Reset(f);
{$I+}
IOR := IOResult;
if (IOR<>0) then
if Q or (IOR = 3) then
begin
WriteLn('Ошибка при обращении к файлу ', Sg);
WriteLn(' ( файл не найден?) ! ');
{3 - не сущ. дир/диск; 2 - не сущ файл}
ReadKey;
CursorOn;
Halt;
end;
{$I-}
if Q then Reset(f)
else ReWrite(f);
{$I+}
if Q then
begin
LLL := FileSize(f);
if LLL*SizeOf(BT)<>1474560 then
begin
WriteLn('Размер файла не подходит для операции!: ');
ReadKey;
Close(f);
CursorOn;
Halt;
end;
WriteLn('Восстановление дискеты по файлу ', Sg, '...');
Write('Способ записи : ');
if Mode then WriteLn('IMG') else WriteLn('DST ');
cs:=PackCylSec(1,1);
if not SetAbsSector(0,0,cs,Buffer)
then
begin
Close(f);
WriteLn('Снимите защиту от записи с дискеты!');
ReadKey;
CursorOn;
Halt;
end;
NErr := 0;
if Mode then
for c:=0 to 79 do
for h:=0 to 1 do
for s:=1 to 18 do
begin
cs:=PackCylSec(c,s);
Read(f, Buffer);
if not SetAbsSector(0,h,cs,Buffer)
then
begin
NErr:=NErr+1;
WriteLn('Произошла ошибка => ', NErr);
ReadKey;
end;
GotoXY(1,25);
if (KeyPressed) then
begin
if ReadKey = #27 then
begin
Close(f);
ReadKey;
CursorOn;
Halt;
end;
end;
Write('Выполнено ', (c*36+h*18+s)/28.8:3:3,'% ');
end else
for h:=0 to 1 do
for c:=0 to 79 do
for s:=1 to 18 do
begin
cs:=PackCylSec(c,s);
Read(f, Buffer);
if not SetAbsSector(0,h,cs,Buffer)
then
begin
NErr:=NErr+1;
WriteLn('Произошла ошибка => ', NErr);
ReadKey;
end;
GotoXY(1,25);
if (KeyPressed) then
begin
if ReadKey = #27 then
begin
Close(f);
ReadKey;
CursorOn;
Halt;
end;
end;
Write('Выполнено ', ((c*18+s)/28.8)+50.0*h:3:3,'% ');
end;
end
else
begin
WriteLn('Сохранение дискеты в файле ', Sg, '...');
Write('Способ чтения : ');
if Mode then WriteLn('IMG') else WriteLn('DST ');
if Mode then
for c:=0 to 79 do
for h:=0 to 1 do
for s:=1 to 18 do
begin
cs:=PackCylSec(c,s);
if not ReadAbsSector(0,h,cs,Buffer)
then
begin
NErr:=Nerr+1;
Info[ h, c, s ] := True;
end;
Write(f, Buffer);
GotoXY(1,25);
if (KeyPressed) then
begin
if ReadKey = #27 then
begin
Close(f);
ReadKey;
CursorOn;
Halt;
end;
end;
Write('Выполнено ', (c*36+h*18+s)/28.8:3:3,'% ');
end else
for h:=0 to 1 do
for c:=0 to 79 do
for s:=1 to 18 do
begin
cs:=PackCylSec(c,s);
if not ReadAbsSector(0,h,cs,Buffer)
then
begin
NErr:=Nerr+1;
Info[ h, c, s ] := True;
end;
Write(f, Buffer);
GotoXY(1,25);
if (KeyPressed) then
begin
if ReadKey = #27 then
begin
Close(f);
ReadKey;
CursorOn;
Halt;
end;
end;
Write('Выполнено ', (s+c*18)/28.8+50.0*h:3:3,'% ');
end;
end;
Close(f);
WriteLn;
end;
{------------------}
Procedure FileWrDTr;
Label L;
var
Q : Boolean;
begin
ClrScr;
WriteLn('Запись в файл или восстановление из него дискеты?(W/R) - З/В');
L : case ReadKey of
#0:
begin
Readkey;
Goto L;
end;
'W','w': Q:=False;
'R','r': Q:=True;
else Goto L;
end;
if Q then WriteLn('Восстановление содержимого дискеты по файлу')
else WriteLn('Сохранение содержимого дискеты в файл');
if Mode then Write('{ IMG } |') else Write('{ DST } |');
Write('T| ');
Repeat
Write('Введите имя файла (| - выход): ');
ReadLn(Sg);
if Sg='|' then Exit;
Until Sg<>'';
{$I-}
Assign(ff, Sg);
Reset(ff);
{$I+}
IOR := IOResult;
if (IOR<>0) then
if Q or (IOR = 3) then
begin
WriteLn('Ошибка при обращении к файлу ', Sg);
WriteLn(' ( файл не найден?) ! ');
{3 - не сущ. дир/диск; 2 - не сущ файл}
ReadKey;
CursorOn;
Halt;
end;
{$I-}
if Q then Reset(ff)
else ReWrite(ff);
{$I+}
if Q then
begin
LLL := FileSize(ff);
if LLL*SizeOf(Track)<>1474560 then
begin
WriteLn('Размер файла не подходит для операции!: ');
ReadKey;
Close(ff);
CursorOn;
Halt;
end;
WriteLn('Восстановление дискеты по файлу ', Sg, '...');
Write('Способ записи : ');
if Mode then WriteLn('IMG') else WriteLn('DST ');
cs:=PackCylSec(1,1);
if not SetAbsSector(0,0,cs,TrackBuffer)
then
begin
Close(ff);
WriteLn('Снимите защиту от записи с дискеты!');
ReadKey;
CursorOn;
Halt;
end;
NErr := 0;
NSecRead := 18;
if Mode then
for c:=0 to 79 do
for h:=0 to 1 do
begin
s := 1;
cs:=PackCylSec(c,s);
Read(ff, TrackBuffer);
if not SetAbsSector(0,h,cs,TrackBuffer)
then
begin
NErr:=NErr+1;
WriteLn('Произошла ошибка => ', NErr);
ReadKey;
end;
GotoXY(1,25);
if (KeyPressed) then
begin
if ReadKey = #27 then
begin
Close(ff);
ReadKey;
CursorOn;
NSecRead := 1;
Halt;
end;
end;
Write('Выполнено ', (c*36+h*18+s)/28.8:3:3,'% ');
end else
for h:=0 to 1 do
for c:=0 to 79 do
begin
s := 1;
cs:=PackCylSec(c,s);
Read(ff, TrackBuffer);
if not SetAbsSector(0,h,cs,TrackBuffer)
then
begin
NErr:=NErr+1;
WriteLn('Произошла ошибка => ', NErr);
ReadKey;
end;
GotoXY(1,25);
if (KeyPressed) then
begin
if ReadKey = #27 then
begin
Close(ff);
ReadKey;
CursorOn;
Halt;
NSecRead := 1;
end;
end;
Write('Выполнено ', ((c*18+s)/28.8)+50.0*h:3:3,'% ');
end;
end
else
begin
WriteLn('Сохранение дискеты в файле ', Sg, '...');
Write('Способ чтения : ');
if Mode then WriteLn('IMG') else WriteLn('DST ');
NSecRead := 18;
NErr := 0;
if Mode then
for c:=0 to 79 do
for h:=0 to 1 do
begin
s := 1;
cs:=PackCylSec(c,s);
if not ReadAbsSector(0,h,cs,TrackBuffer)
then
begin
NErr:=Nerr+1;
Info[ h, c, s ] := True;
end;
Write(ff, TrackBuffer);
GotoXY(1,25);
if (KeyPressed) then
begin
if ReadKey = #27 then
begin
Close(ff);
ReadKey;
CursorOn;
NSecRead := 1;
Halt;
end;
end;
Write('Выполнено ', (c*36+h*18+s)/28.8:3:3,'% ');
end else
for h:=0 to 1 do
for c:=0 to 79 do
begin
s := 1;
cs:=PackCylSec(c,s);
if not ReadAbsSector(0,h,cs,TrackBuffer)
then
begin
NErr:=NErr+1;
Info[ h, c, s ] := True;
end;
Write(ff, TrackBuffer);
GotoXY(1,25);
if (KeyPressed) then
begin
if ReadKey = #27 then
begin
Close(ff);
ReadKey;
CursorOn;
NSecRead := 1;
Halt;
end;
end;
Write('Выполнено ', (s+c*18)/28.8+50.0*h:3:3,'% ');
end;
end;
Close(ff);
WriteLn;
end;
const
sIMG : String = '(IMG)-формат / попарно дорожки на одном цилиндре /';
sDST : String = '(DST)-формат / дорожки на первой головке, затем на второй/';
sTrack : String = 'Дорожка целиком';
sSector : String = 'Посекторно ';
Procedure ChangeFlag(var Bl : Boolean);
begin
Bl := not Bl;
GotoXY(22, 1);
if Mode then Write(sIMG)
else Write(sDST);
GotoXY(23, 2);
if Tr then Write(sTrack)
else Write(sSector);
end;
{======Основная программа======}
begin
Mode := True;
Tr := True;
if ParamCount>0 then
begin
if ParamStr(1) = '/DST' then Mode := False;
if ParamStr(1) = '/IMG' then Mode := True;
end;
ClrScr;
for i:=0 to 1 do
for j:=0 to 79 do
for k:=1 to 18 do Info [i, j, k] := False;
Repeat
WriteLn('Вставьте дискету...');
if ReadKey = #27 then Halt;
cs:=PackCylSec(1,1);
ReadAbsSector(0,0,cs,Buffer);
DStat := DiskStatus;
Until DStat <> $80 ;
ClrScr;
CursorOff;
Write('Режим чтения-записи: ');
if Mode then WriteLn(sIMG)
else WriteLn(sDST);
Write('Способ чтения/записи: ');
if Tr then WriteLn(sTrack)
else WriteLn(sSector);
WriteLn('Статус дискеты:', DStat);
WriteLn('Введите режим просмотра дискеты (G-g-Г-г ) - графический;');
WriteLn('(T-t-Т-т ) - текстовый; (C-c-П-п ) - проверка дискеты');
WriteLn('(F, f, Ф, ф) - сохранение/восстановление в/из файл(а)');
WriteLn('F1 - изменить режим чтения/записи');
WriteLn('F2 - изменить способ чтения/записи при работе с файлами');
L : case ReadKey of
#0:
begin
case Readkey of
#59 : ChangeFlag(Mode);
#60 : ChangeFlag(Tr);
end;
Goto L;
end;
'G','g','Г','г': GraphView;
'T','t','Т','т': TextView;
'C','c','П','п': CheckView;
'F','f','Ф','ф': if Tr then FileWrDTr else FileWrDSec;
#27 :
begin
CursorOn;
Halt;
end;
else Goto L;
end;
CursorOn;
end.
< -->