{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

You may retrieve the latest version of this file at the FBA Creator Home Page,
located at http://www.fbacreator.com

Known Issues:
-----------------------------------------------------------------------------}
unit Unit3;


interface

uses
SysUtils, Windows, Classes, Dialogs, Registry, shlobj, ShellApi, StrLib, Forms,
Graphics, IniFiles, ComCtrls;

function FExtractFilePath(p: String): String;
function FPath(p: String): String;
function SplitStrings(const str: string; const separator: string;
                        Strings: TStrings): TStrings;
procedure SaveResourceAsFile(const ResName: string; const FileName: string);
function CopyRes(resname: String; finalfile: String; is_fba_player: Boolean): Boolean;
function ChangeIconExe(FileName, IcoFileName: pchar): Boolean;
function LauncherResName(device: Integer; presuffix: String): String;
function LauncherVCBuildName(device: Integer; presuffix: String): String;
function GetLUAFunctionsFromFile(resname: String): TStringList;
function GetResourceAsPointer(ResName: pchar; ResType: pchar; out Size: longword): pointer;
procedure RegisterFileType(ExtName:String; AppName:String) ;
procedure InitLuaFunctionsImmediateHelp();
procedure FreeLuaFunctionsImmediateHelp();
function FindQuickHelp(key: String): String;
function GetSetupDllName(appname: String): String;
function Sto_ShellExecute(const FileName, Parameters: String;
  var ExitCode: DWORD; const Wait: DWORD = 0;
  const Hide: Boolean = False): Boolean;
function MakeValidPath(s: String): String;
function  GetAppVersion:string;
function GetDllVersion(): string;
function LaunchWithTempFileAndWaitKill(tempdir: String; cmd: String; timeout: Integer): Boolean;
function GetIniFile: String;

procedure InitLastOpenedProjectsList();
procedure FreeLastOpenedProjectsList();
procedure AddOpenedProjectsList(prj: String);
function GetLastOpenedProject(index: Integer): String;
function GetLastOpenedProjectCount: Integer;
procedure LoadEditorOptionsInMemory();

// funzioni gestione risorse esportate dalla DLL
// old code tenuto per riferimento - chiamate statica
{
function ECopyRes(resname: PChar; finalfile: PChar): Boolean; external 'FBIde.dll';
function EGetDllVersion(): PChar; external 'FBIde.dll';
function EGetResourceAsPointer(ResName: pchar; ResType: pchar; out Size: longword): pointer; external 'FBIde.dll';
function ERegisterExeFile(ffile: PChar): Boolean; external 'FBIde.dll';
}

// inizializza e finalizza il caricamento della libreria
function InitDLL(root: String): Boolean;
function GetDLLFuncs(): Boolean;
function FreeDLL(): Boolean;

const


SETTINGS_ORIENTATION=1;
SETTINGS_FPS=2;
SETTINGS_SOUNDFREQ=3;
SETTINGS_SOUNDBPS=4;
SETTINGS_SOUNDSTEREO=5;
SETTINGS_SOUNDMAXMUSCHANNELS=6;
SETTINGS_SOUNDMAXSFXCHANNELS=7;
SETTINGS_PROJECTNAME=8;
SETTINGS_PROJECTAUHTOR=9;
SETTINGS_EXT_SOUNDS=10;
SETTINGS_EXT_TTF=11;
SETTINGS_START_BACKCOL1=12;
SETTINGS_START_BACKCOL2=13;
SETTINGS_START_BACKCOL3=14;
SETTINGS_TRANS1=15;
SETTINGS_TRANS2=16;
SETTINGS_TRANS3=17;
SETTINGS_VGA=18;
SETTINGS_WINDOWS_WIDTH=19;
SETTINGS_WINDOWS_HEIGHT=20;
SETTINGS_APPLICATION_ICON=21;

SETTINGS_MAX_SETTINGS=21;

// tipi per puntatori esportati dalla DLL
type
  TECopyRes = function(resname: PChar; finalfile: PChar): Boolean;
  TEGetDllVersion = function(): PChar;
  TEGetResourceAsPointer = function(ResName: pchar; ResType: pchar; out Size: longword): pointer;
  TERegisterExeFile= function(ffile: PChar): Boolean;

var
  // settings del progetto
  SETTINGS: array[1..SETTINGS_MAX_SETTINGS] of String;

  fasthelp_names, fasthelp_text: TStringList;

  lastProjects: TStringList;

  WindowList: TList;

  // handle DLL e puntatori alle procedure
  DLLHANDLE: THandle = 0;
  ECopyRes: TECopyRes = nil;
  EGetDllVersion: TEGetDllVersion = nil;
  EGetResourceAsPointer: TEGetResourceAsPointer = nil;
  ERegisterExeFile: TERegisterExeFile = nil;

  // settings ide
  OPTIONS_BOOL: array[0..30] of Boolean;
  OPTIONS_NUMBER: array[0..30] of LongInt;
  OPTIONS_STRING: array[0..30] of String;

  // la creazione del file .dat e dell'exe di FBA è stata cachata?
  // settato a TRUE quando abbiamo già copiato il .dat e/o l'exe
  // risettato a false quando è necessario ricrearli perchè invalidati (aggiunta/rimozione risorsa etc)
  COPY_INTERNAL_RESOURCES_CACHED: Boolean = false;
  COPY_FBA_PLAYER_CACHED: Boolean = false;
  COPY_EXTERNAL_RESOURCES_CACHED: Boolean = False;

const
  // settings bool
  IDE_OPTIONS_LAUNCER_TOPMOST = 0;
  // settings strings
  IDE_OPTIONS_COLOR_COMMENTS=0;
  IDE_OPTIONS_COLOR_KEYS=1;
  IDE_OPTIONS_COLOR_FUNCTIONS=2;
  IDE_OPTIONS_COLOR_STRINGS=3;
  IDE_OPTIONS_COLOR_ACTIVELINEBACK=4;
  IDE_OPTIONS_COLOR_EDITORBACK=5;
  IDE_OPTIONS_COLOR_SELECTEDBACK=6;
  IDE_OPTIONS_COLOR_SELECTEDFORE=7;
  IDE_OPTIONS_COLOR_SYNTAX1=8;
  IDE_OPTIONS_COLOR_SYNTAX2=9;
  IDE_OPTIONS_COLOR_SYNTAX3=10;
  IDE_OPTIONS_COLOR_SYNTAX4=11;
  IDE_OPTIONS_COLOR_SYNTAX5=12;
  IDE_OPTIONS_COLOR_SYNTAX6=13;
  // settings long
  IDE_OPTIONS_TABS_SPACE=0;

  const
  DEBUG_VC_X86RELEASE_LOADER_DIR='C:\Windows CE Tools\PocketFrog\samples\FBasic\Release\';
  DEBUG_VC_ARMRELEASE_LOADER_DIR='C:\Windows CE Tools\PocketFrog\samples\FBasic\ARMRel\';

implementation

// inizializza e finalizza il caricamento della libreria
function InitDLL(root: String): Boolean;
begin
 if FileExists(root + 'FBIdeR.dll') then begin
  DLLHANDLE := LoadLibrary(PChar(root + 'FBIdeR.dll'));
 end else if FileExists(root + 'FBIde.dll') then begin
  DLLHANDLE := LoadLibrary(PChar(root + 'FBIde.dll'));
 end else begin
  Result := false;
  exit;
 end;
 Result := (DLLHANDLE <> 0);
end;


function GetDLLFuncs(): Boolean;
begin
  if DLLHANDLE <> 0 then begin
    @ECopyRes := GetProcAddress(DLLHANDLE, 'ECopyRes');
    @EGetDllVersion := GetProcAddress(DLLHANDLE, 'EGetDllVersion');
    @EGetResourceAsPointer := GetProcAddress(DLLHANDLE, 'EGetResourceAsPointer');
    @ERegisterExeFile := GetProcAddress(DLLHANDLE, 'ERegisterExeFile');
  end;

  if ( (@ECopyRes = nil) or (@EGetDllVersion = nil) or (@EGetResourceAsPointer = nil) or (@ERegisterExeFile = nil) ) then begin
    Result := false;
  end else begin
    Result := true;
  end;
end;

// inizializza e finalizza il caricamento della libreria
function FreeDLL(): Boolean;
begin
  Result := false;
  if DLLHANDLE <> 0 then begin
    FreeLibrary(DLLHANDLE);
    Result := true;
  end;
end;

function GetIniFile: String;
begin
  Result := FPath(ExtractFilePath(Application.ExeName)) + 'fba_ide.ini';
end;

function GetLastOpenedProject(index: Integer): String;
begin
  Result := '';
  if index < lastProjects.Count then begin
    Result := lastProjects.Strings[index];
  end;
end;

function GetLastOpenedProjectCount: Integer;
begin
  Result := lastProjects.Count;
end;

procedure InitLastOpenedProjectsList();
var
ini: TIniFile;
a: Integer;
str: String;
begin
  lastProjects := TStringList.Create;

  // carica lista ultimi progetti aperti dal file ini
  ini := TIniFile.Create(GetIniFile);
  for a:=1 to 15 do begin
    str := ini.ReadString('LAST_OPENED', 'S'+IntToStr(a),'');
    if Length(str) > 0 then begin
      lastProjects.Add(str);
    end;
  end;
  ini.Free;
end;


procedure FreeLastOpenedProjectsList();
var
ini: TIniFile;
a: Integer;
begin
  // salva lista ultimi progetti aperti nel file ini
  ini := TIniFile.Create(GetIniFile);
  if lastProjects.Count > 0 then begin
    for a:=0 to lastProjects.Count-1 do begin
      ini.WriteString('LAST_OPENED', 'S'+IntToStr(a+1), lastProjects.Strings[a]);
    end;
  end;
  ini.Free;

  lastProjects.Free;
end;

procedure AddOpenedProjectsList(prj: String);
var
a: Integer;
found: Boolean;
begin
  // adda se non c'era già
  found := False;
  if lastProjects.Count > 0 then begin
    for a:=0 to lastProjects.Count-1 do begin
      if UpperCase(lastProjects.Strings[a]) = UpperCase(prj) then begin
        found := true;
        break;
      end;
    end;
  end;

  if found = false then begin
    lastProjects.Add(prj);
    if lastProjects.Count > 15 then lastProjects.Delete(0);
  end;
end;

function LaunchWithTempFileAndWaitKill(tempdir: String; cmd: String; timeout: Integer): Boolean;
var
tempfile: String;
f: TFileStream;
start: LongInt;
begin
  Randomize;

  // crea file temporaneo che dovrà essere cancellato dal player
  try
    tempfile := FPath(tempdir)+'FBA_RUNNING_PLAYER_PID'+IntToStr(Random(1000000));
    f := TFileStream.Create(tempfile, fmCreate);
    f.Free;
  except
    Result := false;
    exit;
  end;

  ShellExecute(0, 'open', PChar(cmd),Pchar(Replace(tempfile, '\', '\\')),'',SW_SHOWNORMAL) ;

  // attendi che il file sia cancellato o max X secondi
  start := GetTickCount();
  while (GetTickCount() - start) < timeout do begin
    Application.ProcessMessages;
    if FileExists(tempfile) = false then begin
      Result := true;
      exit;
    end;
  end;

  Result := false;
end;

function Sto_ShellExecute(const FileName, Parameters: String;
  var ExitCode: DWORD; const Wait: DWORD = 0;
  const Hide: Boolean = False): Boolean;
var
  myInfo: SHELLEXECUTEINFO;
  iWaitRes: DWORD;
begin
  // prepare SHELLEXECUTEINFO structure
  ZeroMemory(@myInfo, SizeOf(SHELLEXECUTEINFO));
  myInfo.cbSize := SizeOf(SHELLEXECUTEINFO);
  myInfo.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
  myInfo.lpFile := PChar(FileName);
  myInfo.lpParameters := PChar(Parameters);
  if Hide then
    myInfo.nShow := SW_HIDE
  else
    myInfo.nShow := SW_SHOWNORMAL;
  // start file
  ExitCode := 0;
  Result := ShellExecuteEx(@myInfo);

  // if process could be started
  if Result then
  begin
    // wait on process ?
    if (Wait > 0) then
    begin
    // To wait until the application has been started (instead of finished), replace "WaitForSingleObject" with "WaitForInputIdle".
      iWaitRes := WaitForInputIdle(myInfo.hProcess, Wait);
      // timeout reached ?
      if (iWaitRes = WAIT_TIMEOUT) then
      begin
        Result := False;
        TerminateProcess(myInfo.hProcess, 0);
      end;
      // get the exitcode
      GetExitCodeProcess(myInfo.hProcess, ExitCode);
    end;
    // close handle, because SEE_MASK_NOCLOSEPROCESS was set
    CloseHandle(myInfo.hProcess);
  end;
end;


function GetSetupDllName(appname: String): String;
var
s: String;
c: Integer;
a: Integer;
begin
  Result := 'fbasetup_';
  s := LowerCase(appname);
  for a:=1 to Length(s) do begin
    c := Ord(Copy(s, a, 1)[1]);
    if ( ((c>=48)and(c<=57)) or ((c>=65)and(c<=90)) or ((c>=97)and(c<=122)) ) then begin
      Result := Result + Copy(s, a, 1);
    end else begin
      Result := Result + '_';
    end;
  end;
  Result := Result + '.dll';
end;

function GetResourceAsPointer(ResName: pchar; ResType: pchar; out Size: longword): pointer;
var
  InfoBlock: HRSRC;
  GlobalMemoryBlock: HGLOBAL;
begin

    InfoBlock := FindResource(hInstance, resname, restype);

    if InfoBlock = 0 then begin
      Result := nil;
      exit;
    end;

    // raise Exception.Create(SysErrorMessage(GetLastError));

    size := SizeofResource(hInstance, InfoBlock);

    if size = 0 then begin
      Result := nil;
      exit;
    end;

    //raise Exception.Create(SysErrorMessage(GetLastError));

    GlobalMemoryBlock := LoadResource(hInstance, InfoBlock);

    if GlobalMemoryBlock = 0 then begin
      Result := nil;
    end else begin
      //raise Exception.Create(SysErrorMessage(GetLastError));
      Result := LockResource(GlobalMemoryBlock);
    end;
      //raise Exception.Create(SysErrorMessage(GetLastError));
end;


// decide il nome della risorsa del launcher (contenuto nella risorsa delphi) in base a:
// a) hai selezionato audio extension nel menu
// b) hai selezionato ttf extension nel menu
// - il tipo di device
function LauncherResName(device: Integer; presuffix: String): String;
var
cpu: String;
begin
  if device = 1 then begin
    cpu := 'ARM';
  end else begin
    cpu := 'X86';
  end;


  if (SETTINGS[SETTINGS_EXT_SOUNDS]='0') and (SETTINGS[SETTINGS_EXT_TTF]='1') then begin
    // solo ttf
    Result := 'FBA'+cpu+presuffix+'_TTF_NOAUDIO';
  end else if (SETTINGS[SETTINGS_EXT_SOUNDS]='1') and (SETTINGS[SETTINGS_EXT_TTF]='0') then begin
    // solo sounds
    Result := 'FBA'+cpu+presuffix;
  end else if (SETTINGS[SETTINGS_EXT_SOUNDS]='0') and (SETTINGS[SETTINGS_EXT_TTF]='0') then begin
    // ne suoni ne sounds
    Result := 'FBA'+cpu+presuffix+'_NOTTF_NOAUDIO';
  end else begin
    // negli altri casi usa l'exe completo
    Result := 'FBA'+cpu+'_TTF';
  end;

  // per X86, prendi sempre lo stesso exe (debug o release)
  if device <> 1 then begin
    Result := 'FBAX86'+presuffix+'_TTF';
  end;

end;


function LauncherVCBuildName(device: Integer; presuffix: String): String;
var
cpu: String;
begin
  if device = 1 then begin
    cpu := 'ARM';
  end else begin
    cpu := 'X86';
  end;

  if (SETTINGS[SETTINGS_EXT_SOUNDS]='0') and (SETTINGS[SETTINGS_EXT_TTF]='1') then begin
    // solo ttf
    Result := 'fba'+cpu+presuffix+'_TTF_NOAUDIO.exe';
  end else if (SETTINGS[SETTINGS_EXT_SOUNDS]='1') and (SETTINGS[SETTINGS_EXT_TTF]='0') then begin
    // solo sounds
    Result := 'fba'+cpu+presuffix+'.exe';
  end else if (SETTINGS[SETTINGS_EXT_SOUNDS]='0') and (SETTINGS[SETTINGS_EXT_TTF]='0') then begin
    // ne suoni ne sounds
    Result := 'fba'+cpu+presuffix+'_NOTTF_NOAUDIO.exe';
  end else begin
    // negli altri casi usa l'exe completo
    Result := 'fba'+cpu+presuffix+'_TTF.exe';
  end;

  // per X86, prendi sempre lo stesso exe
  if device <> 1 then begin
    Result := 'fbaX86'+presuffix+'_TTF.exe';
  end;

end;

function CopyRes(resname: String; finalfile: String; is_fba_player: Boolean): Boolean;
begin
  // non lo copiare se è il player fba.exe ed è già stato cachato
  // in un run precedente
  if (is_fba_player) and (COPY_FBA_PLAYER_CACHED) then begin
    Result := true;
  end else begin
    Result := ECopyRes(PChar(resname), PChar(finalfile));
  end;

  {
  if FileExists(finalfile) then DeleteFile(PChar(finalfile));
  SaveResourceAsFile(resname,  finalfile);
  Result := true;
  }
end;


function FPath(p: String): String;
begin
  if Length(p) = 0 then begin
    Result := '';
    exit;
  end;
  if Copy(p, Length(p), 1) <> '\' then begin
    Result := p+'\';
  end else begin
    Result := p;
  end;
end;

function FExtractFilePath(p: String): String;
var
pp: String;
begin
  pp := ExtractFilePath(p);
  Result := FPath(pp);
end;

procedure SaveResourceAsFile(const ResName: string; const FileName: string);
begin
    with TResourceStream.Create(0, ResName, RT_RCDATA) do
      try
        SaveToFile(FileName);
      finally
        Free;
      end;
end;

procedure InitLuaFunctionsImmediateHelp();
var
  ResData: PChar;
  ResSize: Longword;
  res: String;
  lines: TStringList;
  tag, value, row: String;
  a,b: Integer;
begin
  fasthelp_names := TStringList.Create;
  fasthelp_text := TStringList.Create;
  ResData := EGetResourceAsPointer(PChar('LOADERLUA'), RT_RCDATA, ResSize);
  if ResData <> nil then begin
    SetString(res, ResData, ResSize);

    res := Replace(res, chr(10), '');
    res := Replace(res, chr(9), '');

    lines := TStringList.Create;
    SplitStrings(res, chr(13), lines);
    for a:=0 to lines.Count-1 do begin

      tag := '---- STARTSECTION:';

      if Pos(tag, lines.Strings[a]) > 0 then begin
        row := Copy(lines.Strings[a], Pos(tag, lines.Strings[a])+Length(tag), Length(lines.Strings[a]) - Pos(tag, lines.Strings[a])-Length(tag)+1);
        b := a;
        value := '';
        while(UpperCase(lines.Strings[b]) <> 'SYNTAX:') do b:=b+1;
        b := b + 1;
        while(UpperCase(lines.Strings[b]) <> 'PARAM:') do begin
          if Length(value) > 0 then value := value + ' or ';
          value := value + lines.Strings[b];
          b:=b+1;
        end;

        fasthelp_names.Add(row);
        fasthelp_text.Add(value);

      end;
    end;
    lines.Free;

  end;
end;

function FindQuickHelp(key: String): String;
var
mystr: String;
a: Integer;
begin
  mystr := UpperCase(key);
  for a:= 0 to fasthelp_names.Count-1 do begin
    if UpperCase(fasthelp_names.Strings[a])=mystr then begin
      Result := fasthelp_text.Strings[a];
      exit;
    end;
  end;
  Result := '';
end;

procedure FreeLuaFunctionsImmediateHelp();
begin
  fasthelp_names.Free;
  fasthelp_text.Free;
end;


function GetLUAFunctionsFromFile(resname: String): TStringList;
var
  list: TStringList;
  ResData: PChar;
  ResSize: Longword;
  res: String;
  startat, a, _start, _end: Integer;
  searchStart: Boolean;
begin

  startat := 0;
  list := TStringList.Create;

  ResData := EGetResourceAsPointer(PChar(resname), RT_RCDATA, ResSize);

  if ResData <> nil then begin

    SetString(res, ResData, ResSize);
    _start := Pos('// BEGIN IDE AUTOCUT', res);
    _end := Pos('// END IDE AUTOCUT', res);
    searchStart := true;

    if ((_start > 0) and (_end > 0)) then begin
      res := Copy(res, _start, _end-_start);
      for a:=1 to Length(res) do begin
        if Copy(res, a, 1) = '"' then begin
          if searchStart then begin
            startat := a+1;
            searchStart := false;
          end else begin
            searchStart := true;
            list.Add(Copy(res, startat, a-startat));
          end;
        end;
      end;
    end;
  end;

  Result := list;

end;

function SplitStrings(const str: string; const separator: string;
                        Strings: TStrings): TStrings;
  // Fills a string list with the parts of "str" separated by
  // "separator". If Nil is passed instead of a string list,
  // the function creates a TStringList object which has to
  // be freed by the caller
  var
    n: integer;
    p, q, s: PChar;
    item: string;
  begin
    if Strings = nil then
      Result := TStringList.Create
    else
      Result := Strings;
    try
      p := PChar(str);
      s := PChar(separator);
      n := Length(separator);
      repeat
        q := StrPos(p, s);
        if q = nil then q := StrScan(p, #0);
        SetString(item, p, q - p);
        Result.Add(item);
        p := q + n;
      until q^ = #0;
    except
      item := '';
      if Strings = nil then Result.Free;
      raise;
    end;
end;



function ChangeIconExe(FileName, IcoFileName: pchar): Boolean;

procedure Error(const Msg: String);
begin
  //raise Exception.Create('Resource update error: ' + Msg);
  ShowMessage('Resource update error: ' + Msg);
end;

procedure ErrorWithLastError(const Msg: String);
begin
  Error(Msg + '(' + IntToStr(GetLastError) + ')');
end;

function EnumLangsFunc(hModule: Cardinal; lpType, lpName: PAnsiChar;
wLanguage: Word; lParam: Integer): Boolean; stdcall;
begin
  PWord(lParam)^ := wLanguage;
  Result := False;
end;

function GetResourceLanguage(hModule: Cardinal; lpType, lpName: PAnsiChar;
var wLanguage: Word): Boolean;
begin
  wLanguage := 0;
  EnumResourceLanguages(hModule, lpType, lpName, @EnumLangsFunc,
Integer(@wLanguage));
  Result := True;
end;

type
  PIcoItemHeader = ^TIcoItemHeader;
  TIcoItemHeader = packed record
    Width: Byte;
    Height: Byte;
    Colors: Byte;
    Reserved: Byte;
    Planes: Word;
    BitCount: Word;
    ImageSize: DWORD;
  end;
  PIcoItem = ^TIcoItem;
  TIcoItem = packed record
    Header: TIcoItemHeader;
    Offset: DWORD;
  end;
  PIcoHeader = ^TIcoHeader;
  TIcoHeader = packed record
    Reserved: Word;
    Typ: Word;
    ItemCount: Word;
    Items: array [0..MaxInt shr 4 - 1] of TIcoItem;
  end;
  PGroupIconDirItem = ^TGroupIconDirItem;
  TGroupIconDirItem = packed record
    Header: TIcoItemHeader;
    Id: Word;
  end;
  PGroupIconDir = ^TGroupIconDir;
  TGroupIconDir = packed record
    Reserved: Word;
    Typ: Word;
    ItemCount: Word;
    Items: array [0..MaxInt shr 4 - 1] of TGroupIconDirItem;
  end;

  function IsValidIcon(P: Pointer; Size: Cardinal): Boolean;
  var
    ItemCount: Cardinal;
  begin
    Result := False;
    if Size < Cardinal(SizeOf(Word) * 3) then
      Exit;
    if (PChar(P)[0] = 'M') and (PChar(P)[1] = 'Z') then
      Exit;
    ItemCount := PIcoHeader(P).ItemCount;
    if Size < Cardinal((SizeOf(Word) * 3) + (ItemCount * SizeOf(TIcoItem)))
then
      Exit;
    P := @PIcoHeader(P).Items;
    while ItemCount > Cardinal(0) do begin
      if (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) <
Cardinal(PIcoItem(P).Offset)) or
         (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) >
Cardinal(Size)) then
        Exit;
      Inc(PIcoItem(P));
      Dec(ItemCount);
    end;
    Result := True;
  end;

var
  H: THandle;
  M: HMODULE;
  R: HRSRC;
  Res: HGLOBAL;
  GroupIconDir, NewGroupIconDir: PGroupIconDir;
  I: Integer;
  wLanguage: Word;
  //F: TFile;
  F: TFileStream;
  Ico: PIcoHeader;
  N: Cardinal;
  NewGroupIconDirSize: LongInt;
begin
  result := false;

  if Win32Platform <> VER_PLATFORM_WIN32_NT then begin
    ShowMessage('IconChane: Only supported on Windows NT and above');
    Exit;
  end;

  Ico := nil;

  try
    { Load the icons }
    //F := TFile.Create(IcoFileName, fdOpenExisting, faRead, fsRead);
    F := TFileStream.Create(IcoFileName, fmOpenRead, fmShareDenyRead);
    try
      N := F.Size;// .Capped Size;
      if Cardinal(N) > Cardinal($100000) then begin { sanity check }
        Error('[IUPDATE] Icon file is too large');
        Exit;
      end;
      GetMem(Ico, N);
      F.ReadBuffer(Ico^, N);
    finally
      F.Free;
    end;

    { Ensure the icon is valid }
    if not IsValidIcon(Ico, N) then begin
      Error('[] Icon file is invalid');
      Exit;
    end;

    { Update the resources }
    H := BeginUpdateResource(PChar(FileName), False);
    if H = 0 then begin
      ErrorWithLastError('[] BeginUpdateResource failed (1)');
      Exit;
    end;
    try
      M := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
      if M = 0 then begin
        ErrorWithLastError('[] LoadLibraryEx failed (1)');
        Exit;
      end;

      try
       { Load the 'MAINICON' group icon resource }
        R := FindResource(M, MAKEINTRESOURCE(116), RT_GROUP_ICON);
        if R = 0 then begin
          ErrorWithLastError('[] FindResource failed (1)');
          Exit;
        end;
        Res := LoadResource(M, R);
        if Res = 0 then begin
          ErrorWithLastError('[IUPDATE] LoadResource failed (1)');
          Exit;
        end;
        GroupIconDir := LockResource(Res);
        if GroupIconDir = nil then begin
          ErrorWithLastError('[] LockResource failed (1)');
          Exit;
        end;

        { Delete 'MAINICON' }
        if not GetResourceLanguage(M, RT_GROUP_ICON, MAKEINTRESOURCE(116), wLanguage)
then begin
          ErrorWithLastError('[] GetResourceLanguage failed (1)');
          Exit;
        end;
        if not UpdateResource(H, RT_GROUP_ICON, MAKEINTRESOURCE(116), wLanguage, nil,
0) then begin
          ErrorWithLastError('[] UpdateResource failed (1)');
          Exit;
        end;

        { Delete the RT_ICON icon resources that belonged to 'MAINICON' }
        for I := 0 to GroupIconDir.ItemCount-1 do begin
          if not GetResourceLanguage(M, RT_ICON,
MakeIntResource(GroupIconDir.Items[I].Id), wLanguage) then begin
            ErrorWithLastError('[] GetResourceLanguage failed (2)');
            Exit;
          end;
          if not UpdateResource(H, RT_ICON,
MakeIntResource(GroupIconDir.Items[I].Id), wLanguage, nil, 0) then begin
            ErrorWithLastError('[] UpdateResource failed (2)');
            Exit;
          end;
        end;

        { Build the new group icon resource }
        NewGroupIconDirSize :=
3*SizeOf(Word)+Ico.ItemCount*SizeOf(TGroupIconDirItem);
        GetMem(NewGroupIconDir, NewGroupIconDirSize);
        try
          { Build the new group icon resource }
          NewGroupIconDir.Reserved := GroupIconDir.Reserved;
          NewGroupIconDir.Typ := GroupIconDir.Typ;
          NewGroupIconDir.ItemCount := Ico.ItemCount;
          for I := 0 to NewGroupIconDir.ItemCount-1 do begin
            NewGroupIconDir.Items[I].Header := Ico.Items[I].Header;
            NewGroupIconDir.Items[I].Id := I+1; //assumes that there aren'tany icons left
          end;

          { Update 'MAINICON' }
          for I := 0 to NewGroupIconDir.ItemCount-1 do
            if not UpdateResource(H, RT_ICON,
MakeIntResource(NewGroupIconDir.Items[I].Id), 1033, Pointer(DWORD(Ico) +
Ico.Items[I].Offset), Ico.Items[I].Header.ImageSize) then begin
              ErrorWithLastError('[] UpdateResource failed (3)');
              Exit;
            end;

          { Update the icons }
          if not UpdateResource(H, RT_GROUP_ICON, MAKEINTRESOURCE(116), 1033,
NewGroupIconDir, NewGroupIconDirSize) then begin
            ErrorWithLastError('[] UpdateResource failed (4)');
            Exit;
          end;
        finally
          FreeMem(NewGroupIconDir);
        end;
      finally
        FreeLibrary(M);
      end;
    except
      EndUpdateResource(H, True);  { discard changes }
      raise;
    end;
    if not EndUpdateResource(H, False) then begin
      Error('[] EndUpdateResource failed');
      Exit;
    end;
  finally
    FreeMem(Ico);
  end;

  result := true;
end;

procedure RegisterFileType(ExtName:String; AppName:String);
var
  reg: TRegistry;
  changed: Boolean;
begin
  changed := false;
  reg := TRegistry.Create;
  try
   reg.RootKey:=HKEY_CLASSES_ROOT;
   reg.OpenKey('.' + ExtName, True) ;
   reg.WriteString('', ExtName + 'file') ;
   reg.CloseKey;
   reg.CreateKey(ExtName + 'file') ;
   reg.OpenKey(ExtName + 'file\DefaultIcon', True) ;
   reg.WriteString('', AppName + ',0') ;
   reg.CloseKey;
   reg.OpenKey(ExtName + 'file\shell\open\command', True) ;
   if UpperCase(AppName+' "%1"') <> UpperCase(reg.ReadString('')) then begin
    reg.WriteString('',AppName+' "%1"') ;
    changed:=true;
   end;
   reg.CloseKey;
  finally
   reg.Free;
  end;
  if changed then SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil) ;
end;

function MakeValidPath(s: String): String;
var
a: Integer;
c: Char;
begin
  Result := '';
  for a:=1 to Length(s) do begin
    c := Copy(s, a, 1)[1];
    if (
      ( c = '.' ) or
      ( (Ord(c) >= 65) and (Ord(c) <= 90) ) or
      ( (Ord(c) >= 48) and (Ord(c) <= 57) ) or
      ( (Ord(c) >= 97) and (Ord(c) <= 122) )
    ) then begin
      Result := Result + Copy(s, a, 1);
    end else begin
      Result := Result + '_';
    end;
  end;
end;

function GetDllVersion():string;
begin
  Result := EGetDllVersion();
end;

function  GetAppVersion:string;
   var
    Size, Size2: DWord;
    Pt, Pt2: Pointer;
   begin
     Size := GetFileVersionInfoSize(PChar (ParamStr (0)), Size2);
     if Size > 0 then
     begin
       GetMem (Pt, Size);
       try
          GetFileVersionInfo (PChar (ParamStr (0)), 0, Size, Pt);
          VerQueryValue (Pt, '\', Pt2, Size2);
          with TVSFixedFileInfo (Pt2^) do
          begin
            Result:= IntToStr (HiWord (dwFileVersionMS)) + '.' +
                     IntToStr (LoWord (dwFileVersionMS)) + '.' +
                     IntToStr (HiWord (dwFileVersionLS)) + '.' +
                     IntToStr (LoWord (dwFileVersionLS));
         end;
       finally
         FreeMem (Pt);
       end;
     end;
end;

// carica i settaggi dell'editor in memoria
procedure LoadEditorOptionsInMemory();
var
ini: TIniFile;
begin
  // Carica settings
  ini := TIniFile.Create(GetIniFile);

  OPTIONS_BOOL[IDE_OPTIONS_LAUNCER_TOPMOST] := ini.ReadBool('Debugging_Player', 'TopMost', true);

  OPTIONS_STRING[IDE_OPTIONS_COLOR_COMMENTS] := ini.ReadString('Colors', 'Comments', ColorToString(clYellow));
  OPTIONS_STRING[IDE_OPTIONS_COLOR_KEYS] := ini.ReadString('Colors', 'Keys', ColorToString(clAqua));
  OPTIONS_STRING[IDE_OPTIONS_COLOR_FUNCTIONS] := ini.ReadString('Colors', 'Functions', ColorToString($00E2B88D));
  OPTIONS_STRING[IDE_OPTIONS_COLOR_STRINGS] := ini.ReadString('Colors', 'Strings', ColorToString($0066ff00));

  OPTIONS_STRING[IDE_OPTIONS_COLOR_STRINGS] := ini.ReadString('Colors', 'Strings', ColorToString($0066ff00));

  OPTIONS_NUMBER[IDE_OPTIONS_TABS_SPACE] := ini.ReadInteger('Editor', 'TabsSpace', 8);

  OPTIONS_STRING[IDE_OPTIONS_COLOR_ACTIVELINEBACK] := ini.ReadString('Editor', 'ActiveLineBackColor', ColorToString($00D2914F));
  OPTIONS_STRING[IDE_OPTIONS_COLOR_EDITORBACK] := ini.ReadString('Editor', 'Backcolor', ColorToString($00885522));
  OPTIONS_STRING[IDE_OPTIONS_COLOR_SELECTEDBACK] := ini.ReadString('Editor', 'SelectedTextBackcolor', ColorToString($0077AADD));
  OPTIONS_STRING[IDE_OPTIONS_COLOR_SELECTEDFORE] := ini.ReadString('Editor', 'SelectedTextForecolor', ColorToString(clBlack));

  OPTIONS_STRING[IDE_OPTIONS_COLOR_SYNTAX1] := ini.ReadString('Editor', 'Syntax1Color', ColorToString(clAqua));
  OPTIONS_STRING[IDE_OPTIONS_COLOR_SYNTAX2] := ini.ReadString('Editor', 'Syntax2Color', ColorToString(clWhite));
  OPTIONS_STRING[IDE_OPTIONS_COLOR_SYNTAX3] := ini.ReadString('Editor', 'Syntax3Color', ColorToString($0066ff00));
  OPTIONS_STRING[IDE_OPTIONS_COLOR_SYNTAX4] := ini.ReadString('Editor', 'Syntax4Color', ColorToString(clYellow));
  OPTIONS_STRING[IDE_OPTIONS_COLOR_SYNTAX5] := ini.ReadString('Editor', 'Syntax5Color', ColorToString($00E2B88D));
  OPTIONS_STRING[IDE_OPTIONS_COLOR_SYNTAX6] := ini.ReadString('Editor', 'Syntax6Color', ColorToString(clWhite));

  ini.Free;
end;

end.
