Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit Unit1;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, FIBDatabase, pFIBDatabase, Vcl.StdCtrls,
- SIBEABase, SIBFIBEA, Vcl.ExtCtrls, Vcl.ImgList, CPort,inifiles,
- System.ImageList;
- type
- TForm1 = class(TForm)
- Database1: TpFIBDatabase;
- Event1: TSIBfibEventAlerter;
- TrayIcon: TTrayIcon;
- Database2: TpFIBDatabase;
- Event2: TSIBfibEventAlerter;
- ImageList1: TImageList;
- Timer1: TTimer;
- ComPort: TComPort;
- Timer2: TTimer;
- Button1: TButton;
- Button2: TButton;
- Label1: TLabel;
- procedure FormDestroy(Sender: TObject);
- procedure Event1EventAlert(Sender: TObject; EventName: string;
- EventCount: Integer);
- procedure FormCreate(Sender: TObject);
- procedure TrayIconDblClick(Sender: TObject);
- procedure Event2EventAlert(Sender: TObject; EventName: string;
- EventCount: Integer);
- procedure Timer1Timer(Sender: TObject);
- procedure TrayIconMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure Timer2Timer(Sender: TObject);
- procedure Button1Click(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- Form1: TForm1;
- ComPort: TComPort;
- // Event: TEvent;
- pause1,pause2,kol1,kol2,run:integer;
- ip1,ip2:string;
- implementation
- {$R *.dfm}
- procedure beep_();
- begin
- Winapi.Windows.Beep(1000, 500);
- end;
- procedure _Delay(dwMilliseconds: Longint);
- var
- iStart, iStop: DWORD;
- begin
- iStart := GetTickCount;
- repeat
- iStop := GetTickCount;
- Application.ProcessMessages;
- until (iStop - iStart) >= DWORD(dwMilliseconds);
- end;
- procedure Open_ini_file();
- var ini : TIniFile;
- begin
- //ini := TInifile.Create(ExtractFileDir(ParamStr(0))+'setup.ini');
- Ini:=Tinifile.Create(extractfilepath(paramstr(0))+'setup.ini');
- ShowMessage ('qwe');
- //Form1.Label1.Caption:='asdsad';
- form1.ComPort.Port:=ini.ReadString('Form1', 'Port', 'COM4');
- pause1:=ini.ReadInteger('Form1', 'Pause1', 50);
- pause2:=ini.ReadInteger('Form1', 'Pause2', 1000);
- kol1:=ini.ReadInteger('Form1', 'kol1', 15);
- kol2:=ini.ReadInteger('Form1', 'kol2', 3);
- ip1:=ini.ReadString('Form1', 'ip1', '10.2.2.1:c:dbbd.bd');
- ip2:=ini.ReadString('Form1', 'ip2', '10.2.2.2:c:dbbd.bd');
- ini.Free;
- end;
- procedure add_log(txt:string); // Добавляем данные в ЛОГ
- var f:TStrings;
- File_:TextFile;
- begin
- if not FileExists('log.txt') then
- begin
- AssignFile(File_,'log.txt');
- Rewrite(File_);
- CloseFile(File_);
- end;
- f:=TStringList.Create();
- f.LoadFromFile('log.txt');
- f.Insert(0,DateTimeToStr(Now)+' '+txt);
- f.SaveToFile('log.txt');
- f.Free;
- end;
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- run:=0;
- Open_ini_file();
- //------------------------------------------ DB1
- if DataBase1.Connected then DataBase1.Connected := False;
- with DataBase1.ConnectParams do
- begin
- UserName := 'sys';
- Password := 'pass';
- end;
- DataBase1.DBName := ip1;
- DataBase1.Connected := True;
- //------------------------------------------ DB2
- if DataBase2.Connected then DataBase2.Connected := False;
- with DataBase2.ConnectParams do
- begin
- UserName := 'sys';
- Password := 'pass';
- end;
- DataBase2.DBName := ip2;
- DataBase2.Connected := True;
- end;
- procedure TForm1.FormDestroy(Sender: TObject);
- var ini : TIniFile;
- begin
- ini := TInifile.Create(ExtractFileDir(ParamStr(0))+'setup.ini');
- ini.WriteString('Form1', 'Port', form1.ComPort.Port);
- ini.WriteInteger('Form1', 'Pause1', pause1);
- ini.WriteInteger('Form1', 'Pause2', pause2);
- ini.WriteInteger('Form1', 'kol1', kol1);
- ini.WriteInteger('Form1', 'kol2', kol2);
- ini.Free;
- if form1.comport.Connected then form1.comport.Connected:=false;
- if DataBase1.Connected then DataBase1.Connected := False;
- if DataBase2.Connected then DataBase2.Connected := False;
- end;
- procedure TForm1.Timer1Timer(Sender: TObject);
- begin
- timer1.Enabled:=false;
- trayicon.Animate:=false;
- end;
- procedure mig_time(txt,t:string;d:integer);
- var i:integer;
- j: Integer;
- begin
- if run=0 then
- begin
- run:=1;
- if form1.comport.Connected then form1.comport.Connected:=false;
- if not form1.comport.Connected then
- begin
- form1.comport.Connected:=true;
- for i := 1 to 4 do
- begin
- form1.ComPort.WriteStr('0');
- _Delay(1000);
- end;
- for i := 1 to 100 do
- begin
- form1.ComPort.WriteStr('0');
- _Delay(10);
- end;
- form1.comport.Connected:=false;
- end;
- run:=0;
- add_log(txt+' '+t+' '+inttostr(d));
- end;
- end;
- procedure TForm1.Timer2Timer(Sender: TObject);
- var x:integer;
- t:string;
- begin
- timer2.Enabled:=false;
- t:=TimeToStr(time);
- x:=DayOfWeek(Date);
- if t='16:59:45' then
- if (x=2) or (x=3) or (x=4) or (x=5) then mig_time('конец рабочего дня',t,x);
- if t='15:44:45' then
- if (x=6) then mig_time('конец рабочего дня',t,x);
- if t='11:59:45' then
- if (x=2) or (x=3) or (x=4) or (x=5) or (x=6) then mig_time('обед',t,x);
- // Перекуры
- if t='8:49:45' then
- if (x=2) or (x=3) or (x=4) or (x=5) or (x=6) then mig_time('регламентированный перерыв',t,x);
- if t='9:49:45' then
- if (x=2) or (x=3) or (x=4) or (x=5) or (x=6) then mig_time('регламентированный перерыв',t,x);
- if t='10:59:45' then
- if (x=2) or (x=3) or (x=4) or (x=5) or (x=6) then mig_time('регламентированный перерыв',t,x);
- if t='13:59:45' then
- if (x=2) or (x=3) or (x=4) or (x=5) or (x=6) then mig_time('регламентированный перерыв',t,x);
- if t='14:59:45' then
- if (x=2) or (x=3) or (x=4) or (x=5) or (x=6) then mig_time('регламентированный перерыв',t,x);
- if t='15:59:45' then
- if (x=2) or (x=3) or (x=4) or (x=5) then mig_time('регламентированный перерыв',t,x);
- timer2.Enabled:=true;
- end;
- procedure TForm1.TrayIconDblClick(Sender: TObject);
- begin
- if DataBase1.Connected then DataBase1.Connected := False;
- if DataBase2.Connected then DataBase2.Connected := False;
- if form1.comport.Connected then form1.comport.Connected:=false;
- form1.Close;
- end;
- procedure mig();
- var i:integer;
- j: Integer;
- begin
- if run=0 then
- begin
- run:=1;
- if form1.comport.Connected then form1.comport.Connected:=false;
- if not form1.comport.Connected then
- begin
- form1.comport.Connected:=true;
- for j := 1 to kol2 do
- begin
- for i := 1 to kol1 do
- begin
- form1.ComPort.WriteStr('0');
- _Delay(pause1);
- end;
- _Delay(pause2);
- end;
- form1.comport.Connected:=false;
- end;
- run:=0;
- end;
- end;
- procedure TForm1.TrayIconMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- begin
- case Button of
- MbLeft:
- begin
- end;
- MbRight:
- begin
- mig();
- end;
- MbMiddle:
- begin
- if DataBase1.Connected then DataBase1.Connected := False;
- if DataBase2.Connected then DataBase2.Connected := False;
- if form1.comport.Connected then form1.comport.Connected:=false;
- form1.Close;
- end;
- end;
- end;
- procedure TForm1.Button1Click(Sender: TObject);
- begin
- mig_time('тестирование',TimeToStr(time),DayOfWeek(Date));
- end;
- procedure TForm1.Button2Click(Sender: TObject);
- begin
- caption:=TimeToStr(time)+' '+inttostr(DayOfWeek(Date));
- end;
- procedure TForm1.Event1EventAlert(Sender: TObject; EventName: string; EventCount: Integer);
- begin
- timer1.Enabled:=true;
- trayicon.Animate:=true;
- trayicon.BalloonTitle:='Северная дверь ['+DateTimeToStr(Now)+']';
- trayicon.BalloonFlags:=bfWarning;
- if EventName='IIP' then begin trayicon.BalloonHint:='Иванов Иван Петрович'; mig(); trayicon.ShowBalloonHint; add_log('Ильин Валерий Петрович [C]'); end;
- end;
- procedure TForm1.Event2EventAlert(Sender: TObject; EventName: string;
- EventCount: Integer);
- begin
- timer1.Enabled:=true;
- trayicon.Animate:=true;
- trayicon.BalloonTitle:='Южная дверь ['+DateTimeToStr(Now)+']';
- trayicon.BalloonFlags:=bfWarning;
- if EventName='IIP' then begin trayicon.BalloonHint:='Иванов Иван Петрович'; mig(); trayicon.ShowBalloonHint; add_log('Ильин Валерий Петрович [Ю]'); end;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement