Фонд социального страхования

  3:Self.WindowState:=wsMaximized;

end;

myIni.Free;

Application.HelpFile :=ExtractFilePath(Application.ExeName)+'Help\SKLAD.HLP';

end;

 

procedure TfrmMain.ADOConnectionMainAfterConnect(Sender: TObject);

begin

mnFileConnect.Enabled:=False;

mnFileDisconnect.Enabled:=True;

mnBase.Enabled:=True;

 

if Is_Admin then

  begin

    mnBaseUsers.Enabled:=True;

    tbUsers.Enabled:=True;

  end

else

  begin

    mnBaseUsers.Enabled:=False;

    tbUsers.Enabled:=False;

  end;

mnReport.Enabled:=True;

//Справочник номенклатуры доступен

mnBaseSprNom.Enabled:=True;

tbBaseSprNom.Enabled:=True;

//Справочник периодов доступен

mnBaseSprPeriod.Enabled:=True;

tbBaseSprPeriod.Enabled:=True;

//Справочник типов документов  доступен

mnBaseSprTip.Enabled:=True;

tbBaseSprTip.Enabled:=True;

//Справочник ответственных лиц  доступен

mnBaseSprOtvet.Enabled:=True;

tbBaseSprOtvet.Enabled:=True;

//Справочник материалов доступен

mnBaseSprMat.Enabled:=True;

tbBaseSprMat.Enabled:=True;

//Движение материалов доступно

mnBaseMove.Enabled:=True;

tbBaseMove.Enabled:=True;

//Оборотка доступна

mnReportOborot.Enabled:=True;

tbReportOborot.Enabled:=True;

//Архивирование не доступно

mnServiceArchiv.Enabled:=False;

mnServiceRepair.Enabled:=False;

end;

 

procedure TfrmMain.mnFileQuitClick(Sender: TObject);

begin

  frmMain.Close;

end;

 

procedure TfrmMain.mnFileConnectClick(Sender: TObject);

begin

frmLogin.ShowModal;

end;

 

procedure TfrmMain.mnFileDisconnectClick(Sender: TObject);

begin

ADOConnectionMain.Close;

end;

 

procedure TfrmMain.ADOConnectionMainAfterDisconnect(Sender: TObject);

begin

mnFileConnect.Enabled:=True;

mnFileDisconnect.Enabled:=False;

 

mnBaseUsers.Enabled:=False;

tbUsers.Enabled:=False;

 

mnReport.Enabled:=False;

 

mnBase.Enabled:=False;

//Справочник номенклатуры недоступен

mnBaseSprNom.Enabled:=False;

tbBaseSprNom.Enabled:=False;

//Справочник периодов недоступен

mnBaseSprPeriod.Enabled:=False;

tbBaseSprPeriod.Enabled:=False;

//Справочник типов документов  недоступен

mnBaseSprTip.Enabled:=False;

tbBaseSprTip.Enabled:=False;

 

//Справочник ответственных лиц  недоступен

mnBaseSprOtvet.Enabled:=False;

tbBaseSprOtvet.Enabled:=False;

//Справочник материалов недоступен

mnBaseSprMat.Enabled:=False;

tbBaseSprMat.Enabled:=False;

//Движение материалов недоступно

mnBaseMove.Enabled:=False;

tbBaseMove.Enabled:=False;

//Оборотка недоступна

mnReportOborot.Enabled:=False;

tbReportOborot.Enabled:=False;

//Архивирование доступно НЕ  БУДЕТ

//mnServiceArchiv.Enabled:=True;

//mnServiceRepair.Enabled:=True;

end;

 

procedure TfrmMain.mnHelpAboutClick(Sender: TObject);

begin

AboutBox.ShowModal;

end;

 

procedure TfrmMain.mnServiceOptionsClick(Sender: TObject);

begin

frmOptions.ShowModal;

end;

 

procedure TfrmMain.mnBaseUsersClick(Sender: TObject);

begin

frmUsers.ShowModal;

 

 

end;

 

procedure TfrmMain.mnBaseSprNomClick(Sender: TObject);

var fmChild:TfrmSprNom;

begin

fmChild:=TfrmSprNom.Create(Application);

fmChild.Caption:=fmChild.Caption+' ('+IntToStr(frmMain.MDIChildCount)+')';

end;

 

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

if MessageBox(Self.Handle,'Вы хотите выйти  из приложения','Внимание',MB_ICONQUESTION+MB_YESNO)=IDYES then

     CanClose:=True

else

   CanClose:=False;

end;

 

procedure TfrmMain.mnWindowCascadeClick(Sender: TObject);

begin

Self.Cascade;

end;

 

procedure TfrmMain.mnWindowTileClick(Sender: TObject);

begin

Self.Tile;

end;

 

procedure TfrmMain.mnBaseSprPeriodClick(Sender: TObject);

var fmChild:TfrmSprPeriod;

begin

fmChild:=TfrmSprPeriod.Create(Application);

fmChild.Caption:=fmChild.Caption+' ('+IntToStr(frmMain.MDIChildCount)+')';

end;

 

procedure TfrmMain.mnBaseSprTipClick(Sender: TObject);

var fmChild:TfrmTypes;

begin

fmChild:=TfrmTypes.Create(Application);

fmChild.Caption:=fmChild.Caption+' ('+IntToStr(frmMain.MDIChildCount)+')';

end;

 

procedure TfrmMain.mnBaseSprOtvetClick(Sender: TObject);

var fmChild:TfrmOtvet;

begin

fmChild:=TfrmOtvet.Create(Application);

fmChild.Caption:=fmChild.Caption+' ('+IntToStr(frmMain.MDIChildCount)+')';

 

end;

 

procedure TfrmMain.mnBaseSprMatClick(Sender: TObject);

var fmChild:TfrmSprMat;

begin

fmChild:=TfrmSprMat.Create(Application);

fmChild.Caption:=fmChild.Caption+' ('+IntToStr(frmMain.MDIChildCount)+')';

end;

 

procedure TfrmMain.mnBaseMoveClick(Sender: TObject);

var fmChild:TfrmMoveMat;

begin

fmChild:=TfrmMoveMat.Create(Application);

fmChild.Caption:=fmChild.Caption+' ('+IntToStr(frmMain.MDIChildCount)+')';

end;

 

procedure TfrmMain.mnReportOborotClick(Sender: TObject);

var fmChild:TfrmReport;

begin

fmChild:=TfrmReport.Create(Application);

fmChild.Caption:=fmChild.Caption+' ('+IntToStr(frmMain.MDIChildCount)+')';

end;

 

procedure TfrmMain.mnContenstClick(Sender: TObject);

begin

Application.HelpCommand(HELP_FINDER, 0);

end;

 

function ExecuteCommand(CommandString:String):Boolean;

var

  si:STARTUPINFO;

  pi:PROCESS_INFORMATION;

  cmdline:string;

begin

  ZeroMemory(@si,sizeof(si));

  si.cb:=SizeOf(si);

  cmdline:=CommandString;

  if not CreateProcess( nil,              // No module name (use command line).

                        PChar(cmdline),   // Command line.

                        nil,              // Process handle not inheritable.

                        nil,              // Thread handle not inheritable.

                        False,            // Set handle inheritance to FALSE.

                        0,                // No creation flags.

                        nil,              // Use parent's environment block.

                        nil,              // Use parent's starting directory.

                        si,               // Pointer to STARTUPINFO structure.

                        pi )              // Pointer to PROCESS_INFORMATION structure.

  then

  begin

    result:=False;

    Exit;

  end;

  WaitForSingleObject( pi.hProcess, INFINITE );

  CloseHandle( pi.hProcess );

  CloseHandle( pi.hThread );

  result:=True;

end;

 

procedure TfrmMain.mnServiceArchivClick(Sender: TObject);

var ArchName:String;

    Year,Month,Day:Word;

begin

//Архивируем базу данных

DecodeDate(Date,Year,Month,Day);

if Day<10 then ArchName:=ArchName+'0'+IntToStr(Day) else ArchName:=ArchName+IntToStr(Day);

if Month<10 then ArchName:=ArchName+'_0'+IntToStr(Month) else ArchName:=ArchName+'_'+IntToStr(Month);

ArchName:=ArchName+'_'+IntToStr(Year);

SaveDialog1.FileName:=ArchivPath+'\'+ArchName;

if SaveDialog1.Execute then

   begin

     if FileExists(SaveDialog1.FileName) then

        MessageBox(Self.Handle,PChar('Архив  '+SaveDialog1.FileName+' уже существует'),'Внимание',MB_OK+MB_ICONERROR)

     else

      if not ExecuteCommand(ToolsPath+'\winrar a '+SaveDialog1.FileName+' '+DbPath) then

        MessageBox(Self.Handle,'Ошибка  при создании архива','Внимание',MB_OK+MB_ICONERROR)

      else

        if FileExists(SaveDialog1.FileName) then

           MessageBox(Self.Handle,PChar('Создан  архив '+SaveDialog1.FileName),'Внимание',MB_OK+MB_ICONINFORMATION)

        else MessageBox(Self.Handle,'Создание  архива отменено','Внимание',MB_OK+MB_ICONEXCLAMATION);

   end;

end;

 

procedure TfrmMain.mnServiceRepairClick(Sender: TObject);

begin

//Восстанавливаем из архива

if OpenDialog1.Execute then

if MessageBox(Self.Handle,PChar('Вы действительно  хотите восстановить данные из  архива '+OpenDialog1.FileName),'Внимание',MB_YESNO+MB_ICONQUESTION)=IDYES then

  if not ExecuteCommand(ToolsPath+'\winrar e '+OpenDialog1.FileName+' '+ExtractFilePath(DbPath)) then

   MessageBox(Self.Handle,'Ошибка при  извлечении из архива','Внимание',MB_OK+MB_ICONERROR)

  else

   MessageBox(Self.Handle,PChar('Даные из  архива '+OpenDialog1.FileName+' восстановлены'),'Внимание',MB_OK+MB_ICONINFORMATION)

end;

 

end.

 

 

unit untLogin;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls, Buttons, Db, ADODB;

 

type

  TfrmLogin = class(TForm)

    edtName: TEdit;

    Label1: TLabel;

    Label2: TLabel;

    btnOK: TBitBtn;

    btnCancel: TBitBtn;

    edtPassword: TEdit;

    ADOQueryLogin: TADOQuery;

    procedure btnOKClick(Sender: TObject);

    procedure FormShow(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  frmLogin: TfrmLogin;

 

implementation

 

uses untMain;

 

{$R *.DFM}

 

procedure TfrmLogin.btnOKClick(Sender: TObject);

begin

ADOQueryLogin.Parameters[0].Value:=edtName.Text;

//Self.Cursor:=crHourGlass;

//frmMain.Cursor:=crHourGlass;

ADOQueryLogin.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+frmMain.DbPath+';Persist Security Info=False';

ADOQueryLogin.Active:=True;

//Self.Cursor:=crDefault;

//frmMain.Cursor:=crDefault;

if (edtPassword.Text=ADOQueryLogin.FieldByName('PASSWORD').asString) and (ADOQueryLogin.RecordCount<>0) then

  begin

  if ADOQueryLogin.FieldByName('IS_ADMIN').AsBoolean then frmMain.Is_Admin:=True else frmMain.Is_Admin:=False;

  frmMain.ADOConnectionMain.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+frmMain.DbPath+';Persist Security Info=False';

  frmMain.ADOConnectionMain.Connected:=True;

  end

else

  MessageBox(Self.Handle,'Неправильное имя  пользвателя или пароль','Ошибка',MB_OK+MB_ICONERROR);

ADOQueryLogin.Active:=False;

end;

 

procedure TfrmLogin.FormShow(Sender: TObject);

begin

edtPassword.Text:='';

edtName.SetFocus;

end;

 

end.

 

 

unit untUsers;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  ExtCtrls, Grids, DBGrids, Db, ADODB, StdCtrls, Mask, DBCtrls, ComCtrls,

  ToolWin, DBGridEh;

 

type

  TfrmUsers = class(TForm)

    Panel1: TPanel;

    Panel2: TPanel;

    ADOQuery1: TADOQuery;

    DataSource1: TDataSource;

    ADOQuery1ID: TAutoIncField;

    ADOQuery1USER: TWideStringField;

    ADOQuery1PASSWORD: TWideStringField;

    Label1: TLabel;

    DBEdit1: TDBEdit;

    Label2: TLabel;

    DBEdit2: TDBEdit;

    ADOQuery1IS_ADMIN: TBooleanField;

    DBCheckBox1: TDBCheckBox;

    DBGridEh1: TDBGridEh;

    ToolBar1: TToolBar;

    tbAdd: TToolButton;

    tbDelete: TToolButton;

    tbEdit: TToolButton;

    tbSave: TToolButton;

    ToolButton1: TToolButton;

    procedure FormShow(Sender: TObject);

    procedure DBGridEh1GetCellParams(Sender: TObject; Column: TColumnEh;

      AFont: TFont; var Background: TColor; State: TGridDrawState);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  frmUsers: TfrmUsers;

 

implementation

 

uses untMain;

 

{$R *.DFM}

 

procedure TfrmUsers.FormShow(Sender: TObject);

begin

ADOQuery1.Active:=False;

ADOQuery1.Active:=True;

end;

 

procedure TfrmUsers.DBGridEh1GetCellParams(Sender: TObject;

  Column: TColumnEh; AFont: TFont; var Background: TColor;

  State: TGridDrawState);

begin

if DBGridEh1.DataSource.DataSet.RecNo<>-1 then

  if DBGridEh1.DataSource.DataSet.RecNo mod 2 = 0 then

      begin

        AFont.Color:=clBlack;

        Background:=clAqua;

      end

  else

  if DBGridEh1.DataSource.DataSet.RecNo mod 2 <> 0 then

      begin

        AFont.Color:=clBlack;

        Background:=clCream;

      end;

end;

 

end.

 

 

unit untAbout;

 

interface

 

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

  Buttons, ExtCtrls, jpeg;

 

type

  TAboutBox = class(TForm)

    Panel1: TPanel;

    ProgramIcon: TImage;

    ProductName: TLabel;

    Version: TLabel;

    Copyright: TLabel;

    Label1: TLabel;

    Label2: TLabel;

    Label3: TLabel;

    Shape1: TShape;

    TimerAbout: TTimer;

    procedure FormKeyPress(Sender: TObject; var Key: Char);

    procedure TimerAboutTimer(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure FormClick(Sender: TObject);

    procedure Panel1Click(Sender: TObject);

    procedure ProgramIconClick(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  AboutBox: TAboutBox;

 

implementation

 

{$R *.DFM}

 

procedure TAboutBox.FormKeyPress(Sender: TObject; var Key: Char);

begin

TimerAbout.Enabled:=False;

Self.Close;

end;

 

procedure TAboutBox.TimerAboutTimer(Sender: TObject);

begin

TimerAbout.Enabled:=False;

Self.Close;

end;

 

procedure TAboutBox.FormCreate(Sender: TObject);

begin

TimerAbout.Enabled:=True;

end;

 

procedure TAboutBox.FormClick(Sender: TObject);

begin

TimerAbout.Enabled:=False;

Self.Close;

end;

 

procedure TAboutBox.Panel1Click(Sender: TObject);

begin

Self.Click;

end;

 

procedure TAboutBox.ProgramIconClick(Sender: TObject);

begin

Self.Click;

end;

 

end.

 

 

 

unit untOptions;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  ComCtrls, StdCtrls, Buttons, ExtCtrls;

 

type

  TfrmOptions = class(TForm)

    PageControl1: TPageControl;

    TabSheet1: TTabSheet;

    Panel1: TPanel;

    BitBtn1: TBitBtn;

    BitBtn2: TBitBtn;

    MemoDBPath: TMemo;

    Panel2: TPanel;

    OpenDialog1: TOpenDialog;

    TabSheet3: TTabSheet;

    MemoArchivPath: TMemo;

    Panel4: TPanel;

    btnArch: TButton;

    Panel3: TPanel;

    btnDbPath: TButton;

    TabSheet2: TTabSheet;

    Panel5: TPanel;

    btnTools: TButton;

    MemoToolsPath: TMemo;

    procedure FormShow(Sender: TObject);

    procedure BitBtn1Click(Sender: TObject);

    procedure btnArchClick(Sender: TObject);

    procedure btnToolsClick(Sender: TObject);

    procedure btnDbPathClick(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  frmOptions: TfrmOptions;

 

implementation

 

uses untMain,IniFiles,FileCtrl;

 

{$R *.DFM}

 

procedure TfrmOptions.FormShow(Sender: TObject);

begin

MemoDBPath.Text:=frmMain.DbPath;

MemoToolsPath.Text:=frmMain.ToolsPath;

MemoArchivPath.Text:=frmMain.ArchivPath;

end;

 

procedure TfrmOptions.BitBtn1Click(Sender: TObject);

var myIni:TIniFile;

begin

myIni:=TIniFile.Create(ExtractFilePath(Application.ExeName)+copy(ExtractFileName(Application.ExeName),1,length(ExtractFileName(Application.ExeName))-4)+'.INI');

frmMain.DbPath:=MemoDBPath.Text;

myIni.WriteString('Options','DbPath',MemoDBPath.Text);

myIni.WriteString('Options','ToolsPath',MemoToolsPath.Text);

myIni.WriteString('Options','ArchivPath',MemoArchivPath.Text);

myIni.Free;

end;

 

procedure TfrmOptions.btnArchClick(Sender: TObject);

var Dir: string;

begin

  Dir:=frmMain.ArchivPath;

  if SelectDirectory('Укажите папку для  архива','',Dir) then

     MemoArchivPath.Text:=Dir;

end;

 

procedure TfrmOptions.btnToolsClick(Sender: TObject);

var Dir: string;

begin

  Dir:=frmMain.ToolsPath;

  if SelectDirectory('Укажите папку для  инструментов','',Dir) then

     MemoToolsPath.Text:=Dir;

end;

 

procedure TfrmOptions.btnDbPathClick(Sender: TObject);

begin

OpenDialog1.FileName:=frmMain.DbPath;

if OpenDialog1.Execute then MemoDBPath.Text:=OpenDialog1.FileName;

end;

 

end.

 

 

unit untSprNom;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, DB, ADODB, Grids, DBGrids, ExtCtrls, ComCtrls, DBCtrls,

  DBGridEh, ToolWin;

 

type

  TfrmSprNom = class(TForm)

    DataSource1: TDataSource;

    ADOQuery1: TADOQuery;

    StatusBar1: TStatusBar;

    Panel1: TPanel;

    Panel2: TPanel;

    DBGridEh1: TDBGridEh;

    ToolBar1: TToolBar;

    tbAdd: TToolButton;

    tbDelete: TToolButton;

    tbEdit: TToolButton;

    tbSave: TToolButton;

    ToolButton1: TToolButton;

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

    procedure FormCreate(Sender: TObject);

    procedure ADOQuery1AfterScroll(DataSet: TDataSet);

    procedure DBGridEh1GetCellParams(Sender: TObject; Column: TColumnEh;

      AFont: TFont; var Background: TColor; State: TGridDrawState);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  frmSprNom: TfrmSprNom;

 

implementation

 

uses untMain;

 

{$R *.dfm}

 

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

var ColRow:Word;

    Rs:TADOQuery;

begin

Rs:=TADOQuery.Create(Application);

Rs.Connection:=frmMain.ADOConnectionMain;

Rs.SQL:=ADOQuery1.SQL;

Rs.Active:=True;

ColRow:=0;

Rs.First;

while not Rs.Eof do

  begin

    Rs.Edit;

    Rs.FieldByName('Color').Value:=ColRow;

    Rs.Post;

    if ColRow=0 then ColRow:=1 else ColRow:=0;

    Rs.Next;

  end;

Rs.Active:=False;

Rs.Close;

Rs.Free;

Action:=caFree;

end;

 

procedure TfrmSprNom.FormCreate(Sender: TObject);

begin

ADOQuery1.Active:=True;

end;

 

procedure TfrmSprNom.ADOQuery1AfterScroll(DataSet: TDataSet);

begin

if ADOQuery1.RecNo<>-1 then

   StatusBar1.Panels[0].Text:=IntToStr(ADOQuery1.RecNo)+' : '+IntToStr(ADOQuery1.RecordCount)