SR64 (16 стр)

3:44 [SR64] TApp64.Create
3:44 [SR64] TApp64.Variables
3:44 [SR64] TApp64.GetSystemInfo
3:44 [SR64] TApp64.UpdateResolution
3:44 [SR64] TApp64.SystemMetrics
3:44 [SR64] TApp64.ParseParams

3:45 [SR64] TApp64.Create
3:45 [SR64] TApp64.Variables
3:45 [SR64] TApp64.GetSystemInfo
3:45 [SR64] TApp64.UpdateResolution
3:45 [SR64] TApp64.SystemMetrics
3:45 [SR64] TApp64.ParseParams
3:45 [SR64] Путь приложения: C:\Test\SR64\
3:45 [SR64] TApp64.UpperCase(Params)
3:45 [SR64] Инициализация приложения
3:45 [SR64] Установка путей в папке Media
3:45 [SR64] C:\Test\SR64\Media\Images\
3:45 [SR64] C:\Test\SR64\Media\Models\
3:45 [SR64] C:\Test\SR64\Media\Shaders\
3:45 [SR64] C:\Test\SR64\Media\ScreenShots\
3:45 [SR64] C:\Test\SR64\Media\Swatches\
3:45 [SR64] Установка глобальных переменных
3:45 [SR64] Загрузчик изображений
3:45 [SR64] Загрузка ресурсов
3:45 [SR64] C:\Test\SR64\Media\Images\pt_sans_12.tif
3:45 [SR64] C:\Test\SR64\Media\Images\CheckBoxOn.bmp
3:45 [SR64] C:\Test\SR64\Media\Images\CheckBoxOff.bmp
3:45 [SR64] C:\Test\SR64\Media\Images\slider_left_btn.bmp
3:45 [SR64] C:\Test\SR64\Media\Images\slider_right_btn.bmp
3:45 [SR64] C:\Test\SR64\Media\Images\slider_top_btn.bmp
3:45 [SR64] C:\Test\SR64\Media\Images\slider_bottom_btn.bmp
3:45 [SR64] Создание окна приложения
3:45 [SR64] TApp64.Run
3:45 [SR64] Завершение

constructor TApp64.Create(AName: string);
var
  SystemInfo: TSystemInfo;
  i: Integer;
  A, B: string;

begin
  inherited Create;

  // Имя класса
  FClass := ClassName + CDot;

  Log.Add(FClass + 'Create');

  // Инициализация переменных
  FInstance := 0;
  FMainWnd := 0;
  FProgressWnd := 0;
  FHiMode := True;
  FLoMode := (not FHiMode);
  FAppName := AName;
  SetLength(FImagesPath, 0);
  SetLength(FModelsPath, 0);

  Log.Add(FClass + 'Variables');

  // Кол-во процессоров
  GetSystemInfo(SystemInfo);
  FNumProcessors := SystemInfo.dwNumberOfProcessors;

  Log.Add(FClass + 'GetSystemInfo');

  // Запомним стартовое разрешение экрана
  UpdateResolution;
  FDesktop := FScreen;

  Log.Add(FClass + 'UpdateResolution');

  // Окно панели задач
  FTaskbarWnd := FindWindow(PChar(LC_TASKBARNAME), nil);

  // Размер рамки окна
  FBorder.X := GetSystemMetrics(SM_CXFRAME);
  FBorder.Y := GetSystemMetrics(SM_CYFRAME);

  // Высота заголовка
  FCH := GetSystemMetrics(SM_CYCAPTION);

  Log.Add(FClass + 'SystemMetrics');

  // Строка параметров
  ParseParams(FParams, True);
  Log.Add(FClass + 'ParseParams');

  // Инициализация пути приложения
  FAppPath := ExtractFilePath(FParams.Get(0));
  if (FAppPath = '') then
    FAppPath := GetCurrentDir;

  Log.Add('Путь приложения: ' + FAppPath);

  // Флаг использования 64-х битного Z-Буфера
  FZ64 := False;
  B := CPRMS[0]; // -Z64

  // Анализ параметров
  for i := FParams.Lo to FParams.Hi do
  begin
    A := UpperCase(FParams.Get(i));

    if CmpStr(A, B) then
    begin
      FZ64 := True;
      Log.Add('Использован параметр: ' + A);
      Break;
    end;
  end;

  Log.Add(FClass + 'UpperCase(Params)');

  // Сброс таймеров
  ResetTimers;
end;

  FAppPath := ExtractFilePath(FParams.Get(0));
  if (FAppPath = '') then
    FAppPath := GetCurrentDir;

  Log.Add('Путь приложения: ' + FAppPath);

//--------------------------------------------------

function ExtractFilePath(APath: string): string;
var
  i, N, SlashPos: Integer;
  C: Char;
  R: string absolute Result;

const
  BS: Char = #92; // '\';
  FS: Char = #47; // '/';

begin
  SetLength(R, 0);
  N := Length(APath);

  if (N > 0) then
  begin
    SlashPos := 0;

    //Ищем слэш с конца строки
    for i := N downto 1 do
    begin
      C := APath[i];

      if (C = BS) or (C = FS) then
      begin
        SlashPos := i;
        Break;
      end;
    end;

    // Копируем все вместе со слэшем в результат
    if (SlashPos > 0) then
    begin
      SetLength(R, SlashPos);
      MoveBytes(@APath[1], @R[1], SlashPos * SizeOf(Char));
    end;
  end;
end;

//--------------------------------------------------

function TStringArray.Get(AIndex: Integer): string;
begin
  Result := FStringArray[AIndex].Value;
end;

//--------------------------------------------------

const
  DQ = #34;//"
  SQ = #39;//'
  CDot: Char = #46;//.
  SPACE: Char = #32;
  CPRMS: array[0..0] of string = ('-Z64');
  ExcludeChars: array[0..2] of Char = (#0, DQ, SQ);

//--------------------------------------------------

function FileExist64(AName: string): Boolean;
var
  FD: _WIN32_FIND_DATAW;
  H: THandle;

begin
  H := WinApi.Windows.FindFirstFile(PChar(AName), FD);

  if (H = INVALID_HANDLE_VALUE) then
    Result := False else
    Result := True;

  if Result then
  begin
    // Файл не должен быть директорией или устройством
    // Также не может быть скрыт
    if (FD.dwFileAttributes = FILE_ATTRIBUTE_ARCHIVE) or
       (FD.dwFileAttributes = FILE_ATTRIBUTE_NORMAL) then else Result := False;
  end;

  WinApi.Windows.FindClose(H);
end;

//--------------------------------------------------

function MemCmp64(A, B: Pointer; ACount: QWord): Boolean;
asm
  .NOFRAME

  // RCX - A
  // RDX - B
  // R8 - ACount

  cmp ACount, 0 // Размер 0?
  je @NE
  cmp ACount, 8 // Меньше размера QWord'а?
  jl @B

  mov R9, ACount
  and R9, 07h // Остаток

  shr ACount, 3 // Читаем QWord's

  // Сравнение QWord's
 @N:
  mov rax, [A]
  xor rax, [B]
  jnz @NE

  add A, 8
  add B, 8

  dec ACount
  jnz @N

  cmp R9, 0
  je @Exit

  // Побайтное сравнение
  mov ACount, R9 // Остаток

 @B:
  mov al, [A]
  xor al, [B]
  jnz @NE

  inc A
  inc B

  dec ACount
  jnz @B

 @Exit:
  mov al, 1
  ret

 @NE:
  xor al, al
end;

//--------------------------------------------------

function CmpStr(AStr, BStr: AnsiString): Boolean;
var
  A, B: Integer;

begin
  Result := False;

  A := Length(AStr);
  B := Length(BStr);

  if (A = B) then
    Result := MemCmp64(@AStr[1], @BStr[1], A);
end;

//--------------------------------------------------

function CharInArray(C: Char; AChars: array of Char): Boolean;
var
  i: Integer;
  A: UInt64;

begin
  Result := False;
  A := UInt64(@AChars[0]);

  for i := Low(AChars) to High(AChars) do
  begin
    if (PChar(A)^ = C) then Exit(True);
    Inc(A, SizeOf(Char));
  end;
end;

//--------------------------------------------------

function ParamPossible(AValue: string): Boolean;
var
  i: Integer;
  A: string;

begin
  Result := False;
  A := UpperCase(AValue);

  // Проверяем массив корректных параметров
  for i := Low(CPRMS) to High(CPRMS) do
  begin
    if CmpStr(A, CPRMS[i]) then Exit(True);
  end;
end;

//--------------------------------------------------

function CharPossible(AChar: Char): Boolean;
begin
  Result := not CharInArray(AChar, ExcludeChars);
end;

//--------------------------------------------------

function IncorrectChar(AChar: Char): Boolean;
begin
  Result := CharInArray(AChar, ExcludeChars);
end;

//--------------------------------------------------

procedure ParseParams(var AStrings: TStringArray; AZeroParam: Boolean);
var
  AStr: string;
  BStr: string;
  CStr: string;
  ZStr: string;
  i, ALen, BLen, CLen, APos: Integer;
  C: Char;

begin
  AStr := GetCommandLine;
  ALen := Length(AStr);

  if not Assigned(AStrings) then
    AStrings := TStringArray.Create;

  // Нулевая строка
  SetLength(ZStr, 0);
  // Стартовая позиция
  APos := 1;

  // Извлекаем нулевой параметр
  for i := 1 to ALen do
  begin
    // Текущий символ
    C := AStr[APos];
    // Следующая позиция
    Inc(APos);

    // Пропускаем знаки-исключеия
    if CharPossible(C) then
      ZStr := (ZStr + C) else Continue;

    // Если файл существует
    if FileExist64(ZStr) then
    begin
      // Добавим нулевой параметр (это обычно путь App.EXE)
      if AZeroParam then AStrings.Add(ZStr);
      // Прервем поиск
      Break;
    end;
  end;

  //-------------------------------
  // Если остаток строки не пустой
  //-------------------------------

  if (APos < ALen) then
  begin
    // Длина остатка
    BLen := (ALen - APos) + 1;
    SetLength(BStr, BLen);

    // Копируем остаток строки
    MoveBytes(@AStr[APos], @BStr[1], BLen * SizeOf(Char));

    // Строка для сравнения
    SetLength(CStr, 0);
    CLen := Length(CStr);

    // Разбираем остатки строки
    for i := 1 to BLen do
    begin
      // Текущий знак
      C := BStr[i];

      // Пропускаем скобки
      if IncorrectChar(C) then Continue;

      // Возможно это разделитель параметров
      if (C = SPACE) then
      begin
        // Проверим есть ли такой файл
        if FileExist64(CStr) or ParamPossible(CStr) then
        begin
          // Добавим параметр
          AStrings.Add(CStr);

          // Сброс строки
          SetLength(CStr, 0);
          CLen := Length(CStr);

          // Продолжим
          Continue;
        end
        else
        begin
          // Если корректный символ и пробел не первый в строке
          if CharPossible(C) and (CLen <> 0) then
          begin
            CStr := (CStr + C);
            CLen := Length(CStr);
          end;
        end;
      end
      else
      begin
        // Формируем строку
        if CharPossible(C) then
        begin
          CStr := (CStr + C);
          CLen := Length(CStr);
        end;
      end;
    end;//while

    // Если файл существует
    if FileExist64(CStr) or ParamPossible(CStr) then
    begin
      // Добавим параметр
      AStrings.Add(CStr);
    end;
  end;//if (APos < ALen)
end;