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

📄 buffer.pas

📁 操作数据库的例子
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  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 TBaseMtBufferObj.Create;
begin
  inherited;
  setlength(Buffers, 1000);
end;

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

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

procedure TBaseMtBufferObj.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 TBaseMtBufferObj.Read(i: integer): TMtBuffer;
begin
  result := Buffers[i];
end;

procedure TBaseMtBufferObj.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;

//基本
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


//SMGP   电信
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
{ TBaseMoBufferObj }
function TBaseMoBufferObj.BufferSize: integer;
begin
  result := high(Buffers);
end;

function TBaseMoBufferObj.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函数获得锁以后,其他线程将不能再获得这个锁,直到当前线程释放这个锁
        lock;
        try
          setlength(Buffers, 1000);
        finally
          unlock;
        end;
      end;
    end;
  end;
end;

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

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

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

procedure TBaseMoBufferObj.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 TBaseMoBufferObj.Read(i: integer): TMoBuffer;
begin
  result := Buffers[i];
end;

procedure TBaseMoBufferObj.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;
{ TMoLogBufferObj }

function TMoLogBufferObj.Add(Buffer: TMoBuffer): 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(TMoBuffer));
        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(TMoBuffer));
          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 TMoLogBufferObj.BakBuffer;
begin
  SaveToFile('MoLogBuffers.bin', sizeof(TMoBuffer));
end;

constructor TMoLogBufferObj.Create;
begin
  inherited;
  LoadFromFile('MoLogBuffers.bin', sizeof(TMoBuffer));
end;

destructor TMoLogBufferObj.destroy;
begin
  SaveToFile('MoLogBuffers.bin', sizeof(TMoBuffer));
  inherited;
end;

function TMoLogBufferObj.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;
{ TMoBufferObj }

function TMoBufferObj.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(TMoBuffer));
        Buffers[i].mo := pac.MsgBody.DELIVER;
        GetMsgId(Buffers[i].MoInMsgId);
        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(TMoBuffer));
          Buffers[i].mo := pac.MsgBody.DELIVER;
          GetMsgId(Buffers[i].MoInMsgId);
          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 TMoBufferObj.BakBuffer;
begin
  SaveToFile('MoBuffers.bin', sizeof(TMoBuffer));
  LogBuffers.BakBuffer;
end;

constructor TMoBufferObj.Create;
begin
  inherited;
  Seqid := 1;
  LogBuffers := TMoLogBufferObj.Create;
  LoadFromFile('MoBuffers.bin', sizeof(TMoBuffer));
end;

procedure TMoBufferObj.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 TMoBufferObj.destroy;
begin
  SaveToFile('MoBuffers.bin', sizeof(TMoBuffer));
  freeandnil(LogBuffers);
  inherited;
end;

function TMoBufferObj.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) and (Buffers[i].Prced = 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) 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;

procedure TMoBufferObj.GetMsgId(var InMsgId: array of char);
var
  s: string;
  i: integer;
begin
  //GateId是以1开头的1XXX的四位数字,1说明是通信网关
  s := copy(inttostr(GSMSCENTERCONFIG.GateId), 2, 3);
  if length(s) = 1 then s := '00' + s;
  if length(s) = 2 then s := '0' + s;

  s := s + FormatDatetime('yyyymmddhhnnss', now);
  i := GetSeqid;

  if i >= 100 then
    s := s + inttostr(i)
  else if i >= 10 then

⌨️ 快捷键说明

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