承接上篇架構設計,本文深入剖析 Transceiver Service 的核心實現:服務應用程式框架、Port 類動態創建、多 Channel 支持、事件動態分配、數據調度與發送、隊列重試機制。展示 Delphi 構建高性能後台通訊服務的關鍵技術細節。
program Project1;
uses
SvcMgr, Unit1 in 'Unit1.pas' {Service1: TService};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TService1, Service1);
Application.Run;
end.
unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;
type
TService1 = class(TService)
private
public
function GetServiceController: TServiceController; override;
end;
var Service1: TService1;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin Service1.Controller(CtrlCode); end;
function TService1.GetServiceController: TServiceController;
begin Result := ServiceController; end;
end.
要點:繼承 TService、重載 GetServiceController、stdcall 服務控制器回調。無 UI,需自行實現無界面調試輸出(如寫日誌文件、OutputDebugString)。
所有 Port 繼承 TComponent(非 TControl,無 UI)。
type
TFilePort = class(TComponent)
private
FFilePath, FPrefix, FSuffix: string;
published
property FilePath: string read FFilePath write FFilePath;
property Prefix: string read FPrefix write FPrefix;
property Suffix: string read FSuffix write FSuffix;
end;
TCOMPort = class(TComponent)
private
FComFace: string;
published
property ComFace: string read FComFace write FComFace;
end;
參數來源於系統配置庫(Port 表定義),運行時由 Kernel 動態賦值。
private
TCPSource: array of TServerSocket; // TCP Source
TCPTarget: array of TClientSocket; // TCP Target
MailSource: array of TIdPOP3; // Mail Source
MailTarget: array of TIdSMTP; // Mail Target
FileSource: array of TFilePort; // File Source
FileTarget: array of TFilePort; // File Target
ComSource: array of TCOMPort; // COM Source
ComTarget: array of TCOMPort; // COM Target
設計原則:同類型 Port 作為 Source/Target 運行規則截然不同,視為完全獨立對象,分別建立陣列。
{COM Source 範例}
var itmp, isource, itarget: Integer; NullTest: Variant; bValid: Boolean;
begin
itmp := High(ComSource) + 1;
SetLength(ComSource, itmp + 1);
ComSource[itmp] := TCOMPort.Create(Self);
ComSource[itmp].Name := 'Receive' + IntToStr(isource); {關鍵:名稱含 Port ID}
ComSource[itmp].Tag := itarget; {Tag 存放對應 Target Port ID}
NullTest := rece.Fields['Address'].Value; {讀取配置 COM 接口字串}
if (NullTest <> Null) and (Trim(NullTest) <> '') then begin
ComSource[itmp].ComFace := NullTest;
NullTest := rece.Fields['Interval'].Value; {輪詢間隔(分)}
SetTimer(Application.Handle, isource, NullTest * 60000, nil); {建立定時器}
end else
ComSource[itmp].Tag := -1; {標記無效}
end;
TCP Source(事件驅動):
TCPSource[itmp].OnClientRead := TCPServersClientRead;
TCPSource[itmp].OnClientError := TCPServerClientError;
TCPSource[itmp].Socket.Data := @TCPSource[itmp].Tag; {將 Target ID 附加到 Socket}
定時器驅動 Port(COM、POP3、FTP、FILE):
Application.OnMessage := Timer; {重載消息循環}
procedure TCarrier.Timer(var Msg: TMsg; var Handled: Boolean);
var Obj: TComponent; stmp: string;
begin
if Msg.Message = WM_TIMER then begin
Obj := FindComponent('Receive' + IntToStr(Msg.WParam)); {依 Port ID 定位}
if Obj = nil then Exit;
stmp := Obj.ClassName;
if stmp = 'TIdPOP3' then GetPOP3(TIdPOP3(Obj));
if stmp = 'TIdFTP' then GetFTP(TIdFTP(Obj));
if stmp = 'TFilePort' then GetFile(TFilePort(Obj));
if stmp = 'TCOMPort' then GetCOM(TCOMPort(Obj));
end;
end;
{COM Source}
procedure TCarrier.GetCOM(COMObj: TCOMPort);
var COMInterface: OleVariant; stmp: string;
begin
try
COMInterface := CreateOleObject(COMObj.ComFace);
stmp := COMInterface.GetData;
while stmp <> #0 do begin {#0 為結束標誌}
DataArrive(stmp, COMObj.Tag); {交給調度器,Tag 為 Target ID}
stmp := COMInterface.GetData;
end;
finally
COMInterface := Unassigned; {釋放 COM}
end;
end;
{TCP Source}
procedure TCarrier.TCPServersClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
DataArrive(Socket.ReceiveText, Integer(TServerWinSocket(Sender).Data^));
end;
procedure TCarrier.DataArrive(sData: String; PortID: Integer);
var dTime: TDateTime; iLogID: Integer; bSendSuccess: Boolean;
begin
if sData = '' then Exit;
dTime := Now;
if sData[Length(sData)] = #0 then Delete(sData, Length(sData), 1); {兼容 C 風格字串}
bSendSuccess := DataSend(sData, PortID); {分發發送}
if (not TSCfg.LogOnlyError) or (not bSendSuccess) then
iLogID := WriteLog(dTime, Now, sData, PortID, bSendSuccess); {寫日誌}
if TSCfg.Queueing and (not bSendSuccess) then
PutQueue(dTime, Now, sData, PortID, bSendSuccess, iLogID); {入隊重試}
end;
function TCarrier.DataSend(sData: String; PortID: Integer): Boolean;
var Obj: TComponent;
begin
Result := False;
Obj := FindComponent('Send' + IntToStr(PortID));
if (Obj = nil) or (Obj.Tag = -1) then Exit;
case Obj.Tag of
1: Result := PutTCP(TClientSocket(Obj), sData);
3: Result := PutSMTP(TIdSMTP(Obj), sData);
5: Result := PutFTP(TIdFTP(Obj), sData);
7: Result := PutHTTP(TIdHTTP(Obj), sData);
9: Result := PutFile(TFilePort(Obj), sData);
11: Result := PutMSMQ(TMSMQPort(Obj), sData);
13: Result := PutDB(TDBPort(Obj), sData);
15: Result := PutCOM(TCOMPort(Obj), sData);
end;
end;
function TCarrier.PutTCP(TCPObj: TClientSocket; sData: String): Boolean;
var iTime: Integer;
begin
Result := False;
try
TCPObj.Close; TCPObj.Open;
iTime := GetTickCount;
repeat Application.ProcessMessages until TCPObj.Active or (GetTickCount - iTime > 5000);
if TCPObj.Active then begin
TCPObj.Socket.SendText(sData);
Result := True;
end;
finally
TCPObj.Close;
end;
end;
function TCarrier.PutCOM(COMObj: TCOMPort; sData: String): Boolean;
var Com: OleVariant;
begin
Result := False;
try
Com := CreateOleObject(COMObj.ComFace);
Result := Com.PutData(sData);
finally
Com := Unassigned;
end;
end;
依賴 Queue Timer 觸發,讀取資料庫緩衝數據,按 Target Port ID 再次調用 DataSend,成功則標記事務完成,失敗則重入隊列,直到達到最大重試次數。
DataSend 中的 case Obj.Tag 硬編碼類型碼,違反開閉原則。改進:引入介面 ITargetPort 統一 Send(Data) 方法,Shell 註冊工廠,Kernel 僅調用介面。Transceiver 以「Source→Target 數據流」抽象統一異構通訊,Delphi 強大的元件庫與服務框架使其快速落地。核心亮點在於動態 Port/Channel 模型、統一調度器、容錯隊列。理解其設計思想,可遷移至微服務網關、ETL 平台、IoT 數據總線等場景。