📄 buffer.pas
字号:
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 + -