Форум: "Основная";
Текущий архив: 2005.08.14;
Скачать: [xml.tar.bz2];

Вниз

Обновление программных модулей через сеть   Найти похожие ветки 

← →
Cryptopsy   (2005-07-20 22:56) [0]

Здравствуйте, уважаемые Мастера!

Сначала опишу ситуацию. Есть неболькой программный комплекс, реализованный следующим образом: программа-каркас (exe) + модули (bpl), в которых находится весь функционал. Экзешник только подгружает все пакеты, а дальше они сами определяют, что и как.

Хочется реализовать некое удаленное хранилище модулей. Программа-exe соединяется с сервером, на котором хранятся последнии версии модулей, выясняются версии модулей клиента, и если на сервере более новые, они копируются на машину клиента. Т.е. то же самое, что реализовано, например, в AVP и Outpost Firewall. Обновление пока будет вестись по локальной сети, а в дальнейшем по интернету.

Поскольку в сетевых технологиях я почти полный профан, хотелось бы узнать, в какую сторону копать и что читать. Хорошим ли будет решение реализовать серверную часть в виде COM-сервера?

Заранее благодарен за советы!

---

← →
GanibalLector ©   (2005-07-20 23:10) [1]

>Хорошим ли будет решение реализовать серверную часть в виде COM-сервера?

Ну,во-первых DCOM ;) ИМХО не стоит так делать.

---

← →
Cryptopsy   (2005-07-20 23:32) [2]

Почему?

---

← →
Mx ©   (2005-07-21 00:04) [3]

> GanibalLector ©   (20.07.05 23:10) [1]
> Ну,во-первых DCOM ;) ИМХО не стоит так делать.

Интересно, почему?

---

← →
Cryptopsy   (2005-07-21 22:13) [4]

up

---

← →
simpson ©   (2005-07-21 22:40) [5]

> Mx ©   (21.07.05 00:04) [3]

Потому что дырявая до невозможности.

По сабжу.

Не заморачиваться на изобретении велосипедов, по-шустрому переносить функционал на .NET и использовать Remoting.
IMHO.

---

← →
Cryptopsy   (2005-07-21 23:10) [6]

> Не заморачиваться на изобретении велосипедов, по-шустрому
> переносить функционал на .NET и использовать Remoting.
> IMHO.

Никак невозможно. К сожалению. Что-нибудь другое...

---

← →
simpson ©   (2005-07-21 23:19) [7]

Ну... поскольку речь идет о дальнейшем использовании через Интернет, то вполне подойдет простая связка HTTP-клиент <-> HTTP-сервер.

Т. е. твой EXE-модуль - это клиент. При старте он выполняет некий HTTP-запрос GET, в ответ на который сервер отправляет ответ, содержащий версию того или иного модуля. Затем клиент производит сравнение версий, и, если обнаружена более свежая версия модуля, выполняет еще один запрос GET и скачивает обновленный модуль.

И так для всех модулей.

Для реализации клиента и сервера можно использовать, например, Indy.

Настоятельно не рекомендовал бы использование DCOM или придумывание собственного протокола обмена между клиентом и сервером.

---

← →
Cryptopsy   (2005-07-22 07:01) [8]

Спасибо. В принципе, пойдет такое.

Немного оффтоп. А чем DCOM так глючен?

---

← →
ORMADA ©   (2005-07-22 07:36) [9]

уже реализовало и работает по локалке
есть 2 программы
1 заносит в бд новые пакеты
2 клиент стягивает и запускает

1 приводить здесь не буду - надо будет пиши на мыло ormada@mail.ru

а клиенскую часть я всё таки реализовал как бы как COM, чтобы проще было из пакета допустим к главной форме обращаться в нете даже где-то была статейка по этому поводу поищи по слову "Еще раз о Plugin"s…"
удалённое хранилище на MS SQL 2000
серверная часть
//---------------------------------------------------------------
CREATE TABLE dbo.ВерсииФайлов
(
Код                                 INT IDENTITY(1,1) NOT NULL,
КодФайла                            INT,
Файл                                IMAGE NOT NULL,
ВерсияWindows                       VARCHAR(15),
ВерсияSQL                           INT NOT NULL,
Размер                              INT NOT NULL,
ДатаВремя                           DATETIME NOT NULL,
КонтрольнаяСумма                    VARCHAR(255) NOT NULL,
КодПользователя                     INT,
Изменения                           VARCHAR(1000),
CONSTRAINT PK_ВерсииФайлов PRIMARY KEY CLUSTERED ( Код )
)
/*-------- Foreign Keys-----------------*/
ALTER TABLE dbo.ВерсииФайлов
   ADD CONSTRAINT FK_ВерсииФайлов_Файлы FOREIGN KEY( КодФайла )
   REFERENCES [dbo].[Файлы] ( Код )
   ON UPDATE NO ACTION
   ON DELETE NO ACTION;

CREATE TABLE dbo.Файлы
(
Код                                 INT IDENTITY(1,1) NOT NULL,
Имя                                 VARCHAR(255) NOT NULL,
КодАктуальнойВерсии                 INT,
CONSTRAINT PK_Файлы PRIMARY KEY CLUSTERED ( Код )
)

CREATE TABLE dbo.ФайлыПриложений
(
Код                                 INT IDENTITY(1,1) NOT NULL,
КодФайла                            INT NOT NULL,
КодПриложения                       INT NOT NULL,
CONSTRAINT PK_ФайлыПриложений PRIMARY KEY CLUSTERED ( Код )
)
/*-------- Foreign Keys-----------------*/
ALTER TABLE dbo.ФайлыПриложений
   ADD CONSTRAINT FK_ФайлыПриложений_Файлы FOREIGN KEY( КодФайла )
   REFERENCES [dbo].[Файлы] ( Код )
   ON UPDATE NO ACTION
   ON DELETE NO ACTION;

CREATE TABLE dbo.Приложения
(
Код                                 INT NOT NULL,
КодРодителя                         INT,
НомерПоПорядку                      INT,
Имя                                 VARCHAR(255),
КодФайла                            INT,
СтрокаПодключения                   VARCHAR(255),
КодТипаПриложения                   INT,
CONSTRAINT PK_Приложения PRIMARY KEY CLUSTERED ( Код )
)

CREATE TABLE dbo.ТипыПриложений
(
Код                                 INT NOT NULL,
Имя                                 VARCHAR(50),
CONSTRAINT PK_ТипыПриложений PRIMARY KEY CLUSTERED ( Код )
)

CREATE TABLE dbo.Доступ
(
Код                                 INT IDENTITY(1,1) NOT NULL,
КодКомпьютера                       INT NOT NULL,
КодПриложения                       INT NOT NULL,
КодПользователя                     INT NOT NULL,
CONSTRAINT PK_Доступ PRIMARY KEY CLUSTERED ( Код )
)
/*-------- Foreign Keys-----------------*/
ALTER TABLE dbo.Доступ
   ADD CONSTRAINT FK_Доступ_Компьютеры FOREIGN KEY( КодКомпьютера )
   REFERENCES [dbo].[Компьютеры] ( Код )
   ON UPDATE NO ACTION
   ON DELETE NO ACTION;
ALTER TABLE dbo.Доступ
   ADD CONSTRAINT FK_Доступ_Пользователи FOREIGN KEY( КодПользователя )
   REFERENCES [dbo].[Пользователи] ( Код )
   ON UPDATE NO ACTION
   ON DELETE NO ACTION;

---

← →
ORMADA ©   (2005-07-22 07:38) [10]

клиентская часть

unit UpdateARMs;

interface

uses ADODB, Classes, Forms, ComCtrls, Types, Windows, SysUtils, DB, Menus,
 ActiveX, CryptoApi, Controls, PublicProcAndFunctions, Variants, PlaceEvent;

type

 TShowForm = function(AHandle: THandle; AFormCaption: TCaption;
   AADOConnectionString: string; AUserCompInfo: TUserCompInfo; AAppCode: integer): integer;
 stdcall;

 TStatus = (UnKnow = -1, NowPosition = 0, Sucsess = 1, Failed = 2, DontNeed = 3);
 {TStatus
 -1 - нету
 0 - |>
 1 - green
 2 - red
 3 - grey
 }

 TARM = class
   FBPLFileName: string;
   FFormCaption: string;
   FConnectionString: string;
   FARMCode: integer;
   constructor Create(ABPLFileName, AFormCaption, AConnectionString: string;
     AARMCode: integer);
 end;

 TARMFile = class
   FName: string;
   FCRC: string;
   FVersion: string;
   FCode: integer;
   constructor Create(AName, ACRC, AVersion: string; ACode: integer);
 end;

 TARMs = class
 private
   { Private declarations }
   FADOStoredProc: TADOStoredProc;
   FUserCode: integer;
   FComputerCode: integer;
   FARMsListView: TListView;
   FARMFilesListView: TListView;
   FARMsList: TList;
   Spisok_IDList: TStringList;
   FMenuList: TList;
   FMainMenu: TMainMenu;
   FARMFilesList: TList;
   FARMsCount: integer;
   FSessionCode: integer;
   procedure ARMsProgressAdd(AARMsListView: TListView; AItemNum: integer; AStatus:
     TStatus);
   //--- добавление прогресса по АРМам + установка |> на следующую запись ---
   procedure ARMFilesProgressAdd(AARMFilesListView: TListView; AItemNum: integer;
     AStatus: TStatus);
   //--- добавление прогресса по Файлам АРМа + установка |> на следующую запись ---
   function CompareFileVersion(AARMFile: TARMFile): boolean;
   //--- сравнение версий файлов True-обновлять нада ---
   function DownloadFile(AARMFile: TARMFile): boolean;
   //--- скачивание файла на диск ---
   procedure GetARMFiles(AARM: TARM); //--- получение Файлов для АРМа ---
   procedure MenuClick(Sender: TObject); //--- клик мыши в меню ---
   procedure FillARMsListView(AARMsListView: TListView);
   //--- заполнение  ListView Файлов АРМа + установка |> на первую запись ---
   procedure FillARMFilesListView(AARMFilesListView: TListView);
   //--- заполнение ListView АРМов + установка |> на первую запись ---
   procedure CreateARMs(AUserCode, AComputerCode: integer);
   //--- создание TARMs ---
   procedure GetUsersARMsCount; //--- получение доступных АРМов ---

   //--- Меню ---begin---------------------------------------------------------
   function CodeInStringList(AInput_Code: Integer; AStringList: TStringList): Boolean;
   procedure Check_Menu(AProgDataset: TDataSet; AInput_Code: Integer);
   procedure Build_Menu(AProgDataset: TDataSet; AInput_Menu: TMenuItem; AInput_Code: Integer);

   procedure AddSubItem(AName_Menu: string; AInput_Menu: TMenuItem; AInput_Proc:
     Boolean; AInput_Code: Integer);

   procedure AddMainItem(AName_Menu: string; AInput_Menu: TMenuItem; AInput_Type:
     Integer; AInput_Code: Integer); ///добавляет на тот же уровнь
   //--- Меню ---end-----------------------------------------------------------

   function UserInARM(AARMCode: integer): boolean;
   function UserOutARM(AARMCode: integer): boolean;

   function SetPlaceEvent: boolean;
   //--- установка места события ----------------------------------------------

   property ARMFilesList: TList read FARMFilesList write FARMFilesList;
 public
   { Public declarations }
   ReeBootNeeded: boolean;
   constructor Create(AADOStoredProc: TADOStoredProc; AUserCode, AComputerCode: integer);
   destructor Destroy; override;

   function UpdateExecute(AARMsListView, AARMFilesListView: TListView): Boolean;
   procedure FillARMsMainMenu(AMainMenu: TMainMenu);
   //--- заполнение Главного меню АРМами

   procedure RunARM(AARM: TARM);
   property ARMsCount: integer read FARMsCount;
   property ARMsList: TList read FARMsList write FARMsList;
 end;

var
 ARMs: TARMs;

implementation

{ TARMs }

function TARMs.CompareFileVersion(AARMFile: TARMFile): boolean;
var
 Hash: string;
begin
 Result := False;
 FADOStoredProc.Close;

 FADOStoredProc.ProcedureName := "Get_Загрузчик_СравнитьВерсиюФайла";
 FADOStoredProc.Parameters.Refresh;
 try

   FADOStoredProc.Parameters.ParamByName("@КодВерсииФайла").Value := AARMFile.FCode;
   FADOStoredProc.Parameters.ParamByName("@ЛокальнаяВерсияWindows").Value :=
     FileVersion(AARMFile.FName).FileVersion;

   HashFile(HASH_CRC32, ExtractFileDir(Application.ExeName) + "\" +
     AARMFile.FName, Hash);
   FADOStoredProc.Parameters.ParamByName("@ЛокальнаяКонтрольнаяСумма").Value := Hash;
   FADOStoredProc.ExecProc;
   Result := Boolean(FADOStoredProc.Parameters.ParamByName("@RETURN_VALUE").Value);

 except
   Application.MessageBox(PAnsiChar(CreateExecuteErrorInfo(FADOStoredProc) + #13 + "Обратитесь к Администратору"),
     "Ошибка выполнения процедуры!", MB_ICONERROR);
 end;
end;

constructor TARMs.Create(AADOStoredProc: TADOStoredProc; AUserCode, AComputerCode: integer);
begin
 FADOStoredProc := AADOStoredProc;
 FUserCode := AUserCode;
 FComputerCode := AComputerCode;
 ARMsList := TList.Create;

 Spisok_IDList := TStringList.Create;

 FMenuList := TList.Create;
 ReeBootNeeded := False;
 GetUsersArmsCount; //--- Заполнение FARMsCount ---
end;

destructor TARMs.Destroy;
var
 i: integer;
begin
 if Assigned(ARMsList) then
 begin
   for i := ARMsList.Count - 1 downto 0 do
     TARM(ARMsList.Items[i]).Free;
   ARMsList.Clear;
   FreeAndNil(FARMsList);
 end;

 if Assigned(Spisok_IDList) then
 begin
   Spisok_IDList.Clear;
   FreeAndNil(Spisok_IDList);
 end;

 if Assigned(FMenuList) then
 begin
   for i := FMenuList.Count - 1 downto 0 do
     TMenuItem(FMenuList.Items[i]).Free;
   FreeAndNil(FMenuList);
 end;
end;



---

← →
ORMADA ©   (2005-07-22 07:39) [11]


function TARMs.DownloadFile(AARMFile: TARMFile): boolean;
var
 MS: TMemoryStream;
begin
 FADOStoredProc.Close;

 FADOStoredProc.ProcedureName := "Get_Загрузчик_ПолучитьВерсиюФайла;1";
 FADOStoredProc.Parameters.Refresh;
 try

   FADOStoredProc.Parameters.ParamByName("@КодВерсииФайла").Value := AARMFile.FCode;
   FADOStoredProc.Parameters.ParamByName("@Имя").Value := Null;
   FADOStoredProc.Open;

   if FileExists("Loader.exe.old") then
     DeleteFile("Loader.exe.old");

   if FileExists("Loader.exe") then
     RenameFile("Loader.exe", "Loader.exe.old");

   MS := TMemoryStream.Create;
   try
     TBLOBField(FADOStoredProc.FieldByName("Файл")).SaveToStream(ms);
     UnPackStream(MS);

     MS.Position := 0;
     MS.SaveToFile(AARMFile.FName);
   finally
     MS.Free;
   end;

   Application.ProcessMessages;

   if LowerCase(FADOStoredProc.Parameters.ParamByName("@Имя").Value) = "loader.exe" then
     ReeBootNeeded := True;

   FADOStoredProc.Close;
   Result := True;

   if not FileExists("Loader.exe") then
     if FileExists("Loader.exe.old") then
       RenameFile("Loader.exe.old", "Loader.exe");

 except;
   Result := False;
   if not FileExists("Loader.exe") then
     if FileExists("Loader.exe.old") then
       RenameFile("Loader.exe.old", "Loader.exe");

   Application.MessageBox(PAnsiChar(CreateExecuteErrorInfo(FADOStoredProc) + #13 + "Обратитесь к Администратору"),
     "Ошибка выполнения процедуры!", MB_ICONERROR);
 end;
end;

procedure TARMs.FillARMsListView(AARMsListView: TListView);
var
 i: integer;
 ARMsListCount: integer;
begin
 AARMsListView.Clear;
 ARMsListCount := ARMsList.Count;

 for i := 0 to ARMsListCount - 1 do
 begin
   AARMsListView.Items.Add;
   AARMsListView.Items.Item[AARMsListView.Items.Count - 1].Caption :=
     TARM(ARMsList.Items[i]).FFormCaption;
   if i = 0 then
     AARMsListView.Items.Item[AARMsListView.Items.Count - 1].ImageIndex :=
       Ord(NowPosition) //--- установка |> на первую запись ---
   else
     AARMsListView.Items.Item[AARMsListView.Items.Count - 1].ImageIndex :=
       Ord(UnKnow);
 end;
end;

procedure TARMs.GetARMFiles(AARM: TARM);
var
 ARMFile: TARMFile;
 i: integer;
begin
 FADOStoredProc.Close;

 FADOStoredProc.ProcedureName := "Get_Загрузчик_ПолучитьФайлыПриложений;1";
 FADOStoredProc.Parameters.Refresh;
 try

   FADOStoredProc.Parameters.ParamByName("@КодПриложения").Value := AARM.FARMCode;
   FADOStoredProc.Parameters.ParamByName("@КодПользователя").Value := FUserCode;
   FADOStoredProc.Parameters.ParamByName("@КодКомпьютера").Value := FComputerCode;
   FADOStoredProc.Open;

   if ARMFilesList.Count > 0 then //--- убиваем ранее созданные TARMFile ---
   begin
     for i := ARMFilesList.Count - 1 downto 0 do
       TARMFile(ARMFilesList.Items[i]).Free;
     ARMFilesList.Clear;
   end;

   while not FADOStoredProc.Eof do
   begin
     ARMFile := TARMFile.Create(FADOStoredProc.FieldByName("Имя").AsString,
       FADOStoredProc.FieldByName("КонтрольнаяСумма").AsString,
       FADOStoredProc.FieldByName("ВерсияWindows").AsString,
       FADOStoredProc.FieldByName("КодАктуальнойВерсии").AsInteger);

     ARMFilesList.Add(ARMFile);
     FADOStoredProc.Next;
   end;
   FADOStoredProc.Close;

 except
   Application.MessageBox(PAnsiChar(CreateExecuteErrorInfo(FADOStoredProc) + #13 + "Обратитесь к Администратору"),
     "Ошибка выполнения процедуры!", MB_ICONERROR);
 end;
end;

procedure TARMs.GetUsersARMsCount;
begin
 FARMsCount := 0;
 FADOStoredProc.Close;

 FADOStoredProc.ProcedureName := "Get_Загрузчик_ПолучитьКоличествоАРМовДоступныеПользователю;1";
 FADOStoredProc.Parameters.Refresh;
 try

   FADOStoredProc.Parameters.ParamByName("@КодКомпьютера").Value := FComputerCode;
   FADOStoredProc.Parameters.ParamByName("@КодПользователя").Value := FUserCode;

   FADOStoredProc.ExecProc;

   FARMsCount := FADOStoredProc.Parameters.ParamByName("@RETURN_VALUE").Value;
 except
   Application.MessageBox(PAnsiChar(CreateExecuteErrorInfo(FADOStoredProc) + #13 + "Обратитесь к Администратору"),
     "Ошибка выполнения процедуры!", MB_ICONERROR);
 end;
end;

function TARMs.UpdateExecute(AARMsListView, AARMFilesListView: TListView):
 Boolean;
var
 i, j: integer;
 ARMsListCount, ARMFilesListCount: integer;
 FFailed, FDontNeed: boolean;
begin
 try
   Result := False;
   Screen.Cursor := crHourGlass;
   FARMsListView := AARMsListView;
   FARMFilesListView := AARMFilesListView;

   //--- получили кол-во доступных АРМов ---
   if FARMsCount > 0 then
   begin
     CreateARMs(FUserCode, FComputerCode);
     FillARMsListView(FARMsListView); //--- заполнили ListView АРМов ---

     ARMFilesList := TList.Create;
     try

       ARMsListCount := ARMsList.Count;

       for i := 0 to ARMsListCount - 1 do
       begin

         if Self.ReeBootNeeded then Exit;

         GetARMFiles(TARM(ARMsList.Items[i]));
         //--- получаем список файлов для АРМа ---

         FillARMFilesListView(FARMFilesListView);
         //--- заполнили ListView ФАйлов для АРМа ---

         FFailed := False;
         FDontNeed := True;
         ARMFilesListCount := ARMFilesList.Count;

         if ARMFilesListCount > 0 then
         begin

           for j := 0 to ARMFilesListCount - 1 do
           begin

             if FileExists(TARMFile(ARMFilesList.Items[j]).FName) then
               //--- если файл существует ---
               if not CompareFileVersion(TARMFile(ARMFilesList.Items[j])) then
                 //--- если версии совпадают -> идём дальше ---
               begin
                 ARMFilesProgressAdd(FARMFilesListView, j, DontNeed);
                 continue;
               end;

             if DownloadFile(TARMFile(ARMFilesList.Items[j])) then
             begin
               ARMFilesProgressAdd(FARMFilesListView, j, Sucsess);
               FDontNeed := False;
             end
             else
             begin
               ARMFilesProgressAdd(FARMFilesListView, j, Failed);
               FFailed := True;
               FDontNeed := False;
             end;
           end;

           if FFailed then
             FDontNeed := False;
           //--- если хоть 1 неудалось обновить то результат провал ---

           if FFailed then
             ARMsProgressAdd(FARMsListView, i, Failed)
           else if FDontNeed then
             ARMsProgressAdd(FARMsListView, i, DontNeed)
           else
             ARMsProgressAdd(FARMsListView, i, Sucsess);

         end
         else
           //--- если файлов нет то хз какой результат обновления -----------------
           ARMsProgressAdd(FARMsListView, i, DontNeed);
       end;

       Result := True;
     finally
       if ARMFilesList.Count > 0 then //--- убиваем ранее созданные TARMFile ---
         for j := ARMFilesList.Count - 1 downto 0 do
           TARMFile(ARMFilesList.Items[j]).Free;
       ARMFilesList.Clear;
       FreeAndNil(FARMFilesList);
     end;
   end;
 finally
   Screen.Cursor := crDefault;
 end;
end;



---

← →
ORMADA ©   (2005-07-22 07:40) [12]


procedure TARMs.ARMFilesProgressAdd(AARMFilesListView: TListView; AItemNum:
 integer; AStatus: TStatus);
begin
 AARMFilesListView.Items.Item[AItemNum].ImageIndex := Ord(AStatus);
 if AARMFilesListView.Items.Count > AItemNum + 1 then
   AARMFilesListView.Items.Item[AItemNum + 1].ImageIndex := Ord(NowPosition);
 //--- установка |> на следующую запись ---
 Application.ProcessMessages;
end;

procedure TARMs.ARMsProgressAdd(AARMsListView: TListView; AItemNum: integer;
 AStatus: TStatus);
begin
 AARMsListView.Items.Item[AItemNum].ImageIndex := Ord(AStatus);
 if AARMsListView.Items.Count > AItemNum + 1 then
   AARMsListView.Items.Item[AItemNum + 1].ImageIndex := Ord(NowPosition);
 //--- установка |> на следующую запись ---
 Application.ProcessMessages;
end;

procedure TARMs.FillARMsMainMenu(AMainMenu: TMainMenu);
var
 i: integer;
begin //--- заполнение МЕНЮ ---
 FMainMenu := AMainMenu;

 Spisok_IDList.Clear;
 FADOStoredProc.Close;

 FADOStoredProc.ProcedureName := "Get_Загрузчик_Приложения;1";
 FADOStoredProc.Parameters.Refresh;
 try
   FADOStoredProc.Parameters.ParamByName("@КодТипаПриложения").Value := -1;

   FADOStoredProc.Open;
 except
   Application.MessageBox(PAnsiChar(CreateExecuteErrorInfo(FADOStoredProc) + #13 + "Обратитесь к Администратору"),
     "Ошибка выполнения процедуры!", MB_ICONERROR);
 end;

 FADOStoredProc.Filter := "";
 FADOStoredProc.Filtered := True;

 for i := 0 to ARMsList.Count - 1 do
   Check_Menu(FADOStoredProc, TARM(ARMsList.Items[i]).FARMCode);

 Build_Menu(FADOStoredProc, FMainMenu.Items, 1);

 AddMainItem("Выход", FMainMenu.Items, 3, -1);

 FADOStoredProc.Close;
end;

procedure TARMs.AddMainItem(AName_Menu: string; AInput_Menu: TMenuItem; AInput_Type:
 Integer; AInput_Code: Integer); ///добавляет на тот же уровнь
var
 NewItem: TMenuItem;
begin
 NewItem := TMenuItem.Create(Application);
 NewItem.Caption := AName_Menu;

 if AInput_Type = 3 then NewItem.OnClick := MenuClick;
 NewItem.Tag := AInput_Code;

 AInput_Menu.Insert(AInput_Menu.Count, NewItem);
 FMenuList.Add(NewItem);
end;

procedure TARMs.AddSubItem(AName_Menu: string; AInput_Menu: TMenuItem; AInput_Proc:
 Boolean; AInput_Code: Integer);
var
 NewItem, ToItem: TMenuItem;
begin
 ToItem := AInput_Menu.Items[AInput_Menu.Count - 1];
 NewItem := TMenuItem.Create(ToItem);

 NewItem.Caption := AName_Menu;

 if AInput_Proc then NewItem.OnClick := MenuClick;
 NewItem.Tag := AInput_Code;
 ToItem.Insert(ToItem.Count, NewItem);
 FMenuList.Add(Pointer(NewItem));
end;

procedure TARMs.MenuClick(Sender: TObject);
var
 i: integer;
 InitialDir: string;
begin
 InitialDir := ExtractFileDir(Application.ExeName);
 for i := 0 to ARMsList.Count - 1 do
 begin
   if TMenuItem(Sender).Tag = -1 then
   begin
     Application.Terminate;
     Exit;
   end;

   if TARM(ARMsList.Items[i]).FARMCode = TMenuItem(Sender).Tag then
   begin
     if TARM(ARMsList.Items[i]).FARMCode in [0, 1] then Exit;
     RunARM(TARM(ARMsList.Items[i]));
     ChDir(InitialDir);
     Exit;
   end;
 end;
end;

procedure TARMs.RunARM(AARM: TARM);
var
 HandlePack: THandle;
 ShowForm: TShowForm;
 PackageFileName,
   PackageFormCaption,
   ConnectioinString: string;
begin
 PackageFileName := AARM.FBPLFileName;
 PackageFormCaption := AARM.FFormCaption;
 ConnectioinString := AARM.FConnectionString;
 HandlePack := 0;

 Screen.Cursor := crHourGlass;
 Screen.ActiveForm.Caption := "Подождите идёт загрузка АРМа [" +
   PackageFormCaption + "] !";
 Application.ProcessMessages;
 try

   if not FileExists(PackageFileName) then
   begin
     Application.MessageBox(PAnsiChar("Невозможно загрузить " +
       PackageFormCaption + #13 +
       "Файл " + PackageFileName + " не найден!" + #13 +
       "Обратитесь к Администратору"),
       "Ошибка!", MB_OK + MB_ICONERROR);
     Abort;
   end;

   try

     try
       HandlePack := LoadPackage(PackageFileName);
     except
       Application.MessageBox(PAnsiChar("Невозможно загрузить " +
         PackageFormCaption + #13 + "Произошла следующая ошибка:" + #13 +
         Exception(ExceptObject).Message + #13 +
         "Обратитесь к Администратору"),
         "Ошибка!", MB_OK + MB_ICONERROR);
       Abort;
     end;

     if HandlePack > 0 then
     begin
       @ShowForm := GetProcAddress(HandlePack, "ShowForm");
       if addr(ShowForm) <> nil then
       begin

         if not SetPlaceEvent then Exit; //--- установка места события -------------------------

         CoInitialize(nil);
         try

           if ARMsCount > 1 then
             Screen.ActiveForm.WindowState := wsMinimized;
           Screen.Cursor := crDefault;

           if not UserInARM(AARM.FARMCode) then //--- вход юзера в АРМ ---
             Exit

           else
           try

             try
               ShowForm(Application.Handle, PackageFormCaption,
                 ConnectioinString, UserCompInfo, AARM.FARMCode);
             except
               Application.MessageBox(PAnsiChar("Невозможно загрузить " +
                 PackageFormCaption + #13 + "Произошла следующая ошибка:" + #13 +
                 Exception(ExceptObject).Message +
                 #13 + "Обратитесь к Администратору"),
                 "Ошибка!", MB_OK + MB_ICONERROR);
               Exit;
             end;

           finally
             UserOutARM(AARM.FARMCode); //--- выход юзера из АРМа ---
           end;

         finally
           CoUninitialize;
           if ARMsCount > 1 then
             Screen.ActiveForm.WindowState := wsNormal;
         end;

       end
       else
         Application.MessageBox(PAnsiChar("Невозможно загрузить " +
           PackageFormCaption + #13 + "Процедура ShowForm не найдена!" + #13 +
           "Обратитесь к Администратору"),
           "Ошибка!", MB_OK + MB_ICONERROR);
     end
     else
       Application.MessageBox(PAnsiChar("Невозможно загрузить " +
         PackageFileName + #13 + "Обратитесь к Администратору"),
         "Ошибка!", MB_OK + MB_ICONERROR);

   finally
     if HandlePack > 0 then
       UnloadPackage(HandlePack);
   end;

 finally
   Screen.Cursor := crDefault;
   if ARMsCount > 1 then
     Screen.ActiveForm.Caption := "Главная форма."
 end;
end;



---

← →
ORMADA ©   (2005-07-22 07:40) [13]


procedure TARMs.CreateARMs(AUserCode, AComputerCode: integer);
var
 ARM: TARM;
begin
 FADOStoredProc.Close;

 FADOStoredProc.ProcedureName := "Get_Загрузчик_ПолучитьАРМыДоступныеПользователю;1";
 try
   FADOStoredProc.Parameters.Refresh;

   FADOStoredProc.Parameters.ParamByName("@КодКомпьютера").Value := FComputerCode;
   FADOStoredProc.Parameters.ParamByName("@КодПользователя").Value := FUserCode;
   FADOStoredProc.Open;

   while not FADOStoredProc.Eof do
   begin
     ARM := TARM.Create(FADOStoredProc.FieldByName("ИмяОсновногоФайла").AsString,
       FADOStoredProc.FieldByName("Имя").AsString,
       FADOStoredProc.FieldByName("СтрокаПодключения").AsString,
       FADOStoredProc.FieldByName("Код").AsInteger);

     ARMsList.Add(ARM);
     FADOStoredProc.Next;
   end;
   FADOStoredProc.Close;

 except
   Application.MessageBox(PAnsiChar(CreateExecuteErrorInfo(FADOStoredProc) + #13 + "Обратитесь к Администратору"),
     "Ошибка выполнения процедуры!", MB_ICONERROR);
 end;
end;

function TARMs.UserInARM(AARMCode: integer): boolean;
begin
 FSessionCode := -1;
 Result := True;

 FADOStoredProc.Close;

 FADOStoredProc.ProcedureName := "Ins_Загрузчик_НачалоКлиентскойСессии;1";
 try
   FADOStoredProc.Parameters.Refresh;
   FADOStoredProc.Parameters.ParamByName("@КодПользователя").Value := FUserCode;
   FADOStoredProc.Parameters.ParamByName("@КодКомпьютера").Value := FComputerCode;
   FADOStoredProc.Parameters.ParamByName("@КодМестаСобытия").Value := UserCompInfo.PlaceCode;
   FADOStoredProc.Parameters.ParamByName("@КодПриложения").Value := AARMCode;

   FADOStoredProc.ExecProc;

   if FADOStoredProc.Parameters.ParamByName("@RETURN_VALUE").Value <> Null then
     FSessionCode := FADOStoredProc.Parameters.ParamByName("@RETURN_VALUE").Value
   else
     Application.MessageBox(PAnsiChar(CreateExecuteErrorInfo(FADOStoredProc) + #13 + "Обратитесь к Администратору"),
       "Ошибка выполнения процедуры!", MB_ICONERROR);

 except
   Result := False;
   Application.MessageBox(PAnsiChar(CreateExecuteErrorInfo(FADOStoredProc) + #13 + "Обратитесь к Администратору"),
     "Ошибка выполнения процедуры!", MB_ICONERROR);
 end;
end;

function TARMs.UserOutARM(AARMCode: integer): boolean;
begin
 Result := True;
 FADOStoredProc.Close;

 FADOStoredProc.ProcedureName := "Upd_Загрузчик_КонецКлиентскойСессии;1";
 try
   FADOStoredProc.Parameters.Refresh;

   if FSessionCode = -1 then
   begin
     Application.MessageBox(PAnsiChar(CreateExecuteErrorInfo(FADOStoredProc) + #13 + "Обратитесь к Администратору"),
       "Ошибка выполнения процедуры!", MB_ICONERROR);
     Exit;
   end;

   FADOStoredProc.Parameters.ParamByName("@КодСессии").Value := FSessionCode;

   FADOStoredProc.ExecProc;

   if FADOStoredProc.Parameters.ParamByName("@КодСессии").Value = Null then
     Application.MessageBox(PAnsiChar(CreateExecuteErrorInfo(FADOStoredProc) + #13 + "Обратитесь к Администратору"),
       "Ошибка выполнения процедуры!", MB_ICONERROR);

 except
   Result := False;
   Application.MessageBox(PAnsiChar(CreateExecuteErrorInfo(FADOStoredProc) + #13 + "Обратитесь к Администратору"),
     "Ошибка выполнения процедуры!", MB_ICONERROR);
 end;
end;

function TARMs.SetPlaceEvent;
begin
 PlaceEventForm := TPlaceEventForm.Create(Application);
 try
   Result := PlaceEventForm.SetPlaceCode;
 finally
   FreeAndNil(PlaceEventForm);
 end;
end;

function TARMs.CodeInStringList(AInput_Code: Integer;
 AStringList: TStringList): Boolean;
var i: integer;
begin
 Result := False;
 for i := 0 to AStringList.Count - 1 do
   if AStringList.Strings[i] = IntToStr(AInput_Code) then
   begin
     Result := True;
   end;
end;



---

← →
ORMADA ©   (2005-07-22 07:40) [14]


procedure TARMs.Check_Menu(AProgDataset: TDataSet; AInput_Code: Integer);
begin
 if AProgDataset.Locate("Код", IntToStr(AInput_Code), []) then
 begin
   if not CodeInStringList(AInput_Code, Spisok_IDList) then Spisok_IDList.Add(IntToStr(AInput_Code));
   Check_Menu(FADOStoredProc, AProgDataset.FieldByName("КодРодителя").AsInteger);
 end;
end;

procedure TARMs.Build_Menu(AProgDataset: TDataSet; AInput_Menu: TMenuItem;
 AInput_Code: Integer);
var RecNo: Integer;
begin
 case AInput_Code of
   1: //строим верхние меню
     begin ///КОД верхнего уровеня всегда 1!!!
       while (not AProgDataset.Eof) do
       begin
         AProgDataset.Filter := "КодРодителя = " + IntToStr(AInput_Code);
         RecNo := AProgDataset.RecNo;

         if CodeInStringList(AProgDataset.FieldByName("Код").AsInteger, Spisok_IDList)
           then
         begin
           AddMainItem(AProgDataset.FieldByName("Имя").AsString,
             FMainMenu.Items,
             AProgDataset.FieldByName("КодТипаПриложения").AsInteger,
             AProgDataset.FieldByName("Код").AsInteger);

           Build_Menu(FADOStoredProc, FMainMenu.Items, AProgDataset.FieldByName("Код").AsInteger);
         end;
         AProgDataset.Filter := "КодРодителя = " + IntToStr(AInput_Code);
         AProgDataset.RecNo := RecNo;
         AProgDataset.Next;
       end;
     end
 else
   begin
     while (not AProgDataset.Eof) do
     begin
       AProgDataset.Filter := "КодРодителя = " + IntToStr(AInput_Code);
       RecNo := AProgDataset.RecNo;
       case AProgDataset.FieldByName("КодТипаПриложения").AsInteger of
         1: //меню
           begin
             if CodeInStringList(AProgDataset.FieldByName("Код").AsInteger, Spisok_IDList)
               then
             begin
               AddSubItem(AProgDataset.FieldByName("Имя").AsString, AInput_Menu,
                 False, 0);
               Build_Menu(FADOStoredProc, AInput_Menu.Items[AInput_Menu.Count - 1],
                 AProgDataset.FieldByName("Код").AsInteger);
             end;
           end;

         2: //разделитель
           begin
             AddSubItem("-", AInput_Menu, False, 0);
           end;

         3: //программа
           begin
             if CodeInStringList(AProgDataset.FieldByName("Код").AsInteger, Spisok_IDList)
               then
               AddSubItem(AProgDataset.FieldByName("Имя").AsString, AInput_Menu,
                 True, AProgDataset.FieldByName("Код").AsInteger);
           end;
       end;
       AProgDataset.Filter := "КодРодителя = " + IntToStr(AInput_Code);
       AProgDataset.RecNo := RecNo;
       AProgDataset.Next;
     end;
   end;
 end;
end;

{ TARM }

constructor TARM.Create(ABPLFileName, AFormCaption,
 AConnectionString: string; AARMCode: integer);
begin
 FBPLFileName := ABPLFileName;
 FFormCaption := AFormCaption;
 FConnectionString := AConnectionString;
 FARMCode := AARMCode;
end;

procedure TARMs.FillARMFilesListView(AARMFilesListView: TListView);
var
 i: integer;
begin
 AARMFilesListView.Clear;

 for i := 0 to ARMFilesList.Count - 1 do
 begin
   AARMFilesListView.Items.Add;
   AARMFilesListView.Items.Item[AARMFilesListView.Items.Count - 1].Caption :=
     TARMFile(ARMFilesList.Items[i]).FName;
   if i = 0 then
     AARMFilesListView.Items.Item[AARMFilesListView.Items.Count - 1].ImageIndex
       := Ord(NowPosition) //--- установка |> на первую запись ---
   else
     AARMFilesListView.Items.Item[AARMFilesListView.Items.Count - 1].ImageIndex
       := Ord(UnKnow);
 end;
 Application.ProcessMessages;
end;

{ TARMFile }

constructor TARMFile.Create(AName, ACRC, AVersion: string; ACode: integer);
begin
 FName := AName;
 FCRC := ACRC;
 FVersion := AVersion;
 FCode := ACode;
end;

end.


писал с полтора года - назад всё работает нормально
но статью очень рекомендую почитать чтоб потом избежать ограничений
ещё есть интересный вариант реализации плагинов у Jedi пример там тоже есть - посмотри хуже не будет :)

---

← →
ORMADA ©   (2005-07-22 07:42) [15]

у меня было реализовано по быстрому не как com как следствие получили гемор при расширении системы
статья
http://delphi.olympus.ru/dk/mastering/plugins01.htm

---

← →
Cryptopsy   (2005-07-22 09:57) [16]

ORMADA, спасибо! Будем посмотреть :)

---

← →
ORMADA ©   (2005-07-22 11:22) [17]

:)

---

← →
vers ©   (2005-07-22 14:44) [18]

У меня тоже работающая система :) Но менее крутая: TCP-сервер и TCP-клиенты. Подключаются к серверу, смотрят какие длл-ки им разрешено загружать, смотрят, есть ли они уже у них, если есть загружают, импортирую оттуда функцию определения версии, смотрят версию, делают запрос на сервер, сравнивают версию и выбирают качать или не качать. Перекачка осуществляется через этот же TCP-сервер. Работает где угодно: хоть в локалке, хоть в инете.

---

← →
simpson ©   (2005-07-22 15:31) [19]

> ORMADA ©   (22.07.05 11:22) [17]

Да Вы оптимист, батенька. :) Автор же ясно сказал - надо будет работать через Интернет. Я бы, например, не рискнул открывать наружу порт MS SQL Server... Особенно, если на нем одновременно крутится база какой-нить КИС... :)

Кроме того, представьте себе, что завтра приходит Ваш начальник и говорить - не хочу MS SQL, хочу Firebird... На этом все - вы переписываете проект целиком.

Уж лучше делать как
> vers ©   (22.07.05 14:44) [18]

Хотя, и такой способ - далеко не самое лучшее решение, потому как при разработке собственного протокола и собственных клиента и сервера под него трудно написать достаточно стойкий продукт по отношению к атакам извне... Китайские кулхацкеры не дремлют.

А в варианте с обменом по HTTP можно даже не писать свой сервер, а воспользоваться, например, IIS, или Apache. Просто реализуешь Web-сервис и цепляешь его к готовому серваку. На этом головная боль заканчивается.

Безусловно, это - мое субъективное мнение. Выбор делать автору темы.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.08.14;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.6 MB
Время: 0.017 c