PROGRAM STIRATEL;  {УТИЛИТА СТИРАНИЯ}
uses Dos, CRT;
VAR Q, W, E, R, Q0, W0, Y0, QQ0, WW0, T100: SHORTINT; VAR QQ, WW, EE, RR, TT, YY, UU: INTEGER;

VAR Q1, W1, E1, R1, T1, Y1, U1: REAL;
VAR Q2, W2, E2, R2, T2, Y2, U2, I2: LONGINT; VAR Q3, W3, E3 ,R3, T3, Y3, U3    :BYTE;

VAR QQQ, WWW, EEE, RRR:         BOOLEAN;
VAR Q4, W4, E4:           POINTER;
VAR Q5, W5, E5, R5, T5, Y5, U5, I5, O5, P5, A5,S5, D5,F5,G5: CHAR;
VAR Q8, W8, E8, R8, T8, Y8, U8: WORD;
LABEL 1, 2, 3, 4, 5, 7, 8,9,10, 11, 12, 13, 20, 100, 14,15,16,17,18,19,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40; CONST ASDQ=1;ASDW=2;ASDF='A.S';
VAR Q7, W7: FILE;

UUUUU:ARRAY[1..256] OF BYTE;
VAR ASD2, ZXC2:LONGINT;
PROCEDURE HELPUH;
BEGIN;
WRITELN('');
WRITE('ПРИВЕТ ,В НАТУРЕ . ДМИТРИЙ КОРЯГИН ПРЕДСТАВЛЯЕТ АФИГЕННО НУЖНУЮ И ПОЛЕЗНУЮ УТИЛИТУ РАСШИРЕННОГО СТИРАНИЯ '); WRITE('ФАЙЛОВ ДЛИНОЙ ДО 2 ГИГ "СТИРАТЕЛЬ 1.02". НУ, ТИПА ТОГО ,КАК-БЫ ТАК,САМУ УТИЛИТУ ЖЕЛАТЕЛЬНО ПРИСТЕГНУТЬ К НОРТОНУ ИЛ'); WRITE('И РАЗМЕСТИТЬ В КАКОМ-НИБУТЬ КАТАЛОГЕ ,УКАЗАННОМ В СТРОКЕ PATH ФАЙЛА AUTOEXET.BAT (C:\DOS , C:\WINDOWS , C:\WINDOWS\'); WRITE('COMMAND  И Т. Д. ,МОЖНО ВО ВСЕХ СРАЗУ). ТОГДА, В СТАДАРТНОМ СЛУЧАЕ, ПРИНЦИП ПРИМЕНЕНИЯ СЕЙ МИКСТУРЫ ТАКОВ: '); WRITE('СНЯТЬ ЗАЩИТНЫЕ АТРИБУТЫ СО СТИРАЕМОГО ФАЙЛА , ЕСЛИ ОНИ ЕСТЬ.В ПРОТИВНОМ СЛУЧАЕ,ВАШИ ДИВНЫЕ ГЛАЗЕЛКИ ');

WRITE(' СМОГУТ НАСЛАДИТЬСЯ СОЗЕРЦАНИЕМ СООБЩЕНИЯ ОБ ОШИБКЕ.ЗНАТОКИ АСТМЫ И ВСЕ КТО ПРИВЫК СЧИТАТЬ '); WRITE('БАКСЫ В ШЕСТНАДЦАТИРИЧНОЙ ФОРМЕ СЧИСЛЕНИЯ,БЕЗ ТРУДА ПОЙМУТ ЧТО ТАМ НАПИСАНО. КАТАЛОГ СО ');
WRITE('СТИРАЕМЫМ ФАЙЛОМ ДЕЛАЕТСЯ ТЕКУЩИМ, В КОМАНДНОЙ СТРОКЕ НАБИРАЕТСЯ ИМЯ ФАЙЛА УТИЛИТЫ И, ЧЕРЕЗ ПРОБЕЛ , ИМЯ '); WRITE('СТИРАЕМОГО ФАЙЛА ,КАК ОНО ВИДИТСЯ В ДОСЕ (НАПРИМЕР:  STIRATEL.EXE KARTINA.GIF  , ИЛИ  STIRATEL KARTINA.GIF '); WRITE(', ИЛИ С ИСПОЛЬЗОВАНИЕМ  КЛЮЧА <A> : STIRATEL KARTINA.GIF A ,В ЭТОМ СЛУЧАЕ ФАЙЛ УНИЧТОЖАЕТСЯ АВТОМАТИЧЕСКИ '); WRITE('АНАЛОГИЧНО ПУНКТУ 4 ВСПЛЫВАЮЩЕГО МЕНЮ.)');
WRITE(',ЖМЁТСЯ ENTER. ДАЛЕЕ СМОТРИ ВСПЛЫВАЮЩЕ ПОДПЛЫВАЮЩЕЕ МЕНЮ. ');
WRITE('НАБИРАЕТСЯ НУЖНОЕ ЧИСЛО,НАЖИМАЕТСЯ ENTER. ПУНКТ 4 ОБОЗНАЧАЕТ, ЧТО ФАЙЛ ПЕРЕД СТИРАНИЕМ ПОЛУЧИТ ИМЯ ');

WRITE(' 00000000.000 , ВО ИЗБЕЖАНИЕ КОНФЛИКТА , НЕОБХОДИМО ЧТОБЫ ФАЙЛА С ТАКИМ ИМЕНЕМ В ДАННОМ КАТАЛОГЕ НЕ БЫЛО. '); WRITE('НЕДОКУМЕНТИРУЕМОЕ ДВУХЗНАЧНОЕ ЧИСЛО ВЫЗЫВАЕТ ДОПОЛНИТЕЛЬНЫЕ ЭФФЕКТЫ ЛУЧШЕ ВСЕГО ПРОЯВЛЯЮЩИЕСЯ ПРИ ЯРКО СИНЕМ '); WRITE('ЦВЕТЕ ДОС ШРИФТА. ПОПЫТКА ВОССТАНОВЛЕНИЯ СТЁРТОГО ФАЙЛА НЕСЁТ В СЕБЕ МНОГО ЦЕННОЙ ЛЕГКОУСВОЯЕМОЙ ИНФОРМАЦИИ ! '); WRITE('  ПРОГРАММА ЯВЛЯЕТСЯ FREEWARE ВЕРСИЕЙ , И ЕЁ АВТОР НЕ НЕСЁТ НИКАКОЙ ОТВЕТСТВЕННОСТИ ЗА РЕЗУЛЬТАТЫ ЕЁ ПРИМЕНЕНИЯ.'); WRITELN('');
END;
PROCEDURE AU256;
LABEL 1,2,3,4,5;
CONST   Y000=256;
BEGIN;
ASSIGN(Q7,'00000000.000');RESET(Q7,1);
IF FILESIZE(Q7)<257 THEN GOTO 1 ELSE GOTO 2;
2: SEEK(Q7,Y000);TRUNCATE(Q7); {УСЕКАЕТ ДЛИНУ}
1: CLOSE(Q7);
END;
PROCEDURE DURILKA;
BEGIN;
I2:=1234567; ASSIGN(Q7,'00000000.000');RESET(Q7);SETFTIME(Q7,I2);CLOSE(Q7);
END;
BEGIN; {НАЧАЛО}
UUUUU[1]:=141; UUUUU[2]:=133; UUUUU[3]:=148;UUUUU[4]:=136;UUUUU[5]:=131;

UUUUU[6]:=32;UUUUU[7]:=135; UUUUU[8]:=155;  UUUUU[9]:=144; UUUUU[10]:=136; UUUUU[11]:=146;  UUUUU[12]:=156;UUUUU[13]:=33; IF UUUUU[12]<>156 THEN GOTO 100;
IF UUUUU[7]<>135 THEN GOTO 100; IF UUUUU[4]<>136 THEN GOTO 100; IF UUUUU[9]<>144 THEN GOTO 100;
7:ASSIGN(Q7,ParamStr(1)); RESET(Q7,1);
WRITELN(' КОД СМЕРТИ НАБРАН ::::  ',ParamStr(1));
Q2:= FileSizE(Q7);
IF ParamStr(2)='A' THEN BEGIN
 Q:=1;GOTO 5;
 END;
IF ParamStr(2)='a' THEN BEGIN
 Q:=1;GOTO 5;
 END;
2:GOTO 1;
3:WRITELN('НЕ ПОПАЛ , ПОПРОБУЙ ЕЩЁ.');
1: Writeln('    РАЗМЕР ФАЙЛА В БАЙТАХ: ', FileSize (Q7),' ИСКЛЮЧЕНИЕ ИЗ РЕАЛЬНОСТИ :'); Writeln('       ВВЕДИ:  1 - ДА     2 - НЕТ     3 - ПОМОЩЬ     4 - НАГРАЖДЁН ПОСМЕРТНО'); READ (Q3); CASE (Q3) OF
1:GOTO 5;
2:GOTO 8;
3: HELPUH;
21:GOTO 12;
22: BEGIN;
    TextMode(CO80);GOTO 12;
    END;
25: BEGIN;
    W:=1;GOTO 5;
    END;
4: GOTO 11; ELSE GOTO 3;
END;
GOTO 1;
12: W:=1;TextColor(9);TextBackground(0);GOTO 5;
11: Q:=1;GOTO 5;
5: Q2:=Q2-1; U2:=256;
9: FOR E2:=W2 TO Q2 DO  GOTO 10;

IF Q=1 THEN GOTO 13 ELSE GOTO 18; 18:IF W=1 THEN GOTO 13 ELSE GOTO 4; 10: SEEK(Q7,E2); BLOCKWRITE(Q7,UUUUU,U2); W2:=W2+256;
IF W=1 THEN WRITE('* ',E2,' *  ') ELSE GOTO 9;
GOTO 9;
4: CLOSE (Q7); ERASE(Q7);
GOTO 14;
13: CLOSE (Q7); RENAME (Q7,'00000000.000');AU256;DURILKA; ERASE(Q7);
14: WRITELN(''); WRITELN('В  НАТУРЕ , ВСЁ  В  АЖУРЕ!'); GOTO 100; 8: CLOSE (Q7);
100: END.