Program DisketteWriter;
{$M 65520, 0, 655360}
{$G+,D-,E-,N+}
Uses DOS, ProgFace;
type
THCS = record
H, C, S, nSec : Byte;
end;
TWinColor = record
_WinAttr, _WBorderAttr, _WinHAttr, _MnAttrK, _MnAttrM,
_ButtAttr, _ButtLight, _ButtShadow : Byte;
end;
var
MainWinColor, ErrorWinColor, CompileWinColor, WorkWinColor, EnterWinColor : TWinColor;
HCS : THCS;
longHCS: Longint Absolute HCS;
FSize : Longint;
nH, nC, nS : Byte;
bH, bC, bS : Byte;
{ FileName: String;}
CylSec : Word;
i, j, k : Word;
curDScript: String;
cfgName : String;
curFile, cfgFile, tmpFile : File;
logFile, DScriptFile: Text;
tmpSt, tmpStx : String;
ttxx : array[0..255] of Char Absolute tmpSt;
tx0Attr, txAttr, tx1Attr, txCompile, ErAttr : Byte;
cDate : record
Year, Month, Day, DayofWeek : Word;
end;
cTime : record
Hour, Minute, Second, Sec100 : Word;
end;
Buffer : array[0..512*48-1] of Byte;
BuffSz : Word;
compileBuff : array[0..512*18-1] of Byte Absolute Buffer;
NCommCount, zStrCount, nCompCount, erStrCount, nCount, Mode : Word;
_Mode : String[3];
_rw : String[1];
_H, _C, _S, _File : String;
TTT : Byte Absolute WinAttr;
const
addpossible : Boolean = False;
SBig : Boolean = False;
CBig : Boolean = False;
logon : Boolean = True;
HeadString: String = '[ Diskette Writer by Felix! ]';
HeadStringConfig: String = '[ Diskette Writer by Felix! ]: * Configure * ';
StatString: String = '*** /Status/ ***';
tmpName = 'diwr.tmp';
logName = 'diwr.log';
cfgExt = '.CFG';
NSecrw : Word = 1;
{===============}
Procedure ScrollByOneLineUp(y, Cnt : Word); Assembler;
{ScrollByOneLineUp(2*12*80, 8*80)}
asm
push ds
push es
mov ax, 0B800h
mov ds, ax
mov es, ax
cld
mov di, y
mov si, di
add si, 2*80
mov cx, Cnt
rep movsw
pop es
pop ds
end;
{------------------}
Procedure ToggleIntense_Blink(b : Byte);Assembler;{0 - Intense/ 1 - Blink}
asm
mov bl, byte ptr b
mov ax, 1003h
int 10h
end;
{------------------}
Procedure SetWidth8;Assembler;
asm
mov dx, 03C4h
mov al, 01h
out dx, al
inc dx
in al, dx
and al, 11111011b
or al, 00000001b
out dx, al
end;
Procedure SetWidth9;Assembler;
asm
mov dx, 03C4h
mov al, 01h
out dx, al
inc dx
in al, dx
and al, 0FEh
out dx, al
end;
Procedure SetCurColor(GQ : TWinColor);
begin
with GQ do
begin
WinAttr := _WinAttr;
WBorderAttr := _WBorderAttr;
WinHAttr := _WinHAttr;
MnAttrK := _MnAttrK;
MnAttrM := _MnAttrM;
ButtAttr := _ButtAttr;
ButtLight := _ButtLight;
ButtShadow := _ButtShadow;
end;
end;
Procedure ChangeColor(var GQ : TWinColor);
begin
with GQ do
begin
_WinAttr := WinAttr;
_WBorderAttr := WBorderAttr;
_WinHAttr := WinHAttr;
_MnAttrK := MnAttrK;
_MnAttrM := MnAttrM;
_ButtAttr := ButtAttr;
_ButtLight := ButtLight;
_ButtShadow := ButtShadow;
end;
end;
{------------------}
Function InitMouse : Boolean; Assembler;
asm
mov ax, 0
int 33h
end;
Procedure ShowMouse; Assembler;
asm
mov ax, 1
int 33h
end;
Procedure HideMouse; Assembler;
asm
mov ax, 2
int 33h
end;
Function MouseButt : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, bx
end;
Function MouseX : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, cx
shr ax, 3
inc ax
end;
Function MouseY : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, dx
shr ax, 3
inc ax
end;
{---------------------}
Function MouseIn(x1, y1, x2, y2 : Word) : Boolean;
begin
MouseIn := (MouseX>=x1) and (MouseX<=x2) and (MouseY>=y1) and (MouseY<=y2);
end;
{=================}
Procedure WaitRetrace;Assembler;
asm
mov dx, 03DAh
@VRTL1:
in al, dx
test al, 8
jnz @VRTL1
@VRTL2:
in al, dx
test al, 8
jne @VRTL2
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 := NSecrw; {Читаем один NSECREAD секторов}
es := seg(Buf);
bx := ofs(Buf);
Intr($13,R);
SetAbsSector:=(Flags and FCarry) = 0
end
end; {SetAbsSector}
{---------------------}
Function DiskStatus : Byte;Assembler;
asm
mov ah, 1
mov dl, 0
int $13
end;
{---------------------}
Function ReadAbsSector(Disk,Head:Byte;CylSec:Word;var Buf):Boolean;
var
R:Registers;
begin
with R do
begin
ah:=2;
al:=NSecrw;
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;
Function UpString(S:String):String;
var
i : Integer;
S1 : String;
begin
S1 := S;
for i := 1 to Length(S1) do
S1[i] := UpCase(S1[i]);
UpString := S1;
end;
Procedure logWrTimeDate;
begin
if not logon then Exit;
with cDate do GetDate(Year, Month, Day, DayofWeek);
with cTime do GetTime(Hour, Minute, Second, Sec100);
with cDate do
begin
Str(Day, tmpSt);
Write(logFile, tmpSt+' ');
case Month of
1: tmpSt := 'Января';
2: tmpSt := 'Февраля';
3: tmpSt := 'Марта';
4: tmpSt := 'Апреля';
5: tmpSt := 'Мая';
6: tmpSt := 'Июня';
7: tmpSt := 'Июля';
8: tmpSt := 'Августа';
9: tmpSt := 'Сентября';
10: tmpSt := 'Октября';
11: tmpSt := 'Ноября';
12: tmpSt := 'Декабря'
end;
Write(logFile, tmpSt+' ');
Str(Year, tmpSt);
Write(logFile, tmpSt+' года, ');
case DayofWeek of
0: tmpSt := 'Вс';
1: tmpSt := 'Пн';
2: tmpSt := 'Вт';
3: tmpSt := 'Ср';
4: tmpSt := 'Чт';
5: tmpSt := 'Пт';
6: tmpSt := 'Сб';
end;
Write(logFile, tmpSt+', ');
end;
with cTime do
begin
Str(Hour, tmpSt);
Write(logFile, tmpSt+'ч. ');
Str(Minute, tmpSt);
Write(logFile, tmpSt+'мин. ');
Str(Second, tmpSt);
Write(logFile, tmpSt+'.');
Str(Sec100, tmpSt);
Write(logFile, tmpSt+' сек.');
end;
end;
{---------------}
Procedure logTimeWr;
begin
if not logon then Exit;
with cTime do GetTime(Hour, Minute, Second, Sec100);
with cTime do
begin
Str(Hour, tmpSt);
Write(logFile, tmpSt+':');
Str(Minute, tmpSt);
Write(logFile, tmpSt+':');
Str(Second, tmpSt);
Write(logFile, tmpSt+'.');
Str(Sec100, tmpSt);
Write(logFile, tmpSt+'# ');
end;
end;
{---------------}
Procedure Error(St : String);
var
tSt : String;
begin
if logon then
begin
{$I-}
Append(logFile);
{$I+}
if IOResult = 0 then
begin
Write(logFile, '=> diwr: [* Ошибка! *] ');
logTimeWr;
WriteLn(logFile, 'Диагноз: ', St);
Close(logFile);
end;
end;
SetCurColor(ErrorWinColor);
SaveBar(27, 8, 53, 16);
SetWindow(27, 8, 53, 16, 2, ' -= Ошибка !!! =- ', True);
Repeat
NewLine;
tSt := Copy(St, 1, Pos('|', St)-1);
Delete(St, 1, Pos('|', St));
WriteLine(tSt, ErAttr);
Until tSt = '';
WriteLine(St, ErAttr);
While not KeyPressed do;
While KeyPressed Do ReadKey;
UndoMenu;
end;
{---------------}
Procedure WriteCFG;
var
tmpb : Byte;
begin
Assign(cfgFile, cfgName);
{$I-}
ReWrite(cfgFile, 1);
{$I+}
if IOResult<>0 then
begin
Error(' | | Ошибка записи | в файл конфигурации!');
if logon then Close(logFile);
Halt($FFF0);
end;
Seek(cfgFile, 0);
tmpSt := 'cfgDIWR'#20;
BlockWrite(cfgFile, ttxx[1], 8);
i := Length(CurDScript);
BlockWrite(cfgFile, i, 2);
BlockWrite(cfgFile, CurDScript, Length(CurDScript)+1);
{Читаем в порядке:
WinAttr, WBorderAttr, WinHAttr, MnAttrK, MnAttrM,
ButtAttr, ButtLight, ButtShadow
}
BlockWrite(cfgFile, MainWinColor, 8);
BlockWrite(cfgFile, ErrorWinColor, 8);
BlockWrite(cfgFile, CompileWinColor, 8);
BlockWrite(cfgFile, WorkWinColor, 8);
BlockWrite(cfgFile, EnterWinColor, 8);
BlockWrite(cfgFile, txCompile, 1);
BlockWrite(cfgFile, tx0Attr, 1);
BlockWrite(cfgFile, tx1Attr, 1);
BlockWrite(cfgFile, txAttr, 1);
BlockWrite(cfgFile, logon, 1);
Close(cfgFile);
end;
Procedure MkStandartCFG;
begin
logon := True;
CurDScript := 'st.ds';
SetAttr(White, Blue, WinAttr);
SetAttr(White, Blue, WBorderAttr);
SetAttr(Yellow, Blue, WinHAttr);
SetAttr(White, Blue, MnAttrK);
SetAttr(Yellow, Blue, MnAttrM);
SetAttr(White, Green, ButtAttr);
SetAttr(Yellow, LightGreen, ButtLight);
SetAttr(LightBlue, Magenta, ButtShadow);
ChangeColor(MainWinColor);
SetAttr(Yellow, Blue, txAttr);
SetAttr(LightGreen, Blue, txCompile);
SetAttr(Cyan, Blue, tx0Attr);
SetAttr(LightCyan, Blue, tx1Attr);
SetAttr(LightRed, LightRed, ErAttr);
WinAttr := ErAttr;
WinHAttr := ErAttr;
WBorderAttr := ErAttr;
ChangeColor(ErrorWinColor);
SetAttr(Green, Blue, WinAttr);
SetAttr(LightMagenta, Blue, WinHAttr);
SetAttr(LightBlue, Blue, WBorderAttr);
ChangeColor(CompileWinColor);
SetAttr(Green, Blue, WinAttr);
SetAttr(LightMagenta, Blue, WinHAttr);
SetAttr(LightBlue, Blue, WBorderAttr);
ChangeColor(WorkWinColor);
SetAttr(Red, Green, WinAttr);
SetAttr(LightRed, Blue, WinHAttr);
SetAttr(Red, Blue, WBorderAttr);
ChangeColor(EnterWinColor);
WriteCFG;
end;
Procedure ReadCFG;
begin
Assign(cfgFile, cfgName);
{$I-}
ReSet(cfgFile, 1);
{$I+}
if IOResult<>0 then
begin
SetAttr(LightRed, LightRed, ErAttr);
WinAttr := ErAttr;
WinHAttr := ErAttr;
WBorderAttr := ErAttr;
ChangeColor(ErrorWinColor);
CursorOff;
Error(' | Ошибка открытия | файла конфигурации!| | Будет записан| стандартный файл...');
MkStandartCFG;
CursorOn;
Halt;
end;
BlockRead(cfgFile, ttxx[1], 8);
tmpSt[0] := #8;
if tmpSt <> 'cfgDIWR'#20 then
begin
Error(' | | Неверный файл | конфигурации!| |'+'('+cfgName+')');
While KeyPressed Do ReadKey;
Exit;
end;
BlockRead(cfgFile, i, 2);
BlockRead(cfgFile, CurDScript, i+1);
{Читаем в порядке:
WinAttr, WBorderAttr, WinHAttr, MnAttrK, MnAttrM,
ButtAttr, ButtLight, ButtShadow
}
BlockRead(cfgFile, MainWinColor, 8);
BlockRead(cfgFile, ErrorWinColor, 8);
BlockRead(cfgFile, CompileWinColor, 8);
BlockRead(cfgFile, WorkWinColor, 8);
BlockRead(cfgFile, EnterWinColor, 8);
BlockRead(cfgFile, txCompile, 1);
BlockRead(cfgFile, tx0Attr, 1);
BlockRead(cfgFile, tx1Attr, 1);
BlockRead(cfgFile, txAttr, 1);
BlockRead(cfgFile, logon, 1);
Close(cfgFile);
ErAttr := ErrorWinColor._WinAttr;
end;
Procedure logWr(S : String);
begin
if not logon then Exit;
{$I-}
Append(logFile);
{$I+}
if IOResult = 0 then
begin
logTimeWr;
WriteLn(logFile, S);
Close(logFile);
end;
end;
Procedure lgWr(S : String);
begin
WaitRetrace;
ScrollByOneLineUp(2*7*80, 16*80);
PutCursor(2, 24);
WriteLine(S+' ', txAttr);
if not logon then Exit;
logTimeWr;
WriteLn(logFile, S);
end;
Function Compile: Boolean;
var
Count, Countn : Byte;
_code : Integer;
n : Word;
firstn, lastn : Word;
begin
txAttr := txCompile;
Count := 0;
Countn := 0;
While Pos(',', _H) <> 0 do
begin
tmpSt := Copy(_H, 1, Pos(',', _H)-1);
Delete(_H, 1, Pos(',', _H));
if Pos('-', tmpSt) = 0 then
begin
Val(tmpSt, n, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для H...');
Compile := False;
Exit;
end;{if _code...}
inc(Count);
inc(Countn);
compileBuff[Count] := n;
end {if Pos...}
else {есть тире}
begin
tmpStx := Copy(tmpSt, 1, Pos('-', tmpSt)-1);
Delete(tmpSt, 1, Pos('-', tmpSt));
Val(tmpStx, firstn, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для H...');
Compile := False;
Exit;
end;
Val(tmpSt, lastn, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для H...');
Compile := False;
Exit;
end;
if lastn>=firstn then
begin
for i := firstn to lastn do
begin
inc(Count);
inc(Countn);
CompileBuff[Count] := i;
end;
end
else
begin
for i := firstn downto lastn do
begin
inc(Count);
inc(Countn);
CompileBuff[Count] := i;
end;
end;
end;{else...}
end; {While ...}
if Pos('-', _H) = 0 then
begin
Val(_H, n, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для H...');
Compile := False;
Exit;
end;
inc(Count);
inc(Countn);
compileBuff[Count] := n;
end
else {Тире есть}
begin
tmpSt := _H;
tmpStx := Copy(tmpSt, 1, Pos('-', tmpSt)-1);
Delete(tmpSt, 1, Pos('-', tmpSt));
Val(tmpStx, firstn, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для H...');
Compile := False;
Exit;
end;
Val(tmpSt, lastn, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для H...');
Compile := False;
Exit;
end;
if lastn>=firstn then
begin
for i := firstn to lastn do
begin
inc(Count);
inc(Countn);
CompileBuff[Count] := i;
end;
end
else
begin
for i := firstn downto lastn do
begin
inc(Count);
inc(Countn);
CompileBuff[Count] := i;
end;
end;
end;
compileBuff[0] := Countn;
Str(Countn, tmpSt);
lgWr('Всего значений для H: '+tmpSt);
Countn := 0;{C}
inc(Count);
While Pos(',', _C) <> 0 do
begin
tmpSt := Copy(_C, 1, Pos(',', _C)-1);
Delete(_C, 1, Pos(',', _C));
if Pos('-', tmpSt) = 0 then
begin
Val(tmpSt, n, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для C...');
Compile := False;
Exit;
end;
inc(Count);
inc(Countn);
compileBuff[Count] := n;
end
else {есть тире}
begin
tmpStx := Copy(tmpSt, 1, Pos('-', tmpSt)-1);
Delete(tmpSt, 1, Pos('-', tmpSt));
Val(tmpStx, firstn, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для C...');
Compile := False;
Exit;
end;
Val(tmpSt, lastn, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для C...');
Compile := False;
Exit;
end;
if lastn>=firstn then
begin
for i := firstn to lastn do
begin
inc(Count);
inc(Countn);
CompileBuff[Count] := i;
end;
end
else
begin
for i := firstn downto lastn do
begin
inc(Count);
inc(Countn);
CompileBuff[Count] := i;
end;
end;
end;
end;
if Pos('-', _C) = 0 then
begin
Val(_C, n, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для C...');
Compile := False;
Exit;
end;
inc(Count);
inc(Countn);
compileBuff[Count] := n;
end
else {Тире есть}
begin
tmpSt := _C;
tmpStx := Copy(tmpSt, 1, Pos('-', tmpSt)-1);
Delete(tmpSt, 1, Pos('-', tmpSt));
Val(tmpStx, firstn, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для C...');
Compile := False;
Exit;
end;
Val(tmpSt, lastn, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для C...');
Compile := False;
Exit;
end;
if lastn>=firstn then
begin
for i := firstn to lastn do
begin
inc(Count);
inc(Countn);
CompileBuff[Count] := i;
end;
end
else
begin
for i := firstn downto lastn do
begin
inc(Count);
inc(Countn);
CompileBuff[Count] := i;
end;
end;
end;
compileBuff[Count-Countn] := Countn;
Str(Countn, tmpSt);
lgWr('Всего значений для C: '+tmpSt);
Countn := 0;{S}
inc(Count);
While Pos(',', _S) <> 0 do
begin
tmpSt := Copy(_S, 1, Pos(',', _S)-1);
Delete(_S, 1, Pos(',', _S));
if Pos('-', tmpSt) = 0 then
begin
Val(tmpSt, n, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для S...');
Compile := False;
Exit;
end;
inc(Count);
inc(Countn);
compileBuff[Count] := n;
end
else {есть тире}
begin
tmpStx := Copy(tmpSt, 1, Pos('-', tmpSt)-1);
Delete(tmpSt, 1, Pos('-', tmpSt));
Val(tmpStx, firstn, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для S...');
Compile := False;
Exit;
end;
Val(tmpSt, lastn, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для S...');
Compile := False;
Exit;
end;
if lastn>=firstn then
begin
for i := firstn to lastn do
begin
inc(Count);
inc(Countn);
CompileBuff[Count] := i;
end;
end
else
begin
for i := firstn downto lastn do
begin
inc(Count);
inc(Countn);
CompileBuff[Count] := i;
end;
end;
end;
end;
if Pos('-', _S) = 0 then
begin
Val(_S, n, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для S...');
Compile := False;
Exit;
end;
inc(Count);
inc(Countn);
compileBuff[Count] := n;
end
else {Тире есть}
begin
tmpSt := _S;
tmpStx := Copy(tmpSt, 1, Pos('-', tmpSt)-1);
Delete(tmpSt, 1, Pos('-', tmpSt));
Val(tmpStx, firstn, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для S...');
Compile := False;
Exit;
end;
Val(tmpSt, lastn, _code);
if _code <> 0 then
begin
lgWr('==> Ошибка при компиляции значений для S...');
Compile := False;
Exit;
end;
if lastn>=firstn then
begin
for i := firstn to lastn do
begin
inc(Count);
inc(Countn);
CompileBuff[Count] := i;
end;
end
else
begin
for i := firstn downto lastn do
begin
inc(Count);
inc(Countn);
CompileBuff[Count] := i;
end;
end;
end;
compileBuff[Count-Countn] := Countn;
Str(Countn, tmpSt);
lgWr('Всего значений для S: '+tmpSt);
Compile := True;
end;
Function CheckH : Boolean;
var
i : Byte;
t : Boolean;
begin
t := True;
for i := 1 to compileBuff[0] do
begin
{ Str(compileBuff[i], tmpSt);
Str(i, tmpStx);
lgWr('H['+tmpStx+'] = '+tmpSt);}
t := t and (compileBuff[i] in [0, 1]);
end;
CheckH := t;
end;
Procedure CheckC;
var
i : Byte;
begin
CBig := False;
nC := compileBuff[0] + 1;{//3}
for i := nC + 1 to nC + compileBuff[nC] do
begin
{ Str(compileBuff[i], tmpSt);
Str(i, tmpStx);
lgWr('C['+tmpStx+'] = '+tmpSt);}
if compileBuff[i] > 79 then CBig := True;
end;
end;
Function CheckS : Boolean;
var
i : Byte;
t : Boolean;
begin
SBig := False;
t := True;
nS := compileBuff[0] + 1;{//3}
nS := compileBuff[0] + compileBuff[nS] + 2;
for i := nS + 1 to nS + compileBuff[nS] do
begin
{ Str(compileBuff[i], tmpSt);
Str(i, tmpStx);
lgWr('S['+tmpStx+'] = '+tmpSt);}
t := t and (compileBuff[i] <> 0);
if compileBuff[i] > 18 then SBig := True;
end;
CheckS := t;
end;
Procedure CheckCplDScript;
var
St, tmpS : String;
begin
SaveBar(1, 7, 80, 25);
WaitRetrace;
SetCurColor(CompileWinColor);
SetWindow(1, 7, 80, 25, 2, '', False);
_File := '';
_H := '';
_C := '';
_S := '';
_Mode := ' ';
NCommCount := 0;
zStrCount := 0;
erStrCount := 0;
nCompCount := 0;
nCount := 0;
Mode := 0;
logWr('Проверка и компилирование Data Script-файла '+curDScript+'...');
Assign(DScriptFile, curDScript);
{$I-}
Reset(DScriptFile);
{$I+}
if IOResult<>0 then
begin
Error(' | Ошибка открытия файла| '+curDScript+', | с описаниями действий| работы программы!');
Halt;
end;
logWr('Файл успешно открыт.');
{$I-}
Rewrite(tmpFile, 1);
{$I+}
if IOResult <> 0 then
begin
Close(DScriptFile);
Error(' | | Ошибка открытия| временного файла!');
Exit;
end;
if logon then
begin
{$I-}
Append(logFile);
{$I+}
end;
tmpSt := 'tmpDIWR'#20;
BlockWrite(tmpFile, tmpSt[1], 8);
lgWr('Записан заголовок временного файла. Компиляция...');
While not EOF(DScriptFile) do
begin
ReadLn(DScriptFile, St);
inc(nCount);
if (St[1]+St[2] = '//') or (St[1]+St[2] = '\\') then
begin
inc(NCommCount);
Continue;
end;
{Компиляция}
if Length(St) = 0 then
begin
inc(zStrCount);
Str(zStrCount, St);
lgWr('Внимание! Пустая строка '+St+'!');
Continue;
end;
Str(nCount, tmpS);
St := UpString(St);
lgWr('*** На входе: '+St+'; *** строка '+tmpS);
_rw := St[1];
if (_rw <> 'W') and (_rw<>'R') and (_rw<>'+') then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+'! (Отсутствует "r", "w" или "+" в начале строки).');
Continue;
end;
case _rw[1] of
'W':
begin
lgWr('Выбран режим: '+_rw+' (запись на дискету).');
{ addpossible := True;}
end;
'R':
begin
lgWr('Выбран режим: '+_rw+' (чтение дискеты, запись в файл).');
{ addpossible := True;}
end;
'+':
begin
lgWr('Режим добавления: '+_rw);
if not addpossible then
begin
lgWr('Режим добавления в данном месте невозможен!');
Continue;
end;
end;
end;
if _rw = '+' then Delete(St, 1, 1)
else Delete(St, 1, 2);{Удаляем первые два символа}
if _rw <> '+' then
begin
if Pos(']', St)=0 then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+'! (Отсутствует "]", обозначающая конец имени файла).');
Continue;
end;
_File := Copy(St, 1, Pos(']', St)-1);{Копируем имя файла}
Delete(St, 1, Pos(']', St));{Удаляем имя файла}
end; {if _rw <> '+' ...}
if (_File='') or (_File='?') then
lgWr('Имя файла будет запрашиваться: "['+_File+']"')
else
lgWr('Определено имя файла: '+_File);
if _File='' then _File := '?';
if (Pos('H', St) = 0) or (Pos('C', St) = 0) or (Pos('S', St) = 0) then
begin
lgWr(St);
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Отсутствуют идентификаторы головки, цилиндра или сектора ("H", "C", "S")).');
Continue;
end;
_Mode[1] := St[1];
if not (_Mode[1] in ['H', 'C', 'S']) then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+'! (Неверный идентификатор: "'+_Mode[1]+'")');
Continue;
end;
if St[2]<>'{' then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+'! (Отсутствует открывающая скобка ("{"): "'+St[2]+'")');
Continue;
end;
if Pos('}', St) = 0 then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+'! (Отсутствует закрывающая скобка ("}"):)');
lgWr('"'+St+'"');
Continue;
end;
case _Mode[1] of
'H':
begin
_H := Copy(St, 3, Pos('}', St)-3);
lgWr('Пределы изменения '+_Mode[1]+': '+_H);
end;
'C':
begin
_C := Copy(St, 3, Pos('}', St)-3);
lgWr('Пределы изменения '+_Mode[1]+': '+_C);
end;
'S':
begin
_S := Copy(St, 3, Pos('}', St)-3);
lgWr('Пределы изменения '+_Mode[1]+': '+_S);
end;
end;
Delete(St, 1, Pos('}', St));
_Mode[2] := St[1];
if not (_Mode[2] in ['H', 'C', 'S']) then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+'! (Неверный идентификатор: "'+_Mode[2]+'")');
Continue;
end;
if St[2]<>'{' then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+'! (Отсутствует открывающая скобка ("{"): "'+St[2]+'")');
Continue;
end;
if Pos('}', St) = 0 then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+'! (Отсутствует закрывающая скобка ("}"):)');
lgWr('"'+St+'"');
Continue;
end;
case _Mode[2] of
'H':
begin
_H := Copy(St, 3, Pos('}', St)-3);
lgWr('Пределы изменения '+_Mode[2]+': '+_H);
end;
'C':
begin
_C := Copy(St, 3, Pos('}', St)-3);
lgWr('Пределы изменения '+_Mode[2]+': '+_C);
end;
'S':
begin
_S := Copy(St, 3, Pos('}', St)-3);
lgWr('Пределы изменения '+_Mode[2]+': '+_S);
end;
end;
Delete(St, 1, Pos('}', St));
_Mode[3] := St[1];
if not (_Mode[3] in ['H', 'C', 'S']) then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+'! (Неверный идентификатор: "'+_Mode[3]+'")');
Continue;
end;
if St[2]<>'{' then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+'! (Отсутствует открывающая скобка ("{"): "'+St[2]+'")');
Continue;
end;
if Pos('}', St) = 0 then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+'! (Отсутствует закрывающая скобка ("}"):)');
lgWr('"'+St+'"');
Continue;
end;
case _Mode[3] of
'H':
begin
_H := Copy(St, 3, Pos('}', St)-3);
lgWr('Пределы изменения '+_Mode[3]+': '+_H);
end;
'C':
begin
_C := Copy(St, 3, Pos('}', St)-3);
lgWr('Пределы изменения '+_Mode[3]+': '+_C);
end;
'S':
begin
_S := Copy(St, 3, Pos('}', St)-3);
lgWr('Пределы изменения '+_Mode[3]+': '+_S);
end;
end;
Delete(St, 1, Pos('}', St));
if St <> '' then
lgWr('// *** Остаток (комментарий): '+St);
{Удаляем пробелы}
lgWr('Удаление пробелов...');
While Pos(' ', _H) <> 0 do Delete(_H, Pos(' ', _H), 1);
While Pos(' ', _C) <> 0 do Delete(_C, Pos(' ', _C), 1);
While Pos(' ', _S) <> 0 do Delete(_S, Pos(' ', _S), 1);
lgWr('H: {'+_H+'}');
lgWr('C: {'+_C+'}');
lgWr('S: {'+_S+'}');
if (_H = '') or (_C = '') or (_S = '') then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Неизвестны пределы изменения одного или нескольких идентификаторов!)');
Continue;
end;
if (_File <> '?') and (_rw = 'W') then
begin
Assign(curFile, _File);
{$I-}
Reset(curFile);
{$I+}
if IOResult <> 0 then
begin
lgWr('===--> Не найден файл "'+_File+'"!!!');
lgWr('==> Внимание! Файл с данными для записи не найден! Вам придётся ввести другое имя.');
_File := '?';
end
else
Close(curFile);
end;
{Далее идёт создание по строкам соответствующей процедуры записи/чтения
и запись её во временный файл}
if _Mode = 'HCS' then Mode := 1;
if _Mode = 'CHS' then Mode := 2;
if _Mode = 'HSC' then Mode := 3;
if _Mode = 'SHC' then Mode := 4;
if _Mode = 'CSH' then Mode := 5;
if _Mode = 'SCH' then Mode := 6;
Str(Mode, St);
lgWr('*** Режим работы: '+_Mode+' ('+St+') ***');
case Mode of
1 {HCS}:
begin
if Compile then lgWr('<===> Успешно!')
else
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Ошибка при компиляции пределов изменения параметров!)');
Continue;
end;
if not CheckH then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Одно из значений H не 0 и не 1!)');
Continue;
end;
CheckC;
if not CheckS then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Имеется нулевое значение S!)');
Continue;
end;
if CBig or SBig then
begin
lgWr('>>>==> ВНИМАНИЕ! Заданы нестандартные значения для параметров C или S!');
end;
addpossible := True;
if _rw = '+' then Seek(tmpFile, FilePos(tmpFile) - 4);
nH := compileBuff[0];
bH := 1;
nC := compileBuff[0] + 1;
bC := nC + 1;
nS := compileBuff[0] + compileBuff[nC] + 2;
nC := compileBuff[nC];
bS := nS + 1;
nS := compileBuff[nS];
if _rw <> '+' then
begin
BlockWrite(tmpFile, _rw[1], 1);
i := Length(_File);
BlockWrite(tmpFile, i, 2);
BlockWrite(tmpFile, _File, i+1);
end;
for i := bH to bH + nH - 1 do
for j := bC to bC + nC - 1 do
begin
with HCS do
begin
H := compileBuff[i];
C := compileBuff[j];
k := bS;
S := compileBuff[k];
nSec := 1;
While k < bS + nS - 1 do
begin
inc(k);
if (compileBuff[k] = compileBuff[k-1] + 1) then
inc(nSec)
else
begin
BlockWrite(tmpFile, HCS, 4);
S := compileBuff[k];
nSec := 1;
end;
end;
BlockWrite(tmpFile, HCS, 4);
end;
end;
longHCS := 0;
BlockWrite(tmpFile, HCS, 4);
{ Str(nH, tmpSt);
lgWr('nH = '+tmpSt);
Str(bH, tmpSt);
lgWr('bH = '+tmpSt);
Str(nC, tmpSt);
lgWr('nC = '+tmpSt);
Str(bC, tmpSt);
lgWr('bC = '+tmpSt);
Str(nS, tmpSt);
lgWr('nS = '+tmpSt);
Str(bS, tmpSt);
lgWr('bS = '+tmpSt);}
end;
2 {CHS}:
begin
if Compile then lgWr('<===> Успешно!')
else
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Ошибка при компиляции пределов изменения параметров!)');
Continue;
end;
if not CheckH then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Одно из значений H не 0 и не 1!)');
Continue;
end;
CheckC;
if not CheckS then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Имеется нулевое значение S!)');
Continue;
end;
if CBig or SBig then
begin
lgWr('>>>==> ВНИМАНИЕ! Заданы нестандартные значения для параметров C или S!');
end;
addpossible := True;
if _rw = '+' then Seek(tmpFile, FilePos(tmpFile) - 4);
nH := compileBuff[0];
bH := 1;
nC := compileBuff[0] + 1;
bC := nC + 1;
nS := compileBuff[0] + compileBuff[nC] + 2;
nC := compileBuff[nC];
bS := nS + 1;
nS := compileBuff[nS];
if _rw <> '+' then
begin
BlockWrite(tmpFile, _rw[1], 1);
i := Length(_File);
BlockWrite(tmpFile, i, 2);
BlockWrite(tmpFile, _File, i+1);
end;
for j := bC to bC + nC - 1 do
for i := bH to bH + nH - 1 do
begin
with HCS do
begin
H := compileBuff[i];
C := compileBuff[j];
k := bS;
S := compileBuff[k];
nSec := 1;
While k < bS + nS - 1 do
begin
inc(k);
if (compileBuff[k] = compileBuff[k-1] + 1) then
inc(nSec)
else
begin
BlockWrite(tmpFile, HCS, 4);
S := compileBuff[k];
nSec := 1;
end;
end;
BlockWrite(tmpFile, HCS, 4);
end;
end;
longHCS := 0;
BlockWrite(tmpFile, HCS, 4);
end;
3 {HSC}:
begin
if Compile then lgWr('<===> Успешно!')
else
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Ошибка при компиляции пределов изменения параметров!)');
Continue;
end;
if not CheckH then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Одно из значений H не 0 и не 1!)');
Continue;
end;
CheckC;
if not CheckS then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Имеется нулевое значение S!)');
Continue;
end;
if CBig or SBig then
begin
lgWr('>>>==> ВНИМАНИЕ! Заданы нестандартные значения для параметров C или S!');
end;
addpossible := True;
if _rw = '+' then Seek(tmpFile, FilePos(tmpFile) - 4);
nH := compileBuff[0];
bH := 1;
nC := compileBuff[0] + 1;
bC := nC + 1;
nS := compileBuff[0] + compileBuff[nC] + 2;
nC := compileBuff[nC];
bS := nS + 1;
nS := compileBuff[nS];
if _rw <> '+' then
begin
BlockWrite(tmpFile, _rw[1], 1);
i := Length(_File);
BlockWrite(tmpFile, i, 2);
BlockWrite(tmpFile, _File, i+1);
end;
for i := bH to bH + nH - 1 do
for k := bS to bS + nS - 1 do
for j := bC to bC + nC - 1 do
with HCS do
begin
H := compileBuff[i];
C := compileBuff[j];
S := compileBuff[k];
nSec := 1;
BlockWrite(tmpFile, HCS, 4);
end;
longHCS := 0;
BlockWrite(tmpFile, HCS, 4);
end;
4 {SHC}:
begin
if Compile then lgWr('<===> Успешно!')
else
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Ошибка при компиляции пределов изменения параметров!)');
Continue;
end;
if not CheckH then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Одно из значений H не 0 и не 1!)');
Continue;
end;
CheckC;
if not CheckS then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Имеется нулевое значение S!)');
Continue;
end;
if CBig or SBig then
begin
lgWr('>>>==> ВНИМАНИЕ! Заданы нестандартные значения для параметров C или S!');
end;
addpossible := True;
if _rw = '+' then Seek(tmpFile, FilePos(tmpFile) - 4);
nH := compileBuff[0];
bH := 1;
nC := compileBuff[0] + 1;
bC := nC + 1;
nS := compileBuff[0] + compileBuff[nC] + 2;
nC := compileBuff[nC];
bS := nS + 1;
nS := compileBuff[nS];
if _rw <> '+' then
begin
BlockWrite(tmpFile, _rw[1], 1);
i := Length(_File);
BlockWrite(tmpFile, i, 2);
BlockWrite(tmpFile, _File, i+1);
end;
for k := bS to bS + nS - 1 do
for i := bH to bH + nH - 1 do
for j := bC to bC + nC - 1 do
with HCS do
begin
H := compileBuff[i];
C := compileBuff[j];
S := compileBuff[k];
nSec := 1;
BlockWrite(tmpFile, HCS, 4);
end;
longHCS := 0;
BlockWrite(tmpFile, HCS, 4);
end;
5 {CSH}:
begin
if Compile then lgWr('<===> Успешно!')
else
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Ошибка при компиляции пределов изменения параметров!)');
Continue;
end;
if not CheckH then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Одно из значений H не 0 и не 1!)');
Continue;
end;
CheckC;
if not CheckS then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Имеется нулевое значение S!)');
Continue;
end;
if CBig or SBig then
begin
lgWr('>>>==> ВНИМАНИЕ! Заданы нестандартные значения для параметров C или S!');
end;
addpossible := True;
if _rw = '+' then Seek(tmpFile, FilePos(tmpFile) - 4);
nH := compileBuff[0];
bH := 1;
nC := compileBuff[0] + 1;
bC := nC + 1;
nS := compileBuff[0] + compileBuff[nC] + 2;
nC := compileBuff[nC];
bS := nS + 1;
nS := compileBuff[nS];
if _rw <> '+' then
begin
BlockWrite(tmpFile, _rw[1], 1);
i := Length(_File);
BlockWrite(tmpFile, i, 2);
BlockWrite(tmpFile, _File, i+1);
end;
for j := bC to bC + nC - 1 do
for k := bS to bS + nS - 1 do
for i := bH to bH + nH - 1 do
with HCS do
begin
H := compileBuff[i];
C := compileBuff[j];
S := compileBuff[k];
nSec := 1;
BlockWrite(tmpFile, HCS, 4);
end;
longHCS := 0;
BlockWrite(tmpFile, HCS, 4);
end;
6 {SCH}:
begin
if Compile then lgWr('<===> Успешно!')
else
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Ошибка при компиляции пределов изменения параметров!)');
Continue;
end;
if not CheckH then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Одно из значений H не 0 и не 1!)');
Continue;
end;
CheckC;
if not CheckS then
begin
inc(erStrCount);
Str(erStrCount, St);
lgWr('==> Внимание! Неправильная строка '+St+
'! (Имеется нулевое значение S!)');
Continue;
end;
if CBig or SBig then
begin
lgWr('>>>==> ВНИМАНИЕ! Заданы нестандартные значения для параметров C или S!');
end;
addpossible := True;
if _rw = '+' then Seek(tmpFile, FilePos(tmpFile) - 4);
nH := compileBuff[0];
bH := 1;
nC := compileBuff[0] + 1;
bC := nC + 1;
nS := compileBuff[0] + compileBuff[nC] + 2;
nC := compileBuff[nC];
bS := nS + 1;
nS := compileBuff[nS];
if _rw <> '+' then
begin
BlockWrite(tmpFile, _rw[1], 1);
i := Length(_File);
BlockWrite(tmpFile, i, 2);
BlockWrite(tmpFile, _File, i+1);
end;
for k := bS to bS + nS - 1 do
for j := bC to bC + nC - 1 do
for i := bH to bH + nH - 1 do
with HCS do
begin
H := compileBuff[i];
C := compileBuff[j];
S := compileBuff[k];
nSec := 1;
BlockWrite(tmpFile, HCS, 4);
end;
longHCS := 0;
BlockWrite(tmpFile, HCS, 4);
end;
end;{case...}
{for i := 0 to 30 do
begin
Str(compileBuff[i], tmpSt);
Str(i, tmpStx);
lgWr('Yo!['+tmpStx+'] = '+tmpSt);
end;}
{*** Закончилась}
inc(nCompCount);
Str(nCompCount, St);
lgWr('Скомпилирована строка '+St);
end;
lgWr(' ---------------------------------------------');
Str(nCompCount, St);
lgWr('Всего скомпилировано строк (верных): '+St);
if logon then Close(logFile);
longHCS := 0;
BlockWrite(tmpFile, HCS, 1);
BlockWrite(tmpFile, HCS, 4);
Close(tmpFile);
Str(NCommCount, St);
logWr('Проверка завершена. Комментариев в файле: '+St);
Close(DScriptFile);
ReadKey;
WaitRetrace;
UndoMenu;
end;
{==================}
Procedure DoWork;
begin
CylSec:=PackCylSec(0,1);
ReadAbsSector(0, 0, CylSec, Buffer);
if DiskStatus = $80 then
begin
SaveBar(30, 12, 50, 14);
Repeat
SetCurColor(ErrorWinColor);
SetWindow(30, 12, 50, 13, 1, '[Вставьте дискету!]', False);
if ReadKey = #27 then
begin
UndoMenu;
Exit;
end;
ReadAbsSector(0, 0, CylSec, Buffer);
Until DiskStatus <> $80 ;
UndoMenu;
end;
with HCS do
begin
H := 0; C := 0; S := 1;
CylSec := PackCylSec(C, S);
nSec := 1;
ReadAbsSector(0, H, CylSec, Buffer);
if not SetAbsSector(0, H, CylSec, Buffer) then
begin
SaveBar(30, 12, 50, 14);
SetCurColor(ErrorWinColor);
SetWindow(20, 12, 60, 13, 1, '[Снимите защиту от записи с дискеты!]', False);
ReadKey;
UndoMenu;
Exit;
end;
end;
{$I-}
Reset(tmpFile, 1);
{$I+}
if IOResult <> 0 then
begin
LogWr('==> Внимание! Попытка открыть временный файл завершилась неудачей!');
LogWr('Операция прекращена!');
Exit;
end;
SaveBar(25, 7, 56, 15);
SetCurColor(WorkWinColor);
WaitRetrace;
SetWindow(25, 7, 56, 15, 2, ' <Запись / Чтение> ', True);
BlockRead(tmpFile, ttxx, 8);
While not EOF(tmpFile) do
begin
BlockRead(tmpFile, _rw[1], 1);
_rw[0]:= #1;
if _rw[1] = #0 then Break;
BlockRead(tmpFile, i, 2);
BlockRead(tmpFile, _File, i+1);
if _File = '?' then
begin
Repeat
SaveBar(2, 11, 79, 13);
SetCurColor(EnterWinColor);
SetWindow(2, 11, 79, 13, 1, ' Введите имя файла (пустое поле - отмена): ', False);
ZZCursor;
CursorOn;
ReadLn(_File);
CursorOff;
UndoMenu;
Assign(curFile, _File);
{$I-}
if _rw = 'W' then
Reset(curFile, 1)
else
Rewrite(curFile, 1)
{$I+}
Until (IOResult = 0);
{$I-}
Close(curFile);
{$I+}
end;
Assign(curFile, _File);
if (_rw = 'W') and (_File<>'') then
begin
{$I-}
Reset(curFile, 1);
{$I+}
FSize := FileSize(curFile);
Close(curFile);
end;
if _File = '' then Break;
{$I-}
case _rw[1] of
'W' : Reset(curFile, 1);
'R' : Rewrite(curFile, 1);
end;
{$I+}
BlockRead(tmpFile, HCS, 4);
if EOF(curFile) then Seek(curFile, 0);
While (longHCS <> 0) or not EOF(tmpFile) do
begin
WindowSize(27, 7, 56, 15);
ZZCursor;
NewLine;
NewLine;
WriteLine('Операция: ', tx0Attr);
WriteLine(_rw+' ', tx1Attr);
logWr('Операция: '+_rw);
NewLine;
WriteLine('Головка: ', tx0Attr);
Str(HCS.H, tmpSt);
WriteLine(tmpSt+' ', tx1Attr);
logWr('Головка: '+tmpSt);
NewLine;
WriteLine('Дорожка: ', tx0Attr);
Str(HCS.C, tmpSt);
WriteLine(tmpSt+' ', tx1Attr);
logWr('Дорожка: '+tmpSt);
NewLine;
WriteLine('Сектор: ', tx0Attr);
Str(HCS.S, tmpSt);
WriteLine(tmpSt+' ', tx1Attr);
logWr('Сектор: '+tmpSt);
NewLine;
WriteLine('Число секторов: ', tx0Attr);
Str(HCS.nSec, tmpSt);
WriteLine(tmpSt+' ', tx1Attr);
logWr('Число секторов: '+tmpSt);
NewLine;
with HCS do
case _rw[1] of
'W' :
begin
NSecrw := nSec;
CylSec := PackCylSec(C, S);
if (FSize - FilePos(curFile)) < 512*nSec then
begin
ReadAbsSector(0, H, CylSec, Buffer);
BlockRead(curFile, Buffer, (FSize - FilePos(curFile)));
SetAbsSector(0, H, CylSec, Buffer);
end else
begin
BlockRead(curFile, Buffer, 512*nSec);
SetAbsSector(0, H, CylSec, Buffer);
end;
end;
'R' :
begin
NSecrw := nSec;
CylSec := PackCylSec(C, S);
ReadAbsSector(0, H, CylSec, Buffer);
BlockWrite(curFile, Buffer, nSec*512);
end;
end;
BlockRead(tmpFile, HCS, 4);
if longHCS = 0 then Break;
end;
Close(curFile);
end;
UndoMenu;
Close(tmpFile);
end;
Procedure Example;
begin
PutWindow(3, 2, 40, 20, 2, ' Образец окна ');
PutWindow(5, 4, 30, 15, 1, ' Example Window ');
SetButtSize(9, 2);
SetButton(7, 13, 2, ' Кнопка');
PutCursor(7, 6);
WriteLine('Текст в окне', WinAttr);
PutCursor(8, 7);
WriteLine('Текст в окне', WinAttr);
PutCursor(9, 8);
WriteLine('Текст в окне', WinAttr);
PutCursor(7, 10);
WriteLine('Key', MnAttrK);
WriteLine(' MenuItem', MnAttrM);
end;
Procedure MakePalWin(Col : Byte; Bl : Boolean);
var
i, j, Color : Byte;
Tx, Back : Byte;
begin
HideMouse;
Color := Col;
SetCurColor(MainWinColor);
WaitRetrace;
SetWindow(24, 7, 58, 19, 2, ' { Палитра } ', Bl);
WaitRetrace;
PutWindow(27, 8, 40, 17 , 1, ' Текст');
WaitRetrace;
PutWindow(42, 8, 55, 17 , 1, ' Фон');
WaitRetrace;
for j := 1 to 4 do
for i := 1 to 4 do
begin
SetAttr($4*(j-1)+i-1, 0, Color);
WriteCharXY(25+i*3, 7+j*2, Color, #219);
WriteCharXY(26+i*3, 7+j*2, Color, #219);
WriteCharXY(27+i*3, 7+j*2, Color, #219);
WriteCharXY(25+i*3, 8+j*2, Color, #219);
WriteCharXY(26+i*3, 8+j*2, Color, #219);
WriteCharXY(27+i*3, 8+j*2, Color, #219);
end;
for j := 1 to 4 do
for i := 1 to 4 do
begin
SetAttr($4*(j-1)+i-1, 0, Color);
WriteCharXY(40+i*3, 7+j*2, Color, #219);
WriteCharXY(41+i*3, 7+j*2, Color, #219);
WriteCharXY(42+i*3, 7+j*2, Color, #219);
WriteCharXY(40+i*3, 8+j*2, Color, #219);
WriteCharXY(41+i*3, 8+j*2, Color, #219);
WriteCharXY(42+i*3, 8+j*2, Color, #219);
end;
WindowSize(1, 1, 80, 25);
PutCursor(26, 18);
WriteLine('Пример текста / An Example Text', Col);
UnPackAttribute(Col, Tx, Back);
i := Tx and $3 + 1;
j := (Tx and $C) shr 2 + 1;
WriteCharXY(25+i*3, 7+j*2, 255-Col, #17);
WriteCharXY(26+i*3, 7+j*2, 255-Col, #16);
i := Back and $3 + 1;
j := (Back and $C) shr 2 + (Tx and $80) shr 6 + 1;
WriteCharXY(40+i*3, 7+j*2, 255-Col, #17);
WriteCharXY(41+i*3, 7+j*2, 255-Col, #16);
ShowMouse;
end;
Procedure Palette(var Col : Byte);
var
i, j, Color : Byte;
Tx, Back : Byte;
C : Char;
TB : Boolean;
begin
TB := False;
SaveBar(24, 7, 58, 19);
ShowMouse;
MakePalWin(Col, True);
UnPackAttribute(Col, Tx, Back);
Color := Col;
Repeat
if KeyPressed then
begin
C := ReadKey;
if C = #9 then TB := not TB;
if C = #0 then
begin
UnPackAttribute(Color, Tx, Back);
if not TB then
begin
i := Tx and $3 + 1;
j := (Tx and $C) shr 2 + 1;
end else
begin
i := Back and $3 + 1;
j := (Back and $C) shr 2 + (Tx and $80) shr 6 + 1;
end;
C := ReadKey;
case C of
#72{UP}: dec(j);
#80{DOWN}: inc(j);
#75{LEFT}: dec(i);
#77{Right}: inc(i);
end;{case C...}
if i < 1 then i := 4;
if i > 4 then i := 1;
if j < 1 then j := 4;
if j > 4 then j := 1;
if not TB then
begin
if j = 1 then
case i of
1: Tx := 0;
2: Tx := 1;
3: Tx := 2;
4: Tx := 3;
end;
if j = 2 then
case i of
1: Tx := 4;
2: Tx := 5;
3: Tx := 6;
4: Tx := 7;
end;
if j = 3 then
case i of
1: Tx := 8;
2: Tx := 9;
3: Tx := 10;
4: Tx := 11;
end;
if j = 4 then
case i of
1: Tx := 12;
2: Tx := 13;
3: Tx := 14;
4: Tx := 15;
end;
end else
begin
if j = 1 then
case i of
1: Back := 0;
2: Back := 1;
3: Back := 2;
4: Back := 3;
end;
if j = 2 then
case i of
1: Back := 4;
2: Back := 5;
3: Back := 6;
4: Back := 7;
end;
if j = 3 then
case i of
1: Back := 0 + Blink;
2: Back := 1 + Blink;
3: Back := 2 + Blink;
4: Back := 3 + Blink;
end;
if j = 4 then
case i of
1: Back := 4 + Blink;
2: Back := 5 + Blink;
3: Back := 6 + Blink;
4: Back := 7 + Blink;
end;
end;
if C in [#72, #75, #77, #80] then
begin
SetAttr(Tx, Back, Color);
MakePalWin(Color, False);
end;
end;
end;
if MouseButt = 1 then
begin
if not MouseIn(24, 7, 58, 19) then C := #27;
if MouseIn(28, 9, 39, 16) or MouseIn(43, 9, 54, 16) then
begin
if MouseIn(28, 9, 39, 16) then TB := False;
if MouseIn(43, 9, 54, 16) then TB := True;
if MouseIn( 28, 9, 30, 10) then Tx := Black;
if MouseIn( 31, 9, 33, 10) then Tx := Blue;
if MouseIn( 34, 9, 36, 10) then Tx := Green;
if MouseIn( 37, 9, 39, 10) then Tx := Cyan;
if MouseIn( 28, 11, 30, 12) then Tx := Red;
if MouseIn( 31, 11, 33, 12) then Tx := Magenta;
if MouseIn( 34, 11, 36, 12) then Tx := Brown;
if MouseIn( 37, 11, 39, 12) then Tx := LightGray;
if MouseIn( 28, 13, 30, 14) then Tx := DarkGray;
if MouseIn( 31, 13, 33, 14) then Tx := LightBlue;
if MouseIn( 34, 13, 36, 14) then Tx := LightGreen;
if MouseIn( 37, 13, 39, 14) then Tx := LightCyan;
if MouseIn( 28, 15, 30, 16) then Tx := LightRed;
if MouseIn( 31, 15, 33, 16) then Tx := LightMagenta;
if MouseIn( 34, 15, 36, 16) then Tx := Yellow;
if MouseIn( 37, 15, 39, 16) then Tx := White;
if MouseIn( 43, 9, 45, 10) then Back := Black;
if MouseIn( 46, 9, 48, 10) then Back := Blue;
if MouseIn( 49, 9, 51, 10) then Back := Green;
if MouseIn( 52, 9, 54, 10) then Back := Cyan;
if MouseIn( 43, 11, 45, 12) then Back := Red;
if MouseIn( 46, 11, 48, 12) then Back := Magenta;
if MouseIn( 49, 11, 51, 12) then Back := Brown;
if MouseIn( 52, 11, 54, 12) then Back := LightGray;
if MouseIn( 43, 13, 45, 14) then Back := DarkGray + Blink;
if MouseIn( 46, 13, 48, 14) then Back := LightBlue + Blink;
if MouseIn( 49, 13, 51, 14) then Back := LightGreen + Blink;
if MouseIn( 52, 13, 54, 14) then Back := LightCyan + Blink;
if MouseIn( 43, 15, 45, 16) then Back := LightRed + Blink;
if MouseIn( 46, 15, 48, 16) then Back := LightMagenta + Blink;
if MouseIn( 49, 15, 51, 16) then Back := Yellow + Blink;
if MouseIn( 52, 15, 54, 16) then Back := White + Blink;
SetAttr(Tx, Back, Color);
MakePalWin(Color, False);
While MouseButt<>0 do;
end;
end;{if MouseButt...}
Until (C = #13) or (C = #27);
if KeyPressed then ReadKey;
HideMouse;
if C <> #27 then
Col := Color;
UndoMenu;
end;
Procedure Configure;
var
TxWin, BkGrWin : Byte;
TxButt, BkGrButt : Byte;
begin
ReadCFG;
CursorOff;
SetCurColor(MainWinColor);
SaveBar(1, 1, 80, 25);
WaitRetrace;
SetWindow(1, 1, 80, 25, 2, HeadStringConfig, True);
SetButtSize(12, 2);
SetButton(3, 23, 2, ' Сохранить');
SetButtSize(15, 2);
SetButton(16, 23, 2, ' Восстановить');
SetButtSize(15, 2);
SetButton(63, 23, 2, ' По умолчанию');
PutWindow(52, 17, 70, 21, 2, '');
PutCursor(53, 19);
WriteLine(' Писать логи: ', WinAttr);
PutWindow(67, 18, 69, 20, 1, '');
if logon then WriteLine(#15, WinAttr)
else WriteLine(' ', WinAttr);
PutWindow(42, 2, 78, 4, 1, '(* Текущий скрипт в файле: *)');
PutCursor(44, 3);
WriteLine(CurDScript, WinAttr);
PutWindow(42, 5, 78, 16, 2, '(* Цвета *)');
ZZCursor;
WriteLine(' Основное окно', WinAttr);{MainWinColor}
NewLine;
WriteLine(' Сообщения об ошибке', WinAttr);{ErrorWinColor}
NewLine;
WriteLine(' Окно компиляции', WinAttr);{CompileWinColor}
NewLine;
WriteLine(' Рабочее окно', WinAttr);{WorkWinColor}
NewLine;
WriteLine(' Окно для ввода', WinAttr);{EnterWinColor}
NewLine;
NewLine;
WriteLine(' Текст 1', WinAttr);{txAttr}
NewLine;
WriteLine(' Текст 2', WinAttr);{txCompileAttr}
NewLine;
WriteLine(' Текст 3', WinAttr);{tx0Attr}
NewLine;
WriteLine(' Текст 4', WinAttr);{tx1Attr}
PutWindow(63, 6, 77, 15, 1, '');
ZZCursor;
WriteLine('Текст в окне', WinAttr);{WinAttr}
NewLine;
WriteLine('Рамка окна', WinAttr);{WBorderAttr}
NewLine;
WriteLine('Заголовок', WinAttr);{WinHAttr}
NewLine;
WriteLine('Меню Key', WinAttr);{MnAttrK}
NewLine;
WriteLine('Меню', WinAttr);{MnAttrM}
NewLine;
WriteLine('Кнопка', WinAttr);{ButtAttr}
NewLine;
WriteLine('Кнопка: яркая', WinAttr);{ButtLight}
NewLine;
WriteLine('Кнопка: тень', WinAttr);{ButtShadow}
NewLine;
SetCurColor(MainWinColor);
While MouseButt <> 2 do
begin
Example;
Palette(MainWinColor._WinAttr);
SetCurColor(MainWinColor);
end;
ShowMouse;
{ _WinAttr, _WBorderAttr, _WinHAttr, _MnAttrK, _MnAttrM,
_ButtAttr, _ButtLight, _ButtShadow : Byte;
}
ReadKey;
HideMouse;
UndoMenu;
RestoreScreen;
CursorOn;
end;
begin
InitMouse;
ToggleIntense_Blink(0);
cfgName := ParamStr(0);
Delete(cfgName, Length(cfgName)-3, 4);
cfgName := cfgName + cfgExt;
ReadCFG;
if ParamCount > 0 then
begin
tmpSt := UpString(ParamStr(1));
if (tmpSt = '-NOLOG') or (tmpSt = '/NOLOG')
then logon := False;
if (tmpSt = '-LOGON') or (tmpSt = '/LOGON')
then logon := True;
if (tmpSt = '-CONFIG') or (tmpSt = '/CONFIG')
then
begin
Configure;
Halt;
end;
if (tmpSt[1]<>'-') and (tmpSt[1]<>'/') then curDScript := tmpSt;
end;
Assign(logFile, logName);
Assign(tmpFile, tmpName);
if logon then
begin
{$I-}
Append(logFile);
{$I+}
if IOResult <> 0 then
begin
{$I-}
Rewrite(logFile);
{$I+}
if IOResult <> 0 then
begin
WriteLn('Ошибка при создании файла-лога!');
Halt;
end;
end;
Write(logFile, '=> diwr: [* Запуск *] / ');
logWrTimeDate;
WriteLn(logFile, '/');
Close(logFile);
end;{if logon ...}
{ ClrScr;}
SetCurColor(MainWinColor);
if logon then
begin
{$I-}
Append(logFile);
{$I+}
if IOResult = 0 then
begin
logTimeWr;
Write(logFile, 'Загружена палитра: {');
Write(logFile, WinAttr, '; ');
Write(logFile, WBorderAttr, '; ');
Write(logFile, WinHAttr, '; ');
Write(logFile, MnAttrK, '; ');
Write(logFile, MnAttrM, '; ');
Write(logFile, ButtAttr, '; ');
Write(logFile, ButtLight, '; ');
Write(logFile, ButtShadow, '; ');
Write(logFile, txAttr, '; ');
WriteLn(logFile, ErAttr, '} ');
Close(logFile);
end;
end;
CursorOff;
SaveBar(1, 1, 80, 25);
WaitRetrace;
SetWindow(1, 1, 80, 25, 2, HeadString, True);
SetWindow(1, 1, 26, 25, 1, StatString, True);
Border(1, 1, 80, 25, 2);
Border(26, 1, 56, 2, 1);
for i := 1 to Length(HeadString) do
WriteCharXY(i+26, 1, WinHAttr, HeadString[i]);
for i := 1 to Length(StatString) do
WriteCharXY(i+4, 2, WinHAttr, StatString[i]);
WriteCharXY(26, 1, WBorderAttr, #184);
WriteCharXY(26, 25, WBorderAttr, #207);
WriteCharXY(26, 2, WBorderAttr, #195);
WriteCharXY(56, 1, WBorderAttr, #213);
for i := 1 to 24 do
WriteCharXY(i+1, 3, WinHAttr, #196);
{ UndoMenu;}
PutCursor(2, 4);
WriteLine('Описание текущей работы: ', txAttr);
PutCursor(2, 6);
WriteLine('Файл '+curDScript, txAttr);
CheckCplDScript;
LogWr('Начало обработки дискеты...');
DoWork;
LogWr('Окончание обработки дискеты...');
RestoreScreen;
ZZCursor;
CursorOn;
{ curDScript := 'st.ds';}
if logon then
begin
{$I-}
Append(logFile);
{$I+}
if IOResult = 0 then
begin
Write(logFile, '=> diwr: [* Завершение работы... *] (');
logWrTimeDate;
WriteLn(logFile, ')');
WriteLn(logFile, '===---===---===---===---===---===---===---===---===---===---===---===---===---==');
Close(logFile);
end;
end;{logon}
Erase(tmpFile);
RestoreScreen;
{ ClearScreen;}
end.
< -->