Program GraphDetector;
{$G+}
const
  HS: array [0..15] of Char = '0123456789ABCDEF';
type
   TSVGAMode = record
    Mode:Byte;
    NClearVM, Stdrt, NStdrt, AppFast, LFB, NCVM : Boolean;
    Res : Byte;
   end;
type
  TS = array [0..65500] of Char;
  TW = array [0..32765] of Word;
  TNM = array [1..1024] of Word;
type
   TGeneralSVGAInfoBuffer = record
     VESA_VBE2 : array [0..3] of Char;
     VBEversion : Word;{! BCD}
     ProdIdentStr : ^TS;
     FlagFirst : Byte;
     FlagReserv : array [0..2] of Byte;
     SVGAModeList : ^TW;
     VMSize : Word; {В блоках по 64 Kb}
     InteriorVersion : Word;
     ProdNameStr : ^TS;
     VAdaptNameStr : ^TS;
     VerAdaptStr : ^TS;
     VBE_AFversion : Word;{1 BCD}
     AppFastModesList : ^TW;
     VESAReserv : array [0..215] of Byte;
     VBEDataReserv : array [0..255] of Byte;
   end;
type
   TSVGAModeInfoBuffer = record
     AttribMode : Word;
     WinA_Attr : Byte;
     WinB_Attr : Byte;
     WinGranul : Word;{ Kb}
     WinSize : Word;{ Kb}
     WinA_Seg : Word;
     WinB_Seg : Word;
     TransLockProc : Pointer;
     LogStrSize : Word;{Целых байт}
     Width : Word;{В пикселах или символах}
     Height : Word;{В пикселах или символах}
     SimbolWidth : Byte;{Pix}
     SimbolHeight : Byte;{Pix}
     Planes : Byte;
     BitPerPix : Byte;
     Banks : Byte;
     MemoryModel : Byte;
     BankSize : Byte;
     VideoPages : Byte;
     Reserv1 : Byte;
     BitMaskRed : Byte;
     FirstBitRed : Byte;
     BitMaskGreen : Byte;
     FirstBitGreen : Byte;
     BitMaskBlue : Byte;
     FirstBitBlue : Byte;
     BitMaskReserv : Byte;
     FirstBitReserv : Byte;
     Addition : Byte;
     LFB_Physics : Pointer;
     LFB_Offset : LongInt;
     NoMapLFB : Word;{ Kb}
     Reserv2 : array [0..205] of Byte;
   end;
type
  TFlag = record
    ADC_8bit : Boolean; {Analog-Digital Converter, АЦП, Аналого-цифровой преобр-ль}
    VGAIncompatible : Boolean;
    ADC_RevRayTrace : Boolean;
    VBE_AF_Support : Boolean;
    EnableDirectAccessReq : Boolean;
    AppMouseInd : Boolean;
    AppClipping : Boolean;
    AppBitBlt : Boolean;
  end;
type
  TAttribMode = record
    ModePresent : Boolean;
    PaddInfoPresent : Boolean;{Padding - Дополнительная инф-ция}
    TxBIOSOutpSupport : Boolean;
    ColoredMode : Boolean;
    GraphicsMode : Boolean;
    VGAIncomp : Boolean;
    BankSwitchNotSupp : Boolean;
    LFBNotSupp : Boolean;
    Undef : Boolean;
    EnableDirectAccessRq : Boolean;
    Undef7Bit : Byte;
  end;
type
  TWinAttr = record
    WinPresent : Boolean;
    ReadPermit : Boolean;{Чтение разрешено}
    WritePermit : Boolean;{Запись разрешена}
    OddMent : Byte;{Осаток}
  end;
var
  i, j, k : Word;
  xt, yt : Byte;
  St : String;
var
  SVGAMode: TSVGAMode;
  GeneralSVGAInfo : TGeneralSVGAInfoBuffer;
  SVGAModeInfo : TSVGAModeInfoBuffer;
  Flag : TFlag;
  ModeAttr : TAttribMode;
  WinAttr : TWinAttr;
  NM : TNM;
  f : Text;
Procedure SetGrMode(GrMode:Word);Assembler;
asm
   mov ax, word ptr GrMode
   int 10h
end;
{------------------}
Procedure DecodeSVGAMode(SVGA:Word);
begin
asm
   push ds
   mov bx, seg SVGAMode
   mov ds, bx
   mov bx, offset SVGAMode
   mov ax, word ptr SVGA
   push ax
   and ax, 01111111b
   mov byte ptr [bx], al
   pop ax
   push ax
   and ax, 10000000b
   shr ax, 7
   mov byte ptr [bx+1], al
   pop ax
   push ax
   and ax, 100000000b
   shr ax, 8
   mov byte ptr [bx+2], al
   pop ax
   push ax
   and ax, 1000000000b
   shr ax, 9
   mov byte ptr [bx+3], al
   pop ax
   push ax
   and ax, 10000000000000b
   shr ax, 13
   mov byte ptr [bx+4], al
   pop ax
   push ax
   and ax, 100000000000000b
   shr ax, 14
   mov byte ptr [bx+5], al
   pop ax
   push ax
   and ax, 1000000000000000b
   shr ax, 15
   mov byte ptr [bx+6], al
   pop ax
   push ax
   and ax, 1110000000000b
   shr ax, 10
   mov byte ptr [bx+7], al
   pop ax
   pop ds
end
end;
{------------------}
Function Conv2SVGAMode:Word;{Конвертация в номер видеорежима}
begin
asm
   push ds
   mov bx, seg SVGAMode
   mov ds, bx
   mov bx, offset SVGAMode
   mov ax, 0
   mov al, byte ptr [bx]
   mov dl, byte ptr [bx+1]
   and dl, 1
   shl dx, 7
   or  ax, dx
   mov dl, byte ptr [bx+2]
   and dl, 1
   shl dx, 8
   or  ax, dx
   mov dl, byte ptr [bx+3]
   and dl, 1
   shl dx, 9
   or  ax, dx
   mov dl, byte ptr [bx+4]
   and dl, 1
   shl dx, 13
   or  ax, dx
   mov dl, byte ptr [bx+5]
   and dl, 1
   shl dx, 14
   or  ax, dx
   mov dl, byte ptr [bx+6]
   and dl, 1
   shl dx, 15
   or  ax, dx
   pop ds
end
end;
{------------------}
Function GetGeneralSVGAInfo:Word;Assembler;
asm
   mov ax, 4F00h
   mov bx, seg GeneralSVGAInfo
   mov es, bx
   mov di, offset GeneralSVGAInfo
   int 10h
end;
{------------------}
Function GetSVGAInfo(Mode : Word):Word;Assembler;
asm
   mov ax, 4F01h
   mov bx, seg SVGAModeInfo
   mov es, bx
   mov di, offset SVGAModeInfo
   mov cx, word ptr Mode
   int 10h
end;
{------------------}
Procedure DecodeFlag(Flag_:Byte);
begin
asm
   push ds
   mov bx, seg Flag
   mov ds, bx
   mov bx, offset Flag
   mov al, byte ptr Flag_
   push ax
   and al, 1
   mov byte ptr [bx], al
   pop ax
   push ax
   shr al, 1
   and al, 1
   mov byte ptr [bx+1], al
   pop ax
   push ax
   shr al, 2
   and al, 1
   mov byte ptr [bx+2], al
   pop ax
   push ax
   shr al, 3
   and al, 1
   mov byte ptr [bx+3], al
   pop ax
   push ax
   shr al, 4
   and al, 1
   mov byte ptr [bx+4], al
   pop ax
   push ax
   shr al, 5
   and al, 1
   mov byte ptr [bx+5], al
   pop ax
   push ax
   shr al, 6
   and al, 1
   mov byte ptr [bx+6], al
   pop ax
   push ax
   shr al, 7
   and al, 1
   mov byte ptr [bx+7], al
   pop ax
   pop ds
end
end;
{------------------}
Procedure DecodeAttribMode(Attr : Word);
begin
asm
   push ds
   mov bx, seg ModeAttr
   mov ds, bx
   mov bx, offset ModeAttr
   mov ax, word ptr Attr
   push ax
   and ax, 1
   mov byte ptr [bx], al
   pop ax
   push ax
   shr ax, 1
   and ax, 1
   mov byte ptr [bx+1], al
   pop ax
   push ax
   shr ax, 2
   and ax, 1
   mov byte ptr [bx+2], al
   pop ax
   push ax
   shr ax, 3
   and ax, 1
   mov byte ptr [bx+3], al
   pop ax
   push ax
   shr ax, 4
   and ax, 1
   mov byte ptr [bx+4], al
   pop ax
   push ax
   shr ax, 5
   and ax, 1
   mov byte ptr [bx+5], al
   pop ax
   push ax
   shr ax, 6
   and ax, 1
   mov byte ptr [bx+6], al
   pop ax
   push ax
   shr ax, 7
   and ax, 1
   mov byte ptr [bx+7], al
   pop ax
   push ax
   shr ax, 8
   and ax, 1
   mov byte ptr [bx+8], al
   pop ax
   push ax
   shr ax, 9
   and ax, 1
   mov byte ptr [bx+9], al
   pop ax
   push ax
   shr ax, 10
   mov byte ptr [bx+10], al
   pop ax
   pop ds
end
end;
{------------------}
Procedure DecodeWinAttrib(Attr : Byte);
begin
asm
   push ds
   mov bx, seg WinAttr
   mov ds, bx
   mov bx, offset WinAttr
   mov al, byte ptr Attr
   push ax
   shr al, 1
   and al, 1
   mov byte ptr [bx], al
   pop ax
   push ax
   shr al, 2
   and al, 1
   mov byte ptr [bx+1], al
   pop ax
   push ax
   shr al, 3
   and al, 1
   mov byte ptr [bx+2], al
   pop ax
   push ax
   pop dx
   and al, 1
   shr dl, 3
   or al, dl
   mov byte ptr [bx+3], al
   pop ds
end
end;
{------------------}
Function HexW(X: Word): String;
  {Возвращает 16-ричное написание Х}
var
  S: String;
  k: Byte;
begin
  S := '';
  for k := 3 downto 0 do
   begin
   if (X shr (k*4)) and 15 = 0 then
    if Length(S)=0 then Continue;
    S := S+HS[(X shr (k*4)) and 15];
   end;
  if Length(S) = 0 then S := '0';
  if S=' ' then S := '0';
  HexW := S
end;  {HexW}
{=+=+=+=+=+=+=+=+=+=++=+=+=+=+=+=+}
Procedure ModeInfo(Mode_ : Word);
var
  i : Word;
begin
{    Mode, NClearVM, Stdrt, NStdrt, AppFast, LFB, NCVM : Byte}
  WriteLn(f, '#####   Информация о режиме '+HexW(Mode_)+'h:   ##### ');
  DecodeSVGAMode(Mode_);
  with SVGAMode do
  begin
    WriteLn(f, 'Режим SVGA: '+HexW(Mode)+'h');
    WriteLn(f, 'Резерв: '+HexW(Res)+'h');
      if NClearVM then
       WriteLn(f, '---> Видеопамять не очищается, если остальные - нули')
      else
       WriteLn(f, '---> При установке режима видеопамять очищается');
      if Stdrt then
       WriteLn(f, '---> Стандартный VBE SVGA-режим')
      else
       WriteLn(f, '---> Нестандартный VBE SVGA-режим');
      if NStdrt then
       WriteLn(f, '---> Нестандартный SVGA-режим')
      else
       WriteLn(f, '---> Стандартный SVGA-режим');
      if AppFast then
       WriteLn(f, '---> Использует аппаратное ускорение')
      else
       WriteLn(f, '---> Не использует аппаратное ускорение');
      if LFB then
       WriteLn(f, '---> Использует LFB')
      else
       WriteLn(f, '---> Не использует LFB');
      if NCVM then
       WriteLn(f, '---> При установке режима видеопамять очищается')
      else
       WriteLn(f, '---> При установке режима видеопамять не очищается');
  end;
  GetSVGAInfo(Mode_);
  with SVGAModeInfo do
  begin
    DecodeAttribMode(AttribMode);
    with ModeAttr do
    begin
      if ModePresent then
        WriteLn(f, '---> Режим присутствует')
      else
        WriteLn(f, '---> Режим отсутствует');
      if PaddInfoPresent then
        WriteLn(f, '---> Дополнительная информация присутствует')
      else
        WriteLn(f, '---> Дополнительная информация отсутствует');
      if TxBIOSOutpSupport then
        WriteLn(f, '---> Поддерживается вывод текста на экран средствами BIOS')
      else
        WriteLn(f, '---> Вывод текста на экран средствами BIOS не поддерживается');
      if ColoredMode then
        WriteLn(f, '---> Режим цветной')
      else
        WriteLn(f, '---> Режим чёрно-белый');
      if GraphicsMode then
        WriteLn(f, '---> Режим графический')
      else
        WriteLn(f, '---> Режим текстовый');
      if VGAIncomp then
        WriteLn(f, '---> Несовместим с VGA')
      else
        WriteLn(f, '---> Совместим с VGA');
      if BankSwitchNotSupp then
        WriteLn(f, '---> Не поддерживается переключение банков')
      else
        WriteLn(f, '---> Переключение банков поддерживается');
      if LFBNotSupp then
        WriteLn(f, '---> Не поддерживается LFB')
      else
        WriteLn(f, '---> LFB поддерживается');
      if UnDef then
        WriteLn(f, '---> Неопределённый бит равен 1')
      else
        WriteLn(f, '---> Неопределённый бит равен 0');
      if EnableDirectAccessRq then
        WriteLn(f, '---> Требуется вызов EnableDirectAccess перед переключением банков')
      else
        WriteLn(f, '---> Вызов EnableDirectAccess перед переключением банков не требуется');
    Write(f, 'Семь неопределённых бит равны: ');
    WriteLn(f, HexW(Undef7Bit));
    end;
  DecodeWinAttrib(WinA_Attr);
  WriteLn(f, '^^^ ^^ Окно A ^^ ^^^');
  with WinAttr do
  begin
    if WinPresent then
      WriteLn(f, '---> Окно существует')
    else
      WriteLn(f, '---> Окна нет');
    if ReadPermit then
      WriteLn(f, '---> Чтение из окна разрешено')
    else
      WriteLn(f, '---> Чтение из окна запрещено');
    if WritePermit then
      WriteLn(f, '---> Запись в окно разрешена')
    else
      WriteLn(f, '---> Запись в окно запрещена');
    Write(f, 'Остаток равен: ');
    WriteLn(f, HexW(OddMent));
  end;
  DecodeWinAttrib(WinB_Attr);
  WriteLn(f, '^^^ ^^ Окно B ^^ ^^^');
  with WinAttr do
  begin
    if WinPresent then
      WriteLn(f, '---> Окно существует')
    else
      WriteLn(f, '---> Окна нет');
    if ReadPermit then
      WriteLn(f, '---> Чтение из окна разрешено')
    else
      WriteLn(f, '---> Чтение из окна запрещено');
    if WritePermit then
      WriteLn(f, '---> Запись в окно разрешена')
    else
      WriteLn(f, '---> Запись в окно запрещена');
    Write(f, 'Остаток равен: ');
    WriteLn(f, HexW(OddMent));
  end;
  Str(WinGranul, St);
  WriteLn(f, 'Гранулярность окна - '+St+' Kb');
  Str(WinSize, St);
  WriteLn(f, 'Размер окна - '+St+' Kb');
  WriteLn(f, 'Сегментный адрес окна A: '+HexW(WinA_Seg)+'h');
  WriteLn(f, 'Сегментный адрес окна B: '+HexW(WinB_Seg)+'h');
  Write(f, 'Адрес процедуры перемещения окна: ');
  WriteLn(f, HexW(Seg(TransLockProc^))+'h:'+HexW(Ofs(TransLockProc^))+'h');
  Str(LogStrSize, St);
  WriteLn(f, 'В логической строке '+St+' целых байт');
  Str(Width, St);
  WriteLn(f, 'Ширина в пикселах или символах: '+ St);
  Str(Height, St);
  WriteLn(f, 'Высота в пикселах или символах: '+ St);
  Str(SimbolWidth, St);
  WriteLn(f, 'Ширина символов в пикселах: '+ St);
  Str(SimbolHeight, St);
  WriteLn(f, 'Высота символов в пикселах: '+ St);
  Str(Planes, St);
  WriteLn(f, 'Число плоскостей памяти: '+ St);
  Str(BitPerPix, St);
  WriteLn(f, 'Число бит на пиксел: '+ St);
  Str(Banks, St);
  WriteLn(f, 'Число банков: '+ St);
   Write(f, 'Модель памяти('+HexW(MemoryModel)+'h): ');
   case MemoryModel of
    $00:WriteLn(f, 'ТЕКСТ');
    $01:WriteLn(f, 'CGA-графика');
    $02:WriteLn(f, 'HGC-графика');
    $03:WriteLn(f, 'EGA-графика(16 цветов)');
    $04:WriteLn(f, 'VGA-графика(256 цветов в одной плоскости)');
    $05:WriteLn(f, 'Режим X (256 цветов в разных плоскостях)');
    $06:WriteLn(f, 'RGB(15-битный или выше)');
    $07:WriteLn(f, 'YUV');
    $08..$0F:WriteLn(f, 'VESA');
    $10..$FF:WriteLn(f, 'Нестандартная модель');
   end;
  Str(BankSize, St);
  WriteLn(f, 'Размер банка: '+St+' Kb');
  Str(VideoPages, St);
  WriteLn(f, 'Число видеостраниц: '+St);
  WriteLn(f, 'Значение зарезервированного байта: '+HexW(Reserv1)+'h');
  WriteLn(f, 'Битовая маска красной компоненты: '+HexW(BitMaskRed)+'h');
  Str(FirstBitRed, St);
  WriteLn(f, 'Первый бит красной компоненты: '+St);
  WriteLn(f, 'Битовая маска зелёной компоненты: '+HexW(BitMaskGreen)+'h');
  Str(FirstBitGreen, St);
  WriteLn(f, 'Первый бит зелёной компоненты: '+St);
  WriteLn(f, 'Битовая маска синей компоненты: '+HexW(BitMaskBlue)+'h');
  Str(FirstBitBlue, St);
  WriteLn(f, 'Первый бит синей компоненты: '+St);
  WriteLn(f, 'Битовая маска зарезервированной компоненты: '+HexW(BitMaskReserv)+'h');
  Str(FirstBitReserv, St);
  WriteLn(f, 'Первый бит зарезервированной компоненты: '+St);
   case Addition and 1 of
    1:WriteLn(f, 'Поддерживается перепрограммирование цветов (п/ф 09h)');
    0:WriteLn(f, 'Перепрограммирование цветов не поддерживается');
   end;
   case Addition and 2 of
    0:WriteLn(f, 'Приложение не может использовать биты в зарезервированной компоненте');
    1:WriteLn(f, 'Приложение может использовать биты в зарезервированной компоненте');
   end;
  WriteLn(f, 'Дополнительное поле^^^: '+HexW(Addition)+'h');
  Write(f, 'Физический адрес начала LFB: ');
  WriteLn(f, HexW(Seg(LFB_Physics^))+'h:'+HexW(Ofs(LFB_Physics^))+'h');
  Write(f, 'Смещение от начала LFB до первого байта на экране: ');
  WriteLn(f, HexW(Hi(LFB_Offset))+'|'+HexW(Lo(LFB_Offset)));
  Str(NoMapLFB, St);
  WriteLn(f, 'Размер памяти в LFB, не отображающийся на экране: '+St+' Kb');
    WriteLn(f, 'РЕЗЕРВ: ');
    for j := 0 to 12 do
    begin
    for i := 1 to 16 do Write(f, HexW(Reserv2[16*j+i-1])+' ');
    WriteLn(f, '')
    end;
    WriteLn(f, '---CHAR---  "РЕЗЕРВ" ---CHAR--- ');
    for i := 0 to 205 do Write(f, Char(Reserv2[i])+' ');
    WriteLn(f, '');
    WriteLn(f, '----- конец "РЕЗЕРВ" -------- ');
    WriteLn(f, '================================================');
  end;
end;
{------------------------}
begin
  Assign(f, 'GrphFile.shu');
  ReWrite(f);
  SetGrMode($3);
  xt := 1;
  yt := 1;
  WriteLn(f, '-=-=-=-=-=-=-=-=-=-==========================-=-=-=-=-=-=-=-=-=-=--=');
  WriteLn(f, '               Получение общей SVGA информации...');
  WriteLn(f, '-=-=-=-=-=-=-=-=-=-==========================-=-=-=-=-=-=-=-=-=-=--=');
  GeneralSVGAInfo.VESA_VBE2:='VBE2';
  k := GetGeneralSVGAInfo;
  with GeneralSVGAInfo do
  begin
    if k = $004F then WriteLn(f, 'Данные получены!')
      else
      begin
        WriteLn(f, 'Произошла ОШИБКА!');
        if Lo(k) <> $004F then WriteLn(f, 'Функция не поддерживается.');
        if Hi(k) = 1 then WriteLn(f, 'Данные не получены.');
        Close(f);
        Halt;
      end;
    Write(f, 'Заголовок: ');
    WriteLn(f, VESA_VBE2);
    WriteLn(f, 'Версия: '+HexW(Hi(VBEversion))+'.'+ HexW(Lo(VBEversion)));
    Write(f, 'Внутренняя версия данной реализации VBE: ');
    St :=HexW(InteriorVersion shr 8)+'.'+HexW(InteriorVersion and $00FF);
    WriteLn(f, St);
    WriteLn(f, 'Версия: VBE/AF: '+HexW(Hi(VBE_AFversion))+'.'+ HexW(Lo(VBE_AFversion)));
    WriteLn(f, 'Адрес строки производителя: '+HexW(Seg(ProdIdentStr^))+':'+HexW(Ofs(ProdIdentStr^)));
    Write(f, 'Адрес строки с названием производителя: ');
    Write(f, HexW(Seg(ProdNameStr^))+':');
    WriteLn(f, HexW(Ofs(ProdNameStr^)));
    Write(f, 'Адрес строки с названием адаптера: ');
    Write(f, HexW(Seg(VAdaptNameStr^))+':');
    WriteLn(f, HexW(Ofs(VAdaptNameStr^)));
    Write(f, 'Адрес строки с версией адаптера: ');
    Write(f, HexW(Seg(VerAdaptStr^))+':');
    WriteLn(f, HexW(Ofs(VerAdaptStr^)));
    Write(f, 'Адрес списка доступных режимов: ');
    Write(f, HexW(Seg(SVGAModeList^))+':');
    WriteLn(f, HexW(Ofs(SVGAModeList^)));
    Write(f, 'Адрес списка режимов,');
    Write(f, '  поддерживающих аппаратное ускорение: ');
    Write(f, HexW(Seg(AppFastModesList^))+':');
    WriteLn(f, HexW(Ofs(AppFastModesList^)));
    WriteLn(f, 'Значение флага: '+HexW(FlagFirst));
    WriteLn(f, '>>> Поля флага означают: ');
    DecodeFlag(FlagFirst);
    with Flag do
    begin
      if ADC_8Bit then
       WriteLn(f, '---> АЦП поддерживает 8-битовые цветовые компоненты')
      else
       WriteLn(f, '---> АЦП не поддерживает 8-битовые цветовые компоненты');
      if VGAIncompatible then
       WriteLn(f, '---> Видеоадаптер несовместим с VGA')
      else
       WriteLn(f, '---> Видеоадаптер совместим с VGA');
      if ADC_RevRayTrace then
       WriteLn(f, '---> АЦП можно программировать только при обратном ходе луча')
      else
       WriteLn(f, '---> АЦП можно программировать НЕ только при обратном ходе луча');
      if VBE_AF_Support then
       WriteLn(f, '---> Поддерживается спецификация аппаратного ускорения графики')
      else
       WriteLn(f, '---> Спецификация аппаратного ускорения графики не поддерживается');
      if EnableDirectAccessReq then
       WriteLn(f, '---> Требуется вызов EnableDirectAccess перед использованием LFB')
      else
       WriteLn(f, '---> Вызов EnableDirectAccess перед использованием LFB не требуется');
      if AppMouseInd then
       WriteLn(f, '---> Поддерживается аппаратный указатель мыши')
      else
       WriteLn(f, '---> Аппаратный указатель мыши не поддерживается');
      if AppClipping then
       WriteLn(f, '---> Поддерживается аппаратный clipping')
      else
       WriteLn(f, '---> Аппаратный clipping не поддерживается');
      if AppBitBlt then
       WriteLn(f, '---> Поддерживается аппаратный BitBlt')
      else
       WriteLn(f, '---> Аппаратный BitBlt не поддерживается');
    end;
    Write(f, 'Поля - резервы флагов(байты): ');
    for i := 0 to 2 do
     Write(f, '"'+HexW(FlagReserv[i])+'"  ');
    WriteLn(f, '');
    Write(f, 'Размер ВИДЕОпамяти: ');
    Str(VMSize, St);
    Write(f, St+' * 64 Kb = ');
    Str(VMSize*64, St);
    WriteLn(f, St+ ' Kb');
    Write(f, 'Производитель: ');
    i := 0;
    While (ProdIdentStr^[i] <> #0) and (i<100) do
    begin
      Write(f, ProdIdentStr^[i]);
      inc(i);
    end;
    if ProdIdentStr^[0]=#0 then Write(f, '{ Информация отсутствует }');
    WriteLn(f, '');
    Write(f, 'Название производителя: ');
    i := 0;
    While (ProdNameStr^[i] <> #0) and (i<100) do
    begin
      Write(f, ProdNameStr^[i]);
      inc(i);
    end;
    if ProdNameStr^[0]=#0 then Write(f, '{ Информация отсутствует }');
    WriteLn(f, '');
    Write(f, 'Название адаптера: ');
    i := 0;
    While (VAdaptNameStr^[i] <> #0) and (i<100) do
    begin
      Write(f, VAdaptNameStr^[i]);
      inc(i);
    end;
    if VAdaptNameStr^[0]=#0 then Write(f, '{ Информация отсутствует }');
    WriteLn(f, '');
    Write(f, 'Версия адаптера: ');
    i := 0;
    While (VerAdaptStr^[i] <> #0) and (i<100) do
    begin
      Write(f, VerAdaptStr^[i]);
      inc(i);
    end;
    if VerAdaptStr^[0]=#0 then Write(f, '{ Информация отсутствует }');
    WriteLn(f, '');
    WriteLn(f, 'VESA резерв: ');
    for j := 0 to 26 do
    begin
    for i := 1 to 16 do Write(f, HexW(VESAReserv[16*j+i-1])+' ');
    WriteLn(f, '')
    end;
    WriteLn(f, '---CHAR---  "VESA резерв" ---CHAR--- ');
    for i := 0 to 215 do Write(f, Char(VESAReserv[i])+' ');
    WriteLn(f, '');
    WriteLn(f, '----- конец "VESA резерв" -------- ');
    WriteLn(f, '================================================');
    WriteLn(f, 'Резерв данных VBE: ');
    for j := 0 to 15 do
    begin
    for i := 1 to 16 do Write(f, HexW(VBEDataReserv[16*j+i-1])+' ');
    WriteLn(f, '')
    end;
    WriteLn(f, '---CHAR---  "Резерв данных VBE" ---CHAR--- ');
    for i := 0 to 216 do Write(f, Char(VBEDataReserv[i])+' ');
    WriteLn(f, '');
    WriteLn(f, '----- конец "Резерв данных VBE" -------- ');
    WriteLn(f, '++++++++++++++++ Список доступных режимов ++++++++++++++++');
    i := 0;
    While (SVGAModeList^[i] <> $FFFF)  do
    begin
      Write(f, HexW(SVGAModeList^[i])+'h ');
      inc(i);
    end;
    if SVGAModeList^[0]=$FFFF then Write(f, '[] { Список пуст } []')
    else
    begin
     Str(i, St);
     WriteLn(f, 'Всего доступно режимов: '+St);
    end;
    WriteLn(f, '');
    WriteLn(f, '<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>');
    WriteLn(f, '+++++ Список режимов, поддерживающих аппаратное ускорение +++++');
    i := 0;
    While (AppFastModesList^[i] <> $FFFF)  do
    begin
      Write(f, HexW(AppFastModesList^[i])+'h ');
      inc(i);
    end;
    if AppFastModesList^[0]=$FFFF then Write(f, '[] { Список пуст } []');
    WriteLn(f, '');
    WriteLn(f, '<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>');
    i := 0;
    While (SVGAModeList^[i] <> $FFFF)  do
    begin
      NM[i+1]:=SVGAModeList^[i];
      inc(i);
    end;
      NM[i+1]:=SVGAModeList^[i];
    i := 1;
    While (NM[i] <> $FFFF)  do
    begin
      ModeInfo(NM[i]);
      inc(i);
    end;
    WriteLn(f, '');
  end;
  Close(f);
end.

Назад