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

📄 buffer.pas

📁 操作数据库的例子
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    s := s + '0' + inttostr(i)
  else
    s := s + '00' + inttostr(i);

  HexToChar(s, InMsgId);
end;

function TMoBufferObj.GetSeqid: Cardinal;
begin
  //1-999
  result := Seqid;
  inc(Seqid);
  if Seqid >= 1000 then
  begin
    Seqid := 1;
  end;
end;

procedure TMoBufferObj.Update(i: integer);
begin
  if (i <= high(Buffers)) and (i >= 1) then
  begin
    lock;
    try
      inc(Buffers[i].PrcTimes);
      Buffers[i].LastPrcTime := now;
    finally
      unlock;
    end;
  end;
end;

procedure TMoBufferObj.UpdateResp(i: integer);
begin
  if (i <= high(Buffers)) and (i >= 1) then
  begin
    lock;
    try
      Buffers[i].Prced := 1;
    finally
      unlock;
    end;
    LogBuffers.Add(Buffers[i]);
    Delete(i);
  end;
end;
{ TMtLogBufferObj }

function TMtLogBufferObj.Add(Buffer: TMtBuffer): boolean;
var
  i: integer;
begin
  result := false;

  for i := WriteCursor to high(Buffers) do
  begin
    if Buffers[i].IsUsed = 0 then
    begin
      lock;
      try
        ZeroMemory(@Buffers[i], sizeof(TMtBuffer));
        Buffers[i] := Buffer;
        Buffers[i].IsUsed := 1;
      finally
        unlock;
      end;

      WriteCursor := i + 1;
      if WriteCursor > high(Buffers) then WriteCursor := 1;
      HaveBuffer := True;
      result := True;
      break;
    end;
  end;

  if result = false then
  begin
    for i := 1 to high(Buffers) do
    begin
      if Buffers[i].IsUsed = 0 then
      begin
        lock;
        try
          ZeroMemory(@Buffers[i], sizeof(TMtBuffer));
          Buffers[i] := Buffer;
          Buffers[i].IsUsed := 1;
        finally
          unlock;
        end;

        WriteCursor := i + 1;
        if WriteCursor > high(Buffers) then WriteCursor := 1;
        HaveBuffer := True;
        result := True;
        break;
      end;
    end;
  end;

  if result = false then
  begin
    lock;
    try
      setlength(Buffers, high(Buffers) + 1 + 1000); //加大缓冲
    finally
      unlock;
    end;

    WriteCursor := high(Buffers) + 1; //往前挪一位
    result := Add(Buffer);
  end;
end;

procedure TMtLogBufferObj.BakBuffer;
begin
  SaveToFile('MtLogBuffers.bin', sizeof(TMtBuffer));
end;

constructor TMtLogBufferObj.Create;
begin
  inherited;
  LoadFromFile('MtLogBuffers.bin', sizeof(TMtBuffer));
end;

destructor TMtLogBufferObj.destroy;
begin
  SaveToFile('MtLogBuffers.bin', sizeof(TMtBuffer));
  inherited;
end;

function TMtLogBufferObj.Get: integer;
var
  i: integer;
begin
  if HaveBuffer = false then
  begin
    result := 0;
  end
  else
  begin
    result := 0;

    for i := ReadCursor to high(Buffers) do
    begin
      if Buffers[i].IsUsed = 1 then
      begin
        result := i;
        ReadCursor := i + 1;
        if ReadCursor > high(Buffers) then ReadCursor := 1;
        break;
      end;
    end;

    if result = 0 then
    begin
      for i := 1 to high(Buffers) do
      begin
        if Buffers[i].IsUsed = 1 then
        begin
          result := i;
          ReadCursor := i + 1;
          if ReadCursor > high(Buffers) then ReadCursor := 1;
          break;
        end;
      end;
    end;
  end;
end;
{ TMtBufferObj }

function TMtBufferObj.Add(pac: TSPPO_PACKET): boolean;
var
  i: integer;
begin
  result := false;
  for i := WriteCursor to high(Buffers) do
  begin
    if Buffers[i].IsUsed = 0 then
    begin
      lock;
      try
        ZeroMemory(@Buffers[i], sizeof(TMtBuffer));
        Buffers[i].Mt := pac.Body.Mt;
        if Buffers[i].Mt.MtFeeAddr = '' then Buffers[i].Mt.MtFeeAddr := pac.Body.Mt.MtUserAddr;
        Buffers[i].RecTime := now;
        Buffers[i].IsUsed := 1;
      finally
        unlock;
      end;

      WriteCursor := i + 1;
      if WriteCursor > high(Buffers) then WriteCursor := 1;
      HaveBuffer := True;
      HavePrePrcBuffer := True;
      MoHaveBuffer := True;
      result := True;
      break;
    end;
  end;

  if result = false then
  begin
    for i := 1 to high(Buffers) do
    begin
      if Buffers[i].IsUsed = 0 then
      begin
        lock;
        try
          ZeroMemory(@Buffers[i], sizeof(TMtBuffer));
          Buffers[i].Mt := pac.Body.Mt;
          if Buffers[i].Mt.MtFeeAddr = '' then Buffers[i].Mt.MtFeeAddr := pac.Body.Mt.MtUserAddr;
          Buffers[i].RecTime := now;
          Buffers[i].IsUsed := 1;
        finally
          unlock;
        end;

        WriteCursor := i + 1;
        if WriteCursor > high(Buffers) then WriteCursor := 1;
        HaveBuffer := True;
        HavePrePrcBuffer := True;
        MoHaveBuffer := True;
        result := True;
        break;
      end;
    end;
  end;

  if result = false then
  begin
    lock;
    try
      setlength(Buffers, high(Buffers) + 1 + 1000); //加大缓冲
    finally
      unlock;
    end;

    WriteCursor := high(Buffers) + 1; //往前挪一位
    result := Add(pac);
  end;
end;

procedure TMtBufferObj.BakBuffer;
begin
  SaveToFile('MtBuffers.bin', sizeof(TMtBuffer));
  LogBuffers.BakBuffer;
end;

constructor TMtBufferObj.Create;
begin
  inherited;
  HavePrePrcBuffer := True;
  MoHaveBuffer := True;
  PrePrcCursor := 1;
  MoReadCursor := 1;
  LogBuffers := TMtLogBufferObj.Create;
  LoadFromFile('MtBuffers.bin', sizeof(TMtBuffer));
end;

procedure TMtBufferObj.DelExpired;
var
  i: integer;
begin
  for i := 1 to high(Buffers) do
  begin
    if Buffers[i].IsUsed = 1 then
    begin
      if (Buffers[i].PrcTimes >= 1) and (now() - Buffers[i].LastPrcTime > 10 / 60 / 24) then
      begin
        //处理次数达到1次或以上,且最后发送后,10分钟都没应答
        LogBuffers.Add(Buffers[i]);
        Delete(i);
      end;
    end;
  end;
end;

destructor TMtBufferObj.destroy;
begin
  SaveToFile('MtBuffers.bin', sizeof(TMtBuffer));
  freeandnil(LogBuffers);
  inherited;
end;

function TMtBufferObj.Get: integer;
var
  i: integer;
begin
  if HaveBuffer = false then
  begin
    result := 0;
  end
  else
  begin
    result := 0;

    //优先发送内部MsgType为2345的消息
    if MoHaveBuffer then
    begin
      for i := MoReadCursor to high(Buffers) do
      begin
        if (Buffers[i].IsUsed = 1) and (Buffers[i].preprced = 1) and (Buffers[i].PrePrcResult = 0) and (Buffers[i].Prced = 0) and (Buffers[i].PrcTimes = 0) then
        begin
          if Buffers[i].Mt.MtMsgType in [2, 3, 4, 5] then
          begin
            result := i;
            MoReadCursor := i + 1;
            if MoReadCursor > high(Buffers) then MoReadCursor := 1;
            break;
          end;
        end;
      end;

      if result = 0 then
      begin
        for i := 1 to high(Buffers) do
        begin
          if (Buffers[i].IsUsed = 1) and (Buffers[i].preprced = 1) and (Buffers[i].PrePrcResult = 0) and (Buffers[i].Prced = 0) and (Buffers[i].PrcTimes = 0) then
          begin
            if Buffers[i].Mt.MtMsgType in [2, 3, 4, 5] then
            begin
              result := i;
              MoReadCursor := i + 1;
              if MoReadCursor > high(Buffers) then MoReadCursor := 1;
              break;
            end;
          end;
        end;

        if result = 0 then
        begin
          MoHaveBuffer := false;
        end;
      end;
    end;

    //如果没找到MO引起mt的消息,才开始发非mo引起的mt消息
    if result = 0 then
    begin
      for i := ReadCursor to high(Buffers) do
      begin
        if (Buffers[i].IsUsed = 1) and (Buffers[i].Prced = 0) and (Buffers[i].preprced = 1) and (Buffers[i].PrePrcResult = 0) then
        begin
          if Buffers[i].PrcTimes = 0 then
          begin
            result := i;
            ReadCursor := i + 1;
            if ReadCursor > high(Buffers) then ReadCursor := 1;
            break;
          end;
        end;
      end;

      if result = 0 then
      begin
        for i := 1 to high(Buffers) do
        begin
          if (Buffers[i].IsUsed = 1) and (Buffers[i].Prced = 0) and (Buffers[i].preprced = 1) and (Buffers[i].PrePrcResult = 0) then
          begin
            if Buffers[i].PrcTimes = 0 then
            begin
              result := i;
              ReadCursor := i + 1;
              if ReadCursor > high(Buffers) then ReadCursor := 1;
              break;
            end;
          end;
        end;
      end;
    end;

  end;
end;

function TMtBufferObj.GetPrePrc: integer;
var
  i: integer;
begin
  if HavePrePrcBuffer = false then
  begin
    result := 0;
  end
  else
  begin
    result := 0;
    for i := PrePrcCursor to high(Buffers) do
    begin
      if (Buffers[i].IsUsed = 1) and (Buffers[i].preprced = 0) then
      begin
        result := i;
        PrePrcCursor := i + 1;
        if PrePrcCursor > high(Buffers) then PrePrcCursor := 1;
        break;
      end;
    end;

    if result = 0 then
    begin
      for i := 1 to high(Buffers) do
      begin
        if (Buffers[i].IsUsed = 1) and (Buffers[i].preprced = 0) then
        begin
          result := i;
          PrePrcCursor := i + 1;
          if PrePrcCursor > high(Buffers) then PrePrcCursor := 1;
          break;
        end;
      end;
    end;

    if result = 0 then
    begin
      HavePrePrcBuffer := false;
    end;
  end;
end;

procedure TMtBufferObj.Update(i: integer);
begin
  if (i <= high(Buffers)) and (i >= 1) then
  begin
    lock;
    try
      inc(Buffers[i].PrcTimes);
      Buffers[i].LastPrcTime := now;
    finally
      unlock;
    end;
  end;
end;

procedure TMtBufferObj.UpdateFailPrePrced(i, result: integer);
begin
  if (i <= high(Buffers)) and (i >= 1) then
  begin
    lock;
    try
      Buffers[i].Status := 1;
      Buffers[i].PrePrcResult := result;
      Buffers[i].preprced := 1;
    finally
      unlock;
    end;
    LogBuffers.Add(Buffers[i]);
    Delete(i);
  end;
end;

procedure TMtBufferObj.UpdatePrePrced(i: integer; ServiceID: integer);
begin
  if (i <= high(Buffers)) and (i >= 1) then
  begin
    lock;
    try
      Buffers[i].OutMsgType := Protocol[ServiceID].GateMsgType;
      Move(Protocol[ServiceID].GateCode, Buffers[i].OutServiceID, sizeof(Buffers[i].OutServiceID));
      Move(Protocol[ServiceID].GateFeeType, Buffers[i].OutFeeType, sizeof(Buffers[i].OutFeeType));
      Move(Protocol[ServiceID].GateFixFee, Buffers[i].OutFixedFee, sizeof(Buffers[i].OutFixedFee));
      Move(Protocol[ServiceID].gatefeecode, Buffers[i].OutFeeCode, sizeof(Buffers[i].OutFeeCode));
      Buffers[i].RealFeeCode := Protocol[ServiceID].RealFeeCode;
      Buffers[i].PrePrcResult := 0;
      Buffers[i].preprced := 1;
    finally
      unlock;
    end;
  end;
end;

procedure TMtBufferObj.UpdateResp(i: integer; MtOutMsgId: array of char;
  Status: Cardinal);
begin
  lock;
  try
    Buffers[i].Prced := 1;
    Buffers[i].Status := Status;
    Move(MtOutMsgId, Buffers[i].OutMtMsgid, sizeof(Buffers[i].OutMtMsgid));
  finally
    unlock;
  end;

  LogBuffers.Add(Buffers[i]);
  Delete(i);
end;

{ TOutMonitorBufferObj }

function TMonitorOutBufferObj.Add(pac: TSMGP13_PACKET): boolean;
var
  i: integer;
begin
  result := false;
  for i := WriteCursor to high(Buffers) do
  begin
    if Buffers[i].IsUsed = 0 then
    begin
      lock;
      try
        ZeroMemory(@Buffers[i], sizeof(TOutMonitorBuffer));
        Buffers[i].pac := pac;
        Buffers[i].IsUsed := 1;
      finally
        unlock;
      end;

      HaveBuffer := True;
      WriteCursor := i + 1; //往前挪一位
      if WriteCursor > high(Buffers) then WriteCursor := 0; //回到缓冲队列的头部
      result := True;
      break;
    end;
  end;

  if result = false then
  begin
    for i := 0 to high(Buffers) do
    begin
      if Buffers[i].IsUsed = 0 then
      begin
        lock;
        try
          ZeroMemory(@Buffers[i], sizeof(TOutMonitorBuffer));
          Buffers[i].pac := pac;
          Buffers[i].IsUsed := 1;
        finally
          unlock;
        end;

        HaveBuffer := True;
        WriteCursor := i + 1; //往前挪一位
        if WriteCursor > high(Buffers) then WriteCursor := 0; //回到缓冲队列的头部
        result := True;
        break;
      end;
    end;
  end;

  if result = false then
  begin
    lock;
    try
      setlength(Buffers, high(Buffers) + 1 + 100); //加大缓冲
    finally
      unlock;
    end;

    WriteCursor := high(Buffers) + 1; //往前挪一位
    result := Add(pac);
  end;
end;

constructor TMonitorOutBufferObj.Create;
begin
  inherited;
  setlength(Buffers, 100);
  //监控缓冲有用到0数组
  WriteCursor := 0;
  ReadCursor := 0;
end;

procedure TMonitorOutBufferObj.Delete(i: integer);
begin
  if (i <= high(Buffers)) and (i >= 0) then

⌨️ 快捷键说明

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