build.dpr

East make Tray Icon in delphi

  ps := Pos(' ', FText);
  if ps = 0 then
    Exit;
  P := PChar(FText) + ps;
  while P[0] <> #0 do
  begin
    while P[0] in [#1..#32] do
      Inc(P);
    if P[0] = #0 then
      Break;
    F := P;
    InStr1 := False;
    InStr2 := False;
    while True do
    begin
      case P[0] of
        #0, #9, #32, '/':
          if not (InStr1 or InStr2) or (P[0] = #0) then
          begin
            SetString(S, F, P - F);
            Result := TAttr.Create(S);
            if SameText(Result.Name, Name) then
              Exit;
            Inc(P);
            Break;
          end;
        '''':
          InStr1 := not InStr1;
        '"':
          InStr2 := not InStr2;
      end;
      Inc(P);
    end;
  end;
  Result := TAttr.Create('');
end;
{******************************************************************************}
{ TAttr }

constructor TAttr.Create(const AText: string);
begin
  inherited Create;
  FText := AText;
end;
{******************************************************************************}
function TAttr.Name: string;
var
  ps: Integer;
begin
  ps := Pos('=', FText);
  if ps = 0 then
    Result := FText
  else
    Result := Copy(FText, 1, ps - 1);
end;
{******************************************************************************}
function TAttr.Value: string;
var
  ps: Integer;
begin
  ps := Pos('=', FText);
  if ps = 0 then
    Result := ''
  else
  begin
    Result := Copy(FText, ps + 1, MaxInt);
    if (Result <> '') and (Result[1] in ['''', '"']) then
    begin
      Delete(Result, 1, 1);
      Delete(Result, Length(Result), 1);
    end;
  end;
end;
{******************************************************************************}
function AsterixMacro(const S, AsterixRepl: string): string;
var
  I: Integer;
begin
  Result := S;
  I := Pos('*', Result);
  if I > 0 then
  begin
    Delete(Result, I, 1);
    Insert(AsterixRepl, Result, I);
  end;
end;
{******************************************************************************}
procedure LoadTargetNames;
var
  xml: TXmlFile;
  tg: ITag;
begin
  xml := TXmlFile.Create(LibraryRootDir + '\' + pgEditFile);
  try
    tg := xml.NextTag;
    while tg <> nil do
    begin
      if SameText(tg.Name, 'model') and SameText(tg.Attrs('name').Value, LibraryName) then
      begin
        tg := xml.NextTag;
        while not SameText(tg.Name, 'targets') do
          tg := xml.NextTag;
        while not SameText(tg.Name, '/targets') do
        begin
          if SameText(tg.Name, 'target') then
          begin
            if FileExists(LibraryRootDir + '\packages\' + AsterixMacro(PackageGroupName, tg.Attrs('name').Value) + '.bpg') or
               FileExists(LibraryRootDir + '\packages\' + AsterixMacro(PackageGroupName, tg.Attrs('name').Value) + '.bdsgroup') then
            begin
              SetLength(Targets, Length(Targets) + 1); // we do not have 10tnds iterations so this is acceptable
              with Targets[High(Targets)] do
              begin
                Name := tg.Attrs('name').Value;
                PerName := tg.Attrs('pname').Value;
                PerDir := tg.Attrs('pdir').Value;
              end;
            end;
          end;
          tg := xml.NextTag;
        end;
        Break; // we only want the "LibraryName" part
      end;
      tg := xml.NextTag;
    end;
  finally
    xml.Free;
  end;
end;
{******************************************************************************}
{ TEdition }

constructor TEdition.Create(const AEditionName, PerDirName: string);
var
  Index: Integer;
begin
  if UpCase(AEditionName[1]) = 'D' then
    Typ := Delphi
  else
    Typ := BCB;

  VersionStr := AEditionName[2];
  if (Length(AEditionName) > 2) and (AEditionName[3] in ['0'..'9']) then
  begin
    VersionStr := VersionStr + AEditionName[3];
    Index := 4;
  end
  else
    Index := 3;

  Version := StrToInt(VersionStr);
  IDEVersionStr := VersionStr;
  IDEVersion := Version;

  if Version > 7 then
  begin
    Typ := BDS;
    IDEVersion := Version - 6; // D 8 = BDS 2
    IDEVersionStr := IntToStr(IDEVersion);
  end;

  FMainName := Copy(AEditionName, 1, Index - 1);
  FName := AEditionName;
  PkgDir := AEditionName;

  FIsCLX := SameText('clx', Copy(AEditionName, Index, 3));
  FIsPersonal := False;
  if Length(AEditionName) > Index then
  begin
    if (UpCase(AEditionName[Index]) = 'P') or (UpCase(AEditionName[Index]) = 'S') then
    begin
      FIsPersonal := True;
      PkgDir := PerDirName
    end;
  end;

  ReadRegistryData;
end;
{******************************************************************************}
procedure TEdition.ReadRegistryData;
var
  KeyName: string;
  Reg: HKEY;
  RegTyp: LongWord;
  ProjectsDir: string;

  function ReadStr(const Name: string): string;
  var
    Len: Longint;
  begin
    Len := MAX_PATH;
    SetLength(Result, MAX_PATH);
    RegQueryValueEx(Reg, PChar(Name), nil, @RegTyp, PByte(Result), @Len);
    SetLength(Result, StrLen(PChar(Result)));
  end;

  function ResolveMacros(const Dir: string): string;
  var
    ps, psEnd: Integer;
    S: string;
  begin
    if StartsText('$(DELPHI)', Dir) then
      Result := FRootDir + Copy(Dir, 10, MaxInt)
    else if StartsText('$(BCB)', Dir) then
      Result := FRootDir + Copy(Dir, 7, MaxInt)
    else if StartsText('$(BDS)', Dir) then
      Result := FRootDir + Copy(Dir, 7, MaxInt)
    else if StartsText('$(BDSPROJECTSDIR)', Dir) then
      Result := GetBDSProjectsDir + Copy(Dir, 18, MaxInt)
    else
    begin
      Result := Dir;
      ps := Pos('$(', Result);
      if ps > 0 then
      begin
        psEnd := Pos(')', Result);
        if psEnd > 0 then
        begin
          S := Copy(Result, ps + 2, psEnd - ps - 2);
          if S <> '' then
          begin
            Delete(Result, ps, 2 + Length(S) + 1);
            Insert(GetEnvironmentVariable(S), Result, ps);
          end
        end;
      end;
    end
  end;

begin
  case Typ of
    Delphi:
      KeyName := 'Software\Borland\Delphi\' + IDEVersionStr + '.0';
    BCB:
      KeyName := 'Software\Borland\C++Builder\' + IDEVersionStr + '.0';
    BDS:
      KeyName := 'Software\Borland\BDS\' + IDEVersionStr + '.0';
  end;

  if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(KeyName), 0, KEY_QUERY_VALUE or KEY_READ, Reg) = ERROR_SUCCESS then
  begin
    FRootDir := ExcludeTrailingPathDelimiter(ReadStr('RootDir'));
    RegCloseKey(Reg);
  end;

  if Typ = BDS then
    ProjectsDir := GetBDSProjectsDir
  else
    ProjectsDir := FRootDir + '\Projects';

  FDcpDir := FRootDir + '\Projects\Bpl';
  FBplDir := FRootDir + '\Projects\Bpl';
  if Typ = BCB then
    FLibDir := FRootDir + '\Projects\Lib'
  else
    FLibDir := FRootDir + '\Projects\Bpl';

  if RegOpenKeyEx(HKEY_CURRENT_USER, PChar(KeyName + '\Library'), 0, KEY_QUERY_VALUE or KEY_READ, Reg) = ERROR_SUCCESS then
  begin
    FDcpDir := ResolveMacros(ExcludeTrailingPathDelimiter(ReadStr('Package DCP Output')));
    FBplDir := ResolveMacros(ExcludeTrailingPathDelimiter(ReadStr('Package DPL Output')));
    RegCloseKey(Reg);
  end;
end;
{******************************************************************************}
function TEdition.GetBDSProjectsDir: string;
var
  h: HMODULE;
  LocaleName: array[0..4] of Char;
  Filename: string;
  PersDir: string;
begin
  if (Typ = BDS) and (IDEVersion >= Low(BDSVersions)) and (IDEVersion <= High(BDSVersions)) then
  begin
    Result := 'Borland Studio Projects'; // do not localize

    FillChar(LocaleName, SizeOf(LocaleName[0]), 0);
    GetLocaleInfo(GetThreadLocale, LOCALE_SABBREVLANGNAME, LocaleName, SizeOf(LocaleName));
    if LocaleName[0] <> #0 then
    begin
      Filename := RootDir + '\Bin\coreide' + BDSVersions[IDEVersion].CIV + '.';
      if FileExists(Filename + LocaleName) then
        Filename := Filename + LocaleName
      else
      begin
        LocaleName[2] := #0;
        if FileExists(Filename + LocaleName) then
          Filename := Filename + LocaleName
        else
          Filename := '';
      end;

      if Filename <> '' then
      begin
        h := LoadLibraryEx(PChar(Filename), 0,
          LOAD_LIBRARY_AS_DATAFILE or DONT_RESOLVE_DLL_REFERENCES);
        if h <> 0 then
        begin
          SetLength(Result, 1024);
          SetLength(Result, LoadString(h, BDSVersions[IDEVersion].ProjectDirResId, PChar(Result), Length(Result) - 1));
          FreeLibrary(h);
        end;
      end;
    end;

    SetLength(PersDir, MAX_PATH);
    if SHGetSpecialFolderPath(0, PChar(PersDir), CSIDL_PERSONAL, False) then
    begin
      SetLength(PersDir, StrLen(PChar(PersDir)));
      Result := ExcludeTrailingPathDelimiter(PersDir) + '\' + Result;
    end
    else
      Result := '';
  end
  else
    Result := '';
end;
{******************************************************************************}
procedure FindDxgettext(Version: Integer);
var
  reg: HKEY;
  len: Longint;
  RegTyp: LongWord;
  i: Integer;
  S: string;
begin
 // dxgettext detection
  if RegOpenKeyEx(HKEY_CLASSES_ROOT, 'bplfile\Shell\Extract strings\Command', 0, KEY_QUERY_VALUE or KEY_READ, reg) <> ERROR_SUCCESS then
    Exit;
  SetLength(S, MAX_PATH);
  len := MAX_PATH;
  RegQueryValueEx(reg, '', nil, @RegTyp, PByte(S), @len);
  SetLength(S, StrLen(PChar(S)));
  RegCloseKey(reg);

  if S <> '' then
  begin
    if S[1] = '"' then
    begin
      Delete(S, 1, 1);
      i := 1;
      while (i <= Length(S)) and (S[i] <> '"') do
        Inc(i);
      SetLength(S, i - 1);
    end;
    S := ExtractFileDir(S);
    DxgettextDir := S;
    if not FileExists(DxgettextDir + '\msgfmt.exe') then
      DxgettextDir := ''
    else
    begin
      if Version = 5 then
        S := S + '\delphi5';
      ExtraUnitDirs := ExtraUnitDirs + ';' + S;
    end;
  end;
end;
{******************************************************************************}
function TargetIndexOfEdition(const ed: string): Integer;
begin
  for Result := 0 to High(Targets) do
    if SameText(Targets[Result].Name, ed) or SameText(Targets[Result].PerName, ed) then
      Exit;
  Result := -1;
end;
{******************************************************************************}
procedure AddEdition(const ed: string);
var
  I: Integer;
begin
  if ed = '' then
    Exit;
  if SameText(ed, 'k3') then // build.exe is for Windows only (maybe CrossKylix)
    Exit;
  for I := 0 to High(Editions) do
    if SameText(Editions[i].Name, ed) then
      Exit;

  I := TargetIndexOfEdition(ed);
  if I >= 0 then
  begin
    SetLength(Editions, Length(Editions) + 1);
    Editions[High(Editions)] := TEdition.Create(ed, Targets[I].PerDir);
  end;
end;
{******************************************************************************}
procedure AddAllEditions(AddPersonal: Boolean);
var
  i: Integer;
begin
  Editions := nil;
  for i := 0 to High(Targets) do
  begin
    AddEdition(Targets[i].Name);
    if AddPersonal then
      AddEdition(Targets[i].PerName);