Files
ttw_fmx_v10/frames/fOBS.pas
T

698 lines
20 KiB
ObjectPascal

unit fOBS;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, uCustomEmoties,
System.Variants, uWebServerChat, fColorSettings, System.Generics.Collections,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
System.Rtti, FMX.Grid.Style, FMX.Grid, FMX.ScrollBox, FMX.Edit, FMX.Colors,
FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Controls.Presentation, uRecords,
System.Generics.Defaults, fFontSettings;
type
TChatWebServers = record
port: integer;
MaxMsg: integer;
TimeMsg: integer;
Freez: boolean;
StyleBorderColor: string;
StyleBlockColor: string;
StyleBlockBorderSize: integer;
StyleBlockPadding: integer;
FontStyleDefault: string;
FontColor: string;
BColor: string;
FontSize: integer;
WebServerChat: TTTW_Chat;
end;
type
TfrOBS = class(TFrame)
sgWebChats: TStringGrid;
btnCreateOBSChat: TButton;
btnDeleteeChat: TButton;
Label1: TLabel;
IntegerColumn1: TIntegerColumn;
StringColumn1: TStringColumn;
StringColumn2: TStringColumn;
btnCreateOBSNotify: TButton;
btnCreateOBSKandinsky: TButton;
procedure btnDeleteeChatClick(Sender: TObject);
procedure btnCreateOBSKandinskyClick(Sender: TObject);
procedure btnCreateOBSChatClick(Sender: TObject);
procedure btnCreateOBSNotifyClick(Sender: TObject);
procedure sgWebChatsCellDblClick(const Column: TColumn; const Row: integer);
private
{ Private declarations }
function checkBttv(aMsg: string): string;
function ReplaceEmotesInMessage(const MessageText,
EmotesString: string): string;
function FindEmoteByID(const ID: string): TEmotes;
function GetBadgesHTML(Badges: string): string;
public
{ Public declarations }
listChats: TArray<TOBSChat>;
listNotify: TArray<TOBSNotify>;
listKandinsky: TArray<TOBSKandinsky>;
BTTV: TBTTV;
m7tv: t7tv;
ChatBadges: Tlist<TChatBadge>;
ChatEmotes: Tlist<TEmotes>;
ChatWebServers: Tlist<TChatWebServers>;
procedure MsgToWebServer(const aRecord: TTwitchChatMessage);
procedure CreateWebChat(chatSettings: TOBSChat);
procedure UpdateGridFromArray;
procedure AddChat(newRecord: TOBSChat);
procedure EdtChat(newRecord: TOBSChat; oldPort: integer);
procedure DelChat(aPort: integer);
procedure AddNotify(newRecord: TOBSNotify);
procedure EdtNotify(newRecord: TOBSNotify; oldPort: integer);
procedure DelNotify(aPort: integer);
procedure AddKandinsky(newRecord: TOBSKandinsky);
procedure DelKandinsky(aPort: integer);
end;
implementation
{$R *.fmx}
uses uGeneral, uCreateChat, uCreateNotify;
{ TfrOBS }
function TfrOBS.checkBttv(aMsg: string): string;
var
Words: tstringlist;
i: integer;
CurrentWord, Url: string;
begin
Words := tstringlist.Create;
try
// Ðàçáèâàåì ñòðîêó íà ñëîâà ïî ïðîáåëàì
Words.Delimiter := ' ';
Words.StrictDelimiter := True; // Èãíîðèðîâàòü ïîâòîðÿþùèåñÿ ïðîáåëû
Words.DelimitedText := aMsg;
// Îáðàáîòêà ñëîâ
for i := 0 to Words.Count - 1 do
begin
CurrentWord := Words[i];
Url := BTTV.generateURL(CurrentWord);
if Url = '' then
Url := m7tv.generateURL(CurrentWord);
if Url <> '' then
Words[i] := Format('<img src="%s" width="18" height="18">', [Url]);
end;
// Ñîáèðàåì ðåçóëüòàò
result := Words.text;
finally
Words.Free;
end;
end;
function TfrOBS.FindEmoteByID(const ID: string): TEmotes;
var
i: integer;
begin
result.ID := '';
if not Assigned(ChatEmotes) then
exit;
for i := 0 to ChatEmotes.Count - 1 do
if ChatEmotes[i].ID = ID then
begin
result := ChatEmotes[i];
Break;
end;
end;
function TfrOBS.ReplaceEmotesInMessage(const MessageText,
EmotesString: string): string;
type
TEmotePosition = record
StartPos: integer;
EndPos: integer;
ImageURL: string;
end;
var
Positions: Tlist<TEmotePosition>;
i, ColonPos: integer;
Parts, EmoteData, Ranges: tstringlist;
EmoteID, RangeStr: string;
StartPos, EndPos: integer;
Emote: TEmotes;
begin
result := MessageText;
if EmotesString.IsEmpty then
exit;
Parts := tstringlist.Create;
EmoteData := tstringlist.Create;
Ranges := tstringlist.Create;
Positions := Tlist<TEmotePosition>.Create;
try
Parts.Delimiter := '/';
Parts.StrictDelimiter := True;
Parts.DelimitedText := EmotesString;
for i := 0 to Parts.Count - 1 do
begin
ColonPos := Pos(':', Parts[i]);
if ColonPos = 0 then
Continue;
EmoteID := Copy(Parts[i], 1, ColonPos - 1);
RangeStr := Copy(Parts[i], ColonPos + 1, MaxInt);
Ranges.Clear;
Ranges.Delimiter := ',';
Ranges.StrictDelimiter := True;
Ranges.DelimitedText := RangeStr;
Emote := FindEmoteByID(EmoteID);
if Emote.ID = '' then
Continue;
for var j := 0 to Ranges.Count - 1 do
begin
EmoteData.Clear;
EmoteData.Delimiter := '-';
EmoteData.StrictDelimiter := True;
EmoteData.DelimitedText := Ranges[j];
if EmoteData.Count <> 2 then
Continue;
if TryStrToInt(EmoteData[0], StartPos) and
TryStrToInt(EmoteData[1], EndPos) then
begin
var
EmotePosition: TEmotePosition;
EmotePosition.StartPos := StartPos;
EmotePosition.EndPos := EndPos;
EmotePosition.ImageURL := Emote.images.Url1x;
Positions.Add(EmotePosition);
end;
end;
end;
Positions.Sort(TComparer<TEmotePosition>.Construct(
function(const Left, Right: TEmotePosition): integer
begin
result := Right.StartPos - Left.StartPos;
end));
var
SB := TStringBuilder.Create(MessageText);
try
for var Pos in Positions do
begin
if (Pos.StartPos < 0) or (Pos.EndPos >= SB.Length) or
(Pos.StartPos > Pos.EndPos) then
Continue;
var
Replacement := Format('<img src="%s" width="18" height="18">',
[Pos.ImageURL]);
SB.Remove(Pos.StartPos, Pos.EndPos - Pos.StartPos + 1);
SB.Insert(Pos.StartPos, Replacement);
end;
result := SB.ToString;
finally
SB.Free;
end;
finally
Parts.Free;
EmoteData.Free;
Ranges.Free;
Positions.Free;
end;
end;
function TfrOBS.GetBadgesHTML(Badges: string): string;
var
BadgeList: TArray<string>;
CodeParts: TArray<string>;
CurrentCode, SetId, VersionId: string;
Badge: TChatBadge;
Version: TBadgeVersion;
Found: boolean;
begin
// Ðàçáèâàåì ñòðîêó íà îòäåëüíûå áåéäæ-êîäû
BadgeList := Badges.Split([',']);
for CurrentCode in BadgeList do
begin
// Ðàçäåëÿåì SetId è VersionId
CodeParts := CurrentCode.Split(['/']);
if Length(CodeParts) <> 2 then
Continue;
SetId := CodeParts[0];
VersionId := CodeParts[1];
Found := false;
// Èùåì ñîîòâåòñòâóþùèé áåéäæ
for Badge in ChatBadges do
begin
if Badge.SetId = SetId then
begin
// Èùåì íóæíóþ âåðñèþ
for Version in Badge.Versions do
begin
if Version.ID = VersionId then
begin
// Ôîðìèðóåì HTML-òåã
result := result +
Format(' <img src="%s" width=18 height=18 alt="%s" title="%s">',
[Version.ImageUrl1x, Version.Title, Version.Description]);
Found := True;
Break;
end;
end;
if Found then
Break;
end;
end;
// Åñëè íå íàøëè - äîáàâëÿåì çàãëóøêó
if not Found then
result := result + ' <img src="placeholder.png" width=18 height=18>';
end;
end;
procedure TfrOBS.MsgToWebServer(const aRecord: TTwitchChatMessage);
var
s: string;
ms: TStyleChat;
i: integer;
begin
s := checkBttv(aRecord.Message);
if aRecord.Emotes <> '' then
s := ReplaceEmotesInMessage(s, aRecord.Emotes);
ms.Nick := GetBadgesHTML(aRecord.Badges) + '<span class="nick" style="color:'
+ aRecord.Color + '">' + aRecord.DisplayName + '</span>';
ms.Context := '<span class="text">' + s + '</span>';
for i := 0 to ChatWebServers.Count - 1 do
begin
ms.FontColor := ChatWebServers[i].FontColor;
ms.FontSize := ChatWebServers[i].FontSize;
ms.FontFamily := '''' + ChatWebServers[i].FontStyleDefault + ''';';
ms.FontFamily := StringReplace(ms.FontFamily, '.ttf', '', [rfReplaceAll]);
ms.BlockColor := ChatWebServers[i].StyleBlockColor;
ms.BlockPadding := ChatWebServers[i].StyleBlockPadding;
ms.MaxMsgCount := ChatWebServers[i].MaxMsg;
ms.TimeMsg := ChatWebServers[i].TimeMsg;
ms.BorderSize := ChatWebServers[i].StyleBlockBorderSize;
ms.BorderColor := ChatWebServers[i].StyleBorderColor;
ms.BColor := ChatWebServers[i].BColor;
ChatWebServers[i].WebServerChat.AddMessage(ms);
end;
end;
procedure TfrOBS.AddChat(newRecord: TOBSChat);
begin
SetLength(listChats, Length(listChats) + 1);
listChats[High(listChats)] := newRecord;
UpdateGridFromArray;
db.SaveRecordArray<TOBSChat>('listChats', listChats);
CreateWebChat(newRecord);
end;
procedure TfrOBS.AddKandinsky(newRecord: TOBSKandinsky);
begin
SetLength(listKandinsky, Length(listKandinsky) + 1);
listKandinsky[High(listKandinsky)] := newRecord;
UpdateGridFromArray;
db.SaveRecordArray<TOBSKandinsky>('listKandinsky', listKandinsky);
end;
procedure TfrOBS.AddNotify(newRecord: TOBSNotify);
begin
SetLength(listNotify, Length(listNotify) + 1);
listNotify[High(listNotify)] := newRecord;
UpdateGridFromArray;
db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
end;
procedure TfrOBS.btnCreateOBSChatClick(Sender: TObject);
var
dport, i: integer;
begin
dport := 8080;
for i := 0 to sgWebChats.RowCount - 1 do
begin
if strtoint(sgWebChats.Cells[0, i]) >= dport then
dport := strtoint(sgWebChats.Cells[0, i]) + 1;
end;
fCreateChat.sbWebServerPort.Value := dport;
fCreateChat.isEdit := false;
fCreateChat.Show;
end;
procedure TfrOBS.btnCreateOBSKandinskyClick(Sender: TObject);
var
dport: integer;
i: integer;
rk: TOBSKandinsky;
begin
dport := 8080;
for i := 0 to sgWebChats.RowCount - 1 do
begin
if strtoint(sgWebChats.Cells[0, i]) >= dport then
dport := strtoint(sgWebChats.Cells[0, i]) + 1;
end;
rk.port := dport;
AddKandinsky(rk);
end;
procedure TfrOBS.btnCreateOBSNotifyClick(Sender: TObject);
var
dport, i: integer;
begin
dport := 8080;
for i := 0 to sgWebChats.RowCount - 1 do
begin
if strtoint(sgWebChats.Cells[0, i]) >= dport then
dport := strtoint(sgWebChats.Cells[0, i]) + 1;
end;
fCreateNotify.sbWebServerPort.Value := dport;
fCreateNotify.isEdit := false;
fCreateNotify.Show;
end;
procedure TfrOBS.btnDeleteeChatClick(Sender: TObject);
begin
if sgWebChats.Cells[1, sgWebChats.Row] = '×àò' then
begin
DelChat(strtoint(sgWebChats.Cells[0, sgWebChats.Row]));
end;
if sgWebChats.Cells[1, sgWebChats.Row] = 'Kandinsky' then
begin
DelKandinsky(strtoint(sgWebChats.Cells[0, sgWebChats.Row]));
end;
if sgWebChats.Cells[1, sgWebChats.Row] = 'Îïîâåùåíèå' then
begin
DelNotify(strtoint(sgWebChats.Cells[0, sgWebChats.Row]));
end;
end;
procedure TfrOBS.CreateWebChat(chatSettings: TOBSChat);
var
ChatWebServer: TChatWebServers;
fonts: tstringlist;
f: TfrColorSettings;
t: TfrFontSettings;
procedure LoadFontList(const mySL: tstringlist);
var
SearchRec: TSearchRec;
n: integer;
begin
if not DirectoryExists(myConst.fontsPath) then
CreateDir(myConst.fontsPath);
n := 1;
if FindFirst(IncludeTrailingPathDelimiter(myConst.fontsPath) + '*.*',
faArchive, SearchRec) = 0 then
try
repeat
if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then
begin
mySL.Add(SearchRec.Name);
Inc(n);
end;
until FindNext(SearchRec) <> 0;
finally
System.SysUtils.FindClose(SearchRec);
end;
end;
begin
fonts := tstringlist.Create;
f := TfrColorSettings.Create(self);
t := TfrFontSettings.Create(self);
try
LoadFontList(fonts);
ChatWebServer.WebServerChat := TTTW_Chat.Create(fonts, chatSettings.port,
f.ccbBColor.Items[chatSettings.ColorBackground]);
ChatWebServer.port := chatSettings.port;
ChatWebServer.MaxMsg := chatSettings.MaxCountMess;
ChatWebServer.TimeMsg := chatSettings.TimeMess;
ChatWebServer.Freez := chatSettings.Freez = 1;
ChatWebServer.StyleBorderColor := f.ccbStyleBorderColor.Items
[chatSettings.ColorBorder];
ChatWebServer.StyleBlockColor := chatSettings.ColorBlock;
ChatWebServer.StyleBlockBorderSize := chatSettings.SolidBorder;
ChatWebServer.StyleBlockPadding := chatSettings.Paddings;
ChatWebServer.FontStyleDefault := t.cbFontStyleDefault.Items
[chatSettings.StyleFont];
ChatWebServer.FontColor := t.ccbFontColor.Items[chatSettings.ColorFont];
ChatWebServer.BColor := f.ccbBColor.Items[chatSettings.ColorBorder];;
ChatWebServer.FontSize := chatSettings.SizeFont;
ChatWebServers.Add(ChatWebServer);
ChatWebServers[ChatWebServers.Count - 1].WebServerChat.ActiveServer(True);
ChatWebServers[ChatWebServers.Count - 1].WebServerChat.SetDeleteMode
(not ChatWebServer.Freez, ChatWebServer.MaxMsg);
finally
fonts.Free;
f.Free;
t.Free;
end;
end;
procedure TfrOBS.DelChat(aPort: integer);
var
i, j: integer;
begin
// Èùåì â îáðàòíîì ïîðÿäêå äëÿ áåçîïàñíîãî óäàëåíèÿ
for i := High(listChats) downto 0 do
begin
if listChats[i].port = aPort then
begin
// Ñäâèãàåì ýëåìåíòû ìàññèâà
for j := i to High(listChats) - 1 do
listChats[j] := listChats[j + 1];
// Óìåíüøàåì ðàçìåð ìàññèâà
SetLength(listChats, Length(listChats) - 1);
// Âûõîäèì ïîñëå ïåðâîãî íàéäåííîãî ñîâïàäåíèÿ (ïðåäïîëàãàåì óíèêàëüíîñòü ïîðòîâ)
Break;
end;
end;
ChatWebServers[i].WebServerChat.ActiveServer(false);
ChatWebServers[i].WebServerChat.Destroy;
ChatWebServers.Delete(i);
db.SaveRecordArray<TOBSChat>('listChats', listChats);
UpdateGridFromArray;
end;
procedure TfrOBS.DelKandinsky(aPort: integer);
var
i, j: integer;
begin
// Èùåì â îáðàòíîì ïîðÿäêå äëÿ áåçîïàñíîãî óäàëåíèÿ
for i := High(listKandinsky) downto 0 do
begin
if listKandinsky[i].port = aPort then
begin
// Ñäâèãàåì ýëåìåíòû ìàññèâà
for j := i to High(listKandinsky) - 1 do
listKandinsky[j] := listKandinsky[j + 1];
// Óìåíüøàåì ðàçìåð ìàññèâà
SetLength(listKandinsky, Length(listKandinsky) - 1);
// Âûõîäèì ïîñëå ïåðâîãî íàéäåííîãî ñîâïàäåíèÿ (ïðåäïîëàãàåì óíèêàëüíîñòü ïîðòîâ)
Break;
end;
end;
UpdateGridFromArray;
db.SaveRecordArray<TOBSKandinsky>('listKandinsky', listKandinsky);
end;
procedure TfrOBS.DelNotify(aPort: integer);
var
i, j: integer;
begin
// Èùåì â îáðàòíîì ïîðÿäêå äëÿ áåçîïàñíîãî óäàëåíèÿ
for i := High(listNotify) downto 0 do
begin
if listNotify[i].port = aPort then
begin
// Ñäâèãàåì ýëåìåíòû ìàññèâà
for j := i to High(listNotify) - 1 do
listNotify[j] := listNotify[j + 1];
// Óìåíüøàåì ðàçìåð ìàññèâà
SetLength(listNotify, Length(listNotify) - 1);
// Âûõîäèì ïîñëå ïåðâîãî íàéäåííîãî ñîâïàäåíèÿ (ïðåäïîëàãàåì óíèêàëüíîñòü ïîðòîâ)
Break;
end;
end;
UpdateGridFromArray;
db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
end;
procedure TfrOBS.EdtChat(newRecord: TOBSChat; oldPort: integer);
var
i, j: integer;
chatWeb: TChatWebServers; // Âðåìåííàÿ ïåðåìåííàÿ äëÿ çàïèñè
f: TfrColorSettings;
t: TfrFontSettings;
begin
f := TfrColorSettings.Create(self);
t := TfrFontSettings.Create(self);
try
// Îáíîâëÿåì çàïèñü â listChats
for i := 0 to High(listChats) do
if listChats[i].port = oldPort then
begin
listChats[i] := newRecord;
Break;
end;
// Îáíîâëÿåì ñîîòâåòñòâóþùèé ñåðâåð â ChatWebServers
for j := 0 to ChatWebServers.Count - 1 do
begin
// 1. Èçâëåêàåì çàïèñü âî âðåìåííóþ ïåðåìåííóþ
chatWeb := ChatWebServers[j];
if chatWeb.port = oldPort then
begin
// 2. Ìîäèôèöèðóåì ïîëÿ çàïèñè
chatWeb.MaxMsg := newRecord.MaxCountMess;
chatWeb.TimeMsg := newRecord.TimeMess;
chatWeb.Freez := newRecord.Freez = 1;
chatWeb.StyleBorderColor := f.ccbStyleBorderColor.Items[newRecord.ColorBorder];
chatWeb.StyleBlockColor := newRecord.ColorBlock;
chatWeb.StyleBlockBorderSize := newRecord.SolidBorder;
chatWeb.StyleBlockPadding := newRecord.Paddings;
chatWeb.FontStyleDefault := t.cbFontStyleDefault.Items[newRecord.StyleFont];
chatWeb.FontColor := t.ccbFontColor.Items[newRecord.ColorFont];
chatWeb.FontSize := newRecord.SizeFont;
chatWeb.BColor := f.ccbBColor.Items[newRecord.ColorBackground];
chatWeb.WebServerChat.changeBackground(f.ccbBColor.Items[newRecord.ColorBackground]);
chatWeb.WebServerChat.SetDeleteMode(not chatWeb.Freez, chatWeb.MaxMsg);
// 4. Âîçâðàùàåì ìîäèôèöèðîâàííóþ çàïèñü â ñïèñîê
ChatWebServers[j] := chatWeb;
Break;
end;
end;
UpdateGridFromArray;
db.SaveRecordArray<TOBSChat>('listChats', listChats);
finally
f.Free;
t.Free;
end;
end;
procedure TfrOBS.EdtNotify(newRecord: TOBSNotify; oldPort: integer);
var
i: integer;
begin
for i := 0 to High(listNotify) do
if listNotify[i].port = oldPort then
begin
listNotify[i] := newRecord;
UpdateGridFromArray;
db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
Break;
end;
end;
procedure TfrOBS.sgWebChatsCellDblClick(const Column: TColumn;
const Row: integer);
var
myChatRec: TOBSChat;
myNotifyRec: TOBSNotify;
i: integer;
begin
if sgWebChats.Cells[1, Row] = 'Îïîâåùåíèå' then
begin
for i := 0 to High(listNotify) do
if listNotify[i].port = (strtoint(sgWebChats.Cells[0, Row])) then
begin
myNotifyRec := listNotify[i];
Break;
end;
fCreateNotify.isEdit := True;
fCreateNotify.setRecord(myNotifyRec);
fCreateNotify.Show;
end;
if sgWebChats.Cells[1, Row] = '×àò' then
begin
for i := 0 to High(listChats) do
if listChats[i].port = (strtoint(sgWebChats.Cells[0, Row])) then
begin
myChatRec := listChats[i];
Break;
end;
fCreateChat.isEdit := True;
fCreateChat.setRecord(myChatRec);
fCreateChat.Show;
end;
end;
procedure TfrOBS.UpdateGridFromArray;
var
i, rowIndex: integer;
begin
sgWebChats.BeginUpdate;
try
sgWebChats.RowCount := 0; // Ñáðàñûâàåì ñòðîêè
rowIndex := 0; // Îòäåëüíûé ñ÷åò÷èê äëÿ ñòðîê ñåòêè
// listChats
for i := 0 to High(listChats) do
begin
sgWebChats.RowCount := rowIndex + 1;
sgWebChats.Cells[0, rowIndex] := inttostr(listChats[i].port);
sgWebChats.Cells[1, rowIndex] := '×àò';
sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' +
inttostr(listChats[i].port);
Inc(rowIndex); // Óâåëè÷èâàåì ñ÷åò÷èê ñòðîê
end;
// listNotify
for i := 0 to High(listNotify) do
begin
sgWebChats.RowCount := rowIndex + 1;
sgWebChats.Cells[0, rowIndex] := inttostr(listNotify[i].port);
sgWebChats.Cells[1, rowIndex] := 'Îïîâåùåíèå';
sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' +
inttostr(listNotify[i].port);
Inc(rowIndex); // Óâåëè÷èâàåì ñ÷åò÷èê ñòðîê
end;
// listKandinsky
for i := 0 to High(listKandinsky) do
begin
sgWebChats.RowCount := rowIndex + 1;
sgWebChats.Cells[0, rowIndex] := inttostr(listKandinsky[i].port);
sgWebChats.Cells[1, rowIndex] := 'Kandinsky';
sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' +
inttostr(listKandinsky[i].port);
Inc(rowIndex); // Óâåëè÷èâàåì ñ÷åò÷èê ñòðîê
end;
finally
sgWebChats.EndUpdate;
end;
end;
end.