MultiPlug2

package PluginInterface;

{$R *.res}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$IMPLICITBUILD ON}

requires
  vcl,
  rtl;

contains
  UClassManager in 'UClassManager.pas',
  UPlugin in 'UPlugin.pas';

end.

unit UClassManager;
{ ============================================= }

{ ============================================= }
interface
{ ============================================= }
uses
  Classes;

type
  TClassManager = class(TList);

function ClassManager: TClassManager;

{ ============================================= }
implementation
{ ============================================= }
var
  Manager: TClassManager;

function ClassManager: TClassManager;
begin
  Result := Manager;
end;

{ ============================================= }
initialization
{ ============================================= }
Manager := TClassManager.Create;

{ ============================================= }
finalization
{ ============================================= }
Manager.Free;

end.

{ ============================================= }
unit UPlugin;
{ ============================================= }

{ ============================================= }
interface
{ ============================================= }

type
  IPluginHost = interface;
  TPlugin = class
  public
    Host: IPluginHost;
    class function Name: string; virtual; abstract;
    class function Group: string; virtual; abstract;
    class function Pos: integer; virtual; abstract;
    class function UserGroups: string; virtual; abstract;
    class function AutoLoad: Boolean; virtual; abstract;
    class function Hidden: Boolean; virtual; abstract;
    procedure Exec(App, Scr: Integer; _Login, _Password, _DataSource, _PicturesDir: string); virtual; abstract;
  end;

  TPluginClass = class of TPlugin;
  IPluginHost = interface
    function RegisterPlugin(PluginClass: TClass): boolean;
    procedure RunPlugin(PluginName: string);
  end;


{ ============================================= }
implementation
{ ============================================= }

end{ ========================================= }.

package TestPlugin;

{$R *.res}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$IMPLICITBUILD ON}

requires
  rtl,
  vcl,
  PluginInterface;

contains
  TestUnit in 'TestUnit.pas' {TestForm},
  UTestPlugin in 'UTestPlugin.pas';

end.

unit UTestPlugin;

interface

uses
  UClassManager, UPlugin;

type
  TTestPlugin = class(TPlugin)
    class function Name: string; override;
    class function Group: string; override;
    class function Pos: integer; override;
    class function UserGroups: string; override;
    class function AutoLoad: Boolean; override;
    class function Hidden: Boolean; override;
    procedure Exec(App, Scr: Integer; _Login, _Password, _DataSource, _PicturesDir: string); override;
  end;

implementation

uses
  TestUnit, Forms;

class function TTestPlugin.Name: string;
begin
  Result := 'Тестовый плагин';
end;

class function TTestPlugin.Group: string;
begin
  Result := 'Справочники'
end;

class function TTestPlugin.Pos: integer;
begin
  Result := 100;
end;

class function TTestPlugin.UserGroups: string;
begin
  Result := '1';
end;

class function TTestPlugin.AutoLoad: Boolean;
begin
  Result := false;
end;

class function TTestPlugin.Hidden: Boolean;
begin
  Result := false;
end;

procedure TTestPlugin.Exec(App, Scr: Integer; _Login, _Password, _DataSource, _PicturesDir: string);
begin
  if not Assigned(TestForm) then
    Application.CreateForm(TTestForm, TestForm);
end;

initialization
  ClassManager.Add(TTestPlugin);

finalization
  ClassManager.Remove(TTestPlugin);

end.

unit MainUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Data.DB, Data.Win.ADODB,
  Vcl.Menus, DbLogDlg, Generics.Collections,
  Inifiles, Types, StrUtils, UPlugin;

type
  TMainForm = class(TForm, IPluginHost)
    MainMenu: TMainMenu;
    Edit1: TMenuItem;
    Undo1: TMenuItem;
    Repeat1: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    PasteSpecial1: TMenuItem;
    Find1: TMenuItem;
    Replace1: TMenuItem;
    GoTo1: TMenuItem;
    Links1: TMenuItem;
    Object1: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Window1: TMenuItem;
    Tile1: TMenuItem;
    Cascade1: TMenuItem;
    ArrangeAll1: TMenuItem;
    Hide1: TMenuItem;
    Show1: TMenuItem;
    N6: TMenuItem;
    Help1: TMenuItem;
    Contents1: TMenuItem;
    SearchforHelpOn1: TMenuItem;
    HowtoUseHelp1: TMenuItem;
    About1: TMenuItem;
    DataBase: TMenuItem;
    Connect: TMenuItem;
    CloseConnection: TMenuItem;
    Exit2: TMenuItem;
    N8: TMenuItem;
    ADOMainConnection: TADOConnection;
    N1: TMenuItem;
    ScanPlugins: TMenuItem;
    ADOUserQuery: TADOQuery;
    DetachPlugins: TMenuItem;
    N2: TMenuItem;
    Next1: TMenuItem;
    CloseTimer: TTimer;
    JrnQuery: TADOQuery;
    ScheduleTimer: TTimer;
    DocumentsMenuItem: TMenuItem;
    MaterialsMenuItem: TMenuItem;
    GrMaterialsMenuItem: TMenuItem;
    PlansMenuItem: TMenuItem;
    CatalogsMenuItem: TMenuItem;
    ManagingMenuItem: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Exit2Click(Sender: TObject);
    procedure ScanPluginsClick(Sender: TObject);
    procedure CloseConnectionClick(Sender: TObject);
    procedure ConnectClick(Sender: TObject);
    procedure Tile1Click(Sender: TObject);
    procedure Cascade1Click(Sender: TObject);
    procedure ArrangeAll1Click(Sender: TObject);
    procedure Hide1Click(Sender: TObject);
    procedure DetachPluginsClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CloseTimerTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ScheduleTimerTimer(Sender: TObject);
    function RegisterPlugin(PluginClass: TClass): boolean;
  private
    Handles: TList<HModule>;
    MenuDict: TDictionary<string, TMenuItem>;
    PicturesDir: string;
    FirstScheduleFlag, SecondScheduleFlag: boolean;
    ImportPlanMenuItem: TMenuItem;
    procedure RescanPluginsDir;
    procedure RefreshPluginsList;
    procedure PlugClick(Sender: TObject);
    procedure ReadIniFile;
    procedure OkButtonClickNoClose(Sender: TObject);
    function BuildDbParams(ConnectionString: string): TDictionary<string, string>;
    function BuildConnectionString(DBParams: TDictionary<string, string>): string;
    function GetUserGroup: integer;
    procedure ClearPlugins;
    procedure RunFlagCloser;
    procedure RunPlugin(PluginName: string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

uses LoginUnit, OleAuto, SplashUnit, UClassManager;

procedure TMainForm.Cascade1Click(Sender: TObject);
begin
  Cascade;
end;

procedure TMainForm.CloseConnectionClick(Sender: TObject);
begin
  ADOMainConnection.Close;
end;

procedure TMainForm.CloseTimerTimer(Sender: TObject);
begin
  if FileExists('flagClose.txt') then begin
    Close;
    RunFlagCloser;
  end;
end;

procedure TMainForm.ConnectClick(Sender: TObject);
begin
  if ADOMainConnection.Connected then
    ADOMainConnection.Close;
  while not ADOMainConnection.Connected do
    case LoginForm.ShowModal of
      mrOk: try
        OkButtonClickNoClose(Sender);
      except
        on Ex: EOleException do MessageDlg(Ex.Message, mtError, [mbRetry], 0);
        on Ex: Exception do MessageDlg(Ex.Message, mtError, [mbRetry], 0);
      end;
      mrCancel: Exit;
    end;
end;

procedure TMainForm.DetachPluginsClick(Sender: TObject);
begin
  ClearPlugins;
end;

procedure TMainForm.Exit2Click(Sender: TObject);
begin
  Close;
end;

function TMainForm.BuildDbParams(ConnectionString: string): TDictionary<string, string>;
var
  s: string;
  Pair: TStringDynArray;
begin
  Result := TDictionary<string, string>.Create;
  for s in SplitString(ConnectionString, ';') do if PosEx('=', s) > 0 then begin
    Pair := SplitString(s, '=');
    Result.Add(Pair[0], Pair[1]);
  end;
end;

procedure TMainForm.ArrangeAll1Click(Sender: TObject);
begin
  ArrangeIconicWindows(Handle);
end;

function TMainForm.BuildConnectionString(DBParams: TDictionary<string, string>): string;
var
  Pair: TPair<string, string>;
begin
  Result := '';
  for Pair in DBParams do
    Result := Result + ';' + Pair.Key + '=' + Pair.Value;
  Result := RightStr(Result, Length(Result) - 1);
end;

procedure TMainForm.ReadIniFile;
var
  IniFile: TIniFile;
  DBParams: TDictionary<string, string>;
begin
  IniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI'));
  try
    DBParams := BuildDbParams(ADOMainConnection.ConnectionString);
    DBParams['Data Source'] := IniFile.ReadString('Main', 'DataBase', DBParams['Data Source']);
    DBParams['User ID'] := IniFile.ReadString('Main', 'Login', DBParams['User ID']);
    ADOMainConnection.ConnectionString := BuildConnectionString(DBParams);
    LoginForm.LoginEdit.Text := DBParams['User ID'];
    PicturesDir := IniFile.ReadString('Main', 'PicturesDir', '');
  finally
    IniFile.Free;
  end;
end;

procedure TMainForm.OkButtonClickNoClose(Sender: TObject);
var
  IniFile: TIniFile;
begin
  if FileExists('flagClose.txt') then begin
    RunFlagCloser;
    Application.Terminate;
    Exit;
  end;
  if ADOMainConnection.Connected then
    ADOMainConnection.Close;
  ADOMainConnection.Open(LoginForm.LoginEdit.Text, LoginForm.PasswordEdit.Text);
  if ADOUserQuery.Active then
    ADOUserQuery.Close;
  ADOUserQuery.Open;
  if ADOUserQuery['UserActive'] = 0 then
    raise Exception.Create('Пользователь неактивен, вход в систему запрещается');
  with JrnQuery, Parameters do begin
    ParamValues['pOperType;pUserName;pChanges'] := VarArrayOf([3, UpperCase(LoginForm.LoginEdit.Text), 'Вход в систему']);
    ExecSQL;
  end;
  CloseTimer.Enabled := True;
  {
  IniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI'));
  try
    IniFile.WriteString('Main', 'Login', LoginForm.LoginEdit.Text);
  finally
    IniFile.Free;
  end;
  }
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if ADOMainConnection.Connected then with JrnQuery, Parameters do begin
    ParamValues['pOperType;pUserName;pChanges'] := VarArrayOf([4, UpperCase(LoginForm.LoginEdit.Text), 'Выход из системы']);
    ExecSQL;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  LoginForm := TLoginForm.Create(Self);
  ReadIniFile;
  while not ADOMainConnection.Connected do
    case LoginForm.ShowModal of
      mrOk: try
        OkButtonClickNoClose(Sender);
      except
        on Ex: EOleException do MessageDlg(Ex.Message, mtError, [mbRetry], 0);
        on Ex: Exception do MessageDlg(Ex.Message, mtError, [mbRetry], 0);
      end;
      mrCancel: begin
        Close;
        Application.Terminate;
        Abort;
      end;
    end;
  MenuDict := TDictionary<string, TMenuItem>.Create;
  MenuDict.Add('Документы', DocumentsMenuItem);
  MenuDict.Add('Материалы', MaterialsMenuItem);
  MenuDict.Add('Группы материалов', GrMaterialsMenuItem);
  MenuDict.Add('Планы', PlansMenuItem);
  MenuDict.Add('Справочники', CatalogsMenuItem);
  MenuDict.Add('Администрирование', ManagingMenuItem);
  Handles := TList<HModule>.Create;
  RescanPluginsDir;
end;

procedure TMainForm.FormShow(Sender: TObject);
var
  Pair: TPair<string, TMenuItem>;
  I: Integer;
  Plugin: TPlugin;
begin
  for Pair in MenuDict do
    for I := 0 to Pair.Value.Count - 1 do begin
      if Pair.Value.Items[I].Caption = '-' then
        Continue;
      Plugin := TPlugin(ClassManager[Pair.Value.Items[I].Tag]).Create;
      if Plugin.AutoLoad then
        PlugClick(Pair.Value.Items[I]);
    end;
end;

procedure TMainForm.Hide1Click(Sender: TObject);
begin
  ActiveMDIChild.Hide;
end;

procedure TMainForm.RefreshPluginsList;
var
  Pair: TPair<string, TMenuItem>;
  I: integer;
begin
  for I := 0 to ClassManager.Count - 1 do
    RegisterPlugin(ClassManager[i]);
  for Pair in MenuDict do
    Pair.Value.Visible := Pair.Value.Count > 0;
end;

procedure TMainForm.RescanPluginsDir;
var
  SearchRec : TSearchRec;
  Pair: TPair<string,TMenuItem>;
  function CountFiles(Mask: string): Integer;
  var
    Rec : TSearchRec;
  begin
    Result := 0;
    if FindFirst(Mask, faAnyFile, Rec) = 0 then
    begin
      repeat
        // Exclude directories from the list of files.
        if ((Rec.Attr and faDirectory) <> faDirectory) then
          Inc(Result);
      until FindNext(Rec) <> 0;
      FindClose(Rec);
    end;
  end;
begin
  ClearPlugins;
   //ищем первый файл
  Handles.Add(LoadPackage('PluginInterface.bpl'));
  if FindFirst('Plugins\*.bpl', faAnyFile, SearchRec) = 0 then begin
    SplashForm := TSplashForm.Create(Self);
    with SplashForm do begin
      ProgressBar.Max := CountFiles('Plugins\*.bpl');
      Show;
      repeat
        LoadingLabel.Caption := 'Загружается плагин: ' + SearchRec.Name;
        ProgressBar.Position := ProgressBar.Position + 1;
        Update;
        Application.ProcessMessages;
        Handles.Add(LoadPackage('Plugins\' + SearchRec.name));
      until FindNext(SearchRec) <> 0;
       //Загружаем последующий
      FindClose(SearchRec);  //Закрываем поиск
      RefreshPluginsList;  // Добавляем плагины в меню
      Close;
      Free;
    end;
    SplashForm := nil;
  end;
end;

procedure TMainForm.ScanPluginsClick(Sender: TObject);
begin
  RescanPluginsDir;
end;

procedure TMainForm.ScheduleTimerTimer(Sender: TObject);
begin
  if (Time > EncodeTime(0, 0, 0, 0)) and (Time < EncodeTime(0, 1, 30, 0)) then begin
    FirstScheduleFlag := False;
    SecondScheduleFlag := False;
  end;
  if (Time > EncodeTime(9, 0, 0, 0)) and (Time < EncodeTime(9, 1, 30, 0)) then if not FirstScheduleFlag then begin
    FirstScheduleFlag := True;
    PlugClick(ImportPlanMenuItem);
  end;
  if (Time > EncodeTime(13, 0, 0, 0)) and (Time < EncodeTime(13, 1, 30, 0)) then if not SecondScheduleFlag then begin
    SecondScheduleFlag := True;
    PlugClick(ImportPlanMenuItem);
  end;
end;

procedure TMainForm.Tile1Click(Sender: TObject);
begin
  Tile;
end;

function TMainForm.RegisterPlugin(PluginClass: TClass): boolean;
var
   //Объявление функции, которая будет возвращать имя плагина
  s: string;
  UsrGrps: TList<integer>;
   //Новый пункт меню
  Item, GrItem : TMenuItem;
  I: Integer;
  Res: TResourceStream;
begin
  Item := TMenuItem.Create(MainMenu);  //Создаём новый пункт меню
  if TPluginClass(PluginClass).Name <> '' then begin
    Item.Caption := TPluginClass(PluginClass).Name;
    if Item.Caption = 'Импорт планов' then
      ImportPlanMenuItem := Item;
    Item.Visible := not TPluginClass(PluginClass).Hidden;
    { TODO: разобраться, как загружать ресурсы в пакет
    try
      Res := TResourceStream.Create(MyHandle, 'bitmap', RT_RCDATA);
      Item.Bitmap.LoadFromStream(Res);
      SplashForm.ShowBitmapFromStream(Res);
    except

    end;
    }
    UsrGrps := TList<integer>.Create;
    for s in SplitString(TPluginClass(PluginClass).UserGroups, ',') do
      UsrGrps.Add(StrToInt(s));
     //Если всё прошло, идём дальше...
    if (UsrGrps.Count = 0) or (UsrGrps.IndexOf(GetUserGroup) > -1) then begin
      if not MenuDict.ContainsKey(TPluginClass(PluginClass).Group) then begin
        GrItem := TMenuItem.Create(MainMenu);
        GrItem.Caption := TPluginClass(PluginClass).Group;
        MainMenu.Items.Add(GrItem);
        MenuDict.Add(TPluginClass(PluginClass).Group, GrItem);
      end;
      Item.Tag := ClassManager.Count - 1;
      Item.onClick:=PlugClick;  //Даём ссылку на обработчик
      for I := MenuDict[TPluginClass(PluginClass).Group].Count + 1 to TPluginClass(PluginClass).Pos - 1 do begin
        GrItem := TMenuItem.Create(MainMenu);
        GrItem.Caption := '-';
        MenuDict[TPluginClass(PluginClass).Group].Add(GrItem);
      end;
      if MenuDict[TPluginClass(PluginClass).Group].Count + 1 = TPluginClass(PluginClass).Pos  then
        MenuDict[TPluginClass(PluginClass).Group].Add(Item)  //Добавляем пункт меню
      else begin
        MenuDict[TPluginClass(PluginClass).Group].Delete(TPluginClass(PluginClass).Pos  - 1);
        MenuDict[TPluginClass(PluginClass).Group].Insert(TPluginClass(PluginClass).Pos  - 1, Item);
      end;
    end;
  end;
  Result := True;
end;

function TMainForm.GetUserGroup: integer;
begin
  if ADOUserQuery.Active then
    ADOUserQuery.Close;
  ADOUserQuery.Parameters.ParamByName('pOraUser').Value := UpperCase(LoginForm.LoginEdit.Text);
  ADOUserQuery.Open;
  Result := ADOUserQuery['GrNrec'];
  ADOUserQuery.Close;
end;

procedure TMainForm.ClearPlugins;
var
  I: Integer;
  Pair: TPair<string, TMenuItem>;
begin
  for I := 0 to Handles.Count - 1 do
    UnloadPackage(Handles[I]);
  Handles.Clear;
end;

procedure TMainForm.RunFlagCloser;
var
  StartupInfo: _STARTUPINFOW;
  ProcessInfo: _PROCESS_INFORMATION;
  Exe: string;
begin
  FillChar(StartupInfo, SizeOf(StartupInfo), 0);
  StartupInfo.cb := SizeOf(StartupInfo);
  Exe := 'FlagCloser.exe';
  UniqueString(Exe);
  CreateProcess(nil, PChar(Exe), nil, nil, False, 0, nil, nil, StartupInfo, ProcessInfo);
end;

procedure TMainForm.PlugClick(Sender: TObject);
var
  //Объявление функции, которая будет выполнять плагин
  Plugin: TPlugin;
  //Хендл dll
  DBParams: TDictionary<string, string>;
  MyTag: Integer;
  Found: Boolean;
  I: Integer;
  procedure LogToFile(FileName, Str: string);
  var
    F: TextFile;
  begin
    if not FileExists(FileName) then
      FileClose(FileCreate(FileName));
    AssignFile(F, FileName);
    Append(F);
    Writeln(F, Str);
    Flush(F);
    CloseFile(F);
  end;
  procedure LaunchPlug;
  begin
    with JrnQuery, Parameters do begin
      ParamValues['pOperType;pUserName;pChanges'] := VarArrayOf([5, UpperCase(LoginForm.LoginEdit.Text), 'Запуск плагина "' + Plugin.Name + '"']);
      ExecSQL;
    end;
    Plugin.Exec(Integer(Application), Integer(Screen), LoginForm.LoginEdit.Text, LoginForm.PasswordEdit.Text, DBParams['Data Source'], PicturesDir);
  end;
begin
  with (Sender as TMenuItem) do begin
    Plugin := TPlugin(ClassManager[Tag]).Create;  //Загружаем dll
    Plugin.Host := Self;
    MyTag := Tag;
  end;
  //Загружаем функции
  DBParams := BuildDbParams(ADOMainConnection.ConnectionString);
  LogToFile('log.txt', 'Запуск плагина ' + Plugin.Name);
  LaunchPlug;
end;

procedure TMainForm.RunPlugin(PluginName: string);
begin
  //
end;

end.