Загрузчик пакетов для Turbo Delphi

Позволяет подгружать в IDE:

• Пакеты BPL;
• Эксперты в виде DLL;
• A также просто DLL от которых зависят пакеты.

Инструкция

1. Проверить файл \lib\dclusr.bdsproj на наличие заблокированных пакетов, если есть то удалить, подредактировав dclusr.bdsproj;
2. Скопировать текущий файл (DTurboPLoader.pas) в папку \lib (рядом с dclusr.dpk);
3. Открыть пакет \lib\dclusr.dpk и добавить в него текущий файл (DTurboPLoader.pas);
4. Сделать Build и Install пакета dclusr.dpk
5. Найти файл dclusr100.bpl, смотри путь в настройках:
   [ Tools | Options | Environment Options | Delphi Options |
Library - Win32 | Directories | Package output directory ]
   По умолчанию сюда попадут все компилируемые вами пакеты.
6. Рядом с dclusr100.bpl создать текстовый файл DTurboPLoader.ini
7. В файле DTurboPLoader.ini указать список пакетов для загрузки. Каждый пакет с новой строки. Указывать полный путь. Если пакет лежит рядом с dclusr100.bpl (смотри выше), то можно указать только имя. Строку можно закомментировать, указав вначале символ ;.

Пакеты будут загружены при следующем запуске Delphi. Если пакет зависит от других пакетов или DLL, то их нужно положить в папку \Bin. Либо рядом с пакетом, но добавить в DTurboPLoader.ini перед ним.

Пример DTurboPLoader.ini

; DelphiSpeedUp by Andreas Hausladen
..\..\Experts\DelphiSpeedUp\DelphiSpeedUpLoader10.bpl
; Delphi Formatter Expert by Egbert van Nes
..\..\Experts\DelForExp\DelForEx10.dll 
; Raize Palette Menu Expert
..\..\Experts\RaizePaletteMenu100.bpl
; Help Link Expert for Delphi by anDY STUDiO
..\..\Experts\HelpLink.bpl
; Delphi Sample Components
..\..\Bin\dclsmp100.bpl

; Пакеты лежат рядом с dclusr100.bpl, например в \Projects\Bpl
; Indy 10
IndySystem100.bpl
IndyCore100.bpl
IndyProtocols100.bpl
dclIndyCore100.bpl
dclIndyProtocols100.bpl
; Tnt Unicode
TntUnicodeVcl100.bpl
TntUnicodeVcl_Design100.bpl

DTurboPLoader.pas

//
//  Модуль автоматической регистрации сторонних пакетов и экспертов в среде
//  Turbo Delphi Explorer (обход ограничения Turbo Delphi Explorer 2006).
//
//  Порядок использования:
//  1. Проверить файл \lib\dclusr.bdsproj на наличие заблокированных пакетов,
//     если есть то удалить, подредактировав dclusr.bdsproj;
//  2. Скопировать текущий файл (DTurboPLoader.pas) в папку \lib
//     (рядом с dclusr.dpk);
//  3. Открыть пакет \lib\dclusr.dpk и добавить в него текущий файл
//     (DTurboPLoader.pas);
//  5. Сделать Build и Install пакета dclusr.dpk
//  6. Найти файл dclusr100.bpl, смотри путь в настройках:
//     [ Tools | Options | Environment Options | Delphi Options |
//       Library - Win32 | Directories | Package output directory ]
//     По умолчанию сюда попадут все компилируемые вами пакеты.
//  7. Рядом с dclusr100.bpl создать текстовый файл DTurboPLoader.ini
//  8. В файле DTurboPLoader.ini указать список пакетов для загрузки. Каждый
//     пакет с новой строки. Указывать полный путь. Если пакет лежит рядом
//     с dclusr100.bpl (смотри выше), то можно указать только имя. Строку можно
//     закомментировать, указав вначале символ ;
//     Например:
//       C:\Borland\BDS\4.0\bpl\DclEhLib100.bpl
//       C:\Borland\BDS\4.0\bpl\DclEhLibDataDrivers100.bpl
//
//  Пакеты будут загружены при следующем запуске Delphi. Если пакет зависит от
//  других пакетов или DLL, то их нужно положить в папку \Bin. Либо рядом
//  с пакетом, но добавить в DTurboPLoader.ini перед ним.
//
//  Based on Loader.pas:
//  (c) Казанцев Алексей (kazantsev.alexey@mail.ru)
//  (c) 2009 Andrey A.P. (apkeyon@gmail.com)
//
//  Author:  nowzorro
//  Version: 2016-12-08
//  Home: https://nowzorro.blogspot.com/2016/11/turbo-delphi-package-loader.html

unit DTurboPLoader;

// Если нужен log файл с информацией о загруженных пакетах, то раскомментируйте
// define перед компиляцией dclusr.dpk
// Смотреть DTurboPLoader.log рядом с dclusr100.bpl
{$DEFINE TRACEINFO}

interface

implementation

uses
  Classes, SysUtils, Windows, ToolsAPI, SysConst;

{$IFDEF TRACEINFO}
type
  TSimpleLog = class(TStringList)
  private
    FPath: string;
  public
    constructor Create(const Path, Comment: string; Append: Boolean = False);
    destructor Destroy; override;
    procedure AddE(const E: Exception); inline;
  end;

{ TSimpleLog }

constructor TSimpleLog.Create(const Path, Comment: string; Append: Boolean);
begin
  FPath := Path;
  if Append and FileExists(Path) then
  begin
    LoadFromFile(Path);
    Add('');
  end;
  Add(FormatDateTime('dd.mm.yyyy hh:nn:ss', Now()) + ' ' + Comment);
  Add('');
end;

destructor TSimpleLog.Destroy;
begin
  SaveToFile(FPath);
  inherited;
end;

procedure TSimpleLog.AddE(const E: Exception);
begin
  Add('ERROR: ' + E.ClassName);
  Add('MSG: ' + E.Message);
end;

var
  Log: TSimpleLog = nil;
{$ENDIF}

procedure GetExportsNames(AHandle: HMODULE; AList: TStrings;
  ANameSubStr: string = '');
var
  NamePtr: PDWORD;
  ExportDir: PImageExportDirectory;
  First, PC: PChar;
  I: Integer;
  S: string;
begin
  ExportDir := Pointer(PImageNtHeaders(AHandle +
    Cardinal(PImageDosHeader(AHandle)._lfanew)).OptionalHeader.DataDirectory[
      IMAGE_DIRECTORY_ENtry_EXPORT].VirtualAddress + AHandle);
  if not Assigned(ExportDir) then
    Exit;
    
  NamePtr := Pointer(Cardinal(ExportDir.AddressOfNames) + AHandle);
  for I := 0 To ExportDir.NumberOfNames - 1 do
  begin
    PC := PChar(NamePtr^ + AHandle);
    if PC^ = '@' then
    begin
      First := PC;
      Inc(PC);
      while (PC^ <> #0) do
        Inc(PC);
      SetString(S, First, PC - First);
      if ((ANameSubStr <> '') and (Pos(UpperCase(ANameSubStr),
          UpperCase(S)) > 0)) or (ANameSubStr = '') then
        AList.Add(S);
    end;
    Inc(NamePtr);
  end;
end;

function TryLoadPackage(const Path: string): HMODULE;
var
  RegProc: TProcedure;
  ClassNames: TStringList;
  I: Integer;
begin
  Result := LoadPackage(Path);
  if Result = 0 then
    Exit;

  ClassNames := TStringList.Create;
  try
    GetExportsNames(Result, ClassNames, '@Register$qqrv');
    for I := 0 To ClassNames.Count - 1 do
    begin
      @RegProc := GetProcAddress(Result, PAnsiChar(ClassNames[I]));
      if Assigned(RegProc) then
      begin
        RegProc;
        {$IFDEF TRACEINFO}
        ClassNames[I] := 'Run: ' + ClassNames[I];
        {$ENDIF}
      end;
    end;
  finally
    {$IFDEF TRACEINFO}
    if Assigned(Log) and (ClassNames.Count > 0) then
      Log.AddStrings(ClassNames);
    {$ENDIF}
    ClassNames.Free;
  end;
end;

function WizardRegister(const Wizard: IOTAWizard): Boolean;
begin
  Result := Assigned(BorlandIDEServices) and
    ((BorlandIDEServices as IOTAWizardServices).AddWizard(Wizard) <> 0);
end;

function TryLoadExpert(const Path: string): TWizardTerminateProc;
var
  HExpert: HMODULE;
  InitProc: TWizardInitProc;
begin
  HExpert := SafeLoadLibrary(Path);
  if HExpert = 0 then
    raise EPackageError.CreateResFmt(@sErrorLoadingPackage,
      [Path, SysErrorMessage(GetLastError)]);

  @InitProc := GetProcAddress(HExpert, 'INITWIZARD0001');
  if not Assigned(InitProc) then
  begin
    {$IFDEF TRACEINFO}
    if Assigned(Log) then
      Log.Add('WARN: INITWIZARD0001 not found');
    {$ENDIF}
    Exit;
  end;

  Result := nil;
  if Assigned(BorlandIDEServices) then
  begin
    {$IFDEF TRACEINFO}
    if Assigned(Log) then
      Log.Add('Run INITWIZARD0001');
    {$ENDIF}
    if not InitProc(BorlandIDEServices, WizardRegister, Result) then
      Result := nil;
  end;
end;

const
  CONFIG_FILENAME = 'DTurboPLoader.ini';
  {$IFDEF TRACEINFO}
  LOG_FILENAME = 'DTurboPLoader.log';
  {$ENDIF}

var
  CurPath: string = '';
  I, L: Integer;
  FileName: array[0..MAX_PATH - 1] of AnsiChar;
  PackPath: string;
  HPackage: HMODULE;
  PackageHandles: array of HMODULE;
  TermProc: TWizardTerminateProc;
  ExpertTermProcs: array of TWizardTerminateProc;

initialization

  try
    if GetModuleFileNameA(HInstance, @FileName, SizeOf(FileName)) > 0 then
    begin
      CurPath := ExtractFilePath(FileName);

      {$IFDEF TRACEINFO}
      Log := TSimpleLog.Create(CurPath + LOG_FILENAME, 'Load');
      try
      {$ENDIF}

      with TStringList.Create do
        try
          LoadFromFile(CurPath + CONFIG_FILENAME);
          for I := 0 To Count - 1 do
          begin
            PackPath := Trim(Strings[I]);
            L := Length(PackPath);
            if (L = 0) or (PackPath[1] = ';') then
              Continue;
            if not FileExists(PackPath) then
            begin
              PackPath := CurPath + PackPath;
              if not FileExists(PackPath) then
                Continue;
            end;
            try
              if LowerCase(ExtractFileExt(PackPath)) = '.bpl' then
              begin
                {$IFDEF TRACEINFO}
                Log.Add('Load Package: ' + PackPath);
                {$ENDIF}
                HPackage := TryLoadPackage(PackPath);
                if HPackage <> 0 then
                begin
                  L := Length(PackageHandles);
                  SetLength(PackageHandles, L + 1);
                  PackageHandles[L] := HPackage;
                end
              end
              else
              begin
                {$IFDEF TRACEINFO}
                Log.Add('Load Expert: ' + PackPath);
                {$ENDIF}
                TermProc := TryLoadExpert(PackPath);
                if Assigned(TermProc) then
                begin
                  L := Length(ExpertTermProcs);
                  SetLength(ExpertTermProcs, L + 1);
                  ExpertTermProcs[L] := TermProc;
                end
              end;
              
            except
              {$IFDEF TRACEINFO}on E : Exception do Log.AddE(E);{$ENDIF}
            end;
          end;
        finally
          Free;
        end;

      {$IFDEF TRACEINFO}
      finally
        Log.Free;
      end;
      {$ENDIF}

    end; // if GetModuleFileNameA..
  except
  end;

finalization

  try
    if CurPath <> '' then
    begin
      {$IFDEF TRACEINFO}
      Log := TSimpleLog.Create(CurPath + LOG_FILENAME, 'Unload', True);
      try
      {$ENDIF}

      for I := Low(PackageHandles) to High(PackageHandles) do
      begin
        try
          UnloadPackage(PackageHandles[I]);
        except
          {$IFDEF TRACEINFO}on E : Exception do Log.AddE(E);{$ENDIF}
        end;
      end;

      for I := Low(ExpertTermProcs) to High(ExpertTermProcs) do
      begin
        try
          ExpertTermProcs[I];
        except
          {$IFDEF TRACEINFO}on E : Exception do Log.AddE(E);{$ENDIF}
        end;
      end;

      {$IFDEF TRACEINFO}
      finally
        Log.Free;
      end;
      {$ENDIF}

    end; // if CurPath..
  except
  end;

end.