ttw_fmx_v10/utils/uWebServerEvents.pas

288 lines
9.5 KiB
Plaintext
Raw Blame History

unit uWebServerEvents;
interface
uses
System.Classes, System.StrUtils, System.DateUtils, System.JSON, System.Generics.Collections,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdContext,
IdCustomHTTPServer, uRecords, System.IOUtils, IdGlobalProtocols,
IdHTTPServer, System.SysUtils, System.SyncObjs;
type
TTTW_Events = class(TObject)
private
msgStyle: TStyleEvent;
fFontsList: TStringList;
FMessages: TList<TStyleEvent>;
FCriticalSection: TCriticalSection;
procedure IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
procedure ProcessFileRequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo; const Folder: string);
function GenerateHTML: string;
function GenerateJSON: string;
procedure CleanupOldMessages;
public
IdHTTPServer1: TIdHTTPServer;
constructor Create(FontList: TStrings; aPort: integer);
destructor Destroy; override;
procedure addMessage(newMsg: TStyleEvent);
procedure ActiveServer(aEn: boolean);
end;
implementation
uses ugeneral;
{ TTTW_Events }
constructor TTTW_Events.Create(FontList: TStrings; aPort: integer);
var
I: integer;
begin
FCriticalSection := TCriticalSection.Create;
FMessages := TList<TStyleEvent>.Create;
fFontsList := TStringList.Create;
fFontsList.Assign(FontList);
IdHTTPServer1 := TIdHTTPServer.Create(nil);
IdHTTPServer1.DefaultPort := aPort;
IdHTTPServer1.OnCommandGet := IdHTTPServer1CommandGet;
end;
destructor TTTW_Events.Destroy;
begin
FreeAndNil(FCriticalSection);
FMessages.Free;
fFontsList.Free;
IdHTTPServer1.Free;
inherited;
end;
procedure TTTW_Events.addMessage(newMsg: TStyleEvent);
begin
FCriticalSection.Enter;
try
FMessages.Add(newMsg);
CleanupOldMessages;
finally
FCriticalSection.Leave;
end;
end;
procedure TTTW_Events.CleanupOldMessages;
var
I: integer;
TimeNow: TDateTime;
begin
TimeNow := Now;
for I := FMessages.Count - 1 downto 0 do
if SecondsBetween(TimeNow, FMessages[I].Timestamp) >= FMessages[I].TimeMsg
then
FMessages.Delete(I);
end;
function TTTW_Events.GenerateHTML: string;
var
I: integer;
s, s1: string;
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> CSS <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
s := 'body { background: #00FF00; }' + #13#10;
for I := 41 to fFontsList.Count - 1 do
begin
s1 := StringReplace(fFontsList[I], '.ttf', '', [rfReplaceAll]);
s := s + Format('@font-face { font-family: ''%s''; src: url(fonts/%s); }',
[s1, fFontsList[I]]) + #13#10;
end;
Result := '<!DOCTYPE html><html><head>' +
'<meta http-equiv="Cache-Control" content="no-cache, no-store, must-revalidate">'
+ '<meta http-equiv="Pragma" content="no-cache">' +
'<meta http-equiv="Expires" content="0">' + '<title>Twitch Messages</title>'
+ '<style>' + s + '.message { ' + ' will-change: transform, opacity;' +
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
' backface-visibility: hidden;' + ' transform: translateZ(0);' +
' margin:5px; ' + ' border-radius:5px; ' +
' transition: opacity 1s linear; ' + ' max-width: 600px; ' +
' margin-left: auto; ' + ' margin-right: auto; ' + '}' +
'.nick { margin: 0; padding: 2px; }' + '.text { margin: 0; padding: 5px; }'
+ '#audio-warning { ' + ' display: none; ' + ' position: fixed; ' +
' top: 10px; ' + ' right: 10px; ' + ' background: #ffcccc; ' +
' padding: 10px; ' + ' border: 1px solid red; ' + '}' + '</style>' +
'<script>' + 'let lastPlayedTimestamp = 0;' + 'let audioEnabled = false;' +
'let pendingMessages = [];' +
'function enableAudio() {' + ' audioEnabled = true;' +
' document.getElementById("audio-overlay").style.display = "none";' +
' processPendingMessages();' + '}' +
'function processPendingMessages() {' + ' pendingMessages.forEach(msg => {'
+ ' playNotificationSound(msg);' + ' });' +
' pendingMessages = [];' + '}' +
'function playNotificationSound(msg) {' + ' if(!msg.sound) return;' +
' const audio = new Audio(msg.sound);' + ' audio.play()' +
' .catch(error => console.log("Audio error:", error));' + '}' +
'function fetchMessages() {' + ' fetch("/messages")' +
' .then(response => response.json())' + ' .then(data => {' +
' const container = document.getElementById("messages");' +
' container.innerHTML = "";' + ' data.forEach(msg => {' +
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
' if(msg.sound && msg.timestamp > lastPlayedTimestamp) {' +
' playNotificationSound(msg);' +
' lastPlayedTimestamp = msg.timestamp;' + ' }' +
' const div = document.createElement("div");' +
' div.className = "message";' +
' div.id = "msg-" + msg.timestamp;' + ' div.style = `' +
' background-color: ${msg.color};' +
' padding: ${msg.padding}px;' +
' border: ${msg.sizeBorder}px solid ${msg.colorBorder};' +
' text-align: center;' + ' `;' +
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> HTML
' let content = "";' + ' if(msg.url) {' +
' content += `<img src="${msg.url}" style="max-width: 100%; height: auto;">`;'
+ ' }' + ' content += `' + ' <p class="nick" style="'
+ ' color: ${msg.titlecolor};' +
' font-family: ''${msg.titlefamily}'';' +
' font-size: ${msg.titleSize}px;">' +
' ${msg.nickname}' + ' </p>' +
' <p class="text" style="' +
' color: ${msg.contentcolor};' +
' font-family: ''${msg.contentfamily}'';' +
' font-size: ${msg.contentSize}px;">' +
' ${msg.content}' + ' </p>' + ' `;' +
' div.innerHTML = content;' +
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
' setTimeout(() => {' + ' div.style.opacity = "0";' +
' setTimeout(() => div.remove(), 1000);' +
' }, (msg.duration - 1) * 1000);' +
' container.appendChild(div);' + ' });' + ' });' + '}' +
'setInterval(fetchMessages, 1000);' + 'fetchMessages();' + '</script>' +
'</head>' + '<body>' + ' <div id="messages"></div>' +
'</body></html>';
end;
function TTTW_Events.GenerateJSON: string;
var
JSONArray: TJSONArray;
I: Integer;
Msg: TStyleEvent;
begin
JSONArray := TJSONArray.Create;
try
CleanupOldMessages;
FCriticalSection.Enter;
try
for I := 0 to FMessages.Count - 1 do
begin
Msg := FMessages[I];
JSONArray.AddElement(
TJSONObject.Create
.AddPair('nickname', Msg.Title)
.AddPair('url', Msg.Url)
.AddPair('content', Msg.Context)
.AddPair('timestamp', TJSONNumber.Create(DateTimeToUnix(Msg.Timestamp)))
.AddPair('sound', Msg.SoundURL)
.AddPair('duration', Msg.TimeMsg)
.AddPair('color', Msg.BlockColor)
.AddPair('colorBorder', Msg.BorderColor)
.AddPair('sizeBorder', TJSONNumber.Create(Msg.BorderSize))
.AddPair('fontSize', TJSONNumber.Create(Msg.FontTitle.Size))
.AddPair('titlecolor', Msg.FontTitle.Color)
.AddPair('titlefamily', TPath.GetFileNameWithoutExtension(Msg.FontTitle.Font))
.AddPair('titleSize', TJSONNumber.Create(Msg.FontTitle.Size))
.AddPair('contentcolor', Msg.FontContext.Color)
.AddPair('contentfamily', TPath.GetFileNameWithoutExtension(Msg.FontContext.Font))
.AddPair('contentSize', TJSONNumber.Create(Msg.FontContext.Size))
);
end;
finally
FCriticalSection.Leave;
end;
Result := JSONArray.ToString;
finally
JSONArray.Free;
end;
end;
procedure TTTW_Events.ProcessFileRequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo; const Folder: string);
var
FileName: string;
FilePath: string;
FS: TFileStream;
begin
FileName := TPath.GetFileName(ARequestInfo.Document);
FilePath := myConst.AppDataPath + Folder + '\' + FileName;
if FileExists(FilePath) then
begin
try
FS := TFileStream.Create(FilePath, fmOpenRead + fmShareDenyWrite);
AResponseInfo.ContentStream := FS;
AResponseInfo.ContentType := GetMIMETypeFromFile(FilePath);;
AResponseInfo.ResponseNo := 200;
AResponseInfo.FreeContentStream := True;
except
FS.Free;
AResponseInfo.ResponseNo := 500;
end;
end
else
begin
AResponseInfo.ResponseNo := 404;
end;
end;
procedure TTTW_Events.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if ARequestInfo.Document = '/' then
begin
AResponseInfo.CacheControl := 'no-cache, no-store, must-revalidate';
AResponseInfo.Pragma := 'no-cache';
AResponseInfo.Expires := 0;
AResponseInfo.ContentType := 'text/html';
AResponseInfo.ContentText := GenerateHTML;
end
else if ARequestInfo.Document = '/messages' then
begin
AResponseInfo.ContentType := 'application/json; charset=utf-8';
AResponseInfo.ContentText := GenerateJSON;
end
else if ARequestInfo.Document.StartsWith('/sounds/') then
begin
ProcessFileRequest(ARequestInfo, AResponseInfo, 'sounds');
end
else if ARequestInfo.Document.StartsWith('/fonts/') then
begin
ProcessFileRequest(ARequestInfo, AResponseInfo, 'fonts');
end
else if ARequestInfo.Document.StartsWith('/imgs/') then
begin
ProcessFileRequest(ARequestInfo, AResponseInfo, 'imgs');
end
else
AResponseInfo.ResponseNo := 404;
end;
procedure TTTW_Events.ActiveServer(aEn: boolean);
begin
IdHTTPServer1.Active := aEn;
end;
end.