Список литературы. 
Разработка информационно-поисковой системы

• 1. Гагарина Л. Г., Зубов Н. Н., Стрижков А. В., Федотова Е. Л. Методические указания по подготовке дипломного проекта специалистов направления 654 600 «Информатика и вычислительная техника» (специальность 220 400 «Программное обеспечение вычислительной техники и автоматизированных систем»). Под редакцией А. Э. Нестерова — М.: МИЭТ, 2004 — 66с.: ил.
• 2. Ковязин А., Востриков С. Мир InterBase. Архитектура, администрирование и разработка приложений баз данных в InterBase/FireBird/Yaffil. — М.: КУДИЦ-ОБРАЗ, 2002. — 496 с.
• 3. Фаронов В. В. Программирование баз данных в Delphi 7. Учебный курс. — СПб.: ПИТЕР, 2003. — 459 с.
• 4. Архангельский А. Я. Программирование в Delphi 7. — M.: ЗАО «Издательство БИНОМ», 2003. — 1152 с.
• 5. Роджерсон Дэйл. Основы СОМ. — М.: Русская редакция, 2000. — 400 с.
• 6. Котлер Ф. Основы маркетинга / Пер. с англ. — М.: Ростинтэр, 2002.
• 7. Моисеева Н. К., Костина Г. Д. Маркетинговые исследования при создании и использовании программных продуктов. Методические указания для выполнения курсовых и дипломных работ по специальности «Менеджмент». М.: МГИЭТ (ТУ), 1996. — 78 с.: ил.
• 8. Каракеян В. И. Безопасность жизнедеятельности. — М.: МИЭТ, 1999.
• 9. ГОСТ 12.2.032−78. ССБТ. Рабочее место при выполнении работ сидя. Общие эргономические требования.

ПРИЛОЖЕНИЕ

Текст программы Программное обеспечение информационно-поисковой системы «Разработка и макетирование» (ИПС РиМ) состоит из пятидесяти семи модулей. Ниже приводится листинг основных модулей.

//Модуль работы с учетными записями пользователей.

unit UsersView;

interface.

uses.

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, StdCtrls, ExtCtrls, Grids, DBGrids, ComCtrls, ToolWin, Buttons, Tabs, IniFiles;

type.

TfmUsersView = class (TForm).

StatusBar: TStatusBar;

BottomPanel: TPanel;

tsPages: TTabSet;

LeftBottomPanel: TPanel;

sbFirst: TSpeedButton;

sbLeft: TSpeedButton;

sbRight: TSpeedButton;

sbLast: TSpeedButton;

ToolBar: TToolBar;

tbAddUser: TToolButton;

tbDeleteUser: TToolButton;

ToolButton5: TToolButton;

tbFind: TToolButton;

ToolButton2: TToolButton;

tbEdit: TToolButton;

ToolButton3: TToolButton;

tbTable: TToolButton;

tbForm: TToolButton;

mmTableView: TMainMenu;

N1: TMenuItem;

mmAddUser: TMenuItem;

mmDeleteUser: TMenuItem;

N4: TMenuItem;

mmExit: TMenuItem;

N2: TMenuItem;

mmFind: TMenuItem;

N3: TMenuItem;

mmEdit: TMenuItem;

N5: TMenuItem;

mmTable: TMenuItem;

mmForm: TMenuItem;

pmTableView: TPopupMenu;

pmOpenCategory: TMenuItem;

pmCloseCategory: TMenuItem;

ButtonPanel: TPanel;

buSetLevel: TButton;

lblSearch: TLabel;

edSearch: TEdit;

ClosePanel: TPanel;

sbCloseResults: TSpeedButton;

ToolButton1: TToolButton;

tbRemind: TToolButton;

tbImport: TToolButton;

mmImport: TMenuItem;

N7: TMenuItem;

ListView: TListView;

mmDict: TMenuItem;

tbDictControl: TToolButton;

procedure FormClose (Sender: TObject; var Action: TCloseAction);

procedure FormCreate (Sender: TObject);

procedure FormActivate (Sender: TObject);

procedure mmExitClick (Sender: TObject);

procedure mmFindClick (Sender: TObject);

procedure mmEditClick (Sender: TObject);

procedure mmTableClick (Sender: TObject);

procedure mmFormClick (Sender: TObject);

procedure sbFirstClick (Sender: TObject);

procedure sbLeftClick (Sender: TObject);

procedure sbRightClick (Sender: TObject);

procedure sbLastClick (Sender: TObject);

procedure tsPagesClick (Sender: TObject);

procedure mmAddUserClick (Sender: TObject);

procedure mmDeleteUserClick (Sender: TObject);

procedure FormResize (Sender: TObject);

procedure buSetLevelClick (Sender: TObject);

procedure edSearchChange (Sender: TObject);

procedure ClosePanelResize (Sender: TObject);

procedure sbCloseResultsClick (Sender: TObject);

procedure FormShow (Sender: TObject);

procedure tbRemindClick (Sender: TObject);

procedure mmImportClick (Sender: TObject);

procedure ListViewDblClick (Sender: TObject);

procedure ListViewColumnClick (Sender: TObject; Column: TListColumn);

procedure ListViewCompare (Sender: TObject; Item1, Item2: TListItem;

Data: Integer; var Compare: Integer);

procedure mmDictClick (Sender: TObject);

private.

{Private declarations}.

public.

OldLogin: string; //сохранение логина.

ColumnToSort: integer; //столбец для сортировки.

NumOfClicks: integer; //число нажатий на столбце.

ShowNew: boolean; //показать новых.

AllSelected: boolean; //выбрать всех.

sSQL: string;

CheckList: TStringList; //список отмеченных.

procedure PrepareGrid;

procedure RestoreChecks;

end;

var.

fmUsersView: TfmUsersView;

implementation.

{$R *.dfm}.

uses.

DataModule, DataModuleRM, DB, IBCustomDataSet, IBStoredProc, UserCardView, UserCard, SetLevel, Search, Reg, Remind, ImportUsers, DictControl;

//*************************//.

// Подготовка грида //.

//*************************//.

procedure TfmUsersView. PrepareGrid;

begin.

with ListView. Columns do.

begin.

Items[1]. Caption := 'Логин';

Items[2]. Caption := 'ФИО';

Items[3]. Caption := 'Должность';

Items[4]. Caption := 'Подразделение';

Items[5]. Caption := 'Код доступа';

Items[6]. Caption := 'Роль';

Items[7]. Caption := 'Дата регистрации';

end;

end;

//**************************//.

// Создание формы //.

//**************************//.

procedure TfmUsersView. FormCreate (Sender: TObject);

var.

i: integer;

begin.

StatusBar.Panels[1]. Text := '1:1';

ShowNew := false;

CheckList := TStringList. Create;

buSetLevel.Left := ButtonPanel. Width — buSetLevel. Width — 5;

ColumnToSort := 1;

NumOfClicks := 0;

with ListView. Columns do.

begin.

Clear;

for i := 0 to 7 do Add;

Items[0]. Width := 18;

Items[1]. Width := 120;

Items[2]. Width := 160;

Items[3]. Width := 160;

Items[4]. Width := 160;

Items[5]. Width := 160;

Items[6]. Width := 130;

Items[7]. Width := 110;

end;

PrepareGrid;

end;

//****************************//.

// Активизация формы //.

//****************************//.

procedure TfmUsersView. FormActivate (Sender: TObject);

begin.

AllSelected := false;

if ShowNew.

then tsPages. TabIndex := 1.

else tsPages. TabIndex := 0;

edSearch.SetFocus;

edSearchChange (Sender);

end;

//**********************************************//.

// Обработчик меню: Выход из программы //.

//**********************************************//.

procedure TfmUsersView. mmExitClick (Sender: TObject);

begin.

fmUsersView.Close;

end;

//**********************************//.

// Обработчик меню: Поиск //.

//**********************************//.

procedure TfmUsersView. mmFindClick (Sender: TObject);

begin.

fmSearch.ShowModal;

end;

//******************************************//.

// Обработчик меню: Редактировать //.

//******************************************//.

procedure TfmUsersView. mmEditClick (Sender: TObject);

var.

sLogin: string;

begin.

if DM.qrUsers.IsEmpty then Exit;

if ListView. Selected = nil.

then.

begin.

ShowMessage ('Выберите пользователя для редактирования');

Exit;

end;

sLogin := ListView.Selected.SubItems.Strings[0];

DM.qrUsers.Locate ('LOGIN', sLogin,[loCaseInsensitive]);

fmUserCard := TfmUserCard. Create (nil, cmEdit);

fmUserCard.Caption := 'Редактирование пользователя';

fmUserCard.ShowModal;

fmUserCard.Free;

tsPagesClick (Sender);

end;

//*********************************//.

// Обработчик меню: Добавить //.

//*********************************//.

procedure TfmUsersView. mmAddUserClick (Sender: TObject);

begin.

fmUserCard := TfmUserCard. Create (nil, cmInsert);

fmUserCard.Caption := 'Добавление пользователя';

fmUserCard.ShowModal;

fmUserCard.Free;

tsPagesClick (Sender);

end;

//*********************************//.

// Обработчик меню: Удалить //.

//*********************************//.

procedure TfmUsersView. mmDeleteUserClick (Sender: TObject);

var.

sLogin: string;

begin.

if ListView. Selected = nil.

then.

begin.

ShowMessage ('Выберите пользователя, которого хотите удалить');

Exit;

end;

sLogin := ListView.Selected.SubItems.Strings[0];

if (sLogin = DM. sLogin) or (sLogin = OldLogin) then.

begin.

Application.MessageBox ('Нельзя удалить текущего пользователя','Ошибка!', MB_ICONERROR);

Exit;

end;

if MessageDlg ('Удалить пользователя «' + sLogin + '» ', mtConfirmation, [mbYes, mbNo], 0) = mrYes.

then.

begin.

with DM. spUser do.

begin.

StoredProcName := 'DELETE_USER';

ParamByName ('VC_LOGIN').Value := sLogin;

Prepare;

ExecProc;

end;

DM.trRimBase.CommitRetaining;

tsPagesClick (Sender);

end;

end;

//***************************************//.

// Обработчик меню: Импорт данных //.

//***************************************//.

procedure TfmUsersView. mmImportClick (Sender: TObject);

begin.

fmImportUsers.ShowModal;

fmUsersView.Activate;

end;

//*******************************************//.

// Обработчик меню: Системные словари //.

//*******************************************//.

procedure TfmUsersView. mmDictClick (Sender: TObject);

begin.

fmDictControl.ShowModal;

fmUsersView.Activate;

end;

//****************************************//.

// Обработчик меню: Вид-Таблица //.

//****************************************//.

procedure TfmUsersView. mmTableClick (Sender: TObject);

var.

i: integer;

begin.

if mmTable. Checked then.

Exit;

mmTable.Checked := true;

mmForm.Checked := false;

tbTable.Down := true;

tbForm.Down := false;

fmUserCardView.Visible := false;

ListView.Visible := true;

i := DM.qrUsers.RecNo;

ListView.Selected := ListView.Items.Item[i-1];

edSearch.SetFocus;

tsPages.SelectedColor := clWhite;

tsPages.UnselectedColor := clBtnFace;

end;

//**************************************//.

// Обработчик меню: Вид-Форма //.

//**************************************//.

procedure TfmUsersView. mmFormClick (Sender: TObject);

var.

sLogin: string;

begin.

if mmForm. Checked then.

Exit;

mmTable.Checked := false;

mmForm.Checked := true;

tbTable.Down := false;

tbForm.Down := true;

if (ListView.Selected nil).

then.

begin.

sLogin := ListView.Selected.SubItems.Strings[0];

DM.qrUsers.Locate ('LOGIN', sLogin,[loCaseInsensitive]);

end.

else DM.qrUsers.First;

ListView.Visible := false;

fmUserCardView.Parent := fmUsersView;

fmUserCardView.Visible := true;

tsPages.SelectedColor := clBtnFace;

tsPages.UnselectedColor := clWhite;

end;

//**************************************//.

// Обработчик: Закрыть категорию //.

//**************************************//.

procedure TfmUsersView. sbCloseResultsClick (Sender: TObject);

var.

s: string;

begin.

if tsPages. TabIndex < 2.

then Exit;

s := 'Закрыть закладку «' + tsPages. Tabs[tsPages.TabIndex] + '» ?';

if Application. MessageBox (PChar (s),'Подтвердите', MB_ICONQUESTION + MB_YESNO) = IDYES.

then.

begin.

tsPages.Tabs.Delete (tsPages.TabIndex);

tsPages.TabIndex := 0;

end;

end;

//*****************************************//.

// Обработчик: Показать уведомление //.

//*****************************************//.

procedure TfmUsersView. tbRemindClick (Sender: TObject);

begin.

fmRemind.ShowModal;

fmUsersView.Activate;

end;

//**************************//.

// Смена закладок //.

//**************************//.

procedure TfmUsersView. tsPagesClick (Sender: TObject);

var.

Left, Top, Bottom, Num: integer;

ValuesList: TStringList;

begin.

Top := Round (StatusBar.Height / 4);

Left := StatusBar. Panels[0]. Width + StatusBar. Panels[1]. Width + 5;

Bottom := 3 * Top;

StatusBar.Canvas.Pen.Color := clNavy;

StatusBar.Canvas.Brush.Color := clNavy;

StatusBar.Panels[1]. Text := IntToStr (tsPages.TabIndex + 1) + ': ' + IntToStr (tsPages.Tabs.Count);

StatusBar.Canvas.Rectangle (Left, Top, Left + 100, Bottom);

DM.qrUsers.Transaction.CommitRetaining;

ValuesList := TStringList. Create;

CheckList.Clear;

for Num := 0 to ListView.Items.Count — 1 do.

if ListView.Items.Item[Num]. Checked.

then CheckList. Add (ListView.Items.Item[Num]. SubItems. Strings[0]);

ListView.Items.BeginUpdate;

ListView.Items.Clear;

sSQL := 'select u.*, da. vc_acl_name, dr. vc_role from USERS u, DICT_ACL da, DICT_ROLE dr where u. uacl=da.n_acl_id and u. urole=dr.n_role_id';

if tsPages. TabIndex = 2.

then sSQL := fmSearch. sSQL;

DM.qrUsers.SQL.Clear;

if tsPages. TabIndex = 1 then sSQL := sSQL + ' and u. n_new = 1';

if (edSearch.Text '') and (tsPages.TabIndex 2).

then.

sSQL := sSQL + ' and upper (u.LOGIN) like upper (''' + edSearch. Text + '%'')';

DM.qrUsers.SQL.Add (sSQL + ' order by upper (u.LOGIN)');

with DM. qrUsers do.

begin.

Close;

Open;

FetchAll;

First;

PrepareGrid;

for Num := 0 to RecordCount — 1 do.

begin.

ValuesList.Clear;

ListView.Items.Add;

ValuesList.Add (FieldValues['LOGIN']);

if not (FieldValues['UNAME'] = null).

then ValuesList. Add (FieldValues['UNAME']).

else ValuesList. Add ('');

if not (FieldValues['UPOST'] = null).

then ValuesList. Add (FieldValues['UPOST']).

else ValuesList. Add ('');

if not (FieldValues['UDEP'] = null).

then ValuesList. Add (FieldValues['UDEP']).

else ValuesList. Add ('');

ValuesList.Add (FieldValues['VC_ACL_NAME']);

ValuesList.Add (FieldValues['VC_ROLE']);

ValuesList.Add (FieldValues['REGDATE']);

ListView.Items.Item[Num]. SubItems. AddStrings (ValuesList);

Next;

end;

end;

if (DM.qrUsers.RecNo = 0) then.

begin.

mmDeleteUser.Enabled := false;

tbDeleteUser.Enabled := false;

tbEdit.Enabled := false;

mmEdit.Enabled := false;

buSetLevel.Enabled := false;

end.

else.

begin.

mmDeleteUser.Enabled := true;

tbDeleteUser.Enabled := true;

tbEdit.Enabled := true;

mmEdit.Enabled := true;

buSetLevel.Enabled := true;

end;

if (tsPages.TabIndex = 2).

then.

begin.

sbCloseResults.Enabled := true;

lblSearch.Visible := false;

edSearch.Visible := false;

end.

else.

begin.

sbCloseResults.Enabled := false;

lblSearch.Visible := true;

edSearch.Visible := true;

end;

AllSelected := false;

RestoreChecks;

ListView.Items.EndUpdate;

StatusBar.Canvas.Pen.Color := clBtnFace;

StatusBar.Canvas.Brush.Color := clBtnFace;

StatusBar.Canvas.Rectangle (Left, Top, Left + 100, Bottom);

StatusBar.Panels.Items[3]. Text := ' Всего пользователей: ' + IntToStr (DM.qrUsers.RecordCount);

end;

//**************************************//.

// Переход на первую закладку //.

//**************************************//.

procedure TfmUsersView. sbFirstClick (Sender: TObject);

begin.

tsPages.TabIndex := 0;

end;

//******************************************//.

// Переход на предыдущую закладку //.

//******************************************//.

procedure TfmUsersView. sbLeftClick (Sender: TObject);

begin.

if (tsPages.TabIndex 0) then.

tsPages.SelectNext (false);

end;

//****************************************//.

// Переход на следующую закладку //.

//****************************************//.

procedure TfmUsersView. sbRightClick (Sender: TObject);

begin.

if (tsPages.TabIndex tsPages.Tabs.Count — 1) then.

tsPages.SelectNext (true);

end;

//****************************************//.

// Переход на последнюю закладку //.

//****************************************//.

procedure TfmUsersView. sbLastClick (Sender: TObject);

begin.

tsPages.TabIndex := tsPages.Tabs.Count — 1;

end;

//**************************//.

// Закрытие формы //.

//**************************//.

procedure TfmUsersView. FormClose (Sender: TObject;

var Action: TCloseAction);

var.

MyIni: TIniFile;

begin.

MyIni := TIniFile. Create (ExtractFilePath (Application.ExeName) + 'IniFilesDB.INI');

try.

MyIni.WriteBool ('OPTIONS','ShowRemind', DM. ShowRemindDialog);

finally.

MyIni.Free;

end;

with DM. spAutoReg do //вызываем процедуру регистрации.

begin.

ParamByName ('VC_LOGIN').Value := OldLogin;

ParamByName ('VC_PASS').Value := 'nopass';

ParamByName ('REFRESH_CALL').Value := 1;

Prepare;

ExecProc;

DM.sName := ParamByName ('VC_NAME').AsString; //запомнили ФИО.

DM.sLogin := ParamByName ('VC_REAL_LOGIN').AsString; //и логин.

DM.nRole := ParamByName ('N_ROLE').AsInteger; //и роль.

DM.nLevel := ParamByName ('N_ACL').AsInteger; //и ACL.

Close;

end;

DM.trRimBase.CommitRetaining;

end;

//*********************************//.

// Изменение размеров формы //.

//*********************************//.

procedure TfmUsersView. FormResize (Sender: TObject);

begin.

buSetLevel.Left := ButtonPanel. Width — buSetLevel. Width — 5;

end;

//*********************************//.

// Установить права доступа //.

//*********************************//.

procedure TfmUsersView. buSetLevelClick (Sender: TObject);

var.

i: integer;

begin.

CheckList.Clear;

for i := 0 to ListView.Items.Count — 1 do.

if ListView.Items.Item[i]. Checked.

then CheckList. Add (ListView.Items.Item[i]. SubItems. Strings[0]);

fmSetLevel.ShowModal;

if tsPages. TabIndex 2 then edSearch. SetFocus;

tsPagesClick (Sender);

AllSelected := true;

RestoreChecks;

end;

//*****************************************//.

// Изменение поля «Поиск по логину» //.

//*****************************************//.

procedure TfmUsersView. edSearchChange (Sender: TObject);

begin.

tsPagesClick (Sender);

end;

//*******************************//.

// Восстановление отметок //.

//*******************************//.

procedure TfmUsersView. RestoreChecks;

var.

Num, ListNum: integer;

begin.

for Num := 0 to ListView.Items.Count — 1 do.

for ListNum := 0 to CheckList. Count — 1 do.

if ListView.Items.Item[Num]. SubItems. Strings[0] = CheckList. Strings[ListNum].

then ListView.Items.Item[Num]. Checked := true;

end;

//**********************************//.

// Изменение размеров панели //.

//**********************************//.

procedure TfmUsersView. ClosePanelResize (Sender: TObject);

begin.

sbCloseResults.Left := ClosePanel. Width — 15;

end;

//********************//.

// Показ формы //.

//********************//.

procedure TfmUsersView. FormShow (Sender: TObject);

begin.

if DM. ShowRemindDialog then fmRemind. ShowModal;

end;

//********************************//.

// Двойной щелчок на гриде //.

//********************************//.

procedure TfmUsersView. ListViewDblClick (Sender: TObject);

var.

sLogin: string;

begin.

if ListView. Selected = nil.

then Exit;

sLogin := ListView.Selected.SubItems.Strings[0];

DM.qrUsers.Locate ('LOGIN', sLogin,[loCaseInsensitive]);

mmEditClick (Sender);

end;

//********************************//.

// Щелчок на столбце грида //.

//********************************//.

procedure TfmUsersView. ListViewColumnClick (Sender: TObject;

Column: TListColumn);

var.

i: integer;

begin.

if Column. Index = 0.

then.

begin.

AllSelected := not AllSelected;

for i := 0 to ListView.Items.Count — 1 do.

if AllSelected.

then ListView.Items.Item[i]. Checked := true.

else ListView.Items.Item[i]. Checked := false;

end.

else.

begin.

ListView.Items.BeginUpdate;

PrepareGrid;

if (ColumnToSort = Column. Index) and (NumOfClicks = 1).

then NumOfClicks := 2 else NumOfClicks := 1;

ColumnToSort := Column. Index;

if NumOfClicks = 1.

then Column. Caption := Column. Caption + ' (+)'.

else Column. Caption := Column. Caption + ' (-)';

(Sender as TCustomListView).AlphaSort;

ListView.Items.EndUpdate;

end;

end;

//*************************//.

// Сортировка грида //.

//*************************//.

procedure TfmUsersView. ListViewCompare (Sender: TObject; Item1,.

Item2: TListItem; Data: Integer; var Compare: Integer);

var.

Index: integer;

begin.

Index := ColumnToSort — 1;

Compare := AnsiCompareText (Item1.SubItems[Index], Item2. SubItems[Index]);

if NumOfClicks = 2 then Compare := (-1) * Compare;

end;

end.

//Модуль складского учета в разрезе элементов.

unit StoreView;

interface.

uses.

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Buttons, Tabs, ExtCtrls, ComCtrls, Menus, ToolWin, ImgList, Grids, DBGrids, StdCtrls, DBCtrls, IniFiles, IB, DB;

type.

TfmStoreView = class (TForm).

StatusBar: TStatusBar;

BottomPanel: TPanel;

tsPages: TTabSet;

LeftBottomPanel…

procedure pmCloseCategoryClick (Sender: TObject);

procedure pmTableViewPopup (Sender: TObject);

procedure sbFirstClick (Sender: TObject);

procedure sbLeftClick (Sender: TObject);

procedure sbRightClick (Sender: TObject);

procedure sbLastClick (Sender: TObject);

procedure tsPagesClick (Sender: TObject);

procedure ClosePanelResize (Sender: TObject);

procedure dbgTableDblClick (Sender: TObject);

procedure mmAvailableClick (Sender: TObject);

procedure mmNotAvailableClick (Sender: TObject);

procedure mmAllClick (Sender: TObject);

procedure mmOrderClick (Sender: TObject);

procedure mmIncomingClick (Sender: TObject);

procedure mmOutgoingClick (Sender: TObject);

procedure mmDocListClick (Sender: TObject);

procedure mmOrderListClick (Sender: TObject);

procedure mmLogClick (Sender: TObject);

procedure tbStorePlacesClick (Sender: TObject);

procedure mmTransferClick (Sender: TObject);

private.

{ Private declarations }.

public.

{ Public declarations }.

end;

var.

fmStoreView: TfmStoreView;

implementation.

{$R *.dfm}.

uses DataModule, DataModuleRM, OpenCategoryStore, ElementStoreView, StoreSearch, StorePlaceView, OrderContent, OrderList, StoreLog, DocList, DocContent, StoreImport;

//**************************//.

// Создание формы //.

//**************************//.

procedure TfmStoreView. FormCreate (Sender: TObject);

var.

i: integer;

IniFile: TIniFile;

StringList: TStringList;

begin.

StatusBar.Panels[1]. Text := '1:1';

IniFile := TIniFile. Create ('IniFilesCategory.ini');

StringList := TStringList. Create;

IniFile.ReadSection ('CATEGORY_STORE', StringList);

if StringList. Count = 0 then.

begin.

StringList.Free;

IniFile.Free;

Exit;

end;

tsPages.Tabs.Clear;

sbCloseCategory.Enabled := true;

for i := 0 to StringList. Count — 1 do.

tsPages.Tabs.Add (IniFile.ReadString ('CATEGORY_STORE', StringList[i], ''));

StringList.Free;

IniFile.Free;

end;

//**********************//.

// Показ формы //.

//**********************//.

procedure TfmStoreView. FormShow (Sender: TObject);

begin.

if DM. nRole 3.

then.

begin.

tbIncoming.Enabled := false;

tbOutgoing.Enabled := false;

tbStorePlaces.Enabled := false;

tbDocList.Enabled := false;

tbLog.Enabled := false;

tbTrasfer.Enabled := false;

mmIncoming.Enabled := false;

mmOutgoing.Enabled := false;

mmDocList.Enabled := false;

mmLog.Enabled := false;

mmTransfer.Enabled := false;

mmImportData.Enabled := false;

end.

else.

begin.

tbIncoming.Enabled := true;

tbOutgoing.Enabled := true;

tbStorePlaces.Enabled := true;

tbDocList.Enabled := true;

tbLog.Enabled := true;

tbTrasfer.Enabled := true;

mmIncoming.Enabled := true;

mmOutgoing.Enabled := true;

mmDocList.Enabled := true;

mmLog.Enabled := true;

mmTransfer.Enabled := true;

mmImportData.Enabled := true;

end;

tsPages.TabIndex := 0;

mmAll.Checked := true;

tsPagesClick (Sender);

end;

//*********************************************//.

// Обработчик меню: Открыть категорию //.

//*********************************************//.

procedure TfmStoreView. mmOpenCategoryClick (Sender: TObject);

begin.

with fmOpenCategoryStore do.

begin.

CallForm := cfStoreView;

ShowModal;

end;

end;

//*********************************************//.

// Обработчик меню: Закрыть категорию //.

//*********************************************//.

procedure TfmStoreView. mmCloseCategoryClick (Sender: TObject);

begin.

pmCloseCategoryClick (nil);

end;

//******************************************//.

// Обработчик меню: Импорт данных //.

//******************************************//.

procedure TfmStoreView. mmImportDataClick (Sender: TObject);

begin.

fmStoreImport.ShowModal;

tsPagesClick (Sender);

end;

//**********************************//.

// Обработчик меню: Выход //.

//**********************************//.

procedure TfmStoreView. mmExitClick (Sender: TObject);

begin.

fmStoreView.Close;

fmStorePlaceView.Close;

end;

//**********************************//.

// Обработчик меню: Поиск //.

//**********************************//.

procedure TfmStoreView. mmFindClick (Sender: TObject);

begin.

fmStoreSearch.CallForm := cStoreView;

if mmAvailable.Checked.

then.

fmStoreSearch.bAvailable := true.

else.

fmStoreSearch.bAvailable := false;

if mmNotAvailable.Checked.

then.

fmStoreSearch.bNotAvailable := true.

else.

fmStoreSearch.bNotAvailable := false;

fmStoreSearch.ShowModal;

end;

//****************************//.

// Показ Popup-меню //.

//****************************//.

procedure TfmStoreView. pmTableViewPopup (Sender: TObject);

begin.

if tsPages. Tabs[0] = 'Пусто'.

then.

pmCloseCategory.Enabled := false.

else.

pmCloseCategory.Enabled := true;

end;

//**********************************************//.

// Обработчик меню: Закрыть категорию //.

//**********************************************//.

procedure TfmStoreView. pmCloseCategoryClick (Sender: TObject);

begin.

if MessageDlg ('Закрыть категорию «' + tsPages. Tabs[tsPages.TabIndex] + '» ', mtConfirmation, [mbYes, mbNo], 0) = mrYes then.

begin.

tsPages.Tabs.Delete (tsPages.TabIndex);

if tsPages.Tabs.Count = 0 then.

begin.

tsPages.Tabs.Add ('Пусто');

tsPages.TabIndex := 0;

sbCloseCategory.Enabled := false;

end;

end;

end;

//******************************************//.

// Обработчик меню: Доступные ЭРИ //.

//******************************************//.

procedure TfmStoreView. mmAvailableClick (Sender: TObject);

begin.

mmAll.Checked := false;

mmNotAvailable.Checked := false;

mmAvailable.Checked := true;

tbAll.Down := false;

tbAvailable.Down := true;

tbNotAvailable.Down := false;

StatusBar.Panels.Items[3]. Text := ' ' + mmAvailable. Caption;

tsPagesClick (Sender);

end;

//******************************************//.

// Обработчик меню: Дефицитные ЭРИ //.

//******************************************//.

procedure TfmStoreView. mmNotAvailableClick (Sender: TObject);

begin.

mmAll.Checked := false;

mmAvailable.Checked := false;

mmNotAvailable.Checked := true;

tbAll.Down := false;

tbAvailable.Down := false;

tbNotAvailable.Down := true;

StatusBar.Panels.Items[3]. Text := ' ' + mmNotAvailable. Caption;

tsPagesClick (Sender);

end;

//***********************************//.

// Обработчик меню: Все ЭРИ //.

//***********************************//.

procedure TfmStoreView. mmAllClick (Sender: TObject);

begin.

mmAll.Checked := true;

mmAvailable.Checked := false;

mmNotAvailable.Checked := false;

tbAll.Down := true;

tbAvailable.Down := false;

tbNotAvailable.Down := false;

StatusBar.Panels.Items[3]. Text := ' ' + mmAll. Caption;

tsPagesClick (Sender);

end;

//****************************************//.

// Обработчик меню: Новая заявка //.

//****************************************//.

procedure TfmStoreView. mmOrderClick (Sender: TObject);

begin.

fmOrderContent.ShowingType := otNew;

fmOrderContent.ShowModal;

tsPagesClick (Sender);

end;

//**********************************************//.

// Обработчик меню: Приходная ведомость //.

//**********************************************//.

procedure TfmStoreView. mmIncomingClick (Sender: TObject);

begin.

fmDocContent.DocType := vtNew;

fmDocContent.nDocType := 3;

fmDocContent.lblOrder.Caption := 'Приходная ведомость № ';

fmDocContent.ShowModal;

tsPagesClick (Sender);

end;

//**********************************************//.

// Обработчик меню: Расходная ведомость //.

//**********************************************//.

procedure TfmStoreView. mmOutgoingClick (Sender: TObject);

begin.

fmDocContent.DocType := vtNew;

fmDocContent.nDocType := 2;

fmDocContent.lblOrder.Caption := 'Расходная ведомость № ';

fmDocContent.ShowModal;

tsPagesClick (Sender);

end;

//************************************************//.

// Обработчик меню: Перемещение по складу //.

//************************************************//.

procedure TfmStoreView. mmTransferClick (Sender: TObject);

begin.

fmDocContent.DocType := vtNew;

fmDocContent.nDocType := 4;

fmDocContent.lblOrder.Caption := 'Перемещение по складу № ';

fmDocContent.ShowModal;

tsPagesClick (Sender);

end;

//********************************************//.

// Обработчик меню: Журнал документов //.

//********************************************//.

procedure TfmStoreView. mmDocListClick (Sender: TObject);

begin.

fmDocList.ShowModal;

tsPagesClick (Sender);

end;

//****************************************//.

// Обработчик меню: Журнал заявок //.

//****************************************//.

procedure TfmStoreView. mmOrderListClick (Sender: TObject);

begin.

fmOrderList.ShowModal;

tsPagesClick (Sender);

end;

//******************************************//.

// Обработчик меню: Журнал операций //.

//******************************************//.

procedure TfmStoreView. mmLogClick (Sender: TObject);

begin.

fmStoreLog.ShowModal;

tsPagesClick (Sender);

end;

//**************************//.

// Смена закладок //.

//**************************//.

procedure TfmStoreView. tsPagesClick (Sender: TObject);

var.

Left, Top, Bottom: integer;

begin.

Top := Round (StatusBar.Height / 4);

Left := StatusBar. Panels[0]. Width + StatusBar. Panels[1]. Width + 5;

Bottom := 3 * Top;

StatusBar.Canvas.Pen.Color := clNavy;

StatusBar.Canvas.Brush.Color := clNavy;

StatusBar.Panels[1]. Text := IntToStr (tsPages.TabIndex + 1) + ': ' + IntToStr (tsPages.Tabs.Count);

rmDM.qrElements.Transaction.CommitRetaining;

if (tsPages.TabIndex = -1) or (tsPages.Tabs[tsPages.TabIndex] = 'Пусто') then.

begin.

rmDM.qrElements.Close;

Exit;

end;

StatusBar.Canvas.Rectangle (Left, Top, Left + 100, Bottom);

with rmDM. qrElements do.

begin.

Close;

SQL.Clear;

SQL.Add ('select * from V_ELEMENTS ');

SQL.Add ('where NAMENE = ''' + tsPages. Tabs[tsPages.TabIndex]+ '''');

if mmAvailable.Checked.

then SQL. Add (' and ACTUAL > 0');

if mmNotAvailable.Checked.

then SQL. Add (' and ACTUAL <= 0');

Open;

FieldByName ('IDE').Visible := false;

FieldByName ('NAMENE').Visible := false;

FieldByName ('PRICE').Visible := false;

FieldByName ('VENDOR').Visible := false;

FieldByName ('REPLACEMENT').Visible := false;

FieldByName ('TYPEE').DisplayLabel := 'Тип ЭРИ';

FieldByName ('TYPEE').DisplayWidth := 30;

FieldByName ('PRODUCER').DisplayLabel := 'Фирма-изготовитель';

FieldByName ('PRODUCER').DisplayWidth := 20;

FieldByName ('PERFORMANCE').DisplayLabel := 'Вид исполнения';

FieldByName ('PERFORMANCE').DisplayWidth := 30;

FieldByName ('EXIST').DisplayLabel := 'Имеется';

FieldByName ('EXIST').DisplayWidth := 12;

FieldByName ('RESERVED').DisplayLabel := 'Заказано';

FieldByName ('RESERVED').DisplayWidth := 12;

FieldByName ('ACTUAL').DisplayLabel := 'Доступно';

FieldByName ('ACTUAL').DisplayWidth := 12;

FieldByName ('COMMENT').DisplayLabel := 'Примечание';

FieldByName ('COMMENT').DisplayWidth := 40;

end;

rmDM.qrElements.Transaction.CommitRetaining;

if mmAll.Checked.

then StatusBar.Panels.Items[3]. Text := ' ' + mmAll. Caption;

StatusBar.Canvas.Pen.Color := clBtnFace;

StatusBar.Canvas.Brush.Color := clBtnFace;

StatusBar.Canvas.Rectangle (Left, Top, Left + 100, Bottom);

end;

//**************************************//.

// Переход на первую закладку //.

//**************************************//.

procedure TfmStoreView. sbFirstClick (Sender: TObject);

begin.

tsPages.TabIndex := -1;

tsPages.TabIndex := 0;

end;

//******************************************//.

// Переход на предыдущую закладку //.

//******************************************//.

procedure TfmStoreView. sbLeftClick (Sender: TObject);

begin.

if (tsPages.TabIndex 0) then.

tsPages.SelectNext (false);

end;

//****************************************//.

// Переход на следующую закладку //.

//****************************************//.

procedure TfmStoreView. sbRightClick (Sender: TObject);

begin.

if (tsPages.TabIndex tsPages.Tabs.Count — 1) then.

tsPages.SelectNext (true);

end;

//****************************************//.

// Переход на последнюю закладку //.

//****************************************//.

procedure TfmStoreView. sbLastClick (Sender: TObject);

begin.

tsPages.TabIndex := -1;

tsPages.TabIndex := tsPages.Tabs.Count — 1;

end;

//****************************************************************//.

// Изменение размеров панели с кнопкой закрытия страниц //.

//****************************************************************//.

procedure TfmStoreView. ClosePanelResize (Sender: TObject);

begin.

sbCloseCategory.Left := ClosePanel. Width — 15;

end;

//**************************************************//.

// Вызов карточки элемента двойным щелчком //.

//**************************************************//.

procedure TfmStoreView. dbgTableDblClick (Sender: TObject);

begin.

if rmDM.qrElements.IsEmpty then.

Exit;

fmElementStoreView.ElementView := true;

fmElementStoreView.ShowModal;

end;

//****************************//.

// Разрушение формы //.

//****************************//.

procedure TfmStoreView. FormDestroy (Sender: TObject);

var.

i: integer;

IniFile: TIniFile;

begin.

IniFile := TIniFile. Create (ExtractFilePath (Application.ExeName) + 'IniFiles/Category.ini');

IniFile.EraseSection ('CATEGORY_STORE');

if tsPages. Tabs[0] 'Пусто' then.

for i := 0 to tsPages.Tabs.Count — 1 do.

IniFile.WriteString ('CATEGORY_STORE', 'CAT' + IntToStr (i+1), tsPages. Tabs[i]);

IniFile.Free;

end;

//***************************************************//.

// Переход в режим просмотра мест хранения //.

//***************************************************//.

procedure TfmStoreView. tbStorePlacesClick (Sender: TObject);

begin.

fmStorePlaceView.ShowModal;

tsPagesClick (Sender);

end;

end.

//Модуль авторегистрации.

unit Reg;

interface.

uses.

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, IB, IniFiles;

type.

TfmReg = class (TForm).

paBack: TPanel;

Label1: TLabel;

pbReg: TProgressBar;

Label2: TLabel;

timReg: TTimer;

procedure FormCreate (Sender: TObject);

procedure timRegTimer (Sender: TObject);

private.

{ Private declarations }.

public.

end;

var.

fmReg: TfmReg;

implementation.

{$R *.dfm}.

uses DataModule, IBStoredProc, Greet, Math, StrUtils, WinSock;

//************************//.

// Получение логина //.

//************************//.

function GetCurrentUserName: string;

const.

cnMaxUserNameLen = 254;

var.

sUserName: string;

dwUserNameLen: DWORD;

begin.

dwUserNameLen := cnMaxUserNameLen — 1;

SetLength (sUserName, cnMaxUserNameLen);

GetUserName (PChar (sUserName), dwUserNameLen); //вызов API-функции.

SetLength (sUserName, dwUserNameLen);

Result := sUserName; //возвращаем имя пользователя.

end;

//***************************//.

// Получение IP-адреса //.

//***************************//.

function GetIPAddress (name: string): string;

var.

WSAData: TWSAData;

p: PHostEnt;

begin.

try.

WSAStartup ($ 0101, WSAData);

p := GetHostByName (PChar (name));

Result := inet_ntoa (PInAddr (p.h_addr_list^)^);

except.

Result := '127.0.0.1';

end;

WSACleanup;

end;

//***********************//.

// Создание формы //.

//***********************//.

procedure TfmReg. FormCreate (Sender: TObject);

begin.

timReg.Enabled := true;

end;

//***************//.

// Таймер //.

//***************//.

procedure TfmReg. timRegTimer (Sender: TObject);

var.

MyIni: TIniFile; //берем путь к базе из ini-файла.

KeyFile: TextFile; //файл с RSA-ключом.

sPassword: string;

Num: integer;

WinDir: PChar;

List: TStringList;

bExist: boolean;

FileName: string;

HostName: string;

DBPath: string;

begin.

timReg.Destroy;

Randomize;

pbReg.StepIt;

fmReg.Refresh;

if not FileExists (ExtractFilePath (Application.ExeName) + 'IniFilesDB.INI').

then.

begin.

Application.MessageBox ('Не найден ini-файл','Ошибка!', MB_ICONERROR);

Application.Terminate;

Exit;

end;

MyIni := TIniFile. Create (ExtractFilePath (Application.ExeName) + 'IniFilesDB.INI'); //обращаемся к нужному ini-файлу.

HostName := MyIni. ReadString ('OPTIONS','DBHOST','-1');

DBPath := MyIni. ReadString ('OPTIONS','DBPATH','-1');

if HostName = '-1' then.

begin.

Application.MessageBox ('Ошибка подключения к базе данных',.

'Ошибка!', MB_ICONERROR); //если не вышло — ошибка!

Application.Terminate;

Exit;

end;

DM.dbRimbase.DatabaseName := GetIPAddress (HostName) + ':' + DBPath;

DM.ShowRemindDialog := MyIni. ReadBool ('OPTIONS','ShowRemind', true);

MyIni.Free;

fmReg.pbReg.StepIt; //двигаем указатель прогресса выполнения.

DM.dbRimbase.Connected := false; //на всякий случай отключаемся от базы.

try //пытаюсь подключиться к базе.

DM.dbRimbase.Open;

except.

GetMem (WinDir, 144);

GetWindowsDirectory (WinDir, 144);

StrCat (WinDir, 'system32driversetcservices');

FileName := StrPas (WinDir);

FreeMem (WinDir, 144);

List:= TStringList. Create;

List.LoadFromFile (FileName);

bExist := false;

for Num :=0 to List. Count — 1 do.

if Pos ('gds_db', List[Num]) 0 then.

begin.

bExist := true;

break;

end;

if not bExist then.

begin.

List.Add ('gds_db 3050/tcp #interbase mlya =)');

List.SaveToFile (FileName);

end;

List.Free;

try.

DM.dbRimBase.Open;

except.

Application.MessageBox ('Ошибка подключения к базе данных',.

'Ошибка!', MB_ICONERROR); //если не вышло — ошибка!

Application.Terminate;

Exit;

end;

end;

fmReg.pbReg.StepIt;

DM.sLogin := Trim (GetCurrentUserName); //определили кто за компом.

//генерация пароля.

if not FileExists (ExtractFilePath (Application.ExeName) + 'IniFileskey.txt').

then.

begin.

Application.MessageBox ('Не найден ключ-файл','Ошибка!', MB_ICONERROR);

Application.Terminate;

Exit;

end;

AssignFile (KeyFile, ExtractFilePath (Application.ExeName) + 'IniFileskey.txt'); //подключаем файл с ключом.

Reset (KeyFile);

for Num := 1 to (1 + Random (24)) do.

Readln (KeyFile, sPassword);

Num := 1 + Random (47);

sPassword := AnsiMidStr (sPassword, Num, 15);

fmReg.pbReg.StepIt;

with DM. spAutoReg do //вызываем процедуру регистрации.

begin.

ParamByName ('VC_LOGIN').Value := DM. sLogin;

ParamByName ('VC_PASS').Value := sPassword;

ParamByName ('REFRESH_CALL').Value := 0;

Prepare;

ExecProc;

DM.sName := ParamByName ('VC_NAME').AsString; //запомнили ФИО.

DM.sLogin := ParamByName ('VC_REAL_LOGIN').AsString; //и логин.

DM.nRole := ParamByName ('N_ROLE').AsInteger; //и роль.

DM.nLevel := ParamByName ('N_ACL').AsInteger; //и ACL.

Close;

end;

fmReg.pbReg.StepIt;

DM.trRimBase.CommitRetaining; //сохраняем изменения в базе.

fmGreet.Show; //играемся с формами.

fmGreet.GreetTimer.Enabled := true;

fmGreet.BringToFront;

fmReg.Hide;

end;

end.

//Модуль импорта сведений о пользователях локальной сети.

unit ImportUsers;

interface.

uses.

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, ShellAPI, Buttons;

type.

TfmImportUsers = class (TForm).

ListView: TListView;

BottomPanel: TPanel;

buGetData: TButton;

buImportData: TButton;

buExit: TButton;

StatusBar: TStatusBar;

RadioGroup: TRadioGroup;

procedure buExitClick (Sender: TObject);

procedure buGetDataClick (Sender: TObject);

procedure FormCreate (Sender: TObject);

procedure ListViewClick (Sender: TObject);

procedure ListViewColumnClick (Sender: TObject; Column: TListColumn);

procedure buImportDataClick (Sender: TObject);

procedure FormShow (Sender: TObject);

procedure ListViewCompare (Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);

private.

{ Private declarations }.

public.

UserList: TStringList;

CheckAll: boolean;

ColumnToSort: integer;

NumOfClicks: integer;

procedure GenerateList (var s: string);

procedure GetUserInfo (sLogin: string);

end;

var.

fmImportUsers: TfmImportUsers;

implementation.

uses StrUtils, DataModule;

{$R *.dfm}.

//***********************************//.

// Перехват вывода из консоли //.

//***********************************//.

function GetDosOutput (const CommandLine: string;

const WorkDir: string;

var text: String): Boolean;

var.

SA: TSecurityAttributes;

SI: TStartupInfo;

PI: TProcessInformation;

StdOutPipeRead, StdOutPipeWrite: THandle;

WasOK: Boolean;

Buffer: array[0.255] of Char;

BytesRead: Cardinal;

Line: String;

begin.

Application.ProcessMessages;

with SA do.

begin.

nLength := SizeOf (SA);

bInheritHandle := True;

lpSecurityDescriptor := nil;

end;

// create pipe for standard output redirection.

CreatePipe (StdOutPipeRead, // read handle.

StdOutPipeWrite, // write handle.

@SA, // security attributes.

0 // number of bytes reserved for pipe — 0 default.

);

try.

// Make child process use StdOutPipeWrite as standard out,.

// and make sure it does not show on screen.

with SI do.

begin.

FillChar (SI, SizeOf (SI), 0);

cb := SizeOf (SI);

dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

wShowWindow := SW_HIDE;

hStdInput := GetStdHandle (STD_INPUT_HANDLE);

hStdOutput := StdOutPipeWrite;

hStdError := StdOutPipeWrite;

end;

// launch the command line compiler.

//WorkDir := 'C:';

result := CreateProcess (.

nil,.

PChar (CommandLine),.

nil,.

nil,.

True,.

0,.

nil,.

PChar (WorkDir),.

SI,.

PI);

CloseHandle (StdOutPipeWrite);

// if process could be created then handle its output.

if result then.

try.

// get all output until dos app finishes.

Line := '';

repeat.

// read block of characters (might contain carriage returns and line feeds).

WasOK := ReadFile (StdOutPipeRead, Buffer, 255, BytesRead, nil);

// has anything been read?

if BytesRead > 0 then.

begin.

// finish buffer to PChar.

Buffer[BytesRead] := #0;

// combine the buffer with the rest of the last run.

Line := Line + Buffer;

end;

until not WasOK or (BytesRead = 0);

// wait for console app to finish (should be already at this point).

WaitForSingleObject (PI.hProcess, INFINITE);

finally.

// Close all remaining handles.

CloseHandle (PI.hThread);

CloseHandle (PI.hProcess);

end;

finally.

text := Line;

CloseHandle (StdOutPipeRead);

end;

end;

//*************************//.

// Перевод кодировки //.

//*************************//.

procedure DosToWinConvert (var s: string); //перекодировка.

var.

Old, New: PChar;

begin.

Old := PChar (s);

New := Old;

OemToChar (Old, New);

s := string (New);

end;

//***********************//.

// Создание формы //.

//***********************//.

procedure TfmImportUsers. FormCreate (Sender: TObject);

begin.

UserList := TStringList. Create;

end;

//********************//.

// Показ формы //.

//********************//.

procedure TfmImportUsers. FormShow (Sender: TObject);

begin.

RadioGroup.ItemIndex := 0;

ListView.Items.Clear;

StatusBar.Panels.Items[0]. Text := ' Всего: 0';

StatusBar.Panels.Items[3]. Text := ' Отмечено: 0';

ColumnToSort := 1;

NumOfClicks := 1;

CheckAll := false;

buImportData.Enabled := false;

end;

//**************************//.

// Обработчик: Выход //.

//**************************//.

procedure TfmImportUsers. buExitClick (Sender: TObject);

begin.

fmImportUsers.Close;

end;

//**************************************//.

// Обработчик: Получить сведения //.

//**************************************//.

procedure TfmImportUsers. buGetDataClick (Sender: TObject);

var.

s: string;

i, Left, Top, Bottom: integer;

Step: double;

begin.

Top := Round (StatusBar.Height / 4);

Left := StatusBar. Panels[0]. Width + StatusBar. Panels[1]. Width + 5;

Bottom := 3 * Top;

StatusBar.Canvas.Pen.Color := clNavy;

StatusBar.Canvas.Brush.Color := clNavy;

StatusBar.Canvas.Rectangle (Left, Top, Left + 8, Bottom);

StatusBar.Panels.Items[1]. Text := ' Идет получение сведений…';

StatusBar.Panels.Items[0]. Text := ' Пусто';

StatusBar.Panels.Items[3]. Text := '';

buExit.Enabled := false;

buGetData.Enabled := false;

buImportData.Enabled := false;

if RadioGroup. ItemIndex = 0.

then GetDosOutput ('net user','c:', s).

else GetDosOutput ('net user /domain','c:', s);

DosToWinConvert (s);

GenerateList (s);

ListView.Items.BeginUpdate; //блокируем отрисовку ListView.

ListView.Items.Clear;

if UserList. Count > 0.

then Step := 130 / UserList. Count;

for i := 0 to UserList. Count — 1 do.

begin.

GetUserInfo (UserList.Strings[i]); //получаем информацию по каждому пользователю.

StatusBar.Canvas.Rectangle (Left, Top, Left + 8 + Round (Step*(i+1)), Bottom);

end;

StatusBar.Panels.Items[1]. Text := '';

ListView.Items.EndUpdate; //разрешаем отрисовку ListView.

if UserList. Count > 0 then.

with StatusBar. Panels do.

begin.

Items[0]. Text := ' Всего: ' + IntToStr (UserList.Count);

Items[1]. Text := '';

Items[3]. Text := ' Отмечено: 0';

buImportData.Enabled := true;

end;

buExit.Enabled := true;

buGetData.Enabled := true;

StatusBar.Canvas.Pen.Color := clBtnFace;

StatusBar.Canvas.Brush.Color := clBtnFace;

StatusBar.Canvas.Rectangle (Left, Top, Left + 140, Bottom);

end;

//**********************************//.

// Обработчик: Импортировать //.

//**********************************//.

procedure TfmImportUsers. buImportDataClick (Sender: TObject);

var.

i, nUpdated, nNew, nType: integer;

s: string;

begin.

DM.spUser.StoredProcName := 'IMPORT_USER_INFO';

nUpdated := 0;

nNew := 0;

StatusBar.Panels.Items[1]. Text := ' Идет импорт сведений…';

for i := 0 to ListView.Items.Count — 1 do.

if ListView.Items.Item[i]. Checked.

then.

with ListView.Items.Item[i]. SubItems do.

begin.

DM.spUser.Close;

DM.spUser.ParamByName ('VC_LOGIN').Value := Strings[0];

DM.spUser.ParamByName ('VC_NAME').Value := Strings[1];

DM.spUser.ParamByName ('VC_DEP').Value := Strings[2];

DM.spUser.Prepare;

DM.spUser.ExecProc;

nType := DM.spUser.ParamByName ('N_TYPE').AsInteger;

if (nType = 1) then nNew := nNew + 1;

if (nType = 0) then nUpdated := nUpdated + 1;

end;

s := 'Добавлено записей: ' + IntToStr (nNew) + #13#10 + 'Обновлено записей: ' + IntToStr (nUpdated);

ShowMessage (s);

StatusBar.Panels.Items[1]. Text := '';

end;

//**************************************//.

// Создание списка пользователей //.

//**************************************//.

procedure TfmImportUsers. GenerateList (var s: string);

var.

tmp, line: string;

i, j: integer;

begin.

UserList.Clear;

i := AnsiPos ('—', s);

if i = 0.

then.

begin.

Application.MessageBox ('Импорт сведений из данного источника невозможен','Ошибка!', MB_ICONERROR);

Exit;

end;

Delete (s, 1, i);

Delete (s, 1,80);

i := Pos (#10,s);

line := Copy (s, 1, i);

tmp := AnsiLeftStr (s, 8);

Delete (s, 1, i);

while (tmp 'The com') and (tmp 'Команда') do.

begin.

for j := 1 to 3 do.

begin.

if (j < 3) and (line '').

then.

begin.

i := AnsiPos (' ', line);

tmp := Copy (line, 1, i-1);

Delete (line, 1, i);

line := TrimLeft (line);

end.

else tmp := line;

tmp := trim (tmp);

if (tmp '') and (tmp 'Administrator') and (tmp 'Guest').

and (tmp 'Администратор') and (tmp 'Гость') then UserList. Add (tmp);

end;

i := Pos (#10,s);

line := Copy (s, 1, i);

tmp := AnsiLeftStr (s, 7);

Delete (s, 1, i);

end;

end;

//******************************************//.

// Получение сведений о пользователе //.

//******************************************//.

procedure TfmImportUsers. GetUserInfo (sLogin: string);

var.

i, j: integer;

s, tmp: string;

NewItem: TListItem;

begin.

if RadioGroup. ItemIndex = 0.

then GetDosOutput ('net user ' + sLogin,'c:', s).

else.

begin.

GetDosOutput ('net user ' + sLogin + ' /domain','c:', s);

for j := 1 to 2 do.

begin.

i := Pos (#10,s);

Delete (s, 1, i);

end;

end;

DosToWinConvert (s);

NewItem := ListView.Items.Add;

for j := 0 to 2 do.

begin.

i := Pos (#10,s);

tmp := Copy (s, 1, i);

Delete (s, 1, i);

i := Pos (' ', tmp);

Delete (tmp, 1, i-1);

tmp := Trim (tmp);

if Length (tmp) > 50 then SetLength (tmp, 50);

NewItem.SubItems.Add (tmp);

end;

end;

//***********************//.

// Щелчок по гриду //.

//***********************//.

procedure TfmImportUsers. ListViewClick (Sender: TObject);

var.

i: integer;

chkCount: integer;

begin.

chkCount := 0;

for i := 0 to ListView.Items.Count — 1 do.

if ListView.Items.Item[i]. Checked.

then chkCount := chkCount + 1;

StatusBar.Panels.Items[3]. Text := ' Отмечено: ' + IntToStr (chkCount);

end;

//********************************//.

// Щелчок по столбцу грида //.

//********************************//.

procedure TfmImportUsers. ListViewColumnClick (Sender: TObject;

Column: TListColumn);

var.

i: integer;

begin.

if ListView.Items.Count = 0 then Exit;

if Column. Index = 0.

then.

begin.

CheckAll := not CheckAll;

if CheckAll.

then.

for i := 0 to ListView.Items.Count — 1 do.

ListView.Items.Item[i]. Checked := true.

else.

for i := 0 to ListView.Items.Count — 1 do.

ListView.Items.Item[i]. Checked := false;

if CheckAll.

then StatusBar.Panels.Items[3]. Text := ' Отмечено: ' + IntToStr (ListView.Items.Count).

else StatusBar.Panels.Items[3]. Text := ' Отмечено: 0';

end.

else.

begin.

ListView.Items.BeginUpdate;

ListView.Columns.Items[1]. Caption := 'Логин';

ListView.Columns.Items[2]. Caption := 'Полное имя';

ListView.Columns.Items[3]. Caption := 'Подразделение (примечание)';

if (ColumnToSort = Column. Index) and (NumOfClicks = 1).

then NumOfClicks := 2 else NumOfClicks := 1;

ColumnToSort := Column. Index;

if NumOfClicks = 1.

then Column. Caption := Column. Caption + ' (+)'.

else Column. Caption := Column. Caption + ' (-)';

(Sender as TCustomListView).AlphaSort;

ListView.Items.EndUpdate;

end;

end;

//************************//.

// Сортировка грида //.

//************************//.

procedure TfmImportUsers. ListViewCompare (Sender: TObject; Item1,.

Item2: TListItem; Data: Integer; var Compare: Integer);

var.

Index: integer;

begin.

Index := ColumnToSort — 1;

Compare := AnsiCompareText (Item1.SubItems[Index], Item2. SubItems[Index]);

if NumOfClicks = 2 then Compare := (-1) * Compare;

end;

end.

Руководство оператора.

1. НАЗНАЧЕНИЕ ПРОГРАММЫ Программное обеспечение информационно-поисковой системы «Разработка и макетирование» (ПО ИПС РиМ) обеспечивает:

• — автоматическую регистрацию и аутентификацию пользователей при входе в ИПС;
• — управление учетными записями пользователей ИПС, а также учетными сведениями о них;
• — автоматическое формирование перечней элементов и ведомостей покупных изделий, используемых в электрических схемах проектируемых узлов и блоков электронной аппаратуры;
• — автоматизацию учета имеющихся на складе ЭРИ, предназначенных для создания макетов и других технических изделий.
• 2. УСЛОВИЯ ВЫПОЛНЕНИЯ ПРОГРАММЫ

ПО ИПС РиМ предназначено для работы на персональных компьютерах с процессором не ниже i486 под управлением операционных систем Windows NT/2000/XP. На компьютере должны быть установлены MS Excel 2000/XP/2003 и MS Word 2000/XP/2003. SQL Server FireBird 1.5 должен быть установлен и запущен на любом компьютере локальной сети.

Минимальные требования: процессор с тактовой частотой не менее 300 МГц, ОЗУ не менее 128 МБ, 500 МБ свободного дискового пространства, манипулятор «мышь».

ПО ИПС РиМ, содержащее программу в файле RimBase. exe, динамическую библиотеку gds32. dll, папку IniFiles с файлами инициализации Category. ini, DB. ini и key. txt, должно находиться на жестком диске компьютера в одной папке с любым именем. Папка с БД может находиться на любом компьютере локальной сети и иметь любое имя.

• 3. ВЫПОЛНЕНИЕ ПРОГРАММЫ
• 3.1. Запуск ПО ИПС РиМ

Для начала работы следует запустить файл RimBase. exe, после чего появляется окно-заставка подключения к базе данных, затем окно-приветствие и главное окно с выбором категорий, реализующее пользовательский интерфейс.

В верхней части главного окна (рис.1) находится меню, выбор команд которого задает выполнение необходимых действий. Под главным меню располагается список элементов, отсортированный по категориям.

Главное меню состоит из следующих команд:

Главное окно ПО ИПС РиМ.

Рисунок 1.

Меню «Администрирование» содержит команды:

3.2 Завершение работы с ПО ИПС РиМ Для завершения работы следует выбрать команду главного меню «Файл->Выход» или нажать на кнопку закрытия главного окна.

3.3. Работа с главным меню ПО ИПС РиМ Выбор команд из главного и дополнительных меню задается щелчком мыши по пунктам меню. Для отмены выбора команды следует нажать клавишу Esc или перевести курсор мыши на другой пункт меню.

3.3.1. Команда «Администрирование».

Команда предназначена для управления пользователями и настройками ПО ИПС РиМ.

3.3.1.1. Команда «Управление пользователями».

Команда предназначена для управления учетными записями пользователей ПО ИПС РиМ. После выбора команды активизируется окно «Управление пользователями» подсистемы администрирования (рис. 2).

Окно для управления пользователями.

Рисунок 2.

В верхней части окна находится меню, выбор команд которого задает выполнение необходимых действий. Под главным меню находится список всех пользователей, отсортированный по признакам «Все» и «Новые».

Главное меню этого окна состоит из следующих команд:

Меню «Файл» содержит команды:

Меню «Поиск» содержит команды:

Меню «Правка» содержит команды:

Меню «Вид» содержит команды:

Работа с главным меню подсистемы администрирования Выбор команд из главного меню задается щелчком мыши по пунктам меню. Для отмена выбора команды следует нажать клавишу Esc или перевести курсор мыши на другой пункт меню.

Команда «Файл».

Команда предназначена для работы с учетными сведениями пользователей.

Команда «Добавить…».

Команда предназначена для добавления нового пользователя. После выбора команды активизируется окно «Добавление пользователя», в котором можно ввести всю необходимую информацию (рис.3).

Окно для добавления пользователя.

Рисунок 3.

Для подтверждения введенных данных необходимо нажать кнопку СОХРАНИТЬ. Для отказа — нажать кнопку ОТМЕНА или кнопку закрытия окна.

Команда «Удалить…».

Команда предназначена для удаления выбранного пользователя. После выбора команды активизируется диалоговое окно с запросом «Удалить пользователя … ?». Нажатие кнопки ДА приводит к удалению этого пользователя, а нажатие кнопки НЕТ позволяет оператору отказаться от удаления.

Команда «Импорт сведений».

Команда предназначена для импорта сведений о пользователях локальной сети. После выбора команды активизируется диалоговое окно «Импорт сведений о пользователях» (рис. 4).

Окно импорта сведений.

Рисунок 4.

Чтобы получить имеющиеся сведения, необходимо сначала выбрать источник этих сведений, а потом нажать на кнопку ПОЛУЧИТЬ СВЕДЕНИЯ. После обработки запроса в списке будут отображены все найденные пользователи. Далее необходимо отметить тех пользователей, сведения о которых нужно импортировать и нажать на кнопку ИМПОРТИРОВАТЬ. Сведения будут занесены в базу данных. Чтобы отказаться от импорта надо нажать на кнопку ВЫХОД или на кнопку закрытия окна.

Команда «Системные словари».

Команда предназначена для управления системными словарями «Роли пользователей» и «Коды доступа к документам». После выбора команды активизируется диалоговое окно «Управление словарями» (рис. 5).

Окно управления словарями.

Рисунок 5.

Чтобы добавить элемент в словарь, необходимо нажать кнопку ДОБАВИТЬ и в открывшемся окне добавления элемента словаря ввести требуемое наименование (рис. 6), после чего нажать кнопку СОХРАНИТЬ. Отменить добавление можно нажатием кнопки ОТМЕНА или кнопки закрытия окна. Для удаления элемента из словаря предназначена кнопка УДАЛИТЬ, для изменения наименования — кнопка РЕДАКТИРОВАТЬ. Переключение между словарями осуществляется щелчком мыши на соответствующей закладке. Чтобы выйти из режима управления словарями, необходимо нажать кнопку ВЫХОД или кнопку закрытия окна.

Окно добавления элемента в словарь.

Рисунок 6.

Команда «Поиск».

Команда предназначена для поиска сведений об учетных записях пользователей по одному или нескольким критериям.

Команда «Найти».

Команда предназначена для поиска сведений об учетных записях пользователей по одному или нескольким критериям. После выбора команды активизируется диалоговое окно «Поиск пользователей» (рис. 7).

Окно поиска сведений о пользователе.

Рисунок 7.

Каждый из предусмотренных критериев поиска выбирается или отменяется щелчком мыши по индикатору, расположенном слева от названия критерия, после чего появляется или исчезает «галочка». Выбранный критерий поиска отмечается «галочкой» в соответствующем индикаторе. После выбора конкретного критерия напротив него активизируется поле для ввода значения или поле выбора значений из списка.

Нажатие на кнопку НАЙТИ запускает процесс поиска информации, удовлетворяющей значениям выбранных критериев. Результат поиска отображается на закладке «Результат поиска» окна «Управление пользователями» (рис.8).

Для закрытия окна необходимо нажать кнопку ОТМЕНА или нажать на кнопку закрытия окна.

Окно с результатом поиска.

Рисунок 8.

Команда «Правка».

Команда предназначена для изменения сведений о пользователях.

Команда «Редактировать».

Команда предназначена для редактирования сведений о пользователях. После выбора команды активизируется диалоговое окно «Редактирование пользователя» (рис. 9).

Окно для редактирования сведений о пользователе.

Рисунок 9.

После внесения всех необходимых изменений необходимо нажать кнопку СОХРАНИТЬ. После этого активизируется диалоговое окно с запросом «Изменить сведения о пользователе???». Нажатие кнопки ДА приводит к сохранению введенной информации, а нажатие кнопки НЕТ позволяет оператору отказаться от сохранения Команда «Вид».

Команда предназначена для переключения режима отображения информации (Таблица/Форма).

Команда «Таблица».

Команда предназначена для отображения информации о пользователях в виде таблицы. Отображение сведений в табличном виде представлено на рисунке 2.

Команда «Форма».

Команда предназначена для отображения информации об элементах в виде формы. Отображение сведений в виде формы представлено на рисунке 10.

Отображение информации в виде формы.

Рисунок 10.

Навигация по учетным записям осуществляется с помощью кнопок, расположенных в левом нижнем углу формы.

Действие «Назначить новые права доступа отмеченным пользователям». Команда предназначена для назначения новых прав доступа пользователям, учетные записи которых были отмечены в окне «Управление пользователей» «галочкой» (в режиме таблицы). В режиме формы команда будет применена к текущей учетной записи. После выбора команды активизируется диалоговое окно «Назначение прав доступа» (рис. 11).

Окно назначения прав доступа пользователям.

Рисунок 11.

В открывшемся окне необходимо отметить «галочкой» категорию прав доступа, которую требуется изменить, после чего выбрать новое значение из выпадающего списка. Для сохранения изменений нужно нажать на кнопку НАЗНАЧИТЬ, для отмены команды — на кнопку ОТМЕНА или кнопку закрытия окна.

Действие «Поиск по логину».

Команда выполняет инкрементальный поиск пользователей по их логину путем установки фильтра отображения на таблицу значений. Модификация фильтра производится путем изменения введенного значения в поле ввода «Поиск по логину».

Работа с панелью инструментов окна «Управление пользователями».

Кнопки на панели инструментов дублируют основные команды главного меню и предназначены для их быстрого вызова.

Протокол.