Приложения

Приложение 1

Текст программы

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

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

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) + 'IniFiles\DB.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: TPanel;

sbFirst: TSpeedButton;

sbLeft: TSpeedButton;

sbRight: TSpeedButton;

sbLast: TSpeedButton;

mmTableView: TMainMenu;

mmFile: TMenuItem;

N4: TMenuItem;

mmExit: TMenuItem;

mmFindGroup: TMenuItem;

mmFind: TMenuItem;

ToolBar: TToolBar;

ToolButton1: TToolButton;

tbFind: TToolButton;

ToolButton2: TToolButton;

mmOpenCategory: TMenuItem;

tbOpenCategory: TToolButton;

dbgTable: TDBGrid;

pmTableView: TPopupMenu;

pmOpenCategory: TMenuItem;

pmCloseCategory: TMenuItem;

ClosePanel: TPanel;

sbCloseCategory: TSpeedButton;

gbxSeparate: TGroupBox;

mmImportData: TMenuItem;

N8: TMenuItem;

mmCloseCategory: TMenuItem;

mmDocs: TMenuItem;

mmLogs: TMenuItem;

mmDocList: TMenuItem;

mmIncoming: TMenuItem;

mmOutgoing: TMenuItem;

mmOrder: TMenuItem;

mmOrderList: TMenuItem;

mmAvailable: TMenuItem;

mmNotAvailable: TMenuItem;

mmFilter: TMenuItem;

mmAll: TMenuItem;

mmLog: TMenuItem;

tbAll: TToolButton;

tbAvailable: TToolButton;

tbNotAvailable: TToolButton;

ToolButton6: TToolButton;

tbOrder: TToolButton;

tbIncoming: TToolButton;

tbOutgoing: TToolButton;

ToolButton10: TToolButton;

tbOrderList: TToolButton;

tbDocList: TToolButton;

tbLog: TToolButton;

ToolButton3: TToolButton;

tbStorePlaces: TToolButton;

tbTrasfer: TToolButton;

mmTransfer: TMenuItem;

procedure FormShow(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure mmFindClick(Sender: TObject);

procedure mmOpenCategoryClick(Sender: TObject);

procedure mmExitClick(Sender: TObject);

procedure mmCloseCategoryClick(Sender: TObject);

procedure mmImportDataClick(Sender: TObject);

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('IniFiles\Category.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) + 'IniFiles\DB.INI')

then

begin

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

Application.Terminate;

Exit;

end;

MyIni := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'IniFiles\DB.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, '\system32\drivers\etc\services');

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) + 'IniFiles\key.txt')

then

begin

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

Application.Terminate;

Exit;

end;

AssignFile(KeyFile,ExtractFilePath(Application.ExeName) + 'IniFiles\key.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.

Приложение 2