u_ctthread.pas

电信网关平台（V3.0）

{－－－－－－－－－－－－－－－－－－－－－－－－}
{                  SUBMIT线程                    }
{                  Author: LUOXINXI              }
{                  DateTime: 2004/3/11           }
{－－－－－－－－－－－－－－－－－－－－－－－－}


unit U_CTThread;
interface
uses
  Windows, classes, Sockets, U_MsgInfo, Smgp13_XML, U_RequestID, Htonl,
  SysUtils, winsock, ScktComp, md5, DateUtils, NetDisconnect;
{MT Thread}
type
  TCPSubmit = class(TThread)
  private
    CTClient: TTcpClient;
    Statustr: string;
    StatuTxt: string;
    StatustrE: string;
    fsleeptime: integer;
    ClientID: string;
    sharesecret: string;
    SocketBuff: array of char;
    loginmode: byte;
    timeout: integer;
    HadLogin: boolean;
    Active_test_time: TDateTime; // integer;
    resptime, sendtimes: integer;
    MT_Warnning: byte;
    ErrWarnning: TWarnning;
    ErrMsg: array of char;
  protected
    procedure Execute; override;
    procedure LoginCT; {登陆过程}
    function ExitCT: boolean; {退出过程}
    procedure MT_ActiveTest; {发送链路检测包}
    function SP_Submit: boolean; {下行短信}
    procedure Receive; {接收下行链路数据}
    procedure MTSocketError(Sender: TObject;
      SocketError: integer);
    procedure ReSubmit(SequenceID: Longword; statu: Longword); {重发}
    function DeleteMT(SequenceID: Longword; var aMid: string): boolean; {删除下行短信缓冲区短信,返回MID}
    procedure MTActive_Test_Resp(CTsequence: Longword); {回复链路检测包}
    function SubmitButDisConn(DisConnTime: TDateTime): integer; //已经下发短信但没有回馈下行链路断开
    function MakeSockBuff(var SubmitLen: integer; rSubmit: xSubmit): Longword; //设置socket传输消息 返回值是该消息序列号
    procedure upmemo;
    procedure NoResponse_Resubmit; //在指定时间没有返回回馈报告的重发
    procedure showError;
    procedure showstatu;
    procedure AddsSeq;
    procedure AddCou;
  public
    constructor create(xCT_IP, xCT_port, xClientID, xsharesecret: string; xsleeptime, xtimeout, xresptime, xsendtimes: integer; xloginmode: byte); virtual;
    destructor destroy; override;
  end;

implementation
uses U_Main;

{ TCPSubmit }
constructor TCPSubmit.create(xCT_IP, xCT_port, xClientID, xsharesecret: string; xsleeptime, xtimeout, xresptime, xsendtimes: integer; xloginmode: byte);
begin
  inherited create(True);
  FreeOnTerminate := True;
  CTClient := TTcpClient.create(nil);
  CTClient.RemoteHost := xCT_IP;
  CTClient.RemotePort := xCT_port;
  CTClient.OnError := MTSocketError;
  ClientID := xClientID;
  sharesecret := xsharesecret;
  fsleeptime := xsleeptime;
  timeout := xtimeout;
  resptime := xresptime;
  sendtimes := xsendtimes;
  loginmode := xloginmode;
  StatuTxt := '【' + datetimetostr(now) + '】下行线程创建,电信网关服务器' + xCT_IP + ',ThreadID:' + inttostr(self.ThreadID);
  synchronize(showstatu);
  Resume;
end;
destructor TCPSubmit.destroy;
begin
  StopCatchSMS := True;
  FreeAndNil(CTClient);
  SocketBuff := nil;
  ErrMsg:=nil;
  StatuTxt := '【' + datetimetostr(now) + '】下行线程中止,ThreadID:' + inttostr(self.ThreadID);
  synchronize(showstatu);
  LogList.AddLog('10' + StatuTxt);
  SMGPGateWay.Label8.Caption := 'Warning:发送短信(MT)线程停止';
  MTExit := False;
  SMGPGateWay.MTLogin1.Enabled := True;
  inherited;
end;
procedure TCPSubmit.Execute;
begin
  HadLogin := False;
  MT_Warnning := 0;
  while not Terminated do
  try
    if not HadLogin then
      LoginCT //登陆
    else
    begin
      NoResponse_Resubmit;
      if not SP_Submit then {发送短信  {if MT List is null then send ActiveTest To CT}
        MT_ActiveTest; //短信发送不成功或没有短信发送则发送链路测试
      Receive;
    end;
    if MTExit then //退出
      if HadLogin then
      begin
        if ExitCT then
        begin
          MTExit := False; break; end; //退出线程
      end
      else
      begin
        MTExit := False; break;
      end;
      sleep(fsleeptime);
  except
    on e: exception do
    begin
      Statustr := '[' + datetimetostr(now) + ']' + 'MT Thread Error:' + e.Message;
      LogList.AddLog('10' + StatuTxt);
      synchronize(upmemo);
    end;
  end;
end;
procedure TCPSubmit.LoginCT;
var
  xLogin: TLogin;
  xLogin_resp: TSMGPLogin_resp;
  Head: TSMGPHead;
  timestr: string;
  str1: string;
  md5str: md5digest;
  md5_con: MD5Context;
  temp: Longword;
  Status: Longword;
begin
  HadLogin := False;
  FillChar(xLogin, sizeof(TLogin), 0);
  FillChar(Head, sizeof(TSMGPHead), 0);
  FillChar(xLogin_resp, sizeof(TSMGPLogin_resp), 0);
  with xLogin do
  begin
    Head.PacketLength := winsock.Htonl(sizeof(TLogin));
    Head.RequestID := winsock.Htonl(Login);
    Head.SequenceID := winsock.Htonl(sSequence);
    strpcopy(body.ClientID, ClientID);
    body.Version := GetVision; //系统支持的版本号$20;
    body.loginmode := loginmode;
    DateTimeToString(timestr, 'MMDDHHMMSS', now);
    xLogin.body.Timestamp := winsock.Htonl(StrToInt(timestr));
    str1 := ClientID + #0#0#0#0#0#0#0 + sharesecret + timestr;
    MD5Init(md5_con);
    MD5Update(md5_con, pchar(str1), length(str1));
    MD5Final(md5_con, md5str);
    move(md5str, body.AuthenticatorClient, 16);
  end;
  try
    CTClient.Close;
  except
  end;
  try
    if CTClient.Connect then
      if sizeof(TLogin) = CTClient.SendBuf(xLogin, sizeof(xLogin), 0) then
      begin {//发送}
        AddsSeq;
        StatuTxt := '【' + datetimetostr(now()) + '】SP-->CT(MT)LoginCT Request 下行连接发送登陆请求...';
        synchronize(showstatu);
        if CTClient.WaitForData(timeout) then
        begin
          if sizeof(TSMGPHead) = CTClient.ReceiveBuf(Head, sizeof(TSMGPHead), 0) then
          begin {//   收头}
            Active_test_time := now; //StrToInt(formatdatetime('ss', now)); //登陆回复时间
            temp := winsock.Htonl(Head.RequestID);
            if Login_resp = temp then
              if CTClient.WaitForData(timeout) then
              begin
                if sizeof(TSMGPLogin_resp) = CTClient.ReceiveBuf(xLogin_resp, sizeof(TSMGPLogin_resp), 0) then
                begin
                  Status := HostToNet(xLogin_resp.Status);
                  case Status of
                    0:
                      begin
                        StatuTxt := '【' + datetimetostr(now()) + '】(MT)Login_Resp-- >下行连接成功登陆中国电信'; HadLogin := True; MT_Warnning := 0; SCanExit := False; MTExit := False; StopCatchSMS := False; end;
                    1:
                      begin
                        StatuTxt := '【' + datetimetostr(now()) + '】(MT)Login_Resp-- >下行连接电信回复系统忙，请稍候再拨'; CTClient.Close; sleep(RetryTime); StopCatchSMS := True; end;
                    21:
                      begin
                        StatuTxt := '【' + datetimetostr(now()) + '】(MT)Login_Resp-- >下行连接电信回复认证错误！！'; CTClient.Close; sleep(RetryTime); StopCatchSMS := True; end;
                  else
                    begin
                      StatuTxt := '【' + datetimetostr(now()) + '】(MT)Login_Resp-- >下行连接电信回复鉴别客户端接入请求状态 ' + inttostr(Status); CTClient.Close; sleep(RetryTime); StopCatchSMS := True; end;
                  end;
                  LogList.AddLog('10' + StatuTxt);
                end;
              end
              else
              begin
                StatuTxt := '【' + datetimetostr(now()) + '】(MT)Login下行请求连接超时,链路关闭,等待' + inttostr(RetryTime div 1000) + '重新登陆...'; CTClient.Close; sleep(RetryTime); end;
          end;
        end
        else
        begin
          StatuTxt := '【' + datetimetostr(now()) + '】(MT)Login下行请求连接超时,链路关闭,等待' + inttostr(RetryTime div 1000) + '秒重新登陆...'; CTClient.Close; sleep(RetryTime); end;
        synchronize(showstatu);
      end;
  except
  end;
end;
procedure TCPSubmit.MT_ActiveTest;
var
  ActiveTest: TSMGPHead;
begin
  FillChar(ActiveTest, sizeof(TSMGPHead), 0);
  if CTClient.Connected then
  begin
    if DateUtils.SecondsBetween(now, Active_test_time) >= (ActiveTestTime div 1000) then
    begin
      with ActiveTest do
      begin
        ActiveTest.PacketLength := HostToNet(sizeof(TSMGPHead));
        ActiveTest.RequestID := HostToNet(Active_test);
        ActiveTest.SequenceID := HostToNet(sSequence);
      end;
      if sizeof(TSMGPHead) = CTClient.SendBuf(ActiveTest, sizeof(TSMGPHead), 0) then
      begin
        AddsSeq;
        StatuTxt := '【' + datetimetostr(now()) + '】(MT)ActiveTest 下行发送链路检测包 ' + inttostr(HostToNet(ActiveTest.SequenceID));
        synchronize(showstatu);
      end;
    end;
  end;
end;
function TCPSubmit.ExitCT: boolean;
var
  SMGPExit: TSMGPHead;
  SMGPExit_Resp: TSMGPHead;
  temp: Longword;
begin
  Result := False;
  FillChar(SMGPExit, sizeof(TSMGPHead), 0);
  FillChar(SMGPExit_Resp, sizeof(TSMGPHead), 0);
  with SMGPExit do
  begin
    SMGPExit.PacketLength := HostToNet(sizeof(TSMGPHead));
    SMGPExit.RequestID := HostToNet(xExit);
    SMGPExit.SequenceID := HostToNet(sSequence);
  end;
  try
    if HadLogin then
      if sizeof(TSMGPHead) = CTClient.SendBuf(SMGPExit, sizeof(TSMGPHead), 0) then
      begin
        AddsSeq;
        StatuTxt := '【' + datetimetostr(now()) + '】SP-->CT(MT)ExitCT Request 下行连接发送退出请求...';
        synchronize(showstatu);
        if CTClient.WaitForData(timeout) then
        begin
          if sizeof(TSMGPHead) = CTClient.ReceiveBuf(SMGPExit_Resp, sizeof(TSMGPHead), 0) then
          begin
            temp := HostToNet(SMGPExit_Resp.RequestID);
            if temp = Exit_resp then
            begin
              CTClient.Close;
              Result := True;
              SCanExit := True;
              StatuTxt := '【' + datetimetostr(now()) + '】MT ExitCT --> 下行连接退出与电信的连接';
              synchronize(showstatu);
            end;
          end;
        end
        else
        begin
          CTClient.Close;
          SCanExit := True;
          Result := True;
          StatuTxt := '【' + datetimetostr(now()) + '】MT ExitCT Request 下行连接发送退出请求超时，连接已经关闭';
          synchronize(showstatu);
        end;
      end;
  except
  end;
end;

procedure TCPSubmit.MTSocketError(Sender: TObject; SocketError: integer);
var
  Error: integer;
begin
  Error := SocketError;
  SocketError := 0;
  SCanExit := True;
  StatuTxt := '【' + datetimetostr(now) + '】(MT)下行链路发生网络故障' + inttostr(Error) + ',等待' + inttostr(RetryTime div 1000) + '秒再次登陆...';
  StopCatchSMS := True;
  //SubmitButDisConn(now);
  synchronize(showstatu);
  LogList.AddLog('10' + StatuTxt);
  inc(MT_Warnning);
  if MT_Warnning > 10 then ErrWarnning := TWarnning.create;
  HadLogin := False;
  sleep(RetryTime);
end;

function TCPSubmit.SP_Submit: boolean;
var
  xList: TList;
  SubmitLen: integer;
  Empty: boolean;
  xTCSubmit: PxSubmit; //系统内部数据消息包指针
  rSubmit: xSubmit; //系统内部数据消息包
  SubmitSequence: Longword;
begin
  Result := True;
  Empty := False;
  xTCSubmit := nil;
  //=======================================================
  {2.0协议后}
  {FillChar(SMGPSubmit2011, sizeof(TSMGPSubmit2011), 0);
  FillChar(SMGPSubmit203, sizeof(TSMGPSubmit203), 0);
  FillChar(SMGPSubmit2021, sizeof(TSMGPSubmit2021), 0);
  FillChar(SMGPSubmit2022, sizeof(TSMGPSubmit2022), 0); }
  //=======================================================
  FillChar(rSubmit, sizeof(xSubmit), 0);
  if CTClient.Connected then
  begin
    xList := SubmitList.LockList;
    try
      if xList.count > 0 then
      begin
        try
          xTCSubmit := PxSubmit(xList.First); //强制类型转换
          rSubmit := xTCSubmit^; //转换记录
          try
            dispose(xTCSubmit); //释放指针
            xList.Delete(0); //删除列表
            xTCSubmit := nil;
          except
          end;
        except
        end;
      end
      else
        Empty := True;
    finally
      SubmitList.UnlockList;
    end;
    if Empty then
    begin
      Result := False;
      exit;
    end;
    SubmitSequence := MakeSockBuff(SubmitLen, rSubmit);
    try
      if (SubmitLen) = CTClient.SendBuf(SocketBuff[0], SubmitLen) then
      begin
        AddsSeq;
        inc(rSubmit.Resend); //发送次数加1
        rSubmit.SequenceID := SubmitSequence; //HostToNet(SMGPSubmit2011.Head.SequenceID);
        rSubmit.Then_DateTime := now; //设置当前发送时间
        new(xTCSubmit);
        xTCSubmit^ := rSubmit;
        SaveSubmitList.Add(xTCSubmit); //SAVE SM
        Statustr := '[' + datetimetostr(now) + ']Submit:';
        Statustr := Statustr +'<SequenceID>'+inttostr(xTCSubmit^.SequenceID) + #32;
        Statustr := Statustr +'<Mid>'+ xTCSubmit^.sSubmit.Mid + #32;
        Statustr := Statustr +'<MsgType>'+ inttostr(xTCSubmit^.sSubmit.MsgType) + #32;
        //Statustr := Statustr +'<NeedReport>'+ inttostr(xTCSubmit^.sSubmit.NeedReport) + #32;
        Statustr := Statustr +'<ServiceID>'+ xTCSubmit^.sSubmit.ServiceID + #32;
        Statustr := Statustr +'<FeeCode>'+ xTCSubmit^.sSubmit.FeeCode + #32;
        Statustr := Statustr +'<FixedFee>'+ xTCSubmit^.sSubmit.FixedFee + #32;
        Statustr := Statustr +'<ChargeTermID>'+ xTCSubmit^.sSubmit.ChargeTermID + #32;
        Statustr := Statustr +'<DestTermID>'+ xTCSubmit^.sSubmit.DestTermID + #13#10;
        Statustr := Statustr +'<SrcTermID>'+ xTCSubmit^.sSubmit.SrcTermID + #32;
        Statustr := Statustr +'<SubmitMsgType>'+ inttostr(xTCSubmit^.sSubmit.SubmitMsgType) + #32;
        Statustr := Statustr +'<LinkID>'+ xTCSubmit^.sSubmit.LinkID + #32;
        Statustr := Statustr +'<MsgContent>'+ xTCSubmit^.sSubmit.MsgContent + #32;
        LogList.AddLog('07' + Statustr);
        AddCou;
        synchronize(upmemo);
      end
      else
      begin //发送不成功
        new(xTCSubmit);
        xTCSubmit^ := rSubmit;
        SubmitList.Add(xTCSubmit);
      end;