transmit.pas

电信网关平台（V3.0）

{－－－－－－－－－－－－－－－－－－－－－－－－}
{                  Transmit线程(收发模式)        }
{                    Author:  LUOXINXI           }
{                    DateTime: 2004/7/28         }
{－－－－－－－－－－－－－－－－－－－－－－－－}
unit Transmit;

interface
uses
  Windows, classes, Sockets, U_MsgInfo, Smgp13_XML, U_RequestID, Htonl, SysUtils,
  winsock, ScktComp, md5, NetDisconnect, DateUtils,strutils;

{收发 Thread}
type
  TTransmit = class(TThread)
  private
    CTDeliver: TTcpClient; //socket 连接
    Statustr: string;
    StatuTxt: string;
    StatustrE: string;
    fsleeptime: integer;
    ClientID: string;
    sharesecret: string;
    loginmode: byte;
    timeout: integer;
    HadLogin: boolean;
    Active_test_time: TDateTime; //integer;
    Warnning: byte;
    resptime, sendtimes: integer;
    ErrWarnning: TWarnning; //上行链路出错时警报
    CTSubmit_Resp: TSMGPDeliver_Resp; //回馈报告
    SocketBuff: array of char;
    SockCanExit: boolean;
    ReceiveDeliverTime: TDateTime;
  protected
    procedure Execute; override;
    procedure LoginCT; {登陆过程}
    function ExitCT: boolean; {退出过程}

    procedure ReceiveHead;
    procedure ReceiveBody(CTRequestID, CTsequence, Len: Longword);

    procedure ActiveTest; {链路测试}
    procedure ActiveTest_Resp(CTsequence: Longword); {链路测试回复}
    procedure SocketError(Sender: TObject;
      SocketError: integer);
    procedure SP_Deliver_Resp(Msg_id: array of char; SequenceID: Longword); {上行回复}
    procedure WriteReport(const Msgid: array of char; const Source: array of char); {写状态报告}
    procedure SaveToDeliverList(aDeliver: TCTDeliver; const LinkID:string); {保存上行短信}
    procedure ShowDeliver(aDeliver: TCTDeliver; const LinkID:string); {上行包记录}
    function SP_Submit: boolean; {下行短信}
    procedure ReSubmit(SequenceID: Longword; statu: Longword); {重发}
    function DeleteMT(SequenceID: Longword; var aMid: string): boolean; {删除下行短信缓冲区短信,返回MID}
    function MakeSockBuff(var SubmitLen: integer; rSubmit: xSubmit): Longword; //设置socket传输消息 返回值是该消息序列号
    procedure NoResponse_Resubmit; //在指定时间没有返回回馈报告的重发
    procedure upmemo;
    procedure showError;
    procedure showstatu;
    procedure AddsSeq;
    procedure AddCou;

    procedure ReceiveDeliver(CTsequence, Len: Longword);
    function ReceiveTLVMsg(const MsgLen:integer;var LinkID:string;var DealReslt:byte):byte;// SubmitMsgType.value
    procedure AddSyncOrdCelMsg(aDeliver: TCTDeliver;const LinkID:string);
    procedure DealWithSyncMsgCont(const msgcontent:string; var ServiceID, MsgContPart:string);
    function GetInstruct(const msgcontent:string):string;
  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;

{ TCPCTDeliver }
constructor TTransmit.create(xCT_IP, xCT_port, xClientID, xsharesecret: string; xsleeptime, xtimeout, xresptime, xsendtimes: integer; xloginmode: byte);
begin
  inherited create(True);
  FreeOnTerminate := True;
  CTDeliver := TTcpClient.create(nil);
  CTDeliver.RemoteHost := xCT_IP;
  CTDeliver.RemotePort := xCT_port;
  CTDeliver.OnError := SocketError;
  ClientID := xClientID;
  sharesecret := xsharesecret;
  fsleeptime := xsleeptime;
  timeout := xtimeout;
  loginmode := xloginmode;
  sendtimes := xsendtimes;
  loginmode := xloginmode;
  StatuTxt := '【' + datetimetostr(now) + '】收发线程创建,电信网关服务器' + xCT_IP + ',ThreadID:' + inttostr(self.ThreadID);
  synchronize(showstatu);
  Resume;
end;

destructor TTransmit.destroy;
begin
  StopCatchSMS := True;
  FreeAndNil(CTDeliver);
  SocketBuff := nil;
  StatuTxt := '【' + datetimetostr(now) + '】收发线程中止,ThreadID:' + inttostr(self.ThreadID);
  synchronize(showstatu);
  LogList.AddLog('10' + StatuTxt);
  SMGPGateWay.Label8.Caption := 'Warning:收发线程停止';
  inherited;
end;
procedure TTransmit.Execute;
begin
  HadLogin := False;
  Warnning := 0;
  while not Terminated do
  try
    if not HadLogin then
    begin
      if TransmitExit then
      begin
        TransmitExit := False;
        break;
      end;
      LoginCT; //登陆
    end
    else
    begin //已经登陆
      if TransmitExit then //如果发送退出命令
      begin
        if HadLogin then
        begin
          ExitCT; //发送退出命令
        end
        else
        begin
          TransmitExit := False;
          break;
        end;
      end
      else
      begin
        NoResponse_Resubmit;
        if not SP_Submit then
          ActiveTest; //发送链路测试
      end;
      ReceiveHead; //接收包头 调用接收包体过程
      if SockCanExit then
      begin
        TransmitExit := False;
        break;
      end;
      sleep(fsleeptime);
    end;
  except
    on e: exception do
    begin
      Statustr := '[' + datetimetostr(now) + ']' + 'Thread Error:' + e.Message;
      LogList.AddLog('10' + Statustr);
      upmemo;
    end;
  end;
end;

procedure TTransmit.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; //系统支持的版本号$13;
    body.loginmode := loginmode;
    DateTimeToString(timestr, 'MMDDHHMMSS', now); //时间转换为字符串
    xLogin.body.Timestamp := winsock.Htonl(StrToInt(timestr)); //字节系转换
    //MD5加密认证
    str1 := ClientID + #0#0#0#0#0#0#0 + sharesecret + timestr; //用户名＋密码＋7个#0＋登陆密码+时间
    MD5Init(md5_con); //初始化md5_con
    MD5Update(md5_con, pchar(str1), length(str1)); //MD5加密
    MD5Final(md5_con, md5str);
    move(md5str, body.AuthenticatorClient, 16); //复制到消息包中的"AuthenticatorClient"字段
  end;
  try
    CTDeliver.Close;
  except
  end;
  try
    if CTDeliver.Connect then
      if sizeof(TLogin) = CTDeliver.SendBuf(xLogin, sizeof(xLogin), 0) then
      begin {//发送}
        AddsSeq;
        StatuTxt := '【' + datetimetostr(now()) + '】SP-->CTLoginCT Request 发送登陆请求...';
        synchronize(showstatu);
        if CTDeliver.WaitForData(timeout) then
        begin
          if sizeof(TSMGPHead) = CTDeliver.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 CTDeliver.WaitForData(timeout) then
              begin
                if sizeof(TSMGPLogin_resp) = CTDeliver.ReceiveBuf(xLogin_resp, sizeof(TSMGPLogin_resp), 0) then
                begin
                  Status := HostToNet(xLogin_resp.Status);
                  case Status of
                    0:
                      begin
                        StatuTxt := '【' + datetimetostr(now()) + '】Login_Resp-->成功登陆中国电信'; HadLogin := True; Warnning := 0; DCanExit := False; TransmitExit := False; StopCatchSMS := False; ReceiveDeliverTime := now; Counter := 0; end;
                    1:
                      begin
                        StatuTxt := '【' + datetimetostr(now()) + '】Login_Resp-->电信回复系统忙，请稍候再拨'; CTDeliver.Close; sleep(RetryTime); StopCatchSMS := True; end;
                    21:
                      begin
                        StatuTxt := '【' + datetimetostr(now()) + '】Login_Resp-->电信回复认证错误！！！'; CTDeliver.Close; sleep(RetryTime); StopCatchSMS := True; end;
                  else
                    begin
                      StatuTxt := '【' + datetimetostr(now()) + '】Login_Resp-->电信回复鉴别客户端接入请求状态 ' + inttostr(Status); CTDeliver.Close; sleep(RetryTime); StopCatchSMS := True; end;
                  end;
                  LogList.AddLog('10' + StatuTxt);
                end;
              end
              else
              begin
                StatuTxt := '【' + datetimetostr(now()) + '】请求连接超时,链路关闭,等待' + inttostr(RetryTime div 1000) + '重新登陆...'; CTDeliver.Close; sleep(RetryTime); end;
          end;
        end
        else
        begin
          StatuTxt := '【' + datetimetostr(now()) + '】请求连接超时,链路关闭,等待' + inttostr(RetryTime div 1000) + '秒重新登陆...'; CTDeliver.Close; sleep(RetryTime); end;
        synchronize(showstatu);
      end;
  except
  end;
end;

procedure TTransmit.ActiveTest;
var
  ActiveTest: TSMGPHead;
begin
  FillChar(ActiveTest, sizeof(TSMGPHead), 0);
  if CTDeliver.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) = CTDeliver.SendBuf(ActiveTest, sizeof(TSMGPHead), 0) then
      begin
        AddsSeq;
        StatuTxt := '【' + datetimetostr(now()) + '】ActiveTest 发送链路检测包 ' + inttostr(HostToNet(ActiveTest.SequenceID));
        synchronize(showstatu);
      end;
    end;
  end;
end;

function TTransmit.ExitCT: boolean;
var
  SMGPExit: TSMGPHead;
  SMGPExit_Resp: TSMGPHead;
  temp: Longword;
begin
  Result := False;
  FillChar(SMGPExit, 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) = CTDeliver.SendBuf(SMGPExit, sizeof(TSMGPHead), 0) then
      begin
        AddsSeq;
        StatuTxt := '【' + datetimetostr(now()) + '】SP-->CT ExitCT Request 发送退出请求...';
        synchronize(showstatu);
      end;
    if CTDeliver.WaitForData(timeout) then
    begin
      if sizeof(TSMGPHead) = CTDeliver.ReceiveBuf(SMGPExit_Resp, sizeof(TSMGPHead), 0) then
      begin
        temp := HostToNet(SMGPExit_Resp.RequestID);
        if temp = Exit_resp then
        begin
          CTDeliver.Close;
          Result := True;
          DCanExit := True;
          StatuTxt := '【' + datetimetostr(now()) + '】ExitCT 退出与电信的连接';
          synchronize(showstatu);
        end;
      end;
    end
    else
    begin
      CTDeliver.Close;
      DCanExit := True;
      Result := True;
      StatuTxt := '【' + datetimetostr(now()) + '】ExitCT Request 发送退出请求超时，连接已经关闭';
      synchronize(showstatu);
    end;
  except
  end;
end;

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


procedure TTransmit.ActiveTest_Resp(CTsequence: Longword);
var
  spActiveTest_Resp: TSMGPHead;
begin
  FillChar(spActiveTest_Resp, sizeof(TSMGPHead), 0);
  spActiveTest_Resp.SequenceID := HostToNet(CTsequence);
  spActiveTest_Resp.PacketLength := HostToNet(sizeof(TSMGPHead));
  spActiveTest_Resp.RequestID := HostToNet(Active_test_resp);
  if CTDeliver.Active then
    if sizeof(TSMGPHead) = CTDeliver.SendBuf(spActiveTest_Resp, sizeof(TSMGPHead)) then
    begin
      StatuTxt := '【' + datetimetostr(now()) + '】SP-->CT ActiveTest_Resp SP回复链路正常... ' + inttostr(CTsequence);
      synchronize(showstatu);
    end;
end;

procedure TTransmit.upmemo;