MMCL/agents/delphi_nilm_agent/UMQTTClient.pas
2026-09-04 11:24:42 +09:00

754 lines
20 KiB
ObjectPascal

unit UMQTTClient;
interface
uses
System.SysUtils, System.Classes, System.SyncObjs, System.DateUtils,
System.Generics.Collections,
IdTCPClient, IdGlobal, IdExceptionCore, IdException, IdIOHandler;
type
TMQTTMessageEvent = procedure(const ATopic, APayload: string) of object;
TMQTTStatusEvent = procedure(AConnected: Boolean; const AErrorMsg: string) of object;
TMQTTRecvThread = class;
TMQTTClient = class
private
FHost: string;
FPort: Word;
FClientID: string;
FUserName: string;
FPassword: string;
FTCPClient: TIdTCPClient;
FRecvThread: TMQTTRecvThread;
FOnMessage: TMQTTMessageEvent;
FOnStatus: TMQTTStatusEvent;
FConnected: Boolean;
FSubscribeTopics: TStringList;
FKeepAlive: Word;
FPacketID: Word;
FActive: Boolean;
FSendQueue: TList<TIdBytes>;
FSendLock: TCriticalSection;
function NextPacketID: Word;
function BuildConnectPacket: TIdBytes;
function BuildSubscribePacket(const ATopic: string): TIdBytes;
function BuildPingReqPacket: TIdBytes;
function BuildDisconnectPacket: TIdBytes;
function BuildPublishPacket(const ATopic, APayload: string): TIdBytes;
function EncodeRemainingLength(ALength: Integer): TIdBytes;
function BuildUnsubscribePacket(const ATopic: string): TIdBytes;
procedure SetConnected(AValue: Boolean; const AErrorMsg: string = '');
procedure FireMessage(const ATopic, APayload: string);
procedure EnqueuePacket(const AData: TIdBytes);
public
constructor Create(const AHost: string; APort: Word; const AClientID: string = ''; const AUserName: string = ''; const APassword: string = '');
destructor Destroy; override;
procedure Connect;
procedure Disconnect;
procedure Subscribe(const ATopic: string);
procedure Unsubscribe(const ATopic: string);
procedure Publish(const ATopic, APayload: string);
property Host: string read FHost write FHost;
property Port: Word read FPort write FPort;
property UserName: string read FUserName write FUserName;
property Password: string read FPassword write FPassword;
property Connected: Boolean read FConnected;
property OnMessage: TMQTTMessageEvent read FOnMessage write FOnMessage;
property OnStatus: TMQTTStatusEvent read FOnStatus write FOnStatus;
end;
TMQTTRecvThread = class(TThread)
private
FOwner: TMQTTClient;
function ReadRemainingLength: Integer;
procedure ProcessPublish(ARemainingLen: Integer);
function FlushSendQueue: Boolean;
protected
procedure Execute; override;
public
constructor Create(AOwner: TMQTTClient);
end;
implementation
{ TMQTTClient }
constructor TMQTTClient.Create(const AHost: string; APort: Word; const AClientID: string; const AUserName: string; const APassword: string);
begin
inherited Create;
FHost := AHost;
FPort := APort;
FUserName := AUserName;
FPassword := APassword;
Randomize;
if AClientID <> '' then
FClientID := AClientID + IntToStr(Random(99999))
else
FClientID := 'Qsentech' + IntToStr(Random(99999));
FKeepAlive := 60;
FPacketID := 0;
FConnected := False;
FActive := False;
FSubscribeTopics := TStringList.Create;
FSubscribeTopics.Sorted := True;
FSubscribeTopics.Duplicates := dupIgnore;
FSendQueue := TList<TIdBytes>.Create;
FSendLock := TCriticalSection.Create;
FTCPClient := TIdTCPClient.Create(nil);
FTCPClient.ConnectTimeout := 5000;
// ReadTimeout: 읽기 대기 시간 (500ms 폴링 주기)
FTCPClient.ReadTimeout := 500;
end;
destructor TMQTTClient.Destroy;
begin
Disconnect;
FTCPClient.Free;
FSendQueue.Free;
FSendLock.Free;
FSubscribeTopics.Free;
inherited;
end;
function TMQTTClient.NextPacketID: Word;
begin
Inc(FPacketID);
if FPacketID = 0 then
FPacketID := 1;
Result := FPacketID;
end;
function TMQTTClient.EncodeRemainingLength(ALength: Integer): TIdBytes;
var
EncodedByte: Byte;
Len: Integer;
begin
SetLength(Result, 0);
Len := ALength;
repeat
EncodedByte := Len mod 128;
Len := Len div 128;
if Len > 0 then
EncodedByte := EncodedByte or $80;
SetLength(Result, Length(Result) + 1);
Result[High(Result)] := EncodedByte;
until Len = 0;
end;
{
function TMQTTClient.BuildConnectPacket: TIdBytes;
var
VarHeader, Payload, Remaining, Packet: TIdBytes;
ClientIDBytes: TIdBytes;
RemLen: Integer;
begin
SetLength(VarHeader, 10);
VarHeader[0] := 0;
VarHeader[1] := 4;
VarHeader[2] := Ord('M');
VarHeader[3] := Ord('Q');
VarHeader[4] := Ord('T');
VarHeader[5] := Ord('T');
VarHeader[6] := 4;
VarHeader[7] := 2;
VarHeader[8] := Hi(FKeepAlive);
VarHeader[9] := Lo(FKeepAlive);
ClientIDBytes := ToBytes(FClientID, IndyTextEncoding_UTF8);
SetLength(Payload, 2 + Length(ClientIDBytes));
Payload[0] := Hi(Word(Length(ClientIDBytes)));
Payload[1] := Lo(Word(Length(ClientIDBytes)));
if Length(ClientIDBytes) > 0 then
CopyTIdBytes(ClientIDBytes, 0, Payload, 2, Length(ClientIDBytes));
RemLen := Length(VarHeader) + Length(Payload);
Remaining := EncodeRemainingLength(RemLen);
SetLength(Packet, 1 + Length(Remaining) + RemLen);
Packet[0] := $10;
CopyTIdBytes(Remaining, 0, Packet, 1, Length(Remaining));
CopyTIdBytes(VarHeader, 0, Packet, 1 + Length(Remaining), Length(VarHeader));
CopyTIdBytes(Payload, 0, Packet, 1 + Length(Remaining) + Length(VarHeader), Length(Payload));
Result := Packet;
end;
}
function TMQTTClient.BuildConnectPacket: TIdBytes;
var
VarHeader, Payload, Remaining, Packet: TIdBytes;
ClientIDBytes: TIdBytes;
UserBytes: TIdBytes;
PassBytes: TIdBytes;
RemLen: Integer;
P: Integer;
ConnectFlags: Byte;
procedure AddMQTTString(var Dest: TIdBytes; const Data: TIdBytes);
var
OldLen: Integer;
begin
OldLen := Length(Dest);
SetLength(Dest, OldLen + 2 + Length(Data));
Dest[OldLen] := Hi(Word(Length(Data)));
Dest[OldLen + 1] := Lo(Word(Length(Data)));
if Length(Data) > 0 then
CopyTIdBytes(Data, 0, Dest, OldLen + 2, Length(Data));
end;
begin
// =========================
// CONNECT FLAGS 생성
// =========================
ConnectFlags := $02; // Clean Session
if FUserName <> '' then
ConnectFlags := ConnectFlags or $80;
if FPassword <> '' then
ConnectFlags := ConnectFlags or $40;
// =========================
// Variable Header
// =========================
SetLength(VarHeader, 10);
VarHeader[0] := 0;
VarHeader[1] := 4;
VarHeader[2] := Ord('M');
VarHeader[3] := Ord('Q');
VarHeader[4] := Ord('T');
VarHeader[5] := Ord('T');
VarHeader[6] := 4; // MQTT 3.1.1
VarHeader[7] := ConnectFlags;
VarHeader[8] := Hi(FKeepAlive);
VarHeader[9] := Lo(FKeepAlive);
// =========================
// Payload
// =========================
SetLength(Payload, 0);
// Client ID
ClientIDBytes := ToBytes(FClientID, IndyTextEncoding_UTF8);
AddMQTTString(Payload, ClientIDBytes);
// Username
if FUserName <> '' then
begin
UserBytes := ToBytes(FUserName, IndyTextEncoding_UTF8);
AddMQTTString(Payload, UserBytes);
end;
// Password
if FPassword <> '' then
begin
PassBytes := ToBytes(FPassword, IndyTextEncoding_UTF8);
AddMQTTString(Payload, PassBytes);
end;
// =========================
// Remaining Length
// =========================
RemLen := Length(VarHeader) + Length(Payload);
Remaining := EncodeRemainingLength(RemLen);
// =========================
// Fixed Header
// =========================
SetLength(Packet, 1 + Length(Remaining) + RemLen);
Packet[0] := $10;
P := 1;
CopyTIdBytes(Remaining, 0, Packet, P, Length(Remaining));
Inc(P, Length(Remaining));
CopyTIdBytes(VarHeader, 0, Packet, P, Length(VarHeader));
Inc(P, Length(VarHeader));
CopyTIdBytes(Payload, 0, Packet, P, Length(Payload));
Result := Packet;
end;
function TMQTTClient.BuildSubscribePacket(const ATopic: string): TIdBytes;
var
TopicBytes, VarHeader, Payload, Remaining, Packet: TIdBytes;
PID: Word;
RemLen: Integer;
begin
PID := NextPacketID;
SetLength(VarHeader, 2);
VarHeader[0] := Hi(PID);
VarHeader[1] := Lo(PID);
TopicBytes := ToBytes(ATopic, IndyTextEncoding_UTF8);
SetLength(Payload, 2 + Length(TopicBytes) + 1);
Payload[0] := Hi(Word(Length(TopicBytes)));
Payload[1] := Lo(Word(Length(TopicBytes)));
CopyTIdBytes(TopicBytes, 0, Payload, 2, Length(TopicBytes));
Payload[2 + Length(TopicBytes)] := 0;
RemLen := Length(VarHeader) + Length(Payload);
Remaining := EncodeRemainingLength(RemLen);
SetLength(Packet, 1 + Length(Remaining) + RemLen);
Packet[0] := $82;
CopyTIdBytes(Remaining, 0, Packet, 1, Length(Remaining));
CopyTIdBytes(VarHeader, 0, Packet, 1 + Length(Remaining), Length(VarHeader));
CopyTIdBytes(Payload, 0, Packet, 1 + Length(Remaining) + Length(VarHeader), Length(Payload));
Result := Packet;
end;
function TMQTTClient.BuildUnsubscribePacket(const ATopic: string): TIdBytes;
var
TopicBytes, VarHeader, Payload, Remaining, Packet: TIdBytes;
PID: Word;
RemLen: Integer;
begin
PID := NextPacketID;
SetLength(VarHeader, 2);
VarHeader[0] := Hi(PID);
VarHeader[1] := Lo(PID);
TopicBytes := ToBytes(ATopic, IndyTextEncoding_UTF8);
SetLength(Payload, 2 + Length(TopicBytes));
Payload[0] := Hi(Word(Length(TopicBytes)));
Payload[1] := Lo(Word(Length(TopicBytes)));
CopyTIdBytes(TopicBytes, 0, Payload, 2, Length(TopicBytes));
RemLen := Length(VarHeader) + Length(Payload);
Remaining := EncodeRemainingLength(RemLen);
SetLength(Packet, 1 + Length(Remaining) + RemLen);
Packet[0] := $A2;
CopyTIdBytes(Remaining, 0, Packet, 1, Length(Remaining));
CopyTIdBytes(VarHeader, 0, Packet, 1 + Length(Remaining), Length(VarHeader));
CopyTIdBytes(Payload, 0, Packet, 1 + Length(Remaining) + Length(VarHeader), Length(Payload));
Result := Packet;
end;
function TMQTTClient.BuildPingReqPacket: TIdBytes;
begin
SetLength(Result, 2);
Result[0] := $C0;
Result[1] := $00;
end;
function TMQTTClient.BuildDisconnectPacket: TIdBytes;
begin
SetLength(Result, 2);
Result[0] := $E0;
Result[1] := $00;
end;
function TMQTTClient.BuildPublishPacket(const ATopic, APayload: string): TIdBytes;
var
TopicBytes, PayloadBytes, Remaining, Packet: TIdBytes;
RemLen, Offset: Integer;
begin
TopicBytes := ToBytes(ATopic, IndyTextEncoding_UTF8);
PayloadBytes := ToBytes(APayload, IndyTextEncoding_UTF8);
RemLen := 2 + Length(TopicBytes) + Length(PayloadBytes);
Remaining := EncodeRemainingLength(RemLen);
SetLength(Packet, 1 + Length(Remaining) + RemLen);
Packet[0] := $30;
Offset := 1;
CopyTIdBytes(Remaining, 0, Packet, Offset, Length(Remaining));
Inc(Offset, Length(Remaining));
Packet[Offset] := Hi(Word(Length(TopicBytes)));
Packet[Offset + 1] := Lo(Word(Length(TopicBytes)));
Inc(Offset, 2);
CopyTIdBytes(TopicBytes, 0, Packet, Offset, Length(TopicBytes));
Inc(Offset, Length(TopicBytes));
if Length(PayloadBytes) > 0 then
CopyTIdBytes(PayloadBytes, 0, Packet, Offset, Length(PayloadBytes));
Result := Packet;
end;
procedure TMQTTClient.EnqueuePacket(const AData: TIdBytes);
begin
FSendLock.Enter;
try
FSendQueue.Add(AData);
finally
FSendLock.Leave;
end;
end;
procedure TMQTTClient.SetConnected(AValue: Boolean; const AErrorMsg: string = '');
var
LStatusEvent: TMQTTStatusEvent;
begin
// 상태가 실제로 변경될 때만 이벤트 발생 (UI 플리커 방지)
// if FConnected = AValue then Exit; // 에러 로깅을 위해 매번 발생시키도록 수정
FConnected := AValue;
LStatusEvent := FOnStatus;
if Assigned(LStatusEvent) then
begin
TThread.Queue(nil,
procedure
begin
if Assigned(LStatusEvent) then
LStatusEvent(AValue, AErrorMsg);
end);
end;
end;
procedure TMQTTClient.FireMessage(const ATopic, APayload: string);
var
LTopic, LPayload: string;
LMessageEvent: TMQTTMessageEvent;
begin
LTopic := ATopic;
LPayload := APayload;
LMessageEvent := FOnMessage;
if Assigned(LMessageEvent) then
begin
TThread.Queue(nil,
procedure
begin
if Assigned(LMessageEvent) then
LMessageEvent(LTopic, LPayload);
end);
end;
end;
procedure TMQTTClient.Connect;
begin
if FActive then
Exit;
FActive := True;
FRecvThread := TMQTTRecvThread.Create(Self);
end;
procedure TMQTTClient.Disconnect;
begin
FActive := False;
if FRecvThread <> nil then
begin
FRecvThread.Terminate;
FRecvThread.WaitFor;
FreeAndNil(FRecvThread);
end;
FConnected := False;
if Assigned(FOnStatus) then
FOnStatus(False, 'User Disconnected');
end;
procedure TMQTTClient.Subscribe(const ATopic: string);
begin
if FSubscribeTopics.IndexOf(ATopic) < 0 then
FSubscribeTopics.Add(ATopic);
if FConnected then
EnqueuePacket(BuildSubscribePacket(ATopic));
end;
procedure TMQTTClient.Unsubscribe(const ATopic: string);
var
Idx: Integer;
begin
Idx := FSubscribeTopics.IndexOf(ATopic);
if Idx >= 0 then
FSubscribeTopics.Delete(Idx);
if FConnected then
EnqueuePacket(BuildUnsubscribePacket(ATopic));
end;
procedure TMQTTClient.Publish(const ATopic, APayload: string);
begin
if FConnected then
EnqueuePacket(BuildPublishPacket(ATopic, APayload));
end;
{ TMQTTRecvThread }
constructor TMQTTRecvThread.Create(AOwner: TMQTTClient);
begin
inherited Create(False);
FreeOnTerminate := False;
FOwner := AOwner;
end;
function TMQTTRecvThread.ReadRemainingLength: Integer;
var
Multiplier: Integer;
EncodedByte: Byte;
begin
Result := 0;
Multiplier := 1;
repeat
EncodedByte := FOwner.FTCPClient.IOHandler.ReadByte;
Result := Result + (EncodedByte and $7F) * Multiplier;
Multiplier := Multiplier * 128;
until (EncodedByte and $80) = 0;
end;
procedure TMQTTRecvThread.ProcessPublish(ARemainingLen: Integer);
var
TopicLen: Word;
TopicBytes, PayloadBytes: TIdBytes;
Topic, Payload: string;
PayloadLen: Integer;
begin
TopicLen := FOwner.FTCPClient.IOHandler.ReadByte shl 8;
TopicLen := TopicLen or FOwner.FTCPClient.IOHandler.ReadByte;
FOwner.FTCPClient.IOHandler.ReadBytes(TopicBytes, TopicLen);
Topic := BytesToString(TopicBytes, IndyTextEncoding_UTF8);
PayloadLen := ARemainingLen - 2 - TopicLen;
if PayloadLen > 0 then
begin
FOwner.FTCPClient.IOHandler.ReadBytes(PayloadBytes, PayloadLen);
Payload := BytesToString(PayloadBytes, IndyTextEncoding_UTF8);
end
else
Payload := '';
FOwner.FireMessage(Topic, Payload);
end;
function TMQTTRecvThread.FlushSendQueue: Boolean;
var
Packets: TList<TIdBytes>;
Pkt: TIdBytes;
begin
Result := True;
Packets := nil;
FOwner.FSendLock.Enter;
try
if FOwner.FSendQueue.Count > 0 then
begin
Packets := TList<TIdBytes>.Create;
Packets.AddRange(FOwner.FSendQueue);
FOwner.FSendQueue.Clear;
end;
finally
FOwner.FSendLock.Leave;
end;
if Packets <> nil then
begin
try
for Pkt in Packets do
begin
try
FOwner.FTCPClient.IOHandler.Write(Pkt);
except
Result := False;
Break;
end;
end;
finally
Packets.Free;
end;
end;
end;
procedure TMQTTRecvThread.Execute;
var
ConnAckBuf: TIdBytes;
PacketType: Byte;
RemainingLen: Integer;
DiscardBuf: TIdBytes;
LastPingTime: TDateTime;
PingIntervalSec: Integer;
begin
PingIntervalSec := FOwner.FKeepAlive div 2;
if PingIntervalSec < 10 then
PingIntervalSec := 10;
while not Terminated do
begin
// === Connection Phase ===
try
FOwner.FTCPClient.Host := FOwner.FHost;
FOwner.FTCPClient.Port := FOwner.FPort;
FOwner.FTCPClient.Connect;
FOwner.FTCPClient.IOHandler.ReadTimeout := 500; // 읽기 타임아웃 재설정
// CONNECT 패킷 전송
FOwner.FTCPClient.IOHandler.Write(FOwner.BuildConnectPacket);
// 무한대기 읽기로 CONNACK 수신 (접속시에만)
FOwner.FTCPClient.IOHandler.ReadTimeout := 500;
var WaitCount := 0;
while (WaitCount < 20) and not Terminated do
begin
FOwner.FTCPClient.IOHandler.CheckForDataOnSource(500);
if not FOwner.FTCPClient.IOHandler.InputBufferIsEmpty then
Break;
Inc(WaitCount);
end;
if Terminated then Break;
FOwner.FTCPClient.IOHandler.ReadBytes(ConnAckBuf, 4, False);
if (Length(ConnAckBuf) >= 4) and (ConnAckBuf[0] = $20) and (ConnAckBuf[3] = $00) then
begin
FOwner.SetConnected(True, '');
LastPingTime := Now;
// Subscribe all registered topics
for var I := 0 to FOwner.FSubscribeTopics.Count - 1 do
begin
FOwner.FTCPClient.IOHandler.Write(FOwner.BuildSubscribePacket(FOwner.FSubscribeTopics[I]));
end;
end
else
begin
try FOwner.FTCPClient.Disconnect; except end;
if Length(ConnAckBuf) >= 4 then
FOwner.SetConnected(False, '서버 접속 거부됨 (Return Code: ' + IntToStr(ConnAckBuf[3]) + ')')
else
FOwner.SetConnected(False, '서버 응답 없음 (CONNACK 타임아웃)');
if not Terminated then Sleep(5000);
Continue;
end;
except
on E: Exception do
begin
FOwner.SetConnected(False, '소켓 통신 에러: ' + E.Message);
try FOwner.FTCPClient.Disconnect; except end;
if not Terminated then Sleep(5000);
Continue;
end;
end;
// === Receive Loop ===
while not Terminated do
begin
// 1) 송신 큐 flush
if not FlushSendQueue then
Break; // 전송 실패 = 연결 끊김
// 2) PINGREQ 주기적 전송
if SecondsBetween(Now, LastPingTime) >= PingIntervalSec then
begin
LastPingTime := Now;
try
FOwner.FTCPClient.IOHandler.Write(FOwner.BuildPingReqPacket);
except
Break; // 전송 실패 = 연결 끊김
end;
end;
// 3) 소켓에서 데이터 읽기 시도
if FOwner.FTCPClient.IOHandler.InputBufferIsEmpty then
begin
FOwner.FTCPClient.IOHandler.CheckForDataOnSource(500);
if FOwner.FTCPClient.IOHandler.InputBufferIsEmpty then
Continue;
end;
try
PacketType := FOwner.FTCPClient.IOHandler.ReadByte;
except
on E: EIdConnClosedGracefully do
begin
Break;
end;
on E: EIdException do
begin
Break;
end;
on E: Exception do
begin
Break;
end;
end;
// 4) 패킷 나머지 읽기 (데이터가 있으므로 타임아웃 가능성 낮음)
try
RemainingLen := ReadRemainingLength;
case (PacketType and $F0) of
$30: // PUBLISH
ProcessPublish(RemainingLen);
$90: // SUBACK
begin
if RemainingLen > 0 then
FOwner.FTCPClient.IOHandler.ReadBytes(DiscardBuf, RemainingLen);
end;
$D0: // PINGRESP
begin
// Keep-Alive 확인 완료
if RemainingLen > 0 then
FOwner.FTCPClient.IOHandler.ReadBytes(DiscardBuf, RemainingLen);
end;
else
// 알 수 없는 패킷 — 남은 바이트 소비
if RemainingLen > 0 then
FOwner.FTCPClient.IOHandler.ReadBytes(DiscardBuf, RemainingLen);
end;
except
// 패킷 파싱 중 오류 = 연결 끊김
Break;
end;
end;
// === 연결 끊김 처리 ===
FOwner.SetConnected(False, '네트워크 단절');
if not Terminated then
begin
try FOwner.FTCPClient.Disconnect; except end;
for var I := 1 to 50 do
begin
if Terminated then Break;
Sleep(100);
end;
end else
begin
try
if FOwner.FTCPClient.Connected and (FOwner.FTCPClient.IOHandler <> nil) then
FOwner.FTCPClient.IOHandler.Write(FOwner.BuildDisconnectPacket);
except end;
try FOwner.FTCPClient.Disconnect; except end;
end;
end;
end;
end.