buffer.pas

操作数据库的例子

  begin
    lock;
    try
      Buffers[i].IsUsed := 0;
    finally
      unlock;
    end;
  end;
end;

destructor TMonitorOutBufferObj.destroy;
begin
  Buffers := nil;
  inherited;
end;

{ TBaseRptBufferObj }

function TBaseRptBufferObj.BufferSize: integer;
begin
  result := high(Buffers);
end;

function TBaseRptBufferObj.Count: integer;
var
  i: integer;
begin
  if HaveBuffer = false then
  begin
    result := 0;
  end
  else
  begin
    result := 0;
    for i := 1 to high(Buffers) do
    begin
      if Buffers[i].IsUsed = 1 then
      begin
        inc(result);
      end;
    end;

    if result = 0 then
    begin
      HaveBuffer := false;

      if high(Buffers) > 999 then
      begin
        lock;
        try
          setlength(Buffers, 1000);
        finally
          unlock;
        end;
      end;
    end;
  end;
end;

constructor TBaseRptBufferObj.Create;
begin
  inherited;
  setlength(Buffers, 1000);
end;

procedure TBaseRptBufferObj.Delete(i: integer);
begin
  lock;
  try
    if (i <= high(Buffers)) and (i >= 1) then
    begin
      Buffers[i].IsUsed := 0;
    end;
  finally
    unlock;
  end;
end;

destructor TBaseRptBufferObj.destroy;
begin
  Buffers := nil;
  inherited;
end;

procedure TBaseRptBufferObj.LoadFromFile(FileName: string;
  BlockSize: integer);
var
  Filestream: Tfilestream;
  i: integer;
begin
  if FileExists(FileName) then
  begin
    Filestream := Tfilestream.Create(FileName, fmOpenRead);
    try
      try
        i := Filestream.Size div BlockSize;

        if i > high(Buffers) then
        begin
          setlength(Buffers, i + 1);
        end;

        for i := 1 to high(Buffers) do
        begin
          if Filestream.Position < Filestream.Size then
          begin
            Filestream.ReadBuffer(Buffers[i], BlockSize);
          end
          else
          begin
            break;
          end;
        end;
      except
        on e: exception do
        begin
          for i := 1 to high(Buffers) do
          begin
            ZeroMemory(@Buffers[i], BlockSize);
          end;
        end;
      end;
    finally
      Filestream.Free;
    end;
  end;
end;

function TBaseRptBufferObj.Read(i: integer): TRptBuffer;
begin
  result := Buffers[i];
end;

procedure TBaseRptBufferObj.SaveToFile(FileName: string;
  BlockSize: integer);
var
  Filestream: Tfilestream;
  i: integer;
begin
  Filestream := Tfilestream.Create(FileName, fmCreate);
  try
    for i := 1 to high(Buffers) do
    begin
      if Buffers[i].IsUsed = 1 then
      begin
        Filestream.WriteBuffer(Buffers[i], BlockSize);
      end;
    end;
  finally
    Filestream.Free;
  end;
end;
{ TRptBufferObj }

function TRptBufferObj.Add(Buffer: TRptBuffer): 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(TRptBuffer));
        Buffers[i] := Buffer;
        Buffers[i].Prced := 0;
        Buffers[i].PrcTimes := 0;
        Buffers[i].LastPrcTime := 0;
        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(TRptBuffer));
          Buffers[i] := Buffer;
          Buffers[i].Prced := 0;
          Buffers[i].PrcTimes := 0;
          Buffers[i].LastPrcTime := 0;
          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 := WriteCursor + 1;
    result := Add(Buffer);
  end;
end;

procedure TRptBufferObj.BakBuffer;
begin
  SaveToFile('RptBuffers.bin', sizeof(TRptBuffer));
end;

constructor TRptBufferObj.Create;
begin
  inherited;
  LoadFromFile('RptBuffers.bin', sizeof(TRptBuffer));
end;

destructor TRptBufferObj.destroy;
begin
  SaveToFile('RptBuffers.bin', sizeof(TRptBuffer));
  inherited;
end;

function TRptBufferObj.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
        if Buffers[i].Prced = 0 then
        begin
          if Buffers[i].PrcTimes = 0 then
          begin
            result := i;
            ReadCursor := ReadCursor + 1;
            if ReadCursor > high(Buffers) then ReadCursor := 1;
            break;
          end
          else
          begin
            if now - Buffers[i].LastPrcTime > 30 / 3600 / 24 then
            begin
              result := i;
              ReadCursor := i + 1;
              if ReadCursor > high(Buffers) then ReadCursor := 1;
              break;
            end;
          end;
        end;
      end;
    end;

    if result = 0 then
    begin
      for i := 1 to high(Buffers) do
      begin
        if Buffers[i].IsUsed = 1 then
        begin
          if Buffers[i].Prced = 0 then
          begin
            if Buffers[i].PrcTimes = 0 then
            begin
              result := i;
              ReadCursor := ReadCursor + 1;
              if ReadCursor > high(Buffers) then ReadCursor := 1;
              break;
            end
            else
            begin
              if now - Buffers[i].LastPrcTime > 30 / 3600 / 24 then
              begin
                result := i;
                ReadCursor := i + 1;
                if ReadCursor > high(Buffers) then ReadCursor := 1;
                break;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

procedure TRptBufferObj.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 TRptBufferObj.UpdateResp(i: integer);
begin
  //消息中心应答回来
  if (i <= high(Buffers)) and (i >= 1) then
  begin
    lock;
    try
      Buffers[i].Prced := 1;
    finally
      unlock;
    end;

    Delete(i);
  end;
end;
{ TRptLogBufferObj }

function TRptLogBufferObj.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(TRptBuffer));
        Buffers[i].Rpt := pac.MsgBody.DELIVER;
        Buffers[i].RecTime := now;
        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(TRptBuffer));
          Buffers[i].Rpt := pac.MsgBody.DELIVER;
          Buffers[i].RecTime := now;
          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(pac);
  end;
end;

procedure TRptLogBufferObj.BakBuffer;
begin
  SaveToFile('RptLogBuffers.bin', sizeof(TRptBuffer));
  SendBuffers.BakBuffer;
end;

constructor TRptLogBufferObj.Create;
begin
  inherited;
  SendBuffers := TRptBufferObj.Create;
  LoadFromFile('RptLogBuffers.bin', sizeof(TRptBuffer));
end;

procedure TRptLogBufferObj.DelExpired;
var
  i: integer;
begin
  for i := 1 to high(Buffers) do
  begin
    if Buffers[i].IsUsed = 1 then
    begin
      if (Buffers[i].PrcTimes >= 10) then
      begin
        Delete(i);
      end;
    end;
  end;
end;

destructor TRptLogBufferObj.destroy;
begin
  SaveToFile('RptLogBuffers.bin', sizeof(TRptBuffer));
  SendBuffers.Free;
  inherited;
end;

function TRptLogBufferObj.Get: integer;
var
  i: integer;
begin
  if HaveBuffer then
  begin
    result := 0;
    for i := ReadCursor to high(Buffers) do
    begin
      if (Buffers[i].IsUsed = 1) and (Buffers[i].Prced = 0) and (now - Buffers[i].RecTime > 10 / 3600 / 24) then
      begin
        if Buffers[i].PrcTimes = 0 then
        begin
          result := i;
          ReadCursor := i + 1;
          if ReadCursor > high(Buffers) then ReadCursor := 1;
          break;
        end
        else
        begin
          if now - Buffers[i].LastPrcTime > 30 / 3600 / 24 then
          begin
            result := i;
            ReadCursor := i + 1;
            if ReadCursor > high(Buffers) then ReadCursor := 1;
            break;
          end;
        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 (now - Buffers[i].RecTime > 10 / 3600 / 24) then
        begin
          if Buffers[i].PrcTimes = 0 then
          begin
            result := i;
            ReadCursor := i + 1;
            if ReadCursor > high(Buffers) then ReadCursor := 1;
            break;
          end
          else
          begin
            if now - Buffers[i].LastPrcTime > 30 / 3600 / 24 then
            begin
              result := i;
              ReadCursor := i + 1;
              if ReadCursor > high(Buffers) then ReadCursor := 1;
              break;
            end;
          end;
        end;
      end;
    end;
  end
  else
  begin
    result := 0;
  end;
end;

procedure TRptLogBufferObj.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 TRptLogBufferObj.UpdateMsgId(i: integer; MtInMsgId: string;
  MtLogicId: Cardinal; MtSpAddr, MtUserAddr: string);
begin
  lock;
  try
    Buffers[i].MtLogicId := MtLogicId;
    HexToChar(MtInMsgId, Buffers[i].MtInMsgId);
    SetPchar(Buffers[i].MtSpAddr, MtSpAddr, sizeof(Buffers[i].MtSpAddr));
    SetPchar(Buffers[i].MtUserAddr, MtUserAddr, sizeof(Buffers[i].MtUserAddr));
    Buffers[i].Prced := 1;
  finally
    unlock;
  end;

  if MtLogicId > 10 then
  begin
    SendBuffers.Add(Buffers[i]);
  end;

  Delete(i);
end;
//SMGP  电信
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


//CMPP  移动
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
{ TBaseMoCMPPBufferObj }

function TBaseMocmppBufferObj.BufferSize: integer;
begin
  result := high(Buffers);
end;

function TBaseMocmppBufferObj.Count: integer;