Cheb's Game Engine

Планы, идеология, архитектура и т.п.

Модератор: Модераторы

Re: Cheb's Game Engine

Сообщение Cheb » 11.09.2015 19:25:38

Изыскания на тему дружественности к кешу. Взял свой дрееевний тест с объектами, связанными цепочкой next/previous, и добавил параллельно массив, в котором хранится та же цепочка.

Результ просчёта физики:
CycleFriendly - 120 наносекунд / шт. Тупым обходом массива.
CycleNonFriendly - 200 наносекунд /шт. Угадайте за счёт чего? Рекурсия, вершина стека всё время ползёт по памяти,

Поправка: 103 и 175 соответственно. Встроенная видяха (сюрприз, сюрприз!) перетягивает ресурсы у ядр процессора, если не убить качество рендера ручную в ноль.

P.P.S. И 375 / 500 в режиме экономии батареи.
Это жалкий миллион просчётов в секунду (10 тысяч на кадр) если брать с запасом.


Код: Выделить всё
  procedure TTest12Data.CycleNonFriendly;
  var
    distance,
    force: float;
    dmx, dmy: float;
    i: integer;
  begin
    if Assigned(next) then next.CycleNonFriendly;
//физега, TL;DR
  end;

  procedure TTest12Data.CycleFriendly;
  var i: integer;
  begin
    if Self <> first then Die(RuEn(
      'Метод CycleFriendly() имеет смысл вызывать только у первого объекта верёвочки.'#10#13'  Искренне ваш, Капитан Очевидность.',
      'The  CycleFriendly() has to be called only on the forst object of the rope.'#10#13'  Sincerely yours, Captain Obvious.'));
    for i:= High(all) downto 0 do all[i].Cycle;
  end;


  procedure TTest12Data.Cycle;
  var
    distance,
    force: float;
    dmx, dmy: float;
    i: integer;
  begin
//такая же физега, TL;DR
  end;


Подробно, физега (для этого теста закомментил вызовы random(), смазывали всю картину):
Код: Выделить всё

procedure TTest12Data.Cycle;
  var
    distance,
    force: float;
    dmx, dmy: float;
    i: integer;
  begin
    if Assigned(next) then begin
      if Assigned(previous) then begin
      distance:=sqrt(sqr(previous.mx - mx) + sqr(previous.my - my));
        if distance < 1 then distance:=1;
        force:= - speed * 0.01 * sqr(PrefDist)/sqr(Distance);
        if force < -5 then force:=-5;
    //    force:=aa * force;
        dmx:= (previous.mx - mx) / distance;
        dmy:= (previous.my - my) / distance;
        mx += force * dmx;
        my += force * dmy;
      end;
    end;
    if Assigned(previous) then begin
      ag:=previous.ag;
      ab:=previous.ab;
      ar:=previous.ar;
      aa:=previous.aa;
      distance:=sqrt(sqr(previous.mx - mx) + sqr(previous.my - my));
      if distance < 1 then distance:=1;
      dmx:= (previous.mx - mx) / distance;
      dmy:= (previous.my - my) / distance;
      if distance > PrefDist
        then begin
          force:= speed * 0.1 * (distance - PrefDist);
          if ag < 0.5 then force:= -force;
        end
        else force:= - speed * 0.1 * PrefDist/Distance;
      if force > 50 then force:=50;
      if force < -5 then force:= -5;
   //   force:=aa * force;
      mx += force * dmx + dx;
      my += force * dmy + dy;

      if mx < -1000 then mx:= -1000;
      if mx > 3000//Mother^.Display.WindowClientRect.Width + 1000
        then mx:=3000;//Mother^.Display.WindowClientRect.Width + 1000;
      if my < -1000 then my:= -1000;
      if my > 2000//Mother^.Display.WindowClientRect.Height + 1000
      then my:= 2000;//Mother^.Display.WindowClientRect.Height + 1000;

//      dx += Speed * 0.01 * (random() - 0.5);
      dx *= 0.98;
//      dy += Speed * 0.01 * (random() - 0.5);
      dy *= 0.98;
     // s += Speed * 0.01 * (PrefSize * (PrefDist/distance) - s);
    end;

    distance:=sqrt(sqr(Module.Logic.mousex - mx) + sqr(Module.Logic.mousey - my));
    if distance < 1 then distance:=1;
    dmx:= (Module.Logic.mousex - mx) / distance;
    dmy:= (Module.Logic.mousey - my) / distance;
    force:=0;
    if ar < 0.5 then force -= speed * 1 * PrefDist / Distance;
    if ab < 0.5 then force += 0.1;
    if force > 5 then force:=5;
    if force < -5 then force:= -5;
  //  force:=aa * force;
    mx += force * dmx;
    my += force * dmy;
  end;

где
Код: Выделить всё
type
  TTest12Data = class;
  TT12Array = array of TTest12Data;
  TTest12Data = class (TcgeObject)//TTrulyPersistent)
  public
    all: TT12Array;
///    _666: integer;
    mx, my, r, g, b, ar, ag ,ab, aa, s, dx, dy: glFloat;
//    m: TImageMode;
//    w,h, t: integer;
//    Oopaloopa: Int64;
//    p: pointer;
//    texture: glUint;
    previous, next, first: TTest12Data;
//    BigBin: TBigBin;
    constructor FirstCreate(prv: TTest12Data); virtual;
    procedure RegisterFields; override;
//    procedure InitTexture;
    procedure Render;
    procedure RenderFirst(OffX, OffY, VsizeX, VsizeY, PixelSize: float);
    procedure Cycle;
    procedure CycleNonFriendly;
    procedure CycleFriendly;
    procedure Scrape; override;
    procedure Grow;
  end; 
Последний раз редактировалось Cheb 11.09.2015 19:42:49, всего редактировалось 2 раз(а).
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 564
Зарегистрирован: 06.06.2005 15:54:34

Re: Cheb's Game Engine

Сообщение runewalsh » 11.09.2015 19:31:10

Cheb писал(а):Отчаялся, и с тяжёлым сердцем решил бросить поддержку Windows 98 :cry: :cry: :cry:

IT HAPPENED
Так-то FBO можно эмулировать, рисуя содержимое на экран и затем копируя в текстуру через glCopyTexImage2D.
Аватара пользователя
runewalsh
постоялец
 
Сообщения: 314
Зарегистрирован: 27.04.2010 00:15:25

Re: Cheb's Game Engine

Сообщение Cheb » 11.09.2015 20:48:58

Неее, там хуже. Там это расширение есть, но не ARB, а EXT.
Оно почти такое же.
Но на таких вот "почти" надрывались титаны духа.

Добавлено спустя 9 минут 25 секунд:
З.Ы. Добавил читерский режим, когда каждая точка верёвочки начинает считаться раз в n кадров, где n = длина / 10000. Причём, не всей сразу, а через каждые n, смещая активную на одну кадый кадр.

Читерская верёвочка ведёт себя почти как настоящая, вплоть до 10 FPS. Вся верёвочка из 100 тыс. точек легковесно порхает на 100 FPS с запасом.
А ведь без чита едва тянуло 30 тыс.

Короче, подогнал тесты под требуемый результат, убедив себя, что мой Хитрый План с редко тикающими объектами кроме особо быстрых/важных даст эпическую производительность на майнкрафтоподобной игре, где 99% объектов - это чанки и падающие партиклы.

Партиклы, мать ихнюю, даже не будут взаимодействовать с другдругом! Накапливаясь, они будут прибавлять к параметру блока "довление", и самовыпихиваться в соседний блок, где оно меньше.

Добавлено спустя 3 минуты 47 секунд:
runewalsh писал(а):рисуя содержимое на экран и затем копируя в текстуру через glCopyTexImage2D.

Мой даавний мод для Quake 2 так и работает для подводного рендера, где надо искажать и размывать картинку.
К слову: Квейк 2/дельфи компилируется только на Турбо Дельфи. С Фри Паскалем исходники (увы) не совместимы.
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 564
Зарегистрирован: 06.06.2005 15:54:34

Re: Cheb's Game Engine

Сообщение скалогрыз » 11.09.2015 21:22:53

runewalsh писал(а):Так-то FBO можно эмулировать, рисуя содержимое на экран и затем копируя в текстуру через glCopyTexImage2D.

а не тормозно будет? Сам не пробовал, но когда-то решал задачу по отрисовке OpenGL в bitmap через glReadPixels.

FBO можно эмулировать через P-buffers, если они в наличии :) (ну совсем древние драйвера)

Помнится как раз писал обёртки, с громким названием TGLRenderTexture. Которая как раз цепляла, либо ARM_FBO (TGLFBO), либо EXT_FBO (TGLEXTFBO )либо P-buffers (TGLPBuffersRender), соотвественно. А смысл был одним, отрисовывать сцену в текстуру.

Добавлено спустя 3 минуты 46 секунд:
Cheb писал(а):Результ просчёта физики:
CycleFriendly - 120 наносекунд / шт. Тупым обходом массива.
CycleNonFriendly - 200 наносекунд /шт. Угадайте за счёт чего? Рекурсия, вершина стека всё время ползёт по памяти,

есть мнение, что кеш процессора тут ни при чём.
просто вызов рекурсивной процедуры более дорогой чем, тело процедуры.

Исходя из описания кешей, тебе нужно сделать чтобы CycleNonFriendly, так же использовал цикл, но при этом на каждой итерации массива обрабатывал данные с двух концов, что-то вроде:
Код: Выделить всё
    for i:= 0 to halfwidth do  begin
      all[i].Cycle;
      all[width-i-1].Cycle;
    end;
скалогрыз
долгожитель
 
Сообщения: 1630
Зарегистрирован: 03.09.2008 02:36:48

Re: Cheb's Game Engine

Сообщение Cheb » 11.09.2015 22:56:52

просто вызов рекурсивной процедуры более дорогой чем, тело процедуры.

Правильно. А дорогой он потому, что тона рекурсии - не кеш-фриндли.
В остальном методы совершенно идентичные. Столько же локальных переменных, функционал - копипаста.
(з.ы. Самый цымес в том, что она сначала вызывает рекурсию для следующего, а потом уже выполняет для себя. То есть, объекты в памяти перебаламутит два раза, сначала в одну сторону, потом в другую).


чтобы CycleNonFriendly, так же использовал цикл, но при этом на каждой итерации массива обрабатывал данные с двух концов, что-то вроде:

Ы? Изображение
Это пример специально сделан исследовать "как неправильно".

FBO можно эмулировать через P-buffers, если они в наличии

Да я скорее Некрономикон штудировать начну, мозг целее будет Изображение

а не тормозно будет?

При разрешениях текстуры порядка 1024х512 - достаточно резво летает, даже на geForce 2 MX 400. См. http://www.gamedev.ru/code/forum/?id=55433 (только оно замирает если окно шире 1024 пикселов!)
А для gF FX 5200 и такого много. Почему? Потому что филлрейт у неё никакой. Конкретно для квейкомода я, ЕМНИП, использовал 512х512.
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 564
Зарегистрирован: 06.06.2005 15:54:34

Re: Cheb's Game Engine

Сообщение скалогрыз » 11.09.2015 23:26:20

Cheb писал(а):Это пример специально сделан исследовать "как неправильно".

Нет, это с целью ликвидировать рекурсию (с её заполнением стэка и вызовами call и ret, ибо это всё дополнительная нагрузка на процессор).

так как насчёт теста? ;)
можно даже оптимизировать код:
Код: Выделить всё
j:=width-1;
for i:= 0 to halfwidth do  begin
  all[i].Cycle;
  all[j].Cycle;
  dec(j);
end;
скалогрыз
долгожитель
 
Сообщения: 1630
Зарегистрирован: 03.09.2008 02:36:48

Re: Cheb's Game Engine

Сообщение hinst » 11.09.2015 23:39:34

издателям и разработчикам многих игр сегодня явно недостаёт упорства в оптимизации
Аватара пользователя
hinst
энтузиаст
 
Сообщения: 782
Зарегистрирован: 12.04.2008 18:32:38

Re: Cheb's Game Engine

Сообщение скалогрыз » 12.09.2015 00:08:14

hinst писал(а):издателям и разработчикам многих игр сегодня явно недостаёт упорства в оптимизации

может у движкописателей? они ориентируются на распоследнее железо (ибо спонсоры!)

а игроделы используют те движки, что есть. Ибо для создателей игры, главное содержимое игры (скрипты, графика, ИИ)

Ну и движкописатели не будут оптимизировать движок под конкретную игру.
скалогрыз
долгожитель
 
Сообщения: 1630
Зарегистрирован: 03.09.2008 02:36:48

Re: Cheb's Game Engine

Сообщение hinst » 12.09.2015 00:30:15

Мне как-то от этого не легче! Пусть выкинут свои тормозные движки и используют лучше Cheb-движок
Аватара пользователя
hinst
энтузиаст
 
Сообщения: 782
Зарегистрирован: 12.04.2008 18:32:38

Re: Cheb's Game Engine

Сообщение скалогрыз » 12.09.2015 00:48:35

hinst писал(а):Мне как-то от этого не легче! Пусть выкинут свои тормозные движки и используют лучше Cheb-движок

я к тому, что это стратегический тупик "индустрии" игр. Что даёт определённые бонусы, самописными движкам-играм.
скалогрыз
долгожитель
 
Сообщения: 1630
Зарегистрирован: 03.09.2008 02:36:48

Re: Cheb's Game Engine

Сообщение Cheb » 12.09.2015 01:14:41

Оптимизация - это такая стерва. Одно улучшишь - другое пострадает :x

я к тому, что это стратегический тупик "индустрии" игр.

Ну, будем надеяться. Инди игр сейчас много, но писать движок - это ТАКОЙ ГЕМОРРОЙ
Очень жалею, что не применил в своё время SDL, половину функционала по работе с железом и ОС уж точно можно было бы на неё спихнуть.

так как насчёт теста? ;)

Добавил. Абсолютно никаких отличий от "дружественного" варианта.
Т.е. виновато именно загрязнение кеша стеком из-за эпически глубокой рекурсии.
Выложу завтра.

Кешу плоскопараллельно в каком порядке подкачивать из памяти - хоть вперёд, хоть назад, хоть крестиком. Имеет значение именно объём.

Откуда, для достижения истинно былинных проорций необходимо:

1. Снижать частоты тиков для всего, что только можно. Вон, в первом квейке монстры тикали на всего лишь 10 кадрах в секунду. И ничего, игра от этого хуже не стала. (а в третьем квейке, боты думают не чаще, чем десять раз в секунду).

2. Сражаться за уменьшение размера объектов. Всё, что можно, буду хранить в полях ShortInt. Для чанков буду применять мощные алгоритмы сжатия, чтобы не хранить в памяти не нужные или повторяющиеся куски. Например, освещение для внутри непрозрачных блоков или выше верхнего блока. Или для массива камня хранить общую запись "блоки отсюда досюда - массив камня", без детализации. Немного напоминает октри, на самом деле.

З.Ы. Обнаружил, что синхронизация потоков работает превосходно на XP и через анус на семёрке (при перегрузе логического потока или режиме "3" частота кадров рендера убивается в ноль, а на хрюше соответственно плавно замедляется или держит стабильные 30). Интересно, почему так?
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 564
Зарегистрирован: 06.06.2005 15:54:34

Re: Cheb's Game Engine

Сообщение Mirage » 12.09.2015 12:35:25

Cheb писал(а):Ы. Обнаружил, что синхронизация потоков работает превосходно на XP и через анус на семёрке (при перегрузе логического потока или режиме "3" частота кадров рендера убивается в ноль, а на хрюше соответственно плавно замедляется или держит стабильные 30). Интересно, почему так?


В семерке улучшенный шедулер потоков. Кстати, шедулер потоков в винде работает не очень интуитивно. Например, поток с меньшим приоритетом может никогда не получить кванта, при наличии потоков с большим приоритетом.
Mirage
энтузиаст
 
Сообщения: 745
Зарегистрирован: 06.05.2005 20:29:07
Откуда: Russia

Re: Cheb's Game Engine

Сообщение Cheb » 13.09.2015 21:17:58

Похоже, дело в том, как выполняется WaitForSingleObject (обёрнутый в WaitFor ). В икспи если на мгновение выставить, то ожидание в другом потоке сразу заканчивается. А в семёрке - ждущий поток не реагирует мгновенно, и если сразу сделать ResetEvent, то прохлопает это радостное событие и продолжит дрыхнуть.

Добавил костыль: ещё одие ивент, включающийся если рендер ждёт дольше интервала, рвного одному кадру на 30 FPS. Типа, "да дай же ты мне встрять наконец". Если логика видит, что этот ивент выставлен, то не гонит вперёд сразу, а сначала ждёт рендера, как в режиме кадр-в-кадр.
Оно получилось дёрганое и неравномерное, но работает. FPS больше не убивается в ноль.

По ходу, теоретические разработки. Тест №20 будет ещё нескоро, поскольку сначала собираюсь воплотить всё нижеописанное:

Для выбранной модели мультиплеера, равно как для работы продвинутого ИИ, движку нужна поддержка расслаиваемого игрового мира.

Проблемы на пути к достижению:

1. Создание полной копии игрового мира невозможно вследствие технических ограничений. Чеперси тупо не хватит быстродействия. Наилучший результат - миллион объектов в секунду, вряд ли это можно хотя бы удвоить оптимизацией. То есть сохранение всего игрового мира в TMemoryStream займёт не менее 50 милисекунд - в несколько раз больше, чем допустимое время кадра (16мс). А если быть реалистом - то 100..300, в зависимости от насколько толстыми у меня получатся чанки. И это - только сохранение, а нужна ещё загрузка.
То есть, тупое решение в лоб отпадает.
2. Необходимость *быстро* получать и сравнивать контрольные суммы, нужно для обнаружения рассинхронизации в сетевой игре.
3. Необходимость привязывать копии одного объекта в разных слоях к рендеру, чтобы могли наследовать туда-обратно имеющийся меш, даже если не совсем точно отражает состояние объекта.

Намечаемое решение:

Все игровые объекты надо делать на основе того или иного рода умных указателей.
Тогда порядок такой: объект А запрашивает у центрального менеджера "дай мне указатель на объект Б для текущего слоя" и получает либо базовый объект Изначального Слоя, если в текущем слое нет изменённой копии, либо эту самую изменённую копию.
Причём, важно, чтобы было два разных вида запросов: для чтения и запрос копии для модификации.

Недостатки:
1. Паскаль не предоставляет средств для создания синтаксического сахара для этого. Любое потенциально изменяющее объект взаимодействие нужно будет оформлять в коде как последовательность "получить на запись - вызывать методы - подтвердить окончание изменений". Если "получить на запись" всегда делать безусловным клонированием, то третий шаг возможно отложить на после пульса, когда менеджер объектов проходит по всем, вызывавшимся на запись и обновляет их контрольные суммы. Возможно, с полным сличением копий? Тогда не отличающиеся от оригинала стираются (изменений не было). Требуется небольшая доработка Чеперси, чтобы обеспечить методы обхода двух потенциально идентичных объектов с с оставлением контрольной суммы.
2. Нужен механизм поиска алгоритмических ошибок, связанных с изменением объектов, полученных только для чтения: когда он уже получен, это ссылка и уследить за всеми манипуляциями трудно.
3. Нужен отдельный сборщик мусора для массива менеджера объектов, в котором хранятся ссылки на них, чтобы не допустить повторного использования занятого индекса (возможно, сам менеджер делает обход через каждые N пульсов логики, и выкидывает из массива все, которые scraped?).

Достоинства:
1. За счёт всего вышеописанного ггеморроя получаем больше контроля и меньше потерь/утечек. Поскольку объектам не позволено хранить ссылки на другие объекты, а только индексы в менеджере, облегчается и ускоряется работа Чеперси по оходу графа, включая сборщик мусора.
2. Выигрыш в размере объектов в 64-битной версии: поскольку индекс - это Longint, он вдвое меньше указателя.


Добавлено спустя 9 минут 22 секунды:
З.Ы. Идея как предотвратить заход на сервер ломаным персонажем:
Перс передаётся на сервер как индекс базового шаблона + уровень + вся цепочка решений по прокачке (на что тратил очки умений и т.п), которую сервер точно повторяет. Т.е. прокачивает персонажа с нуля, по правилам сервера.

Добавлено спустя 16 часов 9 минут 35 секунд:
Сначала сделаю мультиплеер и отлажу его на простейшей сетевой игре "битва верёвочек, водимых мышкой" (кто вокруг соперника обмотался - тот и победил).
Очень хочу, чтобы в моей игре были хорошие иллюзии (этого сейчас никто не делает) - уровня Изанаги, не слабее. Чтобы в сетевой игре можно было работать иллюзиями, ставя иллюзорную стенку, о которую иллюзорно рвутся ракеты, в реале летящие дальше, или заставляя игроков видеть стрейфящегося врага на месте стоящего своего, заставляя лупить по нему и сея раздор и баттхёрт. :mrgreen:

Но возможность этого надо закладывать именно сейчас, в самый фундамент. :x
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 564
Зарегистрирован: 06.06.2005 15:54:34

Re: Cheb's Game Engine

Сообщение Cheb » 18.09.2015 10:57:28

Долго и нудно пишу разрежённый индексный массив, оптимизированный под скорость и минимизацию загрязнения кеша. :x А потом ещё более долго и нудно придётся писать тест для него. Потому что каждая сволочь... Я имею в виду каждый слой и субслой, должен иметь собственный индекс эндемичных объектов. А субслоёв могут быть тысячи, по одному на каждое искажение реальности.

К счастью, я руководствуюсь ограничением, что объектов - в крайнем случае, миллион (оптимально - сто тысяч).

После этого пойдёт такая радость, как сортировка по времени следующего тика. Пока надумал только ограничить время сна до 4096 милисекунд и организовать список на каждый тик как связанный список, растущий из циклически используемого массива.
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 564
Зарегистрирован: 06.06.2005 15:54:34

Re: Cheb's Game Engine

Сообщение Cheb » 19.09.2015 21:09:43

Исправил ещё один баг в Чеперси: неправильно угадывала как компилятор размещает поля - статические массивы из элементов в 1 и 2 байта.

Добавлено спустя 5 часов 36 минут 15 секунд:
Забраковал ранее наработанное (кроме разрежённого массива).
Не будет ограничений на количество слоёв. Это будет древовидная структура произвольной формы. У родительского любое количество дочерних.
Дополнительное ограничение: дочерний слой должен тикать синхронно с родительским. Потом может тикать сам ещё любое число раз. Не может отставать или воздерживаться.
Экземпляры классов не будут хранить, к какому слою они принадлежат. Будут лишь иметь счётчик ссылок.

Фактически, то что я делаю - это костыли для придания классам свойства CopyOnWrite со счётчиком ссылок.

Состоялся губозакатывательный сеанс №2. Слои альтернативной реальности будут расползаться, как раковая опухоль. Расслаиваясь в любом месте, где у родителя или у потомка произошло изменение. Или лечить это механизмом сличения контрольных сумм и "схлопывания" идентичных объектов?
Неее, нуегона. Пусть все слои, кроме базового, будут короткоживущими.

По любому, если поставить перманентное заклинание "здесь не дверь, здесь стенка", то через раздавленных бабочек ИИ близбежавшего зайца это отличие передастся дальше, и через какое-то время будем иметь две полные копии игрового мира, работающие параллельно.
Вывод: иллюзии должны быть или короткими (полторы минуты максимум), или работать на другом принципе, альтернативной чисто визуальной составляющей.

Добавлено спустя 11 часов 19 минут 49 секунд:
В связи с заявленной кончиной GetVersionEx , накатал/скопипастил целую простыню для опознания ОС на основеVerifyVersionInfo(), коя заявлена современной и появилась ещё в Windows 2000. Пристегнул к экзешнику манифест, скопипащенный с https://msdn.microsoft.com/en-us/librar ... 85%29.aspx .

И что бы вы думали? Win32MajorVersion / WIN32MinorVersion показали 10.0.
Но паскаль-то их выставляет, вызывая GetVersionEx() !
Т.е. врут собаки, зря трудился :evil:

З.Ы. В десятке работает плавно, но с секундным подвисанием при переключении с 2 на 3 (ускоренную промотку). На индикаторе при этом мелькает, что основной поток ждёт синхронизации. Но после, когда всё становится плавным, основная его нагрузка - спит! А в семёрке - вся нагрузка всегда окрашена в ждёт синхронизации.

Отрадно, что починили взад, но теперь мне отлаживать синхронизацию потоков в трёх осях: XP, 7 и 10, и в каждой оно ведёт себя серьёзно по разному.

Код: Выделить всё
{$ifdef windows}
  function GetLocalAppDataDir: TFileNameString; forward;

{
https://msdn.microsoft.com/en-us/library/windows/desktop/ms724451%28v=vs.85%29.aspx
[GetVersionEx may be altered or unavailable for releases after Windows 8.1.
Instead, use the Version Helper APIs]

With the release of Windows 8.1, the behavior of the GetVersionEx API has
changed in the value it will return for the operating system version. The value
returned by the GetVersionEx function now depends on how the application
is manifested.

Applications not manifested for Windows 8.1 or Windows 10 will return the
Windows 8 OS version value (6.2). Once an application is manifested for a given
operating system version, GetVersionEx will always return the version that the
application is manifested for in future releases.

    }

  function DetectWindowsNTVersion(): TOSType;
  {$if defined(win32) and (FPC_FULLVERSION<20700)}
    type
      OSVersionInfoEX = record
          dwOSVersionInfoSize : DWORD;
          dwMajorVersion      : DWORD;
          dwMinorVersion      : DWORD;
          dwBuildNumber       : DWORD;
          dwPlatformId        : DWORD;
          szCSDVersion        : array[0..127] of AnsiChar;
          wServicePackMajor   : WORD;
          wServicePackMinor   : WORD;
          wSuiteMask          : WORD;
          wProductType        : BYTE;
          wReserved           : BYTE;
        end;
    var
      VerifyVersionInfo: function(
        var lpVersionInfo:  OSVersionInfoEX;
        dwTypeMask: dword;
        dwlConditionMask: qword
      ): boolean; stdcall;
      VerSetConditionMask: function(
        dwlConditionMask: qword;
        dwTypeBitMask: dword;
        dwConditionMask: byte
      ): qword; stdcall;
//    ULONGLONG WINAPI VerSetConditionMask(
//      _In_ ULONGLONG dwlConditionMask,
//      _In_ DWORD     dwTypeBitMask,
//      _In_ BYTE      dwConditionMask
//    );
      //BOOL WINAPI VerifyVersionInfo(
      //  _In_ LPOSVERSIONINFOEX lpVersionInfo,
      //  _In_ DWORD             dwTypeMask,
      //  _In_ DWORDLONG         dwlConditionMask
      //);

      dll: THandle;
      p: pointer;
    const
      VER_MAJORVERSION = $0000002;
      VER_MINORVERSION = $0000001;
      VER_GREATER_EQUAL = 3;



      function LoadProcAddress(hdll: THandle; ProcName: ansistring) : pointer;
      var
        baseaddr: pointer;
        exename: UnicodeString;
      begin
        Result:= GetProcAddress(hdll, PChar(ProcName));
        if Assigned(Result) then begin
          GetModuleByAddr(Result, baseaddr, exename);
          VerboseLog('      %0() at %1 in %2', [ProcName, Result, exename]);
        end
        else
          VerboseLog('      %0() not found!', [ProcName]);
      end;
  {$endif}
    function IsOrGreater(wMajorVersion, wMinorVersion: Word): Boolean;
    var
      osvi: OSVersionInfoEX;
      dwlConditionMask: qword;
    begin
      FillChar(osvi, sizeof(osvi), 0);
      osvi.dwOSVersionInfoSize := SizeOf(osvi);
      osvi.dwMajorVersion := wMajorVersion;
      osvi.dwMinorVersion := wMinorVersion;
      dwlConditionMask := VerSetConditionMask(0, VER_MAJORVERSION, VER_GREATER_EQUAL);
      dwlConditionMask := VerSetConditionMask(dwlConditionMask, VER_MINORVERSION, VER_GREATER_EQUAL);
      Result := VerifyVersionInfo(osvi, VER_MAJORVERSION or VER_MINORVERSION, dwlConditionMask);
    end;

  begin
    Result:= ostWin2k;
    try
      VerboseLog(  'Detecting Windows NT version...');
      {$if defined(win32) and (FPC_FULLVERSION<20700)}
        VerboseLog('    loading kernel32.dll...');
        dll:= LoadLibrary('kernel32.dll');
        p:=  LoadProcAddress(dll, 'VerifyVersionInfoA');
        if not Assigned(p) then Exit;
        pointer(VerifyVersionInfo):= p;
        p:=  LoadProcAddress(dll, 'VerSetConditionMask');
        if not Assigned(p) then Exit;
        pointer(VerSetConditionMask):= p;
      {$endif}
      if IsOrGreater(5, 1) then Result:= ostWinXP;
      if IsOrGreater(6, 0) then Result:= ostVista;
      if IsOrGreater(6, 1) then Result:= ostWin7;
      if IsOrGreater(6, 2) then Result:= ostWin8;
      if IsOrGreater(6, 3) then Result:= ostWin81;
      if IsOrGreater(10, 0) then Result:= ostWin10;
    except
    end;
  end;

  {$endif}



  procedure DetectOSType;


  begin
    VerboseLog('Detecting operating system...');
   {$ifdef unix}
     {$ifdef darwin}
      Mother^.State.OS:= ostMacOSX;
     {$else}
      Mother^.State.OS:= ostLinux;
     {$endif}
   {$else}
     if RunningInWine then begin
       Mother^.State.OS:= ostWine;
       Mother^.State.DriveZIsRoot:= GetZIsRoot();
       if Mother^.State.DriveZIsRoot then begin
         //otherwise we're unable to tell Linux from MacOS X
         if FileExists('z:usrliblibc.dylib')
           then Mother^.State.OS:= ostDarwine;
       end;
     end
     else
       if _RunningInWindows98 then begin
         Mother^.State.OS:= ostWin98; //98 or Me
         VerboseLog('  It''s Windows 98 or Millennium, v%0.%1.', [Win32MajorVersion, WIN32MinorVersion]);
       end
       else begin
         VerboseLog('  It''s Windows NT %0.%1.', [Win32MajorVersion, WIN32MinorVersion]);
         case Win32MajorVersion of
           3,4: Mother^.State.OS:= ostWin2k;  //Windows NT 3.x and 4.x are treated as Windows 2000. Chentrah probably won't event start there
{           5: if WIN32MinorVersion = 0
                then Mother^.State.OS:= ostWin2k
                else Mother^.State.OS:= ostWinXP; //or server 2003, doesn't matter
           6: case WIN32MinorVersion of
                0: Mother^.State.OS:= ostVista;
                1: Mother^.State.OS:= ostWin7;
                2: Mother^.State.OS:= ostWin8;
              else
                Mother^.State.OS:= ostWin8;
              end;
}
         else
           Mother^.State.OS:= DetectWindowsNTVersion();
         end;
       end;

    Mother^.State.CSIDL_AppDataDir:= GetLocalAppDataDir;
    VerboseLog('  Local app data directory is %0', [GetLocalAppDataDir]);

    Mother^.State.Windows98.DoesNotSupportUnicode:= {$ifdef cpu64} false {$else} not CheckIfWindows98HasUnicodeSupportInstalled() {$endif} ;
   {$endif}
    Mother^.State.OstID:= GetEnumName(typeinfo(TOSType), ord(Mother^.State.OS));
    if Mother^.State.OS = ostWine
      then Mother^.State.OSName:= WineVersionString
      else begin
//        if (Win32MajorVersion < 5) or (Win32MajorVersion > 6)
//        or ((Win32MajorVersion = 6) and (WIN32MinorVersion > 1))
//          then Mother^.State.OSName:= 'Windows NT ' + IntToStr(Win32MajorVersion) + '.' + IntToStr(WIN32MinorVersion)
//          else
        Mother^.State.OSName:= OSDisplayedName[Mother^.State.OS];
      end;
   {$ifdef unix}
    {$ifndef darwin}
     DetectLinuxVersionString;
    {$endif}
   {$endif}
  end


Добавлено спустя 2 минуты 34 секунды:
З.Ы. Пробовал я эти их сраные Version Helper functions. Нету их! По крайней мере, GetProcAddress() их не находит. Возможно, это вообще макросы в сишных хидерах.
Код: Выделить всё
Detecting operating system...
  Trying to detect Wine...
    ..system directory is C:\WINDOWS\system32
    ..trying to open C:\WINDOWS\system32\kernel32.dll for read...
    ..scanning for signature string "Wine placeholder DLL"...
    ..detected = false
  It's Windows NT 6.2.
Trying to detect if this is Windows 8.0 or greater...
    loading kernel32.dll...
      IsWindows8Point1OrGreater() not found!


Добавлено спустя 3 минуты 8 секунд:
З.З.Ы. При отсутствии правильного манифеста, десятка, как и заявлено, тщательно прикидывается восьмёркой.
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 564
Зарегистрирован: 06.06.2005 15:54:34

Пред.След.

Вернуться в Разработки на нашем сайте

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1

Рейтинг@Mail.ru
cron