{*******************************************************}
{                                                       }
{       IDEInsetupPacket                                }
{                                                       }
{       版权所有 (C) 2019 妖蛋                          }
{                                                       }
{*******************************************************}
{                                                       }
{提示：含*方法的代码均来自网络，版权问题请联系作者。    }
{提示：强烈不建议控件安装在含有中文的目录中！           }
{开源地址：https://gitee.com/suxuss_admin/Delphi-InsetPacket-Unit}
{                                                       }

unit IDEInsetupPacket;


interface
uses
  Winapi.Windows,System.SysUtils,System.Classes,System.Win.Registry,
  System.RegularExpressions,
  IdHashCRC,
  Winapi.ShlObj;

const
  bdsmix = 8;
  IdeListMax = 40;
  DelphiReg:string = '\SOFTWARE\Embarcadero\BDS\';
  BCBReg:string = '\C++\Paths\';

type
  TIDEPacket = class;
  TPathStringList = class;
  TCreateComponentLine = class;

  TPlatforms = record
    Name:string;
    BrowsingPath:TPathStringList;
    BrowsingPath_Clang32:TPathStringList;
    SearchPath:TPathStringList;
    SearchPath_Clang32:TPathStringList;
  end;

  TPlatformsArray = array of TPlatforms;

  TIDEInfo = packed record
    IsInsetup:Boolean;                          //是否安装
    Version:string;                             //版本号字符串
    ProductVersion:string;                      //产品版本号
    Name:string;                                //IDE完整名称
    RegeditPath:string;                         //IDE注册表路径
    RootDir:string;                             //安装路径
    AppDir:string;                              //软件路径
    dcc32:string;                               //dcc32.exe路径
    dcc64:string;                               //dcc64.exe路径
    TargetPlatformslistConst:Integer;           //编译类型数量
    TargetPlatformslist:TPlatformsArray;        //编译类型搜索路径列表
    CTargetPlatformslistConst:Integer;           //编译类型数量
    CTargetPlatformslist:TPlatformsArray;        //编译类型搜索路径列表
  end;




  TEnumVersion = function (Version:Integer):Integer of object;
  TCompareFile = function (FileA,FileB:string):Boolean of object;
  TEnumFileAndDir = function (Str:string;IsDir:Boolean):Boolean of object;
  //习惯性加了一个of object，如果您觉得不对可以删掉
  TCopyFile = function (lpExistingFileName, lpNewFileName: LPCWSTR; bFailIfExists: BOOL): BOOL of object;
  TInsetallPackBack = function (Version:Integer;PackPath,PackName:string;Issucceed:Boolean):Boolean of object;
  TUnInsetallPackBack = TInsetallPackBack;
  TDccBit = (dcc32,dcc64);

{ TCreateComponentLine }
  //编译命令生成类
  TCreateComponentLine = class(TObject)
  private
    FPacketPathFileName:string;
    FDccExePathFileName:string;
    FBPLOutpath:string;
    FDCPOutpath:string;
    FObjOutpath:string;
    FBPIOutpath:string;
    FDCUOutpath:string;
    FHppOutpath:string;
    FXMLOutpath:string;
    FOutExecutableFilePath:string;
    FNameSpacepath:string;
    FImageBase:NativeUInt;
    FComponentOption:string;
    FComponentAllUnits:Boolean;
    FGenerateObj:Boolean;
    FGenerateCFile:Boolean;
    FResourceDirectories:string;
    FUnitDirectories:string;
    FCreateMapFile:Boolean;
    FOutputHintMessages:Boolean;
    FOutputNameExtension:string;
    FGenerateDeBug:Boolean;
    FDefineConditionals:string;
    FIncludedirectories:string;
    function GetComponentLine:string;
  protected

  public
    constructor Create(DefaultCompontLine:Boolean);
    destructor Destroy; override;
    procedure SetPacketOutpath(path:string);
    property ComponentAllUnits:Boolean read FComponentAllUnits write FComponentAllUnits;
    //-JPHNE = Generate C++ .obj file, .hpp file, in namespace, export all
    //-JL = Generate package .lib, .bpi, and all .hpp files for C++
    property GenerateCFile:Boolean read FGenerateCFile write FGenerateCFile;
    property GenerateDeBug:Boolean read FGenerateDeBug write FGenerateDeBug;
    property UnitDirectories:string read FUnitDirectories write FUnitDirectories; //-U<paths> = Unit directories
    property Includedirectories:string read FIncludedirectories write FIncludedirectories;
    property DefineConditionals:string read FDefineConditionals write FDefineConditionals;
    property ResourceDirectories:string read FResourceDirectories write FResourceDirectories; //-R<paths> = Resource directories
    property ImageBase:NativeUInt read FImageBase write FImageBase;          //  -K<addr> = Set image base addr
    //输出路径需要带""
    property BPLOutpath:string read FBPLOutpath write FBPLOutpath;           //  -LE<path> = package .bpl output directory
    //输出路径需要带""
    property DCPOutpath:string read FDCPOutpath write FDCPOutpath;           //  -LN<path> = package .dcp output directory
    //输出路径需要带""
    property BPIOutpath:string read FBPIOutpath write FBPIOutpath;           //  -NB<path> = unit .bpi output directory
    //输出路径需要带""
    property DCUOutpath:string read FDCUOutpath write FDCUOutpath;           //  -NU<path> = unit .dcu output directory
    //输出路径需要带""
    property HppOutpath:string read FHppOutpath write FHppOutpath;           // unit .hpp output directory
    //输出路径需要带""
    property ObjOutpath:string read FObjOutpath write FObjOutpath;           //-NO<path> = unit .obj output directory
    //输出路径需要带""
    property XMLOutpath:string read FXMLOutpath write FXMLOutpath;           // -NX<path> = unit .xml output directory
    property GenerateObj:Boolean read FGenerateObj write FGenerateObj;//-J = Generate .obj file
    property OutputHintMessages:Boolean read FOutputHintMessages write FOutputHintMessages; //-H = Output hint messages
    property OutExecutableFilePath:string read FOutExecutableFilePath write FOutExecutableFilePath;// -E<path> = EXE/DLL output directory
    property OutputNameExtension:string read FOutputNameExtension write FOutputNameExtension;
    property NameSpacepath:string read FNameSpacepath write FNameSpacepath;  //-NS<namespaces> = Namespace search path
    property ComponentOption:string read FComponentOption write FComponentOption; //其他编译选项
    property CreateMapFile:Boolean read FCreateMapFile write FCreateMapFile;
    property PacketPathFileName:string read FPacketPathFileName write FPacketPathFileName;
    property ComponentLine:string read GetComponentLine;
    property DccExePathFileName:string read FDccExePathFileName write FDccExePathFileName;
  end;


{ TPathStringList }
  //路径列表解析类
  TPathStringList = class(TObject)
  private
    Fpath :string;
    PathList:TStringList;
    function ForMatPath:Boolean;
    function GetPath:string;
    procedure SetPath(SPath:string);
    function GetCmdPath:string;
    function GetItem(Index:Integer):string;
    procedure SetItem(Index:Integer;SPath:string);
    function GetItemCount:Integer;
  protected

  public
    property PathStr:string read GetPath write SetPath;
    //返回的路径将会有双引号
    property PathCmdStr:string read GetCmdPath;
    property PathItem[Index:Integer]:string read GetItem write SetItem;
    property PathItemCount:Integer read GetItemCount;
    procedure AddPath(addstr:string);
    function DelPath(Index:Integer):Boolean;overload;
    function FindPath(xPath:string):Integer;overload;
    function FindPath(xPath: string;var r:Integer):Boolean;overload;
    constructor Create(F_Path:string);
    destructor Destroy; override;
  end;

{ TIDEPacket }
  //IDE主类
  TIDEPacket = class(TObject)
  private
    IdeList:array [0..IdeListMax] of TIDEInfo;
    function RunDOS(const CommandLine: PWideChar;sRet: TStrings = nil): Boolean;
  protected

  public
    //配置编译参数
    ComponentLine:TCreateComponentLine;
    //枚举已安装的Delphi信息
    function EnumVersionBDS(CallBack:TEnumVersion):Boolean;
    //获取指定版本编译搜索路径
    function GetTargetPlatformslist(Version:Integer;var TargetPlatformslistConst:Integer):TPlatformsArray;
    //安装BPL到指定版本
    function InsetallBPL(Version:Integer;PacketPath,PacketFileName: string;PacketName:string = ''):Boolean;overload;
    //安装BPL到所有版本
    procedure InsetallBPL(PacketPath,PacketFileName: string;PacketName:string = '';CallBack:TInsetallPackBack = nil);overload;
    //指定版本卸载BPL
    function UninsetallBPL(Version:Integer;PacketPath,PacketFileName: string):Boolean;overload;
    //所有版本卸载BPL
    procedure UninsetallBPL(PacketPath,PacketFileName: string;callback:TUnInsetallPackBack = nil);overload;
    //检查是否安装BPL,如不设置Compare则只对比文件名。
    function IsInsetBPL(version:Integer;BPLPathFileName:string;Compare:TCompareFile = nil):string;
    //将修改后的搜索路径信息写入注册表
    function WriteTargetPlatformslistRegedit:Boolean;overload;
    //将修改后的指定版本搜索路径信息写入注册表
    function WriteTargetPlatformslistRegedit(Version:Integer):Boolean;overload;
    //编译32位版本
    function Component32(Version:Integer;PacketPath,PacketFileName:string;AutoAddUnitPath:Boolean = True):Boolean;overload;
    //编译64位版本
    function Component64(Version:Integer;PacketPath,PacketFileName:string;AutoAddUnitPath:Boolean = True):Boolean;overload;
    //免配置快速编译指定版本
    function QuietCompoentPack(Version:Integer;bit:TDccBit;PacketPath,PacketFileName:string):Boolean;overload;
    //添加指定版本IDE插件
    function AddExperts(Version:Integer;ExpertsFileName:string;ExpertsName:string):Boolean;overload;
    //添加所有版本IDE插件
    function AddExperts(ExpertsFileName:string;ExpertsName:string):Boolean;overload;
    //检查是否安装插件,如不设置Compare则只对比文件名。
    function IsInsetExperts(version:Integer;ExpertsPathFileName:string;Compare:TCompareFile = nil):string;
    //添加指定版本指定编译类型搜索路径
    function AddBrowsingPath(Version:Integer;TargetPlatformsName:string;Path:string):Boolean;overload;
    //添加所有版本指定编译类型搜索路径
    function AddBrowsingPath(TargetPlatformsName:string;Path:string):Boolean;overload;
    //删除指定版本指定编译类型搜索路径
    function DelBrowsingPath(Version:Integer;TargetPlatformsName:string;Path:string):Boolean;overload;
    //删除所有版本指定编译类型搜索路径
    function DelBrowsingPath(TargetPlatformsName:string;Path:string):Boolean;overload;
    //获取指定版本的搜索路径
    function GetBrowsingPath(Version:Integer;TargetPlatformsName:string):String;overload;
    //获取指定版本的搜索路径（每个路径添加成对双引号）
    function GetBrowsingCmdPath(Version:Integer;TargetPlatformsName:string):String;overload;
    //添加指定版本指定编译类型搜索路径
    function AddSearchPath(Version:Integer;TargetPlatformsName:string;Path:string):Boolean;overload;
    //添加所有版本指定编译类型搜索路径
    function AddSearchPath(TargetPlatformsName:string;Path:string):Boolean;overload;
    //删除指定版本指定编译类型搜索路径
    function DelSearchPath(Version:Integer;TargetPlatformsName:string;Path:string):Boolean;overload;
    //删除所有版本指定编译类型搜索路径
    function DelSearchPath(TargetPlatformsName:string;Path:string):Boolean;overload;
    //获取指定版本的搜索路径
    function GetSearchPath(Version:Integer;TargetPlatformsName:string):string;overload;
    //获取指定版本的搜索路径（每个路径添加成对双引号）
    function GetSearchCmdPath(Version:Integer;TargetPlatformsName:string):string;overload;
    //获取指定版本的Delphi安装目录
    function GetRootPath(Version:Integer):string;overload;
    //添加指定版本用户变量,IsAdd为假时，重复添加将失败，IsAdd为真时，重复添加将以路径列表形式在现有值基础上添加
    function AddUserOverrides(Version:Integer;name:string;path:string;IsAdd:Boolean):Boolean;overload;
    //添加所有版本用户变量,IsAdd为假时，重复添加将失败，IsAdd为真时，重复添加将以路径列表形式在现有值基础上添加
    function AddUserOverrides(name:string;path:string;IsAdd:Boolean):Boolean;overload;
    //删除指定版本用户变量
    function DelUserOverrides(Version:Integer;name:string):Boolean;overload;
    //删除所有版本用户变量
    function DelUserOverrides(name:string):Boolean;overload;
    //查询用户变量值
    function UserOverridesToString(Version:Integer;TargetPlatformsName:string;UserOverrides:string):string;
    //将路径中的$()转换成对应值
    function ReplacePathUserOverrides(Version:Integer;TargetPlatformsName:string;Path:string):string;
    //查询系统变量值
    function SystemOverridesToString(SystemOverrides:string):string;
    //版本号转工程版本号
    function VersionToProductVersion(Version:Integer):string;
    //获取IDE名称
    function GetIDEName(Version:Integer):string;
    //*判断目录是否可写
    function DirWritable(m_dir:string):boolean;
    //*获取文件CRC效验和
    function GetFileCRC(const iFileName: string): String;
    //获取Delphi控件安装目录,在公共用户文件夹里
    function GetUserPacketDir(Version:Integer):string;
    function GetWinUserPacketDir(Version:Integer):string;
    //复制文件到指定文件夹,返回成功的文件数量,如果不指定pCopyFile则使用winapi中的CopyFileW
    function CopyDirFilesToDir(sPath:string;FileNames:string;sToPath:string;pCopyFile:TCopyFile = nil;FileList:TStrings = nil):Integer;
    //递归枚举文件
    function EnumDirAndFile(sPath:string;pEnum:TEnumFileAndDir):Integer;
    //当前编译器位数
    constructor Create;
    destructor Destroy; override;
  end;

//*提升Debug权限
function EnableDebugPriv: Boolean;
implementation
function EnableDebugPriv: Boolean; //提升进程权限为DEBUG权限
var
  hToken: THandle;
  tp: TTokenPrivileges;
  rl: Cardinal;
begin
  Result := false;
  OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken);
  if LookupPrivilegeValue(nil, 'SeDebugPrivilege', tp.Privileges[0].Luid) then
  begin
    tp.PrivilegeCount:=1;
    tp.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED;
    Result := AdjustTokenPrivileges(hToken, false, tp, SizeOf(tp), nil, rl);
  end;
end;


{ TIDEPacket }


function TIDEPacket.WriteTargetPlatformslistRegedit(Version:Integer):Boolean;
var
  i:Integer;
  Reg:TRegistry;
begin
     Result := False;
     Reg := TRegistry.Create;
     Reg.RootKey := HKEY_CURRENT_USER;
     if IdeList[Version].IsInsetup then
     begin
       for i:= 0 to IdeList[Version].TargetPlatformslistConst - 1 do
       begin
         if Reg.OpenKey(IdeList[Version].RegeditPath + '\Library\' + IdeList[Version].TargetPlatformslist[i].Name,False) then
         begin
          if Reg.ValueExists('Browsing Path') then
            Reg.WriteString('Browsing Path',IdeList[Version].TargetPlatformslist[i].BrowsingPath.PathStr);
          if Reg.ValueExists('Search Path') then
            Reg.WriteString('Search Path',IdeList[Version].TargetPlatformslist[i].SearchPath.PathStr);
          Result := True;
         end;
       end;

       for i:= 0 to IdeList[Version].CTargetPlatformslistConst - 1 do
       begin
         if Reg.OpenKey(IdeList[Version].RegeditPath + BCBReg + IdeList[Version].CTargetPlatformslist[i].Name,False) then
         begin
          if Reg.ValueExists('BrowsingPath') then
            Reg.WriteString('BrowsingPath',IdeList[Version].CTargetPlatformslist[i].BrowsingPath.PathStr);
          if Reg.ValueExists('LibraryPath') then
            Reg.WriteString('LibraryPath',IdeList[Version].CTargetPlatformslist[i].SearchPath.PathStr);

          if Reg.ValueExists('BrowsingPath_Clang32') then
            Reg.WriteString('BrowsingPath_Clang32',IdeList[Version].CTargetPlatformslist[i].BrowsingPath_Clang32.PathStr);
          if Reg.ValueExists('LibraryPath_Clang32') then
            Reg.WriteString('LibraryPath_Clang32',IdeList[Version].CTargetPlatformslist[i].SearchPath_Clang32.PathStr);
          Result := True;
         end;
       end;
     end;
     Reg.Free;
end;

function TIDEPacket.WriteTargetPlatformslistRegedit:Boolean;
var
  c:Integer;
begin
     for c := bdsmix to IdeListMax do
     begin
       Result := WriteTargetPlatformslistRegedit(c);
     end;
end;

function TIDEPacket.UnInsetallBPL(Version:Integer;PacketPath,PacketFileName: string):Boolean;
var
  Reg:TRegistry;
  PacketName:string;
begin
  Result := False;
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  PacketName := ChangeFileExt(PacketFileName,'');
  if FileExists(PacketPath + PacketName + '.bpl') then
  begin
     if IdeList[Version].IsInsetup then
     begin
       if Reg.OpenKey(IdeList[Version].RegeditPath + '\Known Packages',True) then
       begin
          if Reg.ValueExists(PacketPath + PacketName + '.bpl') then
          begin
            Result := Reg.DeleteValue(PacketPath + PacketName + '.bpl');
            DeleteFile(PacketPath + PacketName + '.bpl');
          end;
       end;
     end;
  end;
   Reg.Free;
end;

procedure TIDEPacket.UninsetallBPL(PacketPath,PacketFileName: string;callback:TUnInsetallPackBack = nil);
var
  i:Integer;
  InsetAllResult :Boolean;
begin
    for i := bdsmix to IdeListMax do
    begin
      if IdeList[i].IsInsetup then
      begin
       InsetAllResult := UnInsetallBPL(i,PacketPath,PacketFileName);
       callback(i,PacketPath,PacketFileName,InsetAllResult);
      end;
    end;
end;

function TIDEPacket.InsetallBPL(Version:Integer;PacketPath,PacketFileName: string;PacketName:string = ''):Boolean;
var
  Reg:TRegistry;
  FBPLFileName:string;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Result := False;
  FBPLFileName := ChangeFileExt(PacketFileName,'');
  if FileExists(PacketPath + FBPLFileName + '.bpl') then
  begin
     if IdeList[Version].IsInsetup then
     begin
       if Reg.OpenKey(IdeList[Version].RegeditPath + '\Known Packages',True) then
       begin
          if not Reg.ValueExists(PacketPath + FBPLFileName + '.bpl') then
          begin
            Reg.WriteString(PacketPath + FBPLFileName + '.bpl',PacketName);
            Result := True;
          end;
       end;
     end;
  end;
   Reg.Free;
end;

procedure TIDEPacket.InsetallBPL(PacketPath,PacketFileName: string;PacketName:string = '';CallBack:TInsetallPackBack = nil);
var
  i:Integer;
  InsetAllResult :Boolean;
begin
    for i := bdsmix to IdeListMax do
    begin
      if IdeList[i].IsInsetup then
      begin
       InsetAllResult := InsetallBPL(i,PacketPath,PacketFileName,PacketName);
       CallBack(i,PacketPath,PacketName,InsetAllResult);
      end;
    end;
end;

function TIDEPacket.IsInsetBPL(version:Integer;BPLPathFileName:string;Compare:TCompareFile = nil):string;
var
  Reg:TRegistry;
  ValueStrings:TStringList;
  I: Integer;
begin
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_CURRENT_USER;
    Result := '';
    if IdeList[Version].IsInsetup then
    begin
        if Reg.OpenKeyReadOnly(IdeList[Version].RegeditPath + '\Known Packages') then
        begin
           ValueStrings := TStringList.Create;
           Reg.GetValueNames(ValueStrings);
           for I := 0 to ValueStrings.Count - 1 do
           begin
             if Assigned(Compare) then
             begin
              if Compare(ValueStrings.Strings[i],BPLPathFileName) then
              begin
                Result := ValueStrings.Strings[i];
                EXIT;
              end;
             end
             else
             begin
               if SameText(ExpandFileName(ValueStrings.Strings[i]),ExpandFileName(BPLPathFileName)) then
               begin
                 Result := ValueStrings.Strings[i];
                 Exit;
               end;
             end;
           end;

           ValueStrings.Free;
        end;
    end;
    Reg.Free;
end;

function TIDEPacket.IsInsetExperts(version:Integer;ExpertsPathFileName:string;Compare:TCompareFile = nil):string;
var
  Reg:TRegistry;
  ValueStrings:TStringList;
  I: Integer;
begin
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_CURRENT_USER;
    Result := '';
    if IdeList[Version].IsInsetup then
    begin
        if Reg.OpenKeyReadOnly(IdeList[Version].RegeditPath + '\Experts') then
        begin
           ValueStrings := TStringList.Create;
           Reg.GetValueNames(ValueStrings);
           for I := 0 to ValueStrings.Count - 1 do
           begin
             if Assigned(Compare) then
             begin
              if Compare(reg.ReadString(ValueStrings.Strings[i]) ,ExpertsPathFileName) then
              begin
                Result := ValueStrings.Strings[i];
                EXIT;
              end;
             end
             else
             begin
               if SameText(ExpandFileName(reg.ReadString(ValueStrings.Strings[i])),ExpandFileName(ExpertsPathFileName)) then
               begin
                 Result := ValueStrings.Strings[i];
                 Exit;
               end;
             end;
           end;

           ValueStrings.Free;
        end;
    end;
    Reg.Free;
end;


function TIDEPacket.RunDOS(const CommandLine: PWideChar;sRet: TStrings = nil): Boolean;
var
  HRead, HWrite: THandle;
  StartInfo: TStartupInfo;
  ProceInfo: TProcessInformation;
  sa: TSecurityAttributes;
  inS: THandleStream;
begin
  Result := False;
  FillChar(sa, sizeof(TSecurityAttributes), 0);
  sa.nLength := sizeof(TSecurityAttributes);
  sa.bInheritHandle := True;
  sa.lpSecurityDescriptor := nil;
  //Size一定要够大，否则会卡住
  if not CreatePipe(HRead, HWrite, @sa, 1024*1024*10) then Exit;

  FillChar(StartInfo, SizeOf(StartInfo), 0);
  StartInfo.cb := SizeOf(StartInfo);
  StartInfo.wShowWindow := SW_hide;
  StartInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  StartInfo.hStdError := HWrite;
  StartInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //HRead;
  StartInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
  StartInfo.hStdOutput := HWrite;

  if not CreateProcessW(nil, //lpApplicationName: PChar
    CommandLine, //lpCommandLine: PChar
    nil, //lpProcessAttributes: PSecurityAttributes
    nil, //lpThreadAttributes: PSecurityAttributes
    True, //bInheritHandles: BOOL
    0,
    nil,
    nil,
    StartInfo,
    ProceInfo) then Exit;

  while WaitForSingleObject(ProceInfo.hProcess,1000) = WAIT_TIMEOUT do
  begin
    Sleep(10);
  end;
  inS := THandleStream.Create(HRead);
  if inS.Size > 0 then
  begin
    if sRet <> nil then
      sRet.LoadFromStream(inS);
  end;
  inS.Free;
  Result := True;
  CloseHandle(HRead);
  CloseHandle(HWrite);
end;

function TIDEPacket.AddExperts(Version:Integer;ExpertsFileName:string;ExpertsName:string):Boolean;
var
  Reg:TRegistry;
begin
  Result := False;
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  if IdeList[Version].IsInsetup then
  begin
   if Reg.OpenKey(IdeList[Version].RegeditPath + '\Experts',True) then
   begin
    if not Reg.ValueExists(ExpertsFileName) then
    begin
     reg.WriteString(ExpertsName,ExpertsFileName);
     Result := True;
    end;
   end;
  end;
  Reg.Free;
end;

function TIDEPacket.AddExperts(ExpertsFileName: string;ExpertsName:string): Boolean;
var
  I: Integer;
begin
  for I := bdsmix to IdeListMax do
  begin
    Result :=  AddExperts(i,ExpertsFileName,ExpertsName);
  end;
end;

function TIDEPacket.AddBrowsingPath(Version: Integer; TargetPlatformsName,
  Path: string): Boolean;
var
  TargetPlatformslist:TPlatformsArray;
  i: Integer;
  Count:Integer;
begin
  Result := False;
  if IdeList[Version].IsInsetup then
  begin
    TargetPlatformslist := GetTargetPlatformslist(Version,Count);
    for i := 0 to Count - 1 do
    begin
       if (TargetPlatformslist[i].Name = TargetPlatformsName) then
       begin
         if TargetPlatformslist[i].BrowsingPath.FindPath(Path) < 0 then
         begin
          TargetPlatformslist[i].BrowsingPath.AddPath(Path);
         end;
         Result := True;
       end;
    end;
  end;
end;

function TIDEPacket.AddBrowsingPath(TargetPlatformsName,
  Path: string): Boolean;
var
  Version:Integer;
begin
  for Version := bdsmix to IdeListMax do
  begin
    Result := AddBrowsingPath(Version,TargetPlatformsName,Path);
  end;
end;


function TIDEPacket.DelBrowsingPath(Version:Integer;TargetPlatformsName:string;Path:string):Boolean;
var
  TargetPlatformslist:TPlatformsArray;
  i: Integer;
  Count:Integer;
begin
  Result := False;
  if IdeList[Version].IsInsetup then
  begin
    TargetPlatformslist := GetTargetPlatformslist(Version,Count);
    for i := 0 to Count - 1 do
    begin
       if (TargetPlatformslist[i].Name = TargetPlatformsName) then
       begin
         TargetPlatformslist[i].BrowsingPath.DelPath(TargetPlatformslist[i].BrowsingPath.FindPath(Path)) ;
         Result := True;
       end;
    end;
  end;
end;

function TIDEPacket.DelBrowsingPath(TargetPlatformsName:string;Path:string):Boolean;
var
  Version:Integer;
begin
  for Version := bdsmix to IdeListMax do
  begin
    Result := DelBrowsingPath(Version,TargetPlatformsName,Path);
  end;
end;

function TIDEPacket.GetBrowsingPath(Version:Integer;TargetPlatformsName:string):String;
var
  TargetPlatformslist:TPlatformsArray;
  i: Integer;
  Count:Integer;
begin
  Result := '';
  if IdeList[Version].IsInsetup then
  begin
    TargetPlatformslist := GetTargetPlatformslist(Version,Count);
    for i := 0 to Count - 1 do
    begin
       if (TargetPlatformslist[i].Name = TargetPlatformsName) then
       begin

         Result := TargetPlatformslist[i].BrowsingPath.PathStr;
       end;
    end;
  end;
end;

function TIDEPacket.GetBrowsingCmdPath(Version:Integer;TargetPlatformsName:string):String;
var
  TargetPlatformslist:TPlatformsArray;
  i: Integer;
  Count:Integer;
begin
  Result := '';
  if IdeList[Version].IsInsetup then
  begin
    TargetPlatformslist := GetTargetPlatformslist(Version,Count);
    for i := 0 to Count - 1 do
    begin
       if (TargetPlatformslist[i].Name = TargetPlatformsName) then
       begin

         Result := TargetPlatformslist[i].BrowsingPath.PathCmdStr;
       end;
    end;
  end;
end;

function TIDEPacket.AddSearchPath(Version: Integer; TargetPlatformsName,
  Path: string): Boolean;
var
  TargetPlatformslist:TPlatformsArray;
  i: Integer;
  Count:Integer;
begin
  Result := False;
  if IdeList[Version].IsInsetup then
  begin
    TargetPlatformslist := GetTargetPlatformslist(Version,Count);
    for i := 0 to Count - 1 do
    begin
       if (TargetPlatformslist[i].Name = TargetPlatformsName) then
       begin
         if TargetPlatformslist[i].SearchPath.FindPath(Path) < 0 then
         begin
          TargetPlatformslist[i].SearchPath.AddPath(Path);
         end;
         Result := True;
       end;
    end;
  end;
end;

function TIDEPacket.AddSearchPath(TargetPlatformsName,
  Path: string): Boolean;
var
  Version:Integer;
begin
  for Version := bdsmix to IdeListMax do
  begin
    Result := AddSearchPath(Version,TargetPlatformsName,Path);
  end;
end;

function TIDEPacket.DelSearchPath(Version:Integer;TargetPlatformsName:string;Path:string):Boolean;
var
  TargetPlatformslist:TPlatformsArray;
  i: Integer;
  Count:Integer;
begin
  Result := False;
  if IdeList[Version].IsInsetup then
  begin
    TargetPlatformslist := GetTargetPlatformslist(Version,Count);
    for i := 0 to Count - 1 do
    begin
       if (TargetPlatformslist[i].Name = TargetPlatformsName) then
       begin
         TargetPlatformslist[i].SearchPath.DelPath(TargetPlatformslist[i].SearchPath.FindPath(Path)) ;
         Result := True;
       end;
    end;
  end;
end;

function TIDEPacket.DelSearchPath(TargetPlatformsName:string;Path:string):Boolean;
var
  Version:Integer;
begin
  for Version := bdsmix to IdeListMax do
  begin
    Result := DelSearchPath(Version,TargetPlatformsName,Path);
  end;
end;

function TIDEPacket.GetSearchPath(Version:Integer;TargetPlatformsName:string):string;
var
  TargetPlatformslist:TPlatformsArray;
  i: Integer;
  Count:Integer;
begin
  Result := '';
  if IdeList[Version].IsInsetup then
  begin
    TargetPlatformslist := GetTargetPlatformslist(Version,Count);
    for i := 0 to Count - 1 do
    begin
       if (TargetPlatformslist[i].Name = TargetPlatformsName) then
       begin
         Result := TargetPlatformslist[i].SearchPath.PathStr;
       end;
    end;
  end;
end;

function TIDEPacket.GetSearchCmdPath(Version:Integer;TargetPlatformsName:string):string;
var
  TargetPlatformslist:TPlatformsArray;
  i: Integer;
  Count:Integer;
begin
  Result := '';
  if IdeList[Version].IsInsetup then
  begin
    TargetPlatformslist := GetTargetPlatformslist(Version,Count);
    for i := 0 to Count - 1 do
    begin
       if (TargetPlatformslist[i].Name = TargetPlatformsName) then
       begin
         Result := TargetPlatformslist[i].SearchPath.PathCmdStr;
       end;
    end;
  end;
end;

function TIDEPacket.GetRootPath(Version:Integer):string;
begin
  if IdeList[Version].IsInsetup then
    Result := IdeList[Version].RootDir;

  if Result[Length(Result)] <> '\' then Result := Result + '\';

end;

function TIDEPacket.AddUserOverrides(Version:Integer;name:string;path:string;IsAdd:Boolean):Boolean;
var
  Reg:TRegistry;
  lp:TPathStringList;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Result := False;
  if IdeList[Version].IsInsetup then
  begin
   if Reg.OpenKey(IdeList[Version].RegeditPath + '\Environment Variables',True) then
   begin
      if not Reg.ValueExists(Name) then
      begin
       reg.WriteString(Name,path);
       Result := True;
      end
      else
      begin
        if IsAdd then
        begin
          lp := TPathStringList.Create(reg.ReadString(Name));
          lp.AddPath(path);
          reg.DeleteKey(Name);
          reg.WriteString(name,lp.PathStr);
          Result := True;
          lp.Free;
        end;
      end;
   end;
  end;
  Reg.Free;
end;

function TIDEPacket.AddUserOverrides(name:string;path:string;IsAdd:Boolean):Boolean;
var
  I: Integer;
begin
  for I := bdsmix to IdeListMax do
  begin
    Result := AddUserOverrides(i,name,path,IsAdd);
  end;
end;

function TIDEPacket.DelUserOverrides(Version:Integer;name:string):Boolean;
var
  Reg:TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Result := False;
  if IdeList[Version].IsInsetup then
  begin
   if Reg.OpenKey(IdeList[Version].RegeditPath + '\Environment Variables',True) then
   begin
    if not Reg.ValueExists(Name) then
    begin
     Result := reg.DeleteKey(Name);
    end
    else
     Result := True;
   end;
  end;
  Reg.Free;
end;

function TIDEPacket.DelUserOverrides(name:string):Boolean;
var
  I: Integer;
begin
  for I := bdsmix to IdeListMax do
  begin
    Result := DelUserOverrides(i,name);
  end;
end;

function TIDEPacket.UserOverridesToString(Version:Integer;TargetPlatformsName:string;UserOverrides:string):string;
const
  R:STRING = '([a-zA-Z0-9]{1,50})';
var
  Reg:TRegistry;
  MatchName:string;
  regex:TRegEx;
  match:TMatch;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Result := '';
  regex := tregex.Create(R);
  match := regex.Match(UserOverrides);
  if match.Success then
     MatchName :=  match.Value;

  if MatchName <> '' then
  begin
    if IdeList[Version].IsInsetup then
    begin
      if SameText(MatchName,'BDS')
      or SameText(MatchName,'DELPHI') then
      begin
        Result := IdeList[Version].RootDir;
      end
      else
      if SameText(MatchName,'BDSCOMMONDIR') then
      begin
         Result := GetUserPacketDir(Version);
      end
      else
      if SameText(MatchName,'PLATFORM') then  //
      begin
         Result := TargetPlatformsName;
      end
      else
      if SameText(MatchName,'BDSLIB') then
      begin
         Result := IdeList[Version].RootDir + 'lib\';
      end
      else
      if SameText(MatchName,'BDSUSERDIR') then
      begin
         Result := GetWinUserPacketDir(Version);
      end
      else
      begin
         if Reg.OpenKeyReadOnly(IdeList[Version].RegeditPath + '\Environment Variables') then
         begin
               if Reg.ValueExists(MatchName) then
               begin
                 Result := Reg.ReadString(MatchName); 
               end;
         end;
      end;
    end;
  end;
  Reg.Free;
end;

function TIDEPacket.ReplacePathUserOverrides(Version:Integer;TargetPlatformsName:string;Path:string):string;
const
  R:STRING = '\$\((.*?)\)';
var
  regex:TRegEx;
  match:TMatch;
  newPath:string;
begin
  regex := tregex.Create(R);
  Result := Path;
  match := regex.Match(Result);
  while match.Success do
  begin

    newPath := UserOverridesToString(Version,TargetPlatformsName,match.Value);
    if newPath <> '' then
    begin
      if newPath[Length(newPath)] = '\' then
        Delete(newPath,Length(newPath),1);
     Result := StringReplace(Result,match.Value,newPath,[rfReplaceAll]);
    end;
    match := match.NextMatch;
  end;


end;

function TIDEPacket.SystemOverridesToString(SystemOverrides:string):string;
begin
   Result := GetEnvironmentVariable(SystemOverrides);
end;


function TIDEPacket.VersionToProductVersion(Version:Integer):string;
begin
   if IdeList[Version].IsInsetup then
   begin
     Result := IdeList[Version].ProductVersion;
   end;
end;

function TIDEPacket.GetIDEName(Version:Integer):string;
begin
  Result := idelist[Version].Name;
end;

function TIDEPacket.GetUserPacketDir(Version:Integer):string;
var
  p:array [0..MAX_PATH] of Char;
begin
  SHGetFolderPathW(0,CSIDL_COMMON_DOCUMENTS,0,SHGFP_TYPE_CURRENT,@p);
 // Result := GetEnvironmentVariable('PUBLIC');
 Result := P;
 if Result[Length(Result)] <> '\' then
  Result := Result + '\';

 Result := Result + 'Embarcadero\Studio\' + idelist[Version].Version + '\';
end;

function TIDEPacket.GetWinUserPacketDir(Version:Integer):string;
var
  p:array [0..MAX_PATH] of Char;
begin
  SHGetFolderPathW(0,CSIDL_PERSONAL,0,SHGFP_TYPE_CURRENT,@p);
 // Result := GetEnvironmentVariable('PUBLIC');
 Result := P;
 if Result[Length(Result)] <> '\' then
  Result := Result + '\';

 Result := Result + 'Embarcadero\Studio\' + idelist[Version].Version + '\';
end;



function TIDEPacket.CopyDirFilesToDir(sPath:string;FileNames:string;sToPath:string;pCopyFile:TCopyFile = nil;FileList:TStrings = nil):Integer;
var
  SearchRec: TSearchRec;
  found: integer;
  SucceedNum:Integer;
  Path,ToPath:string;
begin
  Path := sPath;
  ToPath := sToPath;
  if Path[Length(Path)] <> '\' then  Path := Path + '\';
  if ToPath[Length(ToPath)] <> '\' then  ToPath := ToPath + '\';
  SucceedNum := 0;
  found := FindFirst(path + FileNames, faAnyFile, SearchRec);
  while found = 0 do
  begin
    if (SearchRec.Name <> '.') and
       (SearchRec.Name <> '..') and
       (SearchRec.Attr <> faDirectory) then
    begin
      if FileList <> nil then
        FileList.Add(Path + SearchRec.Name);
      if Assigned(pCopyFile) then
      begin
        if pCopyFile(PWideChar(Path + SearchRec.Name),PWideChar(topath + SearchRec.Name),False) then
          inc(SucceedNum);
      end
      else
      begin
        if CopyFileW(PWideChar(Path + SearchRec.Name),PWideChar(topath + SearchRec.Name),False) then
          inc(SucceedNum);
      end;
    end;
    found := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
  Result := SucceedNum;
end;

function TIDEPacket.EnumDirAndFile(sPath:string;pEnum:TEnumFileAndDir):Integer;
var
  SearchRec: TSearchRec;
  found: integer;
  Path:string;
begin
  Path := sPath;
  if Path[Length(Path)] <> '\' then  Path := Path + '\';
  found := FindFirst(path + '*', faAnyFile, SearchRec);
  while found = 0 do
  begin
    if (SearchRec.Name <> '.') and
       (SearchRec.Name <> '..') then
    begin
      if SearchRec.Attr <> faDirectory then
      begin
        if not pEnum(SearchRec.Name,False) then
          exit;
      end
      else
      begin
        if not pEnum(SearchRec.Name,True) then
          exit;
        EnumDirAndFile(Path + SearchRec.Name + '\',pEnum);
      end;

    end;
  end;
end;

function TIDEPacket.Component32(Version:Integer;PacketPath,PacketFileName:string;AutoAddUnitPath:Boolean = True):Boolean;
var
  outcmd:TStringList;
begin
    Result := False;
    if PacketPath[Length(PacketPath)] <> '\' then
     PacketPath := PacketPath + '\';
    ComponentLine.PacketPathFileName := '"' + PacketPath + PacketFileName + '"';

    if IdeList[Version].IsInsetup then
    begin

      ComponentLine.DccExePathFileName := IdeList[Version].dcc32;
      if AutoAddUnitPath then
      begin
        ComponentLine.UnitDirectories := ReplacePathUserOverrides(Version,'Win32',GetSearchCmdPath(Version,'Win32'));
        ComponentLine.Includedirectories := ReplacePathUserOverrides(Version,'Win32',GetBrowsingCmdPath(Version,'Win32'));
      end;
      outcmd := TStringList.Create;
      Result := RunDOS(PWideChar(ComponentLine.ComponentLine),outcmd);
      outcmd.Add(ComponentLine.ComponentLine);
      outcmd.SaveToFile('d:\11.txt');
      outcmd.Free;
    end;
end;

function TIDEPacket.Component64(Version:Integer;PacketPath,PacketFileName:string;AutoAddUnitPath:Boolean = True):Boolean;
var
  outcmd:TStringList;
begin
    Result := False;
    if PacketPath[Length(PacketPath)] <> '\' then
     PacketPath := PacketPath + '\';
    ComponentLine.PacketPathFileName := '"' + PacketPath + PacketFileName + '"';

    if IdeList[Version].IsInsetup then
    begin
      ComponentLine.DccExePathFileName := IdeList[Version].dcc64;
      if AutoAddUnitPath then
      begin
        ComponentLine.UnitDirectories := ReplacePathUserOverrides(Version,'Win64',GetSearchCmdPath(Version,'Win64'));
        ComponentLine.Includedirectories := ReplacePathUserOverrides(Version,'Win64',GetBrowsingCmdPath(Version,'Win64'));
      end;
      outcmd := TStringList.Create;

      Result := RunDOS(PWideChar(ComponentLine.ComponentLine),outcmd);
      outcmd.Add(ComponentLine.ComponentLine);
      outcmd.SaveToFile('d:\11.txt');
      outcmd.Free;
    end;
end;

function TIDEPacket.QuietCompoentPack(Version:Integer;bit:TDccBit;PacketPath,PacketFileName:string):Boolean;
begin
    ComponentLine.BPLOutpath := '"' + PacketPath + '"';

    ComponentLine.DCPOutpath := '"' + PacketPath + '"';

    ComponentLine.HppOutpath := '"' + PacketPath + '"';

    ComponentLine.BPIOutpath := '"' + PacketPath + '"';

    ComponentLine.DCUOutpath := '"' + PacketPath + '"';
    if bit = dcc32 then
      Result := Component32(Version,PacketPath,PacketFileName,True)
    else
      Result := Component64(Version,PacketPath,PacketFileName,True)
end;

constructor TIDEPacket.Create();
begin
  ComponentLine := TCreateComponentLine.Create(True);
end;

destructor TIDEPacket.Destroy;
var
  i,c:Integer;
begin
  for i := bdsmix to IdeListMax do
  begin
    if IdeList[i].IsInsetup then
    begin
       for c := 0 to IdeList[i].TargetPlatformslistConst - 1 do
       begin
        if Assigned(IdeList[i].TargetPlatformslist[c].BrowsingPath) then
         IdeList[i].TargetPlatformslist[c].BrowsingPath.Free;
        if Assigned(IdeList[i].TargetPlatformslist[c].SearchPath) then
         IdeList[i].TargetPlatformslist[c].SearchPath.Free;
       end;
       SetLength(IdeList[i].TargetPlatformslist,0);

       for c := 0 to IdeList[i].CTargetPlatformslistConst - 1 do
       begin
        if Assigned(IdeList[i].CTargetPlatformslist[c].BrowsingPath) then
         IdeList[i].CTargetPlatformslist[c].BrowsingPath.Free;
        if Assigned(IdeList[i].CTargetPlatformslist[c].SearchPath) then
         IdeList[i].CTargetPlatformslist[c].SearchPath.Free;
        if Assigned(IdeList[i].CTargetPlatformslist[c].BrowsingPath_Clang32) then
         IdeList[i].CTargetPlatformslist[c].BrowsingPath_Clang32.Free;
        if Assigned(IdeList[i].CTargetPlatformslist[c].SearchPath_Clang32) then
         IdeList[i].CTargetPlatformslist[c].SearchPath_Clang32.Free;

       end;
       SetLength(IdeList[i].CTargetPlatformslist,0);
    end;
  end;
  ComponentLine.Free;
  inherited;
end;
function TIDEPacket.EnumVersionBDS(CallBack:TEnumVersion): Boolean;
var
  i,c:Integer;
  KeyNames:TStringList;
  Reg:TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  for i := bdsmix to IdeListMax do
  begin
    IdeList[i].Version := i.ToString + '.0';
    IdeList[i].RegeditPath := DelphiReg + IdeList[i].Version;
    if Reg.OpenKeyReadOnly(IdeList[i].RegeditPath) then
    begin
       //取安装目录
       if Reg.ValueExists('RootDir') then
       begin
        IdeList[i].RootDir:= Reg.ReadString('RootDir');
       end;
       //取程序目录
       if Reg.ValueExists('App') then
       begin
        IdeList[i].AppDir := Reg.ReadString('App');
       end;
       
       if Reg.ValueExists('ProductVersion') then
       begin
        IdeList[i].ProductVersion := Reg.ReadString('ProductVersion');
       end;

       //判断是否安装
       if DirectoryExists(IdeList[i].RootDir) and
         FileExists(IdeList[i].AppDir) and
         FileExists(IdeList[i].RootDir + '\bin\dcc32.exe') and
         FileExists(IdeList[i].RootDir + '\bin\dcc64.exe')
       then IdeList[i].IsInsetup := True
       else
        IdeList[i].IsInsetup := False;

       IdeList[I].dcc32 := IdeList[I].RootDir + 'bin\dcc32.exe';
       IdeList[I].dcc64 := IdeList[I].RootDir + 'bin\dcc64.exe';

       if IdeList[i].IsInsetup then
       begin
            //计算版本名称
            case i of
              8: IdeList[i].Name := 'Embarcadero RAD Studio XE';
             17: IdeList[i].Name := 'Embarcadero RAD Studio 10 Seattle';
            else
             if i > 17 then
               IdeList[i].Name := 'Embarcadero RAD Studio 10.' + IntToStr(i - 17) // just a guess
             else if i > 13 then
               IdeList[i].Name := 'Embarcadero RAD Studio XE' + IntToStr(2 + (i - 10))
             else
               IdeList[i].Name := 'Embarcadero RAD Studio XE' + IntToStr(2 + (i - 9));
            end;

             
           //HKEY_CURRENT_USER\SOFTWARE\Embarcadero\BDS\19.0\Library\Win32
           //查找支持编译类型和搜索路径
           if IdeList[i].IsInsetup and Reg.OpenKeyReadOnly(IdeList[i].RegeditPath + '\Library') then
           begin
              if Reg.HasSubKeys then
              begin
                KeyNames := TStringList.Create;
                reg.GetKeyNames(KeyNames);
                if KeyNames.Count <> 0 then
                begin
                  IdeList[i].TargetPlatformslistConst := KeyNames.Count;
                  SetLength(IdeList[i].TargetPlatformslist,IdeList[i].TargetPlatformslistConst);

                  for c := 0 to IdeList[i].TargetPlatformslistConst - 1 do
                  begin
                     if Reg.OpenKeyReadOnly(IdeList[i].RegeditPath + '\Library\' + KeyNames.Strings[c]) then
                     begin
                        IdeList[i].TargetPlatformslist[c].Name := KeyNames.Strings[c];

                        if Reg.ValueExists('Browsing Path') then
                          IdeList[i].TargetPlatformslist[c].BrowsingPath := TPathStringList.Create(Reg.ReadString('Browsing Path'))
                        else
                          IdeList[i].TargetPlatformslist[c].BrowsingPath := TPathStringList.Create('');
                        if Reg.ValueExists('Search Path') then
                          IdeList[i].TargetPlatformslist[c].SearchPath := TPathStringList.Create(Reg.ReadString('Search Path'))
                        else
                          IdeList[i].TargetPlatformslist[c].SearchPath := TPathStringList.Create('');
                     end;
                  end;
                end;
              end;
           end;


           //HKEY_CURRENT_USER\SOFTWARE\Embarcadero\BDS\19.0\C++\paths
           //查找支持编译类型和搜索路径
           if IdeList[i].IsInsetup and Reg.OpenKeyReadOnly(IdeList[i].RegeditPath + bcbreg) then
           begin
              if Reg.HasSubKeys then
              begin
                KeyNames := TStringList.Create;
                reg.GetKeyNames(KeyNames);
                if KeyNames.Count <> 0 then
                begin
                  IdeList[i].CTargetPlatformslistConst := KeyNames.Count;
                  SetLength(IdeList[i].CTargetPlatformslist,IdeList[i].CTargetPlatformslistConst);

                  for c := 0 to IdeList[i].CTargetPlatformslistConst - 1 do
                  begin
                     if Reg.OpenKeyReadOnly(IdeList[i].RegeditPath + bcbreg + KeyNames.Strings[c]) then
                     begin
                        IdeList[i].CTargetPlatformslist[c].Name := KeyNames.Strings[c];

                        if Reg.ValueExists('BrowsingPath') then
                          IdeList[i].CTargetPlatformslist[c].BrowsingPath := TPathStringList.Create(Reg.ReadString('BrowsingPath'))
                        else
                          IdeList[i].CTargetPlatformslist[c].BrowsingPath := TPathStringList.Create('');
                        if Reg.ValueExists('LibraryPath') then
                          IdeList[i].CTargetPlatformslist[c].SearchPath := TPathStringList.Create(Reg.ReadString('LibraryPath'))
                        else
                          IdeList[i].CTargetPlatformslist[c].SearchPath := TPathStringList.Create('');

                        if Reg.ValueExists('BrowsingPath_Clang32') then
                          IdeList[i].CTargetPlatformslist[c].BrowsingPath_Clang32 := TPathStringList.Create(Reg.ReadString('BrowsingPath'))
                        else
                          IdeList[i].CTargetPlatformslist[c].BrowsingPath_Clang32 := TPathStringList.Create('');
                        if Reg.ValueExists('LibraryPath_Clang32') then
                          IdeList[i].CTargetPlatformslist[c].SearchPath_Clang32 := TPathStringList.Create(Reg.ReadString('LibraryPath'))
                        else
                          IdeList[i].CTargetPlatformslist[c].SearchPath_Clang32 := TPathStringList.Create('');
                     end;
                  end;
                end;
              end;
           end;
       end;
    end;
    if IdeList[i].IsInsetup then
      if Assigned(CallBack) then
        CallBack(i);
  end;
  Reg.Free;
  Result := True;
end;

function TIDEPacket.GetTargetPlatformslist(Version:Integer;var TargetPlatformslistConst:Integer):TPlatformsArray;
begin
     TargetPlatformslistConst := IdeList[Version].TargetPlatformslistConst;
     Result := IdeList[Version].TargetPlatformslist;
end;

function TIDEPacket.DirWritable(m_dir:string):boolean;
var tmpStrs: TStrings;  //测试数据目录是否写权限
    tmpName : string;
begin
  try
    Result := True;
    tmpStrs := TStringList.Create;
    tmpStrs.Add('1and1-aMail');
    Randomize;
    tmpName := m_dir + Format('%d-%d-%d-%d.write',[Random(9),Random(9),Random(9),Random(9)]);
    tmpStrs.SaveToFile(tmpName);
    DeleteFile(tmpName);

  except
    on e: EFCreateError do
    begin
      //拒绝访问，无写入权限
      Result := False;
    end;
  end;
end;


function TIDEPacket.GetFileCRC(const iFileName: string): String;
var
  MemSteam: TMemoryStream;
  MyCRC   : TIdHashCRC32;
begin
  MemSteam := TMemoryStream.Create;
  MemSteam.LoadFromFile(iFileName);
  MyCRC  := TIdHashCRC32.Create;
  Result := MyCRC.HashStreamAsHex(MemSteam);
  MyCRC.Free;
  MemSteam.Free;
end;



{ TPathStringList }
procedure TPathStringList.AddPath(addstr:string);
begin
  PathList.Add(addstr);
end;

function TPathStringList.DelPath(Index:Integer):Boolean;
begin
  Result := True;
  if Index > 0 then
    PathList.Delete(Index);
end;

constructor TPathStringList.Create(F_Path: string);
begin
   FPath := F_Path;
   PathList := TStringList.Create;
   ForMatPath;
end;

destructor TPathStringList.Destroy;
begin
  PathList.Free;
  inherited;
end;

//

function TPathStringList.FindPath(xPath: string;var r:Integer):Boolean;
var
  i: Integer;
BEGIN
  result := False;
  for i := 0 to PathItemCount - 1 do
  begin
   if SameText(PathItem[I],xPath) then
   begin
    R := i;
    result := True;
    break;
   end
  end;
END;
function TPathStringList.FindPath(xPath: string): Integer;
begin
 if not FindPath(xpath,result) then
   Result := -1;
end;

function TPathStringList.ForMatPath: Boolean;
const
  RegExStr:string = '("(.*?)"(;|$))|((.*?)(;|$))';
var
  regex:TRegEx;
  match:TMatch;
begin
  Result := True;
  regex := tregex.Create(RegExStr);
  match := regex.Match(Fpath);
  PathList.Clear;
  while match.Success do
  begin
    if (match.Value <> '') or (match.Value <> ';') then
      PathList.Add(match.Value);
    match := match.NextMatch;
  end;
end;

function TPathStringList.GetItem(Index: Integer): string;
begin
  Result := PathList.Strings[Index];
  if Result[Length(Result)] = ';' then
    Delete(Result,Length(Result),1);
end;

procedure TPathStringList.SetItem(Index: Integer; SPath: string);
begin
  if SPath[Length(SPath)] = ';' then
    Delete(SPath,Length(SPath),1);
  PathList.Strings[Index] := SPath;
end;

function TPathStringList.GetItemCount:Integer;
begin
   Result := PathList.Count;
end;

function TPathStringList.GetPath: string;
var
  i: Integer;
  pathitem:string;
begin
  Fpath := '';
  for i := 0 to PathList.Count - 1 do
  begin
   pathitem := PathList.Strings[i];
   if i = PathList.Count - 1 then
   begin
     if pathitem[Length(pathitem)] = ';' then
     begin
      Delete(pathitem,Length(pathitem),1);
     end;
   end
   else
   begin
     if pathitem[Length(pathitem)] <> ';' then
      pathitem := pathitem + ';';
   end;
   Fpath := Fpath + pathitem;
  end;
  Result := Fpath;
end;

function TPathStringList.GetCmdPath: string;
var
  i: Integer;
  pathitem:string;
begin
  Fpath := '';
  for i := 0 to PathList.Count - 1 do
  begin
   pathitem := PathList.Strings[i];
   if pathitem[Length(pathitem)] = ';' then
   begin
    Delete(pathitem,Length(pathitem),1);
   end;

   if pathitem[Length(pathitem)] = '\' then
   begin
    Delete(pathitem,Length(pathitem),1);
   end;

   if PathItem[1] <> '"' then
    pathitem := '"' + pathitem;

   if pathitem[Length(pathitem)] <> '"' then
    pathitem := pathitem + '";';

   if i = PathList.Count - 1 then
   begin
     if pathitem[Length(pathitem)] = ';' then
     begin
      Delete(pathitem,Length(pathitem),1);
     end;
   end;
   Fpath := Fpath + pathitem;
  end;
  Result := Fpath;
end;

procedure TPathStringList.SetPath(SPath:string);
begin
  FPath := SPath;
  ForMatPath;
end;

{ TCreateComponentLine }

constructor TCreateComponentLine.Create(DefaultCompontLine:Boolean);
begin
  //初始化相关参数
  if DefaultCompontLine then
  BEGIN
    ComponentAllUnits := True;
    GenerateCFile := True;
    ComponentOption := '-$Y- -$L- -$D-';
    NameSpacepath := 'Data.Win;Bde;Vcl;Vcl.Imaging;Data;Winapi;System;System.Win;Datasnap;Xml;Xml.Win';
  END
  else
  begin
    ComponentOption := '';
    NameSpacepath := '';
  end;

  ImageBase := 0;
  OutputHintMessages := False;
  Includedirectories := '';
  CreateMapFile := False;
  GenerateObj := False;
  DCUOutpath := '';
  BPLOutpath := '';
  DCPOutpath := '';
  BPIOutpath := '';
  ObjOutpath := '';
  XMLOutpath := '';
  DefineConditionals := '';
  UnitDirectories := '';
  ResourceDirectories := '';
  OutExecutableFilePath := '';
  //
end;

destructor TCreateComponentLine.Destroy;
begin
  //
  inherited;
end;

procedure TCreateComponentLine.SetPacketOutpath(path:string);
begin
  BPLOutpath := path;
  BPIOutpath := path;
  DCPOutpath := path;
end;

function TCreateComponentLine.GetComponentLine: string;
//const
//   Line:string = '%s -$Y- -$L- -$D- -B -JPHNE -JL -NSData.Win;Bde;Vcl;Vcl.Imaging;Data;Winapi;System;System.Win;Datasnap;Xml;Xml.Win %s';
var
  ComponentFormat:string;
begin
    if ComponentOption <> '' then
      ComponentFormat := ComponentOption + ' ';

    if ComponentAllUnits then
      ComponentFormat := ComponentFormat + '-B' + ' ';

    if OutputHintMessages then
      ComponentFormat := ComponentFormat + '-H' + ' ';

    if CreateMapFile then
      ComponentFormat := ComponentFormat + '-GD' + ' ';

    if GenerateObj then
      ComponentFormat := ComponentFormat + '-J' + ' ';

    if ImageBase <> 0 then
      ComponentFormat := ComponentFormat + '-K' + ImageBase.ToString + ' ';

    if DefineConditionals <> '' then
      ComponentFormat := ComponentFormat + '-D' + DefineConditionals + ' ';

    if ResourceDirectories <> '' then
      ComponentFormat := ComponentFormat + '-R' + ResourceDirectories + ' ';

    if GenerateCFile then
      ComponentFormat := ComponentFormat + '-JPHNE -JL' + ' ';

    if Includedirectories <> '' then
      ComponentFormat := ComponentFormat + '-I' + Includedirectories + ' ';
    if NameSpacepath <> '' then
      ComponentFormat := ComponentFormat + '-NS' + NameSpacepath + ' ';

    if UnitDirectories <> '' then
      ComponentFormat := ComponentFormat + '-U' + UnitDirectories + ' ';

    if DCUOutpath <> '' then
      ComponentFormat := ComponentFormat + '-NU' + DCUOutpath + ' ';

    if BPLOutpath <> '' then
      ComponentFormat := ComponentFormat + '-LE' + BPLOutpath + ' ';

    if DCPOutpath <> '' then
      ComponentFormat := ComponentFormat + '-LN' + DCPOutpath + ' ';

    if ObjOutpath <> '' then
      ComponentFormat := ComponentFormat + '-NO' + ObjOutpath + ' ';

    if BPIOutpath <> '' then
      ComponentFormat := ComponentFormat + '-NB' + BPIOutpath + ' ';

    if XMLOutpath <> '' then
      ComponentFormat := ComponentFormat + '-NX' + XMLOutpath + ' ';

    if HppOutpath <> '' then
      ComponentFormat := ComponentFormat + '-NH' + HppOutpath + ' ';

    if GenerateDeBug then
      ComponentFormat := ComponentFormat + '-V -VN' + ' ';

    if OutExecutableFilePath <> '' then
      ComponentFormat := ComponentFormat + '-E' + OutExecutableFilePath + ' ';

    if OutputNameExtension <> '' then
      ComponentFormat := ComponentFormat + '-TX' + OutputNameExtension + ' ';

    ComponentFormat :=  '"' + FDccExePathFileName + '" ' + ComponentFormat + FPacketPathFileName;
    Result := ComponentFormat;
end;

end.