Program D2DFEFix;
{$X+}
Uses Crt, DOS;

Type
  TPatchList = Packed Record
    Offset: Longint;             { file offset }
    Values: Array[0..1] Of Byte; { old_byte new_byte }
  End;

Const
  PatchByte = 2;

  PatchList: Array[1..PatchByte] Of TPatchList = (
    (Offset: $0000A8B1; Values: ($2D, $00)), { flg always 1 }
    (Offset: $00016178; Values: ($02, $00))  { open() flags: READ|WRITE -> READ only }
  );

  FlName = 'DOOM2D.EXE';
  FlSize = 139835;

{
  since Turbo Pascal can't store strings larger than 255 bytes (ASCII characters)
  here is some very weird way to store as much text as anyone may want
  in dx:ax must be result - segmet:offset for Pointer type
  BTW - saves 640 bytes vs constant strings and a bunch of WriteLn()
}
Function GetInfoText: Pointer; Assembler;
Asm
  mov dx, Seg @text
  mov ax, Offset @text
  ret
@text:
  db 10
  db 'Doom2D Fatal Error Fix',10
  db '~~~~~~~~~~~~~~~~~~~~~~',10
  db 'T#i$ PR0GR@M bY -=CHE@TER=-',10
  db 'web: http://ctpax-cheater.losthost.org/htmldocs/doom2dsg.htm',10
  db 'mailto: _CTPAX_@MAIL.RU',10
  db 10
  db 'Данное исправление отключает в игре Doom2D V1.30 защиту:',10
  db 'FATAL ERROR:',10
  db 'Пожалуйста переустановите игру',10
  db 10
  db 'Это версия исправлет только "DOOM2D.EXE".',10
  db 'Файл "DOOM2D.WAD" теперь полностью игнорируется -',10
  db 'игру можно записать хоть на CD/DVD/BD диск и запускать оттуда.',10
  db 10
  db 'Старая версия: 22:00 26.06.2004',10
  db 'Музыкальная поддержка: Roxette - Listen To Your Heart',10
  db 10
  db 'Новая версия: 04:00 16.01.2013 (обновление: 21:12 28.10.2013; 13:40 28.08.2014)',10
  db 'Музыкальная поддержка: Дельфин - Весна',10
  db 10
  db 'Благодарности: Prikol Software, Grom PE и всему Doom2D.org сообществу.',10
  db 10
  db 'Нажатие любой клавиши исправит ошибку...',10
  db 'А чтобы вернуть все изменения в исходное состояние необходимо нажать "1".',10
  db 0
End;

Procedure ShowInfoText;
Var P: ^Char;
Begin
  P:=GetInfoText;
  While P^ <> #0 Do
  Begin
    If P^ = #10 Then WriteLn Else Write(P^);
    Inc(P);
  End;
End;

Var
     Fl: File;
  FAttr: Word;
  FTime: Longint;
   B, I: Integer;
Begin
  ShowInfoText;
  While KeyPressed Do ReadKey;
  B:=Ord(ReadKey <> '1');
  While KeyPressed Do ReadKey;
  WriteLn;

  Assign(Fl, FlName);
  GetFAttr(Fl, FAttr);
  SetFAttr(Fl, Archive);
  {$I-}
  Reset(Fl, 1);
  {$I+}
  If IOResult = 0 Then
  Begin
    GetFTime(Fl, FTime);
    If FileSize(Fl) = FlSize Then
    Begin
      For I:=1 To PatchByte Do
      Begin
        Seek(Fl, PatchList[I].Offset);
        BlockWrite(Fl, PatchList[I].Values[B], 1);
      End;
      WriteLn('Готово.');
    End
    Else
      WriteLn('ОШИБКА: Неверный размер! Этот файл не "' + FlName + '" V1.30!');
    SetFTime(Fl, FTime);
    Close(Fl);
    SetFAttr(Fl, FAttr);
  End
  Else
    WriteLn('ОШИБКА: Невозможно открыть файл "' + FlName + '" для записи!');
End.
