📄 u_main.pas
字号:
{---------------------------------------------}
{单元名称：U_Main.pas
{Authonr: LUOXINXI
{Datetime: 2004/03/18
{单元描述：电信网关平台2.0协议应用程序主界面
{Other:
{---------------------------------------------}
unit U_Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ComCtrls, ToolWin, Sockets, U_MsgInfo, U_CTThread,
U_SPDeliverThread, U_SPReThread, U_CTDeliver, U_SubmitThread, ThreadSafeList, Log, ImgList,
Menus, winsock, ScktComp, xmldom, XMLIntf, msxmldom, XMLDoc, StrUtils, NetDisconnect,
RzButton, Transmit, SaveMessage, Buttons;
const
CM_RESTORE = WM_USER + $1000;
WZGL_APP_NAME = 'FJCTGateWay_System';
type
TSMGPGateWay = class(TForm)
StatusBar1: TStatusBar;
Panel2: TPanel;
Memo3: TMemo;
Splitter2: TSplitter;
Panel4: TPanel;
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton12: TToolButton;
Panel5: TPanel;
ToolBar2: TToolBar;
ToolButton11: TToolButton;
TBSubmitReq: TToolButton;
ToolButton18: TToolButton;
TBResponse: TToolButton;
ToolButton20: TToolButton;
TBReport: TToolButton;
ToolButton22: TToolButton;
TBDToS: TToolButton;
ToolButton24: TToolButton;
TBCreateAll: TToolButton;
ToolButton26: TToolButton;
ImageList1: TImageList;
MainMenu1: TMainMenu;
N111: TMenuItem;
N221: TMenuItem;
N1: TMenuItem;
Splitter3: TSplitter;
GroupBox1: TGroupBox;
Label2: TLabel;
Edit1: TEdit;
Label3: TLabel;
Edit2: TEdit;
Label4: TLabel;
Edit3: TEdit;
Label5: TLabel;
Edit4: TEdit;
Label6: TLabel;
Edit5: TEdit;
Label7: TLabel;
Edit6: TEdit;
ToolButton7: TToolButton;
ToolButton13: TToolButton;
PopupMenu1: TPopupMenu;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
ToolButton14: TToolButton;
ToolButton15: TToolButton;
CheckBox1: TCheckBox;
N5: TMenuItem;
N6: TMenuItem;
ToolButton17: TToolButton;
ToolButton19: TToolButton;
PopupMenu2: TPopupMenu;
MOExit1: TMenuItem;
N7: TMenuItem;
MTExit1: TMenuItem;
N8: TMenuItem;
AllExit1: TMenuItem;
PopupMenu3: TPopupMenu;
AllLogin1: TMenuItem;
N9: TMenuItem;
MTLogin1: TMenuItem;
N10: TMenuItem;
MOLogin1: TMenuItem;
N11: TMenuItem;
Memo11: TMenuItem;
N12: TMenuItem;
Memo21: TMenuItem;
N13: TMenuItem;
Memo31: TMenuItem;
Label8: TLabel;
Label9: TLabel;
Image1: TImage;
Label10: TLabel;
ToolButton16: TToolButton;
ToolButton21: TToolButton;
RzBitBtn1: TRzBitBtn;
RzBitBtn2: TRzBitBtn;
RzBitBtn3: TRzBitBtn;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
N24: TMenuItem;
N25: TMenuItem;
N26: TMenuItem;
N27: TMenuItem;
N28: TMenuItem;
N29: TMenuItem;
N30: TMenuItem;
N31: TMenuItem;
N32: TMenuItem;
N33: TMenuItem;
N34: TMenuItem;
N35: TMenuItem;
N36: TMenuItem;
PopupMenu4: TPopupMenu;
N37: TMenuItem;
Panel1: TPanel;
Panel3: TPanel;
Memo1: TMemo;
Panel6: TPanel;
Memo2: TMemo;
Splitter1: TSplitter;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
CheckBox2: TCheckBox;
procedure ToolButton8Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSubmitReqClick(Sender: TObject);
procedure TBResponseClick(Sender: TObject);
procedure TBReportClick(Sender: TObject);
procedure TBDToSClick(Sender: TObject);
procedure TBCreateAllClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure ToolButton15Click(Sender: TObject);
procedure ToolButton17Click(Sender: TObject);
procedure MOExit1Click(Sender: TObject);
procedure MTExit1Click(Sender: TObject);
procedure AllExit1Click(Sender: TObject);
procedure AllLogin1Click(Sender: TObject);
procedure MTLogin1Click(Sender: TObject);
procedure MOLogin1Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure Memo11Click(Sender: TObject);
procedure Memo21Click(Sender: TObject);
procedure Memo31Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure ToolButton16Click(Sender: TObject);
procedure RzBitBtn1Click(Sender: TObject);
procedure RzBitBtn2Click(Sender: TObject);
procedure RzBitBtn3Click(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure N34Click(Sender: TObject);
procedure N37Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure createParams(var Params: TCreateParams); override;
procedure RestoreRequest(var message: TMessage); message CM_RESTORE;
end;
var
SMGPGateWay: TSMGPGateWay;
DCanExit: Boolean = True; //上行连接没有退出与电信的连接不能退出程序
SCanExit: Boolean = True; //下行连接没有退出与电信的连接不能退出程序
MTExit: Boolean = False; //下行链路退出
MOExit: Boolean = False;
TransmitExit: Boolean = False;
{List}
DeliverList: TThreadList; //上行队列
SubmitList: TThreadList; // 下行队列
ResponseList: TThreadList; //下行回馈队列
ReportList: TThreadList; //递送报告队列
SaveSubmitList: TThreadList; //保存已经下行短信，（重发）
{序列号}
dSequence: integer; //上行包头序列号
sSequence: integer; //下行包头序列号
{thread}
xTCPCTDeliver: TCPCTDeliver; //电信上行
xCPSubmit: TCPSubmit; //SP下行
xDeliverThread: TSPDeliverThread; //网关上行非报告类短信到中间服务器
xSubmitThread: TSubmitThread; //网关向中间服务器请求短信
xRespThread: TResp; //网关向中间服务器发送回馈报告
xRepThread: TRep; //网关向中间服务器发送递送报告
xWriteLog: WriteLog; //写日志线程
xTransmit: TTransmit;
GWMoniter: GWWarnning;
{save thread list}
GDeliverTList: Tlist; {gateway to server}
GSubmitTList: Tlist; {gateway to server}
GRespTList: Tlist; {gateway to server}
GRepTList: Tlist; {gateway to server}
{Thread is Free}
SubmitRequest: Boolean = False;
Send_Deliver: Boolean = False;
Send_Resp: Boolean = False;
Send_Report: Boolean = False;
WriteLog_Free: Boolean = True;
{Log list}
LogList: TThreadSafeStringList; //对日志分类
{counter}
CTD_cou: integer = 0; //电信上行数
SPS_cou: integer = 0; //网关下行数
GDToS_cou: integer = 0; //网关上行短信数
GRespToS_cou: integer = 0; //网关上行回馈报告数
GRepToS_cou: integer = 0; //网关上行递送报告数
SToG_cou: integer = 0; //中间层下发短信数
{connect Error Counter}
SToG_E: integer = 0;
RespError: integer = 0;
RepError: integer = 0;
SPdeliError: integer = 0;
{retry time}
RetryTime: integer = 0;
{share login params}
sharesecret, ServerIP, Port, ClientID,SPID: string;
{当与电信断开连接时 向中间层取数据停止标志}
StopCatchSMS: Boolean = True;
ReadMessage: TReadMessage;
SaveMessage: TSaveMessage;
AppTitle:string;
ActiveTestTime:integer;
{当电信网关在NoReceiveDeliver分钟后没有上行发送提醒消息，如果一直没有上行发送连续发送次}
//---------------------------------------------------------------------------
SendWarn:boolean=True;
NoReceiveDeliver:integer=30;
SendCount:integer=10;
Counter:integer=0;
LastSendWarnMsgTime:TDateTime;
GateID:string;
//---------------------------------------------------------------------------
//------------------------------以下为 Endo Add
AccessNoStrList : TStrings; // Endo Add
//function GetSequenceID(const DestTermID, instructor: string): word;
implementation
{$R *.dfm}
uses
U_SysConfig, md5, Htonl, Smgp13_XML, U_RequestID, GW_Submit, U_DeliverTest;
procedure TSMGPGateWay.FormCreate(Sender: TObject);
var
sleeptime, logNumber: integer;
udpsrvip: string;
udpport: integer;
autowrite: Boolean;
begin
ReadAppTitle(AppTitle);
Caption:=AppTitle;
Application.Title:=AppTitle;
DeliverList := TThreadList.create;
SubmitList := TThreadList.create;
ResponseList := TThreadList.create;
ReportList := TThreadList.create;
SaveSubmitList := TThreadList.create;
GDeliverTList := Tlist.create;
GSubmitTList := Tlist.create;
GRespTList := Tlist.create;
GRepTList := Tlist.create;
DeliverList.Clear;
SubmitList.Clear;
ResponseList.Clear;
ReportList.Clear;
SaveSubmitList.Clear;
GDeliverTList.Clear;
GSubmitTList.Clear;
GRespTList.Clear;
GRepTList.Clear;
LogList := TThreadSafeStringList.create;
readlogth(udpsrvip, udpport, logNumber, sleeptime, autowrite);
xWriteLog := WriteLog.create(udpsrvip, udpport, sleeptime);
readsequID(dSequence, sSequence); //读取包头序列号
//initializeCriticalSection(CSXML); //临界区
readRetrytime(RetryTime);
Label10.Caption := '启动时间:' + datetimetostr(now);
ReadMessage := TReadMessage.create;
AccessNoStrList := TStringList.Create; // Endo Add
AccessNoStrList.Clear;
AccessNoStrList.LoadFromFile(ExtractFilePath(application.ExeName) + 'AccessNo.txt');
end;
{退出电信}
procedure TSMGPGateWay.FormDestroy(Sender: TObject);
begin
FreeAndNil(DeliverList);
FreeAndNil(SubmitList);
FreeAndNil(SaveSubmitList);
FreeAndNil(ResponseList);
FreeAndNil(ReportList);
FreeAndNil(GDeliverTList);
FreeAndNil(GSubmitTList);
FreeAndNil(GRespTList);
FreeAndNil(GRepTList);
FreeAndNil(LogList);
FreeAndNil(AccessNoStrList);
writesequID(dSequence, sSequence); //保存序列号
end;
procedure TSMGPGateWay.TBSubmitReqClick(Sender: TObject);
var
ip, Port: string;
ThreadN, i: integer;
sleeptime: integer;
timeout: integer;
begin
readMTport(Port, ThreadN, sleeptime);
if TBSubmitReq.Tag = 0 then
begin
readSerIp(ip, timeout);
try
for i := 0 to ThreadN - 1 do
begin
xSubmitThread := TSubmitThread.create(ip, Port, sleeptime, timeout); //创建线程
GSubmitTList.Add(xSubmitThread);
end;
SubmitRequest := True;
TBSubmitReq.Caption := 'Stop Request';
TBSubmitReq.Tag := 1;
except
end;
end
else
begin
for i := 0 to ThreadN - 1 do
begin
TSubmitThread(GSubmitTList[i]).Terminate; //中止线程
end;
SubmitRequest := False;
TBSubmitReq.Tag := 0;
TBSubmitReq.Caption := 'Start Request';
end;
end;
procedure TSMGPGateWay.TBResponseClick(Sender: TObject);
var
ip, Port: string;
ThreadN, i: integer;
sleeptime: integer;
timeout: integer;
begin
readRespport(Port, ThreadN, sleeptime);
if TBResponse.Tag = 0 then
begin
readSerIp(ip, timeout);
for i := 0 to ThreadN - 1 do
begin
xRespThread := TResp.create(ip, Port, sleeptime, timeout); //创建线程
GRespTList.Add(xRespThread);
end;
Send_Report := True;
TBResponse.Caption := 'Stop Response';
TBResponse.Tag := 1;
end
else
begin
for i := 0 to ThreadN - 1 do
begin
TResp(GRespTList[i]).Terminate; //中止线程
end;
Send_Report := False;
TBResponse.Tag := 0;
TBResponse.Caption := 'Start Response';
end;
end;
procedure TSMGPGateWay.TBReportClick(Sender: TObject);
var
ip, Port: string;
ThreadN, i: integer;
sleeptime: integer;
timeout: integer;
begin
readRepport(Port, ThreadN, sleeptime);
if TBReport.Tag = 0 then
begin
readSerIp(ip, timeout);
for i := 0 to ThreadN - 1 do
begin
xRepThread := TRep.create(ip, Port, sleeptime, timeout); //创建线程
GRepTList.Add(xRepThread);
end;
Send_Resp := True;
TBReport.Caption := 'Stop Report';
TBReport.Tag := 1;
end
else
begin
for i := 0 to ThreadN - 1 do
begin
TRep(GRepTList[i]).Terminate; //中止线程
end;
Send_Resp := False;
TBReport.Tag := 0;
TBReport.Caption := 'Start Report';
end;
end;
procedure TSMGPGateWay.TBDToSClick(Sender: TObject);
var
ip, Port: string;
ThreadN, i: integer;
sleeptime: integer;
timeout: integer;
begin
readMoport(Port, ThreadN, sleeptime);
if TBDToS.Tag = 0 then
begin
readSerIp(ip, timeout);
{ try
XMLService.XML.Clear;
XMLService.LoadFromFile(extractfilepath(application.ExeName) + 'Service.xml');
if XMLService.Active then XMLService.Active := False;
XMLService.Active := True;
Memo3.Lines.Add('【' + datetimetostr(now) + '】加载XML配置文件成功......');
except
on E: Exception do
begin
Memo3.Lines.Add('【' + datetimetostr(now) + '】加载XML配置文件错误,发送上行短信线程不能创建!');
exit;
end;
end; }
for i := 0 to ThreadN - 1 do
begin
xDeliverThread := TSPDeliverThread.create(ip, Port, sleeptime, timeout); //创建线程
GDeliverTList.Add(xDeliverThread);
end;
Send_Deliver := True;
TBDToS.Tag := 1;
TBDToS.Caption := 'Stop DeliToSer';
end
else
begin
for i := 0 to ThreadN - 1 do
try
TSPDeliverThread(GDeliverTList[i]).Terminate; //中止线程
except
end;
//XMLService.Active := False;
Send_Deliver := False;
TBDToS.Tag := 0;
TBDToS.Caption := 'Start DeliToSer';
end;
end;
procedure TSMGPGateWay.TBCreateAllClick(Sender: TObject);
begin
if TBCreateAll.Tag = 0 then //创建
begin
if TBSubmitReq.Tag = 0 then
TBSubmitReq.Click;
if TBDToS.Tag = 0 then
TBDToS.Click;
if TBResponse.Tag = 0 then
TBResponse.Click;
if TBReport.Tag = 0 then
TBReport.Click;
TBCreateAll.Tag := 1;
TBCreateAll.Caption := 'Stop ALL';
end
else if TBCreateAll.Tag = 1 then //停止
begin
if TBSubmitReq.Tag = 1 then
TBSubmitReq.Click;
if TBResponse.Tag = 1 then
TBResponse.Click;
if TBReport.Tag = 1 then
TBReport.Click;
if TBDToS.Tag = 1 then
TBDToS.Click;
TBCreateAll.Tag := 0;
TBCreateAll.Caption := 'CreateAll';
end;
end;
procedure TSMGPGateWay.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
CanClose := False;
if DCanExit and SCanExit then
CanClose := True
else
begin
messagebox(handle, '连接未中断，请先断开与电信的连接', '警告', mb_ok + MB_ICONWARNING);
exit;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -