SSE（Server-Send Events）
SSE 是一种在基于浏览器的 Web 应用程序中仅从服务器向客户端发送文本消息的技术。SSE基于 HTTP 协议中的持久连接， 具有由 W3C 标准化的网络协议和 EventSource 客户端接口，作为 html5 标准套件的一部分。
使用其他方法实现的很多，采用Delphi实现的却基本没有，请教了一位高手，在他的帮助下实现了，特写下来，希望能帮助到更多的delphier.
废话不多说，直接上代码！
pas如下
unit Unit1;
interface
uses
Winapi.windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdContext, IdCustomHTTPServer, IdHTTPServer,IdTCPConnection,
IdBaseComponent, IdComponent, IdCustomTCPServer, Vcl.StdCtrls;
type
TForm1 = class(TForm)
IdHTTPServer1: TIdHTTPServer;
Memo1: TMemo;
Button1: TButton;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
procedure Button1Click(Sender: TObject);
private
procedure SendSSEMessage(const AMessage: string);
public
end;
var
Form1: TForm1;
gConnection : TIdTCPConnection;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
SendSSEMessage(Edit1.Text);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IdHTTPServer1.DefaultPort := 80; // 设置服务器端口
IdHTTPServer1.ServerSoftware := 'Delphi SSE Server'; // 设置服务器名称 IdHTTPServer1.Active := True;
idHttpServer1.Active := True;
Memo1.Lines.Add('Server started...');
end;
procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
var
LFilename: string;
LPathname: string;
begin
LFilename := ARequestInfo.Document;
LPathname := 'E:StudySSE' + LFilename;
if FileExists(LPathname) then begin
AResponseInfo.ContentStream := TFileStream.Create(LPathname, fmOpenRead + fmShareDenyWrite);
end else begin
if ARequestInfo.URI = '/subscribe' then begin
with AContext.Connection.IOHandler do begin
WriteBufferOpen;
WriteLn('HTTP/1.1 200 OK');
WriteLn('Content-Type: text/event-stream; charset=UTF-8');
WriteLn('Cache-Control: no-cache');
WriteLn('Connection: keep-alive');
WriteLn();
WriteBufferClose;
end;
//
gConnection := AContext.Connection;
end;
end;
end;
procedure TForm1.SendSSEMessage(const AMessage: string);
begin
with gConnection.IOHandler do begin
WriteBufferOpen;
WriteLn('id:'+IntToStr(random(1000))+#13#10);
WriteLn('event:test'+#13#10);
WriteLn('data:'+AMessage+#13#10#13#10);
WriteBufferClose;
end;
end;
end.
dfm如下：
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 242
ClientWidth = 601
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 250
Top = 0
Width = 351
Height = 242
Align = alRight
Lines.Strings = (
'Memo1')
TabOrder = 0
ExplicitLeft = 512
end
object Button1: TButton
Left = 48
Top = 168
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
OnClick = Button1Click
end
object Edit1: TEdit
Left = 48
Top = 32
Width = 121
Height = 21
TabOrder = 2
Text = 'Edit1'
end
object IdHTTPServer1: TIdHTTPServer
Bindings = <>
TerminateWAItTime = 50000
KeepAlive = True
SessionTimeOut = 50000
OnCommandGet = IdHTTPServer1CommandGet
Left = 120
Top = 80
end
end
对应的HTML如下：
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="UTF-8">
<title>Title</title>
<script>
window.onload = ()=> {
console.log("onload!");
if (window.EventSource) {
let source = new EventSource("/subscribe");
let s = '';
//
source.addEventListener('message', function(e) {
console.log("connect message");
document.querySelector("p").innerText = e.data;
})
source.addEventListener('open',function(e){
console.log("connect is open");
},false);
source.addEventListener('error',function(e){
if(e.readyState == EventSource.CLOSE){
console.log("connect is close");
console.log('connection state: ' + source.readyState + ', error: ' + event);
console.log(event);
}else{
console.log(e.readyState);
}
},false);
} else {
alert("浏览器不支持EventSource");
}
}
</script>
</head>
<body>
<p></p>
</body>
</html>
编译版是Delphi 10.4.2
点击Button1，即可向前端推送Edit1中的字符串。
京公网安备 11010802035086号