Форум: "Основная";
Текущий архив: 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.015 c