unit uAppUtils0;

interface

USES Windows;

CONST Entry : ARRAY [0..8] OF PCHar
            = ('CompanyName','FileDescription','FileVersion','InternalName',
               'LegalCopyright','OriginalFilename','ProductName','ProductVersion',
               'Comments');
TYPE
     tBytes= ARRAY[0..0] OF BYTE; pBytes= ^tBytes; pWord = ^WORD;
     tDatasInfosRec = RECORD
       sz: LONGWORD;
       pDatasVers: pBytes;
       slang: STRING[8];
     END;

FUNCTION GetFileDatasVers(aFile: PChar): tDatasInfosRec; // à appeler en premier
FUNCTION GetStringFileInfos(CONST DatasInfos: tDatasInfosRec; idxEntry: INTEGER): PChar;
{ NOTA: ne pas chercher à libérer le PChar retourné par GetInfos, c'est une
        sous-chaine du POINTER de GetDatasVers. Détruire celui-ci par FreeMem. }
FUNCTION GetFixedFileInfos(CONST DatasInfos: tDatasInfosRec): VS_FIXEDFILEINFO;
FUNCTION KeyPressed(vkCode: INTEGER): BOOLEAN;
FUNCTION SysKeyPressed: BOOLEAN;
PROCEDURE NoPeekDelayOrSysKey(ms: LONGWORD);
FUNCTION WaitSysKey(timeout: LONGWORD): BOOLEAN;
FUNCTION GetWinSysDir: STRING;
FUNCTION GetWinDir: STRING;

implementation

uses SysUtils;

TYPE t_hexw = STRING[4];

FUNCTION Hexw(v : WORD): t_hexw;
{
  CONST digits : ARRAY[0..15] OF CHAR = ('0','1','2','3','4','5','6','7','8','9',
                                         'A','B','C','D','E','F');
  VAR d : BYTE;
  BEGIN
    d:=4;
    result:='0000';
    WHILE v<>0 DO BEGIN
      result[d]:=digits[v MOD 16];
      v:=v DIV 16;
      DEC(d);
    END;
  END;

}
BEGIN
  result:=IntToHex(v,4);
END;

FUNCTION GetFileDatasVers(aFile: PChar): tDatasInfosRec; // à appeler en premier
VAR pxVers: LONGWORD; r: BOOL; ppInfos: POINTER; lInfos: LONGWORD;
BEGIN
  WITH result DO BEGIN
    sz:=GetFileVersionInfoSize(aFile,pxVers); // pxVers initialisée à zéro, ça peut servir ?
    IF sz>0 THEN BEGIN
      GetMem(pDatasVers,sz);
      GetFileVersionInfo(aFile,0,sz,pDatasVers);
      r:=VerQueryValue(pDatasVers,'\VarFileInfo\Translation',ppInfos,lInfos);
      IF r THEN BEGIN
        slang:=HexW(pWord(ppInfos)^)+HexW(pWord(INTEGER(ppInfos)+2)^);
      END;
    END;
  END;
END;

FUNCTION GetStringFileInfos(CONST DatasInfos: tDatasInfosRec; idxEntry: INTEGER): PChar;
VAR ppInfos: POINTER; lInfos: LONGWORD;
BEGIN
  WITH DatasInfos DO
    IF (idxEntry<=HIGH(Entry)) AND(sz>0)
       AND VerQueryValue(pDatasVers,PChar('\StringFileInfo\'+slang+'\'+Entry[idxEntry]),
           ppInfos,lInfos) THEN result:=PChar(ppInfos)
                           ELSE result:='';
END;

FUNCTION GetFixedFileInfos(CONST DatasInfos: tDatasInfosRec): VS_FIXEDFILEINFO;
VAR pVS: PVSFixedFileInfo; lInfos: LONGWORD;
BEGIN
  WITH DatasInfos DO
    IF (sz>0) AND VerQueryValue(pDatasVers,PChar('\\'),POINTER(pVS),lInfos) THEN result:=pVS^
                           ELSE FILLCHAR(result,SIZEOF(result),0);
END;

FUNCTION KeyPressed(vkCode: INTEGER): BOOLEAN;
BEGIN
  Result:=WordBool(GetAsyncKeyState(vkCode) AND $8000);
END;

FUNCTION SysKeyPressed: BOOLEAN;
BEGIN
  result:=KeyPressed(vk_shift) OR KeyPressed(vk_control) OR KeyPressed(vk_menu);
END;

FUNCTION WaitSysKey(timeout: LONGWORD): BOOLEAN;
VAR limit: LONGWORD;
BEGIN
  limit:=GetTickCount+timeout;   // 
  REPEAT
    result:=SysKeyPressed;
  UNTIL result OR (GetTickCount>=limit);
END;

PROCEDURE NoPeekDelayOrSysKey(ms: LONGWORD);
VAR limit: LONGWORD;
BEGIN
  limit:=GetTickCount+ms;   // si LONGWORD dépassé....(+ de 49,7 jours)
  REPEAT UNTIL (GetTickCount>=limit) OR SysKeyPressed;
  WHILE SysKeyPressed DO;  // maintient l'affichage jusqu'au relachement
END;

FUNCTION GetWinSysDir: STRING;
BEGIN
  SetLength(result,MAX_PATH);
  SetLength(result,GetSystemDirectory(PCHAR(result),MAX_PATH));
END;

FUNCTION GetWinDir: STRING;
BEGIN
  SetLength(result,MAX_PATH);
  SetLength(result,GetWindowsDirectory(PCHAR(result),MAX_PATH));
END;

end.