реструктуризация файлов, добавление вебчатов
This commit is contained in:
PC1\PTyTb
@@ -0,0 +1,293 @@
|
||||
unit uWebServerChat;
|
||||
|
||||
interface
|
||||
|
||||
uses classes, StrUtils, DateUtils, System.JSON, System.Generics.Collections,
|
||||
IdBaseComponent, IdComponent, IdCustomTCPServer, IdContext,
|
||||
IdCustomHTTPServer, uRecords, System.IOUtils, IdGlobalProtocols,
|
||||
IdHTTPServer, System.SysUtils;
|
||||
|
||||
type
|
||||
TTwitchMessage = record
|
||||
Nickname: string;
|
||||
Content: string;
|
||||
Timestamp: TDateTime;
|
||||
TimeMsg: Integer;
|
||||
end;
|
||||
|
||||
type
|
||||
TTTW_Chat = class(TObject)
|
||||
msgStyle: TStyleChat;
|
||||
fFontsList: tstringlist;
|
||||
IdHTTPServer1: TIdHTTPServer;
|
||||
procedure IdHTTPServer1CommandGet(AContext: TIdContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||||
private
|
||||
FBColor: string;
|
||||
Messages: TThreadList<TTwitchMessage>;
|
||||
FDeleteByTime: Boolean; // Ðåæèì óäàëåíèÿ: ïî âðåìåíè (true) èëè êîëè÷åñòâó (false)
|
||||
FMaxMsgCount: Integer; // Ìàêñèìàëüíîå êîëè÷åñòâî ñîîáùåíèé
|
||||
function GenerateHTML: string;
|
||||
function GenerateJSON: string;
|
||||
procedure CleanupOldMessages;
|
||||
public
|
||||
constructor Create(FontList: tstrings; aPort:integer; aColor:string);
|
||||
destructor Destroy;
|
||||
procedure addMessage(newMsg: TStyleChat);
|
||||
procedure ActiveServer(aEn: boolean);
|
||||
procedure SetDeleteMode(DeleteByTime: Boolean; MaxMsgCount: Integer); // Óñòàíîâêà ðåæèìà óäàëåíèÿ
|
||||
procedure changeBackground(aColor:string);
|
||||
end;
|
||||
|
||||
var
|
||||
Timestamp2: string;
|
||||
|
||||
implementation
|
||||
|
||||
uses uGeneral;
|
||||
|
||||
{ TTTW_Chat }
|
||||
|
||||
procedure TTTW_Chat.SetDeleteMode(DeleteByTime: Boolean; MaxMsgCount: Integer);
|
||||
begin
|
||||
FDeleteByTime := DeleteByTime;
|
||||
FMaxMsgCount := MaxMsgCount;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.ActiveServer(aEn: boolean);
|
||||
begin
|
||||
IdHTTPServer1.Active := aEn;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.addMessage(newMsg: TStyleChat);
|
||||
var
|
||||
Msg: TTwitchMessage;
|
||||
begin
|
||||
Msg.Nickname := newMsg.Nick;
|
||||
Msg.Content := newMsg.Context;
|
||||
Msg.Timestamp := now;
|
||||
Msg.TimeMsg := newMsg.TimeMsg;
|
||||
msgStyle := newMsg;
|
||||
with Messages.LockList do
|
||||
try
|
||||
if not FDeleteByTime then
|
||||
begin
|
||||
// Óäàëåíèå ñòàðûõ ñîîáùåíèé ïðè ïðåâûøåíèè ëèìèòà
|
||||
while Count >= FMaxMsgCount do
|
||||
Delete(0);
|
||||
end;
|
||||
Add(Msg);
|
||||
finally
|
||||
Messages.UnlockList;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.changeBackground(aColor: string);
|
||||
begin
|
||||
FBColor:=aColor;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.CleanupOldMessages;
|
||||
var
|
||||
MsgList: TList<TTwitchMessage>;
|
||||
I: integer;
|
||||
ExpiryTime: TDateTime;
|
||||
begin
|
||||
if not FDeleteByTime then
|
||||
Exit; // Âûõîäèì, åñëè óäàëåíèå ïî âðåìåíè îòêëþ÷åíî
|
||||
MsgList := Messages.LockList;
|
||||
try
|
||||
for I := MsgList.Count - 1 downto 0 do
|
||||
begin
|
||||
ExpiryTime := Now - (MsgList[I].TimeMsg / 86400); // Èñïîëüçóåì çíà÷åíèå èç ñîîáùåíèÿ
|
||||
if MsgList[I].Timestamp < ExpiryTime then
|
||||
MsgList.Delete(I);
|
||||
end;
|
||||
finally
|
||||
Messages.UnlockList;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TTTW_Chat.Create(FontList: tstrings; aPort:integer;AColor:string);
|
||||
var
|
||||
I: integer;
|
||||
begin
|
||||
FBColor := AColor;
|
||||
Messages := TThreadList<TTwitchMessage>.Create;
|
||||
IdHTTPServer1 := TIdHTTPServer.Create;
|
||||
IdHTTPServer1.DefaultPort := aPort;
|
||||
IdHTTPServer1.OnCommandGet := IdHTTPServer1CommandGet;
|
||||
fFontsList := tstringlist.Create;
|
||||
for I := 0 to FontList.Count - 1 do
|
||||
fFontsList.Add(FontList[I]);
|
||||
FDeleteByTime := True; // Ïî óìîë÷àíèþ óäàëåíèå ïî âðåìåíè
|
||||
FMaxMsgCount := 100; // Çíà÷åíèå ïî óìîë÷àíèþ
|
||||
|
||||
end;
|
||||
|
||||
destructor TTTW_Chat.Destroy;
|
||||
begin
|
||||
Messages.Free;
|
||||
IdHTTPServer1.Active := false;
|
||||
IdHTTPServer1.Free;
|
||||
fFontsList.Free;
|
||||
end;
|
||||
|
||||
|
||||
function TTTW_Chat.GenerateHTML: string;
|
||||
var
|
||||
I: integer;
|
||||
s, s1: string;
|
||||
DeleteByTimeJS: string;
|
||||
begin
|
||||
DeleteByTimeJS := LowerCase(BoolToStr(FDeleteByTime)); // Ïðåîáðàçóåì áóëåâî çíà÷åíèå â ñòðîêó 'true' èëè 'false'
|
||||
s := 'body { background: ' + FBColor + '; }' + #13#10;
|
||||
for I := 41 to fFontsList.Count - 1 do
|
||||
begin
|
||||
s1 := StringReplace(fFontsList[I], '.ttf', '', [rfReplaceAll]);
|
||||
s := s + '@font-face { font-family: ''' + s1 + '''; src: url(fonts/' + 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>Messages</title><style>' + s +
|
||||
'.message { margin:5px; border-radius:5px; transition: opacity 1s linear; display: flex; align-items: center; }' +
|
||||
'.message-icon { width: 1.5em; height: 1.5em; margin-right: 0.5em; }' + // Ñòèëü äëÿ èêîíêè
|
||||
'</style><script>' +
|
||||
'let existingMessages = new Map(); let fetching = false;' +
|
||||
'function fetchMessages() {' +
|
||||
' if (fetching) return; fetching = true;' +
|
||||
' fetch("/messages").then(response => response.json()).then(data => {' +
|
||||
' const container = document.getElementById("messages");' +
|
||||
' const newIds = new Set();' +
|
||||
' data.forEach(msg => {' +
|
||||
' const msgId = "msg-" + msg.timestamp;' +
|
||||
' newIds.add(msgId);' +
|
||||
' if (!existingMessages.has(msgId)) {' +
|
||||
' const div = document.createElement("div");' +
|
||||
' div.className = "message";' +
|
||||
' div.id = msgId;' +
|
||||
' div.style = `background-color:${msg.color}; font-family:${msg.family}; ' +
|
||||
' padding:${msg.padding}px; border: ${msg.sizeBorder}px solid ${msg.colorBorder}; ' +
|
||||
' color:${msg.colorText}; font-size:${msg.fontSize}px;`;' +
|
||||
' div.innerHTML = `' +
|
||||
// ' <img src="${msg.iconUrl}" class="message-icon">' + // Äîáàâëåíà èêîíêà
|
||||
' <div><b>${msg.nickname}:</b> ${msg.content}</div>`;' +
|
||||
' div.style.opacity = "1";' +
|
||||
' container.appendChild(div);' +
|
||||
' existingMessages.set(msgId, div);' +
|
||||
' if (deleteByTime) {' + // Óñòàíàâëèâàåì òàéìåð òîëüêî åñëè âêëþ÷åíî óäàëåíèå ïî âðåìåíè
|
||||
' setTimeout(() => {' +
|
||||
' div.style.opacity = "0";' +
|
||||
' setTimeout(() => { div.remove(); existingMessages.delete(msgId); }, 1000);' +
|
||||
' }, msg.timeMsg * 1000);' +
|
||||
' }' +
|
||||
' }' +
|
||||
' });' +
|
||||
' existingMessages.forEach((div, msgId) => {' +
|
||||
' if (!newIds.has(msgId)) { div.remove(); existingMessages.delete(msgId); }' +
|
||||
' });' +
|
||||
' }).finally(() => { fetching = false; });' +
|
||||
'}' +
|
||||
'setInterval(fetchMessages, 500); fetchMessages();' +
|
||||
'</script></head><body><div id="messages"></div></body></html>';
|
||||
end;
|
||||
|
||||
function TTTW_Chat.GenerateJSON: string;
|
||||
var
|
||||
MsgList: TList<TTwitchMessage>;
|
||||
Msg: TTwitchMessage;
|
||||
JSONArray: TJSONArray;
|
||||
JSONObject: TJSONObject;
|
||||
begin
|
||||
JSONArray := TJSONArray.Create;
|
||||
try
|
||||
MsgList := Messages.LockList;
|
||||
try
|
||||
for Msg in MsgList do
|
||||
begin
|
||||
JSONObject := TJSONObject.Create;
|
||||
JSONObject.AddPair('nickname', Msg.Nickname);
|
||||
JSONObject.AddPair('content', Msg.Content);
|
||||
JSONObject.AddPair('timestamp',
|
||||
TJSONNumber.Create(DateTimeToUnix(Msg.Timestamp)));
|
||||
JSONObject.AddPair('color', msgStyle.BlockColor); // Îñòàâëÿåì HEX-öâåò
|
||||
JSONObject.AddPair('bcolor', msgStyle.BColor); // Îñòàâëÿåì HEX-öâåò
|
||||
JSONObject.AddPair('fontSize', TJSONNumber.Create(msgStyle.FontSize));
|
||||
JSONObject.AddPair('colorText', msgStyle.FontColor);
|
||||
|
||||
JSONObject.AddPair('colorBorder', msgStyle.BorderColor);
|
||||
JSONObject.AddPair('sizeBorder',
|
||||
TJSONNumber.Create(msgStyle.BorderSize));
|
||||
JSONObject.AddPair('padding', TJSONNumber.Create(msgStyle.BorderSize));
|
||||
JSONObject.AddPair('family', msgStyle.FontFamily);
|
||||
JSONObject.AddPair('timeMsg', TJSONNumber.Create(Msg.TimeMsg)); // Äîáàâëÿåì âðåìÿ
|
||||
// Óïðàâëÿåò òîëüêî áëîêîì, íå òåêñòîì
|
||||
JSONArray.Add(JSONObject);
|
||||
end;
|
||||
finally
|
||||
Messages.UnlockList;
|
||||
end;
|
||||
Result := JSONArray.ToString;
|
||||
finally
|
||||
JSONArray.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.IdHTTPServer1CommandGet(AContext: TIdContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||||
var
|
||||
HtmlContent: string;
|
||||
FontFileName: string;
|
||||
FontFilePath: string;
|
||||
MIMEType: string;
|
||||
FS: TFileStream;
|
||||
begin
|
||||
CleanupOldMessages;
|
||||
|
||||
if ARequestInfo.Document = '/messages' then
|
||||
begin
|
||||
AResponseInfo.ContentType := 'application/json; charset=utf-8';
|
||||
AResponseInfo.ContentText := GenerateJSON;
|
||||
end
|
||||
else if Pos('/fonts/', ARequestInfo.Document) = 1 then
|
||||
// Ïðîâåðÿåì çàïðîñ ê øðèôòàì
|
||||
begin
|
||||
// Èçâëåêàåì èìÿ ôàéëà èç URL
|
||||
FontFileName := TPath.GetFileName(ARequestInfo.Document);
|
||||
|
||||
// Ôîðìèðóåì ïîëíûé ïóòü ê ôàéëó (ïàïêà fonts äîëæíà áûòü ðÿäîì ñ èñïîëíÿåìûì ôàéëîì)
|
||||
FontFilePath := myConst.fontsPath + FontFileName;
|
||||
|
||||
// Ïðîâåðÿåì ñóùåñòâîâàíèå ôàéëà
|
||||
if FileExists(FontFilePath) then
|
||||
begin
|
||||
|
||||
MIMEType := 'font/ttf';
|
||||
|
||||
// Íàñòðàèâàåì îòâåò
|
||||
AResponseInfo.ContentType := MIMEType;
|
||||
try
|
||||
FS := TFileStream.Create(FontFilePath, fmOpenRead + fmShareDenyWrite);
|
||||
AResponseInfo.ContentStream := FS;
|
||||
AResponseInfo.ResponseNo := 200;
|
||||
except
|
||||
FS.Free;
|
||||
AResponseInfo.ResponseNo := 500;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
AResponseInfo.CacheControl := 'no-cache, no-store, must-revalidate';
|
||||
AResponseInfo.Pragma := 'no-cache';
|
||||
AResponseInfo.Expires := 0;
|
||||
Timestamp2 := IntToStr(DateTimeToUnix(now));
|
||||
AResponseInfo.ContentType := 'text/html; charset=utf-8';
|
||||
AResponseInfo.ContentText := GenerateHTML;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user