Автоматизация складского учета Регионального отделения Фонда социального страхования Российской Федерации по Республике Хакасия

   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)

else

   StatusBar1.Panels[0].Text:='новая';

end;

 

procedure TfrmSprNom.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 untSprPeriod;

 

interface

 

uses

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

  Dialogs, DB, ADODB, Grids, DBGrids, dbcgrids, StdCtrls, Mask, DBCtrls,

  ExtCtrls, ComCtrls, DBGridEh, ToolWin;

 

type

  TfrmSprPeriod = class(TForm)

    DataSource1: TDataSource;

    ADOQuery1: TADOQuery;

    ADOQuery1DSDesigner: TDateTimeField;

    ADOQuery1DSDesigner2: TBooleanField;

    Panel2: TPanel;

    StatusBar1: TStatusBar;

    Panel1: 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

  frmSprPeriod: TfrmSprPeriod;

 

implementation

 

uses untMain;

 

{$R *.dfm}

 

procedure TfrmSprPeriod.FormClose(Sender: TObject;

  var Action: TCloseAction);

begin

Action:=caFree;

end;

 

 

procedure TfrmSprPeriod.FormCreate(Sender: TObject);

begin

ADOQuery1.Active:=True;

end;

 

procedure TfrmSprPeriod.ADOQuery1AfterScroll(DataSet: TDataSet);

begin

if ADOQuery1.RecNo<>-1 then

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

else

   StatusBar1.Panels[0].Text:='новая';

end;

 

procedure TfrmSprPeriod.DBGridEh1GetCellParams(Sender: TObject;

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

  State: TGridDrawState);

begin

if DBGridEh1.DataSource.DataSet.FieldByName('Доступ').AsBoolean then

    begin

      AFont.Color:=clBlack;

      AFont.Style:=[];

      Background:=clAqua;

    end

else

if not DBGridEh1.DataSource.DataSet.FieldByName('Доступ').AsBoolean then

    begin

      AFont.Color:=clGray;

      AFont.Style:=[fsItalic];

      Background:=clCream;

    end;

end;

 

end.

 

 

unit untTypes;

 

interface

 

uses

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

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

  ExtCtrls, DBGridEh, ImgList, ToolWin;

 

type

  TfrmTypes = class(TForm)

    Panel2: TPanel;

    StatusBar1: TStatusBar;

    Panel1: TPanel;

    DataSource1: TDataSource;

    ADOQuery1: TADOQuery;

    DBGridEh1: TDBGridEh;

    ADOQuery1DSDesigner: TAutoIncField;

    ADOQuery1DSDesigner2: TWideStringField;

    ADOQuery1DSDesigner3: TIntegerField;

    ImageListStatus: TImageList;

    ToolBar1: TToolBar;

    tbAdd: TToolButton;

    tbDelete: TToolButton;

    tbEdit: TToolButton;

    tbSave: TToolButton;

    ToolButton1: TToolButton;

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

    procedure ADOQuery1AfterScroll(DataSet: TDataSet);

    procedure FormCreate(Sender: TObject);

    procedure DBGridEh1GetCellParams(Sender: TObject; Column: TColumnEh;

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

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  frmTypes: TfrmTypes;

 

implementation

 

uses untMain;

 

{$R *.dfm}

 

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

begin

Action:=caFree;

end;

 

procedure TfrmTypes.ADOQuery1AfterScroll(DataSet: TDataSet);

begin

if ADOQuery1.RecNo<>-1 then

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

else

   StatusBar1.Panels[0].Text:='новая';

end;

 

procedure TfrmTypes.FormCreate(Sender: TObject);

begin

ADOQuery1.Active:=True;

end;

 

procedure TfrmTypes.DBGridEh1GetCellParams(Sender: TObject;

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

  State: TGridDrawState);

begin

if DBGridEh1.DataSource.DataSet.FieldByName('Статус').Value=1 then

    begin

      AFont.Color:=clBlack;

      Background:=clAqua;

    end

else

if DBGridEh1.DataSource.DataSet.FieldByName('Статус').Value=-1 then

    begin

      AFont.Color:=clBlack;

      Background:=clCream;

    end;

end;

 

end.

 

 

unit untOtvet;

 

interface

 

uses

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

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

  ExtCtrls, ToolWin, DBGridEh;

 

type

  TfrmOtvet = class(TForm)

    Panel2: TPanel;

    StatusBar1: TStatusBar;

    Panel1: TPanel;

    DataSource1: TDataSource;

    ADOQuery1: TADOQuery;

    DBGridEh1: TDBGridEh;

    ToolBar1: TToolBar;

    tbAdd: TToolButton;

    tbDelete: TToolButton;

    tbEdit: TToolButton;

    tbSave: TToolButton;

    ToolButton1: TToolButton;

    procedure ADOQuery1AfterScroll(DataSet: TDataSet);

    procedure FormCreate(Sender: TObject);

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

    procedure DBGridEh1GetCellParams(Sender: TObject; Column: TColumnEh;

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

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  frmOtvet: TfrmOtvet;

 

implementation

 

{$R *.dfm}

 

procedure TfrmOtvet.ADOQuery1AfterScroll(DataSet: TDataSet);

begin

if ADOQuery1.RecNo<>-1 then

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

else

   StatusBar1.Panels[0].Text:='новая';

end;

 

procedure TfrmOtvet.FormCreate(Sender: TObject);

begin

ADOQuery1.Active:=True;

end;

 

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

begin

Action:=caFree;

end;

 

procedure TfrmOtvet.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 untSprMat;

 

interface

 

uses

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

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

  DBCtrls, StdCtrls, Buttons, ToolWin, DBGridEh, ImgList;

 

type

  TfrmSprMat = class(TForm)

    Panel1: TPanel;