📄 ufrmmain.pas.~242~
字号:
unit uFrmMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, CheckLst, ADODB, Grids, activex, ComCtrls,
uFrmTest, ExtCtrls, Menus, ShellAPI, uCom;
const
MI_ICONEVENT = WM_USER + 2;
sqlMSG :string='if not exists (select name from syscolumns where id = object_id(''报警数据'') and name like ''iMsg'') Alter Table 报警数据 Add iMsg tinyint null';
type
TfrmMain = class(TForm)
sBar: TStatusBar;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
chkListWait: TCheckListBox;
chkList: TCheckListBox;
GroupBox1: TGroupBox;
btnComPort: TSpeedButton;
btnComBaud: TSpeedButton;
btnMsgCent: TSpeedButton;
cboMsgPort: TComboBox;
cboMsgBaud: TComboBox;
LstBoxPhone: TListBox;
txtMsgCent: TEdit;
GroupBox2: TGroupBox;
btnSave: TBitBtn;
GroupBox3: TGroupBox;
txtName: TEdit;
txtPhone: TEdit;
Label1: TLabel;
Label2: TLabel;
btnAddPhone: TSpeedButton;
btnDelPhone: TSpeedButton;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
mnuMsgCent: TMenuItem;
N86130109115001: TMenuItem;
N86130101805001: TMenuItem;
N86130107615001: TMenuItem;
N86130102405001: TMenuItem;
N86130109805001: TMenuItem;
N86130109505001: TMenuItem;
N86130107015001: TMenuItem;
N86130108795001: TMenuItem;
N86130101125002: TMenuItem;
imgIcon1: TImage;
PopupMenu2: TPopupMenu;
N22: TMenuItem;
N23: TMenuItem;
N24: TMenuItem;
Timer1: TTimer;
Button1: TButton;
btnSetCent: TBitBtn;
GroupBox4: TGroupBox;
btnCeShiSB: TBitBtn;
btnTestMsg: TSpeedButton;
labHint: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer;
var Resize: Boolean);
procedure mnuMsgCentClick(Sender: TObject);
procedure btnComPortClick(Sender: TObject);
procedure btnComBaudClick(Sender: TObject);
procedure cboMsgBaudClick(Sender: TObject);
procedure cboMsgPortClick(Sender: TObject);
procedure btnAddPhoneClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
procedure txtPhoneKeyPress(Sender: TObject; var Key: Char);
procedure txtMsgCentKeyPress(Sender: TObject; var Key: Char);
procedure btnDelPhoneClick(Sender: TObject);
procedure btnMsgCentClick(Sender: TObject);
procedure txtMsgCentExit(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure N22Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Button1Click(Sender: TObject);
procedure btnCeShiSBClick(Sender: TObject);
procedure btnTestMsgClick(Sender: TObject);
procedure btnSetCentClick(Sender: TObject);
private
{ Private declarations }
bolPause :boolean;//
bolSql :boolean;
procedure InstallIcon; //初始化系统托盘
procedure UnInstallIcon; //删除托盘图标
procedure IconOnClick(var message: TMessage); message MI_ICONEVENT;
procedure WMQueryEndSession(var Msg: TMessage); message WM_QueryEndSession;
procedure subWhile; //线程中的死循环
procedure dbFsh(sTmpDB:string; dtTime:TDateTime); //库搜索
procedure dbFshSnd(sTmpDB:string; dtTime:TDateTime); //搜索库中已经发送的信息
procedure grpOnePhoneAlt(sPhone:string;sMsg :WideString;var bytBuf:TBytes); //组合一个电话号码和一条报警信息
procedure showSet; //显示配置参数
procedure frmMinClick(var msg:tmessage);message wm_syscommand;//声明自定义最小化事件
public
{ Public declarations }
end;
TwpgThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;
procedure Delay(MSecs: Longint);
var
frmMain: TfrmMain;
wpgThread : TwpgThread;
clsCom : TclsCom;
implementation
uses
uPU,uU1, uComMsg;
var
add_ico:TNotifyIcondata;
{$R *.dfm}
procedure Delay(MSecs: Longint);
var
FirstTick, NowTick: Longint;
begin
FirstTick := GetTickCount;//获取结束计数值
repeat
Application.ProcessMessages;
Sleep(1);
NowTick := GetTickCount();
until (NowTick-FirstTick >= MSecs) or (NowTick<FirstTick);
end;
procedure TwpgThread.Execute;
{ vartostr [Variants] now sleep [SysUtils]
}
begin
//Synchronize(frmMain.subWhile);
CoInitialize (nil);
frmMain.subWhile;
end;
procedure TfrmMain.subWhile; //线程中的死循环
var
iCnt :integer;
AnsiStr:WideString;
tmpBytes, ssb1,ssb2:TBytes;
bytSend :array of byte;
i, iPh, iWaitCly,oldLen :integer;
sTmpDB, sID:string;
dtTime:TDateTime;
begin
iCnt :=1; bolPause :=false;
while True do begin
if bolPause then begin
sBar.Panels[1].Text :='外部请求,等待......';
wpgThread.Suspend;
end;
if not bolSql then begin
sBar.Panels[0].Text :=FormatDateTime('yyyy-MM-dd HH:mm:ss',Now);
sBar.Panels[1].Text :='数据库未连接';
Delay(1000);
continue;
end;
Delay(400);
sBar.Panels[0].Text :=FormatDateTime('yyyy-MM-dd HH:mm:ss',Now);
if FormatDateTime('dd',dtTime)<>FormatDateTime('dd',Now) then begin
//当不是同一天时
sTmpDB :='kj78_'+FormatDateTime('yyMM',Now);
uU1.sqlComdExec(sTmpDB,sqlMSG);
dbFshSnd(sTmpDB, Now); //搜索库中已经发送的信息
end;
dtTime :=Now;
sTmpDB :='kj78_'+FormatDateTime('yyMM',dtTime);
if chkListWait.Items.Count=0 then begin //当待发送缓存中没有记录时
if (iCnt>=70) then begin //每分钟执行一次库刷新操作,检索出当天所有未发送的报警
iCnt :=1;
uU1.sqlComdExec(sTmpDB,sqlMSG);
dbFsh(sTmpDB,dtTime); //库搜索
sBar.Panels[1].Text :='刷新缓存';
Delay(300);
end;
sBar.Panels[1].Text :='...'+inttostr(iCnt);
Inc(iCnt);
end else begin
if lstPhone.Count=0 then
sBar.Panels[1].Text :='请配置手机号'
else
sBar.Panels[1].Text :='等待缓存中取数据';
//取出第一条
sID :=uPU.split_2(chkListWait.Items[0],'@');
AnsiStr :=uPU.split_2(chkListWait.Items[0],'@',false);
for iPh:=1 to lstPhone.Count do begin
tmpBytes :=nil;
grpOnePhoneAlt( split_2(lstPhone[iPh-1],'：'), AnsiStr, tmpBytes); //组合一个电话号码和一条报警信息
//转换发送格式
if length(tmpBytes)>13 then begin
sBar.Panels[1].Text :='发送数据准备完毕';
Delay(300);
SetLength(bytSend,length(tmpBytes));
for i:=0 to high(tmpBytes) do begin
bytSend[i] :=tmpBytes[i];
end;
//发送信息
//if SendMsg( uPU.iComPort, uPU.iComBaud, bytSend ) then //此只能判断串口是否正常
if clsCom.bytSendB(bytSend) then //此只能判断串口是否正常
begin
//等待确定是否发送成功
{
for iWaitCly:=1 to 13 do begin
sBar.Panels[1].Text :='等待发送回应 '+IntToStr(iWaitCly);
sBar.Panels[0].Text :=FormatDateTime('yyyy-MM-dd HH:mm:ss',Now);
Delay(1000);
end;
}
for iWaitCly:=1 to 4 do begin
sBar.Panels[1].Text :='等待发送回应 '+IntToStr(iWaitCly);
sBar.Panels[0].Text :=FormatDateTime('yyyy-MM-dd HH:mm:ss',Now);
Delay(1000);
end;
ssb2 :=nil; setLength(ssb2,1);ssb2[0]:=0;
ssb1 :=nil;
ssb1 := clsCom.bytRecB;
iWaitCly:=0;
while high(ssb2)<30 do begin //当没有回应时,成为死循环
Inc(iWaitCly);
if high(ssb1)>3 then begin
oldLen :=high(ssb2)+1; //ssb2[0]存储的是返回串的数,比数组自身小1
setLength(ssb2,oldLen+high(ssb1));//ssb2[0]:=ssb2[0]+ssb1[0];
for i := 1 to high(ssb1) do ssb2[oldLen-1+i]:=ssb1[i];
end;
sBar.Panels[1].Text :='等待发送回应 '+IntToStr(iWaitCly+4);
if(iWaitCly>15) then break;
Delay(1000); //CMP_Time2
ssb1 :=nil;
ssb1 := clsCom.bytRecB; //组合接收串不分人员定位与瓦斯监控
end;
//ssb2 :=nil;
//bytRecB( uPU.iComPort, uPU.iComBaud, ssb2 );//接收字节串(没有过滤)
//ssb2 :=clsCom.bytRecB;
if (ssb2<>nil)and(length(ssb2)>6) then begin
ByteToStr(true,ssb2); //将一个字节数组为字符串
//是否存在回应
if bolReply(ssb2) then begin
//发送信息添加到已发送表
if iPh=1 then begin //有多个待发手机
chkList.Items.Add( AnsiStr );
//删除缓存
chkListWait.ItemIndex :=0;
chkListWait.DeleteSelected;
end else begin
end;
//修改库中的标志
sqlComdExec(sTmpDB,'update 报警数据 set iMsg=1 where [id]='+sID);
sBar.Panels[1].Text :='短信发送成功';
Delay(300);
end else begin
sBar.Panels[1].Text :='回应失败';
Delay(300);
end;
end else begin
sBar.Panels[1].Text :='回应字节流错误';
Delay(300);
end;
end else begin
sBar.Panels[1].Text :='串口检测失败';
end;//if clsCom.bytSendB(bytSend) then //此只能判断串口是否正常
end;
end;//for iPh:=1 to lstPhone.Count do
end;//if chkListWait.Items.Count=0 then
Delay(400);
end;
end;
procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
Application.Minimize;
self.Visible :=false;
Timer1.Enabled :=false;
end;
procedure TfrmMain.txtMsgCentExit(Sender: TObject);
begin
txtMsgCent.Enabled :=false;
end;
procedure TfrmMain.txtMsgCentKeyPress(Sender: TObject; var Key: Char);
begin
if ((key<#48)or(key>#57))and(key<>#8)and(key<>#46)and(key<>#43) then begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -