⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 操作数据库的例子
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      OutReadThread.Terminate;
      OutReadThread := nil;
    end;

    OutReadThread := TOutReadSMGPThreadObj.Create(True);
    OutReadThread.FTCPClient := SMGPTCPClient;
    OutReadThread.Resume;

    MtSendThread := TMtSendSMGPThreadObj.Create(True);
    MtSendThread.Resume;
  except

  end;
end;

//SMGP  小灵通 电信
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
{SMGP  TMtSendSmgpThreadObj }
procedure TMtSendSMGPThreadObj.AddMsgToMemo(const Msg: string);
begin
  ErrMsg := Msg;
  Synchronize(ThAddMsgToMemo);
end;

constructor TMtSendSMGPThreadObj.Create(CreateSuspended: boolean);
begin
  inherited;
  LastActiveTime := now;
end;

destructor TMtSendSMGPThreadObj.destroy;
begin
  LastActiveTime := 0;
  inherited;
end;

procedure TMtSendSMGPThreadObj.Execute;
begin
  FreeOnTerminate := True;
  while not Terminated do
  begin
    try
      try
        MtPrc;
      except
        on e: exception do
        begin
          AddMsgToMemo('MT消息发送线程:' + e.Message);
        end;
      end;
    finally
      LastActiveTime := now;
      //这里需要做流量限制
      sleep(1000 div GGATECONFIG.Flux);
    end;
  end;
end;

procedure TMtSendSMGPThreadObj.MtPrc;
begin
  if OutReadThread <> nil then
  begin
    OutReadThread.PrcMt;
  end;
end;

procedure TMtSendSMGPThreadObj.ThAddMsgToMemo;
begin
  if MainForm <> nil then
  begin
    MainForm.ShowToMemo(ErrMsg, MainForm.MonitorMemo);
  end;
end;

{SMGP TOutReadSmgpThreadObj }
procedure TOutReadSMGPThreadObj.AddMsgToMemo(const Msg: string);
begin
  ErrMsg := Msg;
  Synchronize(ThAddMsgToMemo);
end;

procedure TOutReadSMGPThreadObj.ClientRead;
begin
  try
    try
      FTCPClient.CheckForGracefulDisconnect();
    except
      on e: exception do
      begin
        AddMsgToMemo('TOutReadSmgpThreadObj' + e.Message);
        sleep(1000);
      end;
    end;

    if FTCPClient.Connected then
    begin
      if FRecBuffer.BufferSize = 0 then
      begin
        //初始化结构体,用来分别存放网络数据包和本地数据包
        ZeroMemory(@FlocPacketIn, sizeof(TSMGP13_PACKET));
        ZeroMemory(@FnetPacketIn, sizeof(TSMGP13_PACKET));

        //这里阻塞读取数据包头
        FTCPClient.ReadBuffer(FRecBuffer.Buffer, sizeof(TSMGP13_HEAD));
        FRecBuffer.BufferSize := sizeof(TSMGP13_HEAD);

        //将读到的包头数据复制到网络结构体中
        Move(FRecBuffer.Buffer, FnetPacketIn.MsgHead, sizeof(TSMGP13_HEAD));
        //经网络字节序转换后,将网络结构体包头复制到本地结构体中
        FlocPacketIn.MsgHead.PacketLength := ntohl(FnetPacketIn.MsgHead.PacketLength);
        FlocPacketIn.MsgHead.RequestID := ntohl(FnetPacketIn.MsgHead.RequestID);
        FlocPacketIn.MsgHead.SequenceID := ntohl(FnetPacketIn.MsgHead.SequenceID);
      end;

      case FlocPacketIn.MsgHead.RequestID of
        SMGP13_LOGIN_RESP:
          begin
            //登录应答包,读取对应的长度,并复制到网络结构体和本地结构体中
            FTCPClient.ReadBuffer(FRecBuffer.Buffer[FRecBuffer.BufferSize], sizeof(TSMGP13_LOGIN_RESP));
            FRecBuffer.BufferSize := FRecBuffer.BufferSize + sizeof(TSMGP13_LOGIN_RESP);
            Move(FRecBuffer.Buffer, FnetPacketIn, FRecBuffer.BufferSize);
            FlocPacketIn.MsgBody.LOGIN_RESP := FnetPacketIn.MsgBody.LOGIN_RESP;
            FlocPacketIn.MsgBody.LOGIN_RESP.Status := ntohl(FnetPacketIn.MsgBody.LOGIN_RESP.Status);
          end;

        SMGP13_SUBMIT_RESP:
          begin
            //下行应答包,读取对应的长度,并复制到网络结构体和本地结构体中
            FTCPClient.ReadBuffer(FRecBuffer.Buffer[FRecBuffer.BufferSize], sizeof(TSMGP13_SUBMIT_RESP));
            FRecBuffer.BufferSize := FRecBuffer.BufferSize + sizeof(TSMGP13_SUBMIT_RESP);
            Move(FRecBuffer.Buffer, FnetPacketIn, FRecBuffer.BufferSize);
            FlocPacketIn.MsgBody.SUBMIT_RESP := FnetPacketIn.MsgBody.SUBMIT_RESP;
            FlocPacketIn.MsgBody.SUBMIT_RESP.Status := ntohl(FnetPacketIn.MsgBody.SUBMIT_RESP.Status);
          end;

        SMGP13_DELIVER:
          begin
            FTCPClient.ReadBuffer(FRecBuffer.Buffer[FRecBuffer.BufferSize], FlocPacketIn.MsgHead.PacketLength - FRecBuffer.BufferSize);
            FRecBuffer.BufferSize := FlocPacketIn.MsgHead.PacketLength;
            Move(FRecBuffer.Buffer, FnetPacketIn, FRecBuffer.BufferSize);
            FnetPacketIn.MsgBody.DELIVER.MsgLength := FlocPacketIn.MsgHead.PacketLength - sizeof(TSMGP13_HEAD) - 77;
            FlocPacketIn.MsgBody.DELIVER := FnetPacketIn.MsgBody.DELIVER;

            ZeroMemory(@FlocPacketIn.MsgBody.DELIVER.MsgContent, sizeof(FlocPacketIn.MsgBody.DELIVER.MsgContent));
            ZeroMemory(@FlocPacketIn.MsgBody.DELIVER.Reserve, sizeof(FlocPacketIn.MsgBody.DELIVER.Reserve));

            Move(FnetPacketIn.MsgBody.DELIVER.MsgContent, FlocPacketIn.MsgBody.DELIVER.MsgContent, FlocPacketIn.MsgBody.DELIVER.MsgLength);
            Move(FnetPacketIn.MsgBody.DELIVER.MsgContent[FlocPacketIn.MsgBody.DELIVER.MsgLength], FlocPacketIn.MsgBody.DELIVER.Reserve, sizeof(FlocPacketIn.MsgBody.DELIVER.Reserve));

            FnetPacketIn.MsgBody := FlocPacketIn.MsgBody;
          end;

        SMGP13_ACTIVE_TEST:
          begin
          end;

        SMGP13_ACTIVE_TEST_RESP:
          begin
          end;
      else
        begin
          FTCPClient.Disconnect;
        end;
      end;

      if MainForm.OutMonitor.Checked then
      begin
        MonitorThread.OutMonitorBuffer.Add(FlocPacketIn);
      end;

      case FlocPacketIn.MsgHead.RequestID of
        SMGP13_LOGIN_RESP:
          begin
            if FlocPacketIn.MsgBody.LOGIN_RESP.Status = 0 then
            begin
              FLogined := True;
              AddMsgToMemo('SMGP外部网关登录成功');
            end
            else
            begin
              FLogined := false;
              AddMsgToMemo('SMGP外部网关登录失败');
            end;
          end;

        SMGP13_SUBMIT_RESP:
          begin
            mtbuffer.UpdateResp(FlocPacketIn.MsgHead.SequenceID, FlocPacketIn.MsgBody.SUBMIT_RESP.MsgID, FlocPacketIn.MsgBody.SUBMIT_RESP.Status);
            inc(FMtRespCount);
            WindowSize := WindowSize - 1;
            if WindowSize < 0 then WindowSize := 0;
          end;

        SMGP13_DELIVER: //mo上行过来的写入缓冲
          begin
            //写入缓冲,或是状态报告
            if FlocPacketIn.MsgBody.DELIVER.IsReport = 1 then
            begin
              //状态报告,写入状态报告缓冲中
              rptbuffer.Add(FlocPacketIn);
              inc(FRptCount);
            end
            else
            begin
              //MO,将Mo写入Mo缓冲中
              mobuffer.Add(FlocPacketIn);
              inc(FMoCount);
            end;
            //应答
            SendPacket(CreateRespPacket(FlocPacketIn));
          end;

        SMGP13_ACTIVE_TEST:
          begin
            WindowSize := 0;
            SendPacket(CreateRespPacket(FlocPacketIn));
          end;

        SMGP13_ACTIVE_TEST_RESP:
          begin
            WindowSize := 0;
          end;
      end;

      FRecBuffer.BufferSize := 0;
      ZeroMemory(@FRecBuffer.Buffer, sizeof(FRecBuffer.Buffer));
    end;
  except
    on e: exception do
    begin
      AddMsgToMemo('SMGP外部网关接收线程:' + e.Message);
      sleep(1000);
      FTCPClient.Disconnect;
    end;
  end;
end;

constructor TOutReadSMGPThreadObj.Create(CreateSuspended: boolean);
begin
  inherited;
  ZeroMemory(@FRecBuffer.Buffer, sizeof(FRecBuffer.Buffer));
  FRecBuffer.BufferSize := 0;
  ZeroMemory(@FlocPacketIn, sizeof(TSMGP13_PACKET));
  ZeroMemory(@FnetPacketIn, sizeof(TSMGP13_PACKET));
  FLogined := false;
  FMoCount := 0;
  FMtCount := 0;
  FRptCount := 0;
  FMtRespCount := 0;
  FMtRefuseCount := 0;
  Seqid := 1;
  WindowSize := 0;
  FLastActiveTime := now;
  MtHasUnsendMessage := false;
  MtMessage := '';
  MtNumber := '';
  MtUnsend := 100;
end;

function TOutReadSMGPThreadObj.CreatePacket(
  const RequestID: Cardinal): TSMGP13_PACKET;
var
  pac: TSMGP13_PACKET;
  Time: string;
  strTemp: string;
  tempArray: array[0..255] of char;
  tempbArray: array[0..255] of byte;
  md5: TMD5;
begin
  ZeroMemory(@pac, sizeof(TSMGP13_PACKET));
  pac.MsgHead.RequestID := RequestID;

  case RequestID of
    SMGP13_LOGIN:
      begin
        pac.MsgHead.PacketLength := sizeof(TSMGP13_HEAD) + sizeof(TSMGP13_LOGIN);
        pac.MsgHead.SequenceID := GetSeqid;

        with pac.MsgBody.LOGIN do
        begin
          SetPchar(ClientID, GGATECONFIG.ClientID, sizeof(ClientID));
          LoginMode := 2;
          Time := FormatDatetime('MMDDHHNNSS', now);
          TimeStamp := strtoint(Time);
          Version := SMGP13_VERSION;

          strTemp := GGATECONFIG.ClientID + #0#0#0#0#0#0#0 + GGATECONFIG.ClientSecret + Time;
          SetPchar(tempArray, strTemp, sizeof(tempArray));
          Move(tempArray, tempbArray, sizeof(tempbArray));

          md5 := TMD5.Create(nil);
          try
            md5.InputType := SourceByteArray;
            md5.InputLength := 17 + length(GGATECONFIG.ClientID) + length(GGATECONFIG.ClientSecret);
            md5.pInputArray := @tempbArray;
            md5.pOutputArray := @AuthenticatorClient;
            md5.MD5_Hash;
          finally
            md5.Free;
          end;
        end;
      end;

    SMGP13_SUBMIT:
      begin
        pac.MsgBody.SUBMIT.NeedReport := 1;
        pac.MsgBody.SUBMIT.Priority := 0;
        pac.MsgBody.SUBMIT.DestTermIDCount := 1;
      end;

    SMGP13_ACTIVE_TEST:
      begin
        pac.MsgHead.PacketLength := sizeof(TSMGP13_HEAD);
        pac.MsgHead.SequenceID := GetSeqid;
      end;
  end;
  result := pac;
end;

function TOutReadSMGPThreadObj.CreateRespPacket(
  const recpac: TSMGP13_PACKET): TSMGP13_PACKET;
var
  pac: TSMGP13_PACKET;
begin
  ZeroMemory(@pac, sizeof(TSMGP13_PACKET));

  case recpac.MsgHead.RequestID of
    SMGP13_DELIVER:
      begin
        pac.MsgHead.RequestID := SMGP13_DELIVER_RESP;
        pac.MsgHead.PacketLength := sizeof(TSMGP13_HEAD) + sizeof(TSMGP13_DELIVER_RESP);
        pac.MsgHead.SequenceID := recpac.MsgHead.SequenceID;
        Move(recpac.MsgBody.DELIVER_RESP.MsgID, pac.MsgBody.DELIVER_RESP.MsgID, sizeof(pac.MsgBody.DELIVER_RESP.MsgID));
        pac.MsgBody.DELIVER_RESP.Status := 0;
      end;

    SMGP13_ACTIVE_TEST:
      begin
        pac.MsgHead.PacketLength := sizeof(TSMGP13_HEAD);
        pac.MsgHead.RequestID := SMGP13_ACTIVE_TEST_RESP;
        pac.MsgHead.SequenceID := recpac.MsgHead.SequenceID;
      end;
  end;
  result := pac;
end;

destructor TOutReadSMGPThreadObj.destroy;
begin
  FTCPClient := nil;
  inherited;
end;

procedure TOutReadSMGPThreadObj.Execute;
begin
  FreeOnTerminate := True;
  while not Terminated do
  begin
    try
      ClientRead;
      FLastActiveTime := now(); //如果最后活动时间和现在超过2分钟,发送活动测试包
    finally
      sleep(0);
    end;
  end;
end;

function TOutReadSMGPThreadObj.GetSeqid: Cardinal;
begin
  result := Seqid;
  inc(Seqid);
  if Seqid >= 4294967295 then
  begin
    Seqid := 1;
  end;
end;

// 实际的发送信息到终端的处理过程
procedure TOutReadSMGPThreadObj.PrcMt;
var
  MtSeqId: integer;
begin
  if FTCPClient.Connected then
  begin
    if FLogined then
    begin
      if now - FLastActiveTime > 30 / 3600 / 24 then
      begin
        if now - FLastActiveTime > 90 / 3600 / 24 then
        begin
          FTCPClient.Disconnect;
        end
        else
        begin
          if now - LastSendActiveTime > 10 / 3600 / 24 then
          begin
            //发送活动测试包
            SendPacket(CreatePacket(SMGP13_ACTIVE_TEST));
            //更新最后发送活动测试包时间
            LastSendActiveTime := now();
          end;
        end;
      end
      else
      begin
        // 发送消息(1)
        MtSeqId := mtbuffer.Get;
        if MtSeqId > 0 then
        begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -