u_ctdeliver.pas

电信短信网关平台+v3, dephi写的短信收发程序（包括PDU编解码）,对于进行短信收发程序开发人员很有用!

{－－－－－－－－－－－－－－－－－－－－－－－－}
{                  Deliver线程                   }
{                          LUOXX                 }
{                            2004/3/11           }
{－－－－－－－－－－－－－－－－－－－－－－－－}


unit U_CTDeliver;
interface
uses
  Windows, classes, Sockets, U_MsgInfo, Smgp13_XML, U_RequestID, Htonl, SysUtils,
  winsock, ScktComp, md5, NetDisconnect, DateUtils,strutils;
{MO Thread}
type
  TCPCTDeliver = class(TThread)
  private
    CTDeliver: TTcpClient;
    Statustr: string;
    StatuTxt: string;
    StatustrE: string;
    fsleeptime: integer;
    ClientID: string;
    sharesecret: string;
    loginmode: byte;
    timeout: integer;
    HadLogin: boolean;
    Active_test_time: TDateTime; // integer;
    MO_Warnning: byte;
    ErrWarnning: TWarnning;
    ErrMsg: array of char;
    SockCanExit: boolean;
    ReceiveDeliverTime: TDateTime;

    FServiceID : String;
  protected
    procedure Execute; override;
    procedure LoginCT; {登陆过程}
    function ExitCT: boolean; {退出过程}
    procedure MO_ActiveTest; {发送链路检测包}
//    procedure Receive; {接收上行链路数据}
    procedure MOSocketError(Sender: TObject;
      SocketError: integer);
    procedure SP_Deliver_Resp(MSg_id: array of char; SequenceID: Longword);
    procedure MO_ActiveTest_Resp(CTsequence: 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);
    procedure ReceiveHead;
    procedure ReceiveBody(CTRequestID, CTsequence, Len: Longword);

    procedure ReceiveDeliver(CTsequence, Len: Longword);

    procedure upmemo;
    procedure showError;
    procedure showstatu;
    procedure AddsSeq;
    procedure AddCou;
    //3.0
    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;

    function GetAccessNoByServiceID(aServiceID : String) : String;
  public
    constructor create(xCT_IP, xCT_port, xClientID, xsharesecret: string; xsleeptime, xtimeout: integer; xloginmode: byte); virtual;
    destructor destroy; override;
  end;

implementation
uses U_Main, U_CTThread;

{ TCPCTDeliver }
constructor TCPCTDeliver.create(xCT_IP, xCT_port, xClientID, xsharesecret: string; xsleeptime, xtimeout: integer; xloginmode: byte);
begin
  inherited create(True);
  FreeOnTerminate := True;
  CTDeliver := TTcpClient.create(nil);
  CTDeliver.RemoteHost := xCT_IP;
  CTDeliver.RemotePort := xCT_port;
  CTDeliver.OnError := MOSocketError;
  ClientID := xClientID;
  sharesecret := xsharesecret;
  fsleeptime := xsleeptime;
  timeout := xtimeout;
  loginmode := xloginmode;
  StatuTxt := '【' + datetimetostr(now) + '】上行线程创建,电信网关服务器' + xCT_IP + ',ThreadID:' + inttostr(self.ThreadID);
  synchronize(showstatu);
  Resume;
end;
destructor TCPCTDeliver.destroy;
begin
  FreeAndNil(CTDeliver);
  StatuTxt := '【' + datetimetostr(now) + '】上行线程中止,ThreadID:' + inttostr(self.ThreadID);
  synchronize(showstatu);
  LogList.AddLog('10' + StatuTxt);
  SMGPGateWay.Label9.Caption := 'Warning:接收短信(MO)线程停止';
  ErrMsg := nil;
  inherited;
end;
procedure TCPCTDeliver.Execute;
begin
  HadLogin := False;
  MO_Warnning := 0;
  while not Terminated do
  try
    if not HadLogin then
    begin
      if MOExit then
      begin
        MOExit := False;
        break;
      end;
      LoginCT; //登陆;
    end
    else
    begin //已经登陆
      if MOExit then //如果发送退出命令
      begin
        if HadLogin then
        begin
          ExitCT; //发送退出命令
        end
        else
        begin
          MOExit := False;
          break;
        end;
      end
      else
        MO_ActiveTest; //发送链路测试
      ReceiveHead; //接收包头 调用接收包体过程
      if SockCanExit then
      begin
        MOExit := False;
        break;
      end;
      sleep(fsleeptime);
    end;

    {if MOExit then //退出
      if HadLogin then
      begin
        if ExitCT then
        begin
          MOExit := False;
          break;
        end; //退出线程
      end
      else
      begin
        MOExit := False;
        break;
      end; }
      //==============
    {if SockCanExit then
    begin
       MOExit:=False;
       break;
    end; }
    //==============
  except
    on e: exception do
    begin
      Statustr := '[' + datetimetostr(now) + ']' + 'MO Thread Error:' + e.Message;
      LogList.AddLog('10' + Statustr);
      Synchronize(upmemo);
    end;
  end;
end;
procedure TCPCTDeliver.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-->CT(MO)LoginCT 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()) + '】(MO)Login_Resp-- >上行连接成功登陆中国电信'; HadLogin := True; MO_Warnning := 0; DCanExit := False; MOExit := False; ReceiveDeliverTime := now; LastSendWarnMsgTime := now; Counter := 0; end;
                    1:
                      begin
                        StatuTxt := '【' + datetimetostr(now()) + '】(MO)Login_Resp-- >上行连接电信回复系统忙，请稍候再拨'; CTDeliver.Close; sleep(RetryTime); end;
                    21:
                      begin
                        StatuTxt := '【' + datetimetostr(now()) + '】(MO)Login_Resp-- >上行连接电信回复认证错误！！'; CTDeliver.Close; sleep(RetryTime); end;
                  else
                    begin
                      StatuTxt := '【' + datetimetostr(now()) + '】(MO)Login_Resp-- >上行连接电信回复鉴别客户端接入请求状态 ' + inttostr(Status); CTDeliver.Close; sleep(RetryTime); end;
                  end;
                  LogList.AddLog('10' + StatuTxt);
                end;
              end
              else
              begin
                StatuTxt := '【' + datetimetostr(now()) + '】(MO)Login上行请求连接超时,链路关闭,等待' + inttostr(RetryTime div 1000) + '重新登陆...'; CTDeliver.Close; sleep(RetryTime); end;
          end;
        end
        else
        begin
          StatuTxt := '【' + datetimetostr(now()) + '】(MO)Login上行请求连接超时,链路关闭,等待' + inttostr(RetryTime div 1000) + '秒重新登陆...'; CTDeliver.Close; sleep(RetryTime); end;
        synchronize(showstatu);
      end;
  except
  end;
end;
procedure TCPCTDeliver.MO_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(dSequence);
      end;
      if sizeof(TSMGPHead) = CTDeliver.SendBuf(ActiveTest, sizeof(TSMGPHead), 0) then
      begin
        AddsSeq;
        StatuTxt := '【' + datetimetostr(now()) + '】(MO)ActiveTest 上行发送链路检测包 ' + inttostr(HostToNet(ActiveTest.SequenceID));
        synchronize(showstatu);
      end;
    end;