unit main;
interface
uses Windows, Classes, SysUtils, Dialogs;
type
TCommFortProcess = procedure(dwPluginID : DWORD; dID: DWORD; bOutBuffer : PAnsiChar; dwOutBufferSize : DWORD); stdcall;
TCommFortGetData = function(dwPluginID : DWORD; dwID : DWORD; bInBuffer : PAnsiChar; dwInBufferSize : DWORD; bOutBuffer : PAnsiChar; dwOutBufferSize : DWORD): DWORD; stdcall;
function PluginStart(dwThisPluginID : DWORD; func1 : TCommFortProcess; func2 : TCommFortGetData) : Integer; cdecl; stdcall;
procedure PluginStop(); cdecl; stdcall;
procedure PluginShowOptions(); cdecl; stdcall;
procedure PluginShowAbout(); cdecl; stdcall;
procedure PluginProcess(dwID : DWORD; bInBuffer : PAnsiChar; dwInBufferSize : DWORD); cdecl; stdcall;
function PluginGetData(dwID : DWORD; bInBuffer : PAnsiChar;
dwInBufferSize : DWORD; bOutBuffer : PAnsiChar; dwOutBufferSize : DWORD): DWORD; cdecl; stdcall;
function PluginPremoderation(dwID : DWORD; wText : PWideChar; var dwTextLength : DWORD): Integer; cdecl; stdcall;
function fReadInteger(bInBuffer : PAnsiChar; var iOffset : Integer): Integer;
function fReadText(bInBuffer : PAnsiChar; var iOffset : Integer): WideString;
procedure fWriteInteger(var bOutBuffer : PAnsiChar; var iOffset : Integer; iValue : Integer);
procedure fWriteText(bOutBuffer : PAnsiChar; var iOffset : Integer; uValue : WideString);
function fTextToAnsiString(uText : WideString) : AnsiString;
function fIntegerToAnsiString(iValue : Integer) : AnsiString;
exports PluginStart, PluginStop, PluginProcess, PluginGetData, PluginShowOptions, PluginShowAbout, PluginPremoderation;
implementation
var
dwPluginID : DWORD;
CommFortProcess : TCommFortProcess;
CommFortGetData : TCommFortGetData;
//---------------------------------------------------------------------------
function fReadInteger(bInBuffer : PAnsiChar; var iOffset : Integer): Integer; //вспомогательная функция для упрощения работы с чтением данных
begin
CopyMemory(@Result, bInBuffer + iOffSet, 4);
iOffset := iOffset + 4;
end;
function fReadText(bInBuffer : PAnsiChar; var iOffset : Integer): WideString; //вспомогательная функция для упрощения работы с чтением данных
var iLength : Integer;
begin
CopyMemory(@iLength, bInBuffer + iOffSet, 4);
iOffset := iOffset + 4;
SetLength(Result, iLength);
CopyMemory(@Result[1], bInBuffer + iOffSet, iLength * 2);
iOffset := iOffset + iLength * 2;
end;
//---------------------------------------------------------------------------
procedure fWriteInteger(var bOutBuffer : PAnsiChar; var iOffset : Integer; iValue : Integer); //вспомогательная функция для упрощения работы с записью данных
begin
CopyMemory(bOutBuffer + iOffSet, @iValue, 4);
iOffset := iOffset + 4;
end;
//---------------------------------------------------------------------------
procedure fWriteText(bOutBuffer : PAnsiChar; var iOffset : Integer; uValue : WideString); //вспомогательная функция для упрощения работы с записью данных
var iLength : Integer;
begin
iLength := Length(uValue);
CopyMemory(bOutBuffer + iOffset, @iLength, 4);
iOffset := iOffset + 4;
CopyMemory(bOutBuffer + iOffSet, @uValue[1], iLength * 2);
iOffset := iOffset + iLength * 2;
end;
//---------------------------------------------------------------------------
function fTextToAnsiString(uText : WideString) : AnsiString; //вспомогательная функция для упрощения работы с данными
var iLength : Integer;
begin
//функция предназначена для ознакомительных целей,
//не рекомендуется для реального применения,
//так как при ее использовании проявляется избыточное копирование данных
iLength := Length(uText);
SetLength(Result, 4 + iLength * 2);
CopyMemory(@Result[1], @iLength, 4);
CopyMemory(PAnsiChar(Result) + 4, @uText[1], iLength * 2);
end;
//---------------------------------------------------------------------------
function fIntegerToAnsiString(iValue : Integer) : AnsiString; //вспомогательная функция для упрощения работы с данными
begin
//функция предназначена для ознакомительных целей,
//не рекомендуется для реального применения,
//так как при ее использовании проявляется избыточное копирование данных
SetLength(Result, 4);
CopyMemory(@Result[1], @iValue, 4);
end;
//---------------------------------------------------------------------------
function PluginStart(dwThisPluginID : DWORD; func1 : TCommFortProcess; func2 : TCommFortGetData) : Integer;
var aDataToSend, aData : AnsiString;
iSize, iReadOffset : Integer;
uVersion : WideString;
begin
dwPluginID := dwThisPluginID;
//При инициализации планину присваивается уникальный идентификатор
//его необходимо обязательно сохранить, и указывать
//в качестве первого параметра при инициировании событий
CommFortProcess := func1;
//указываем функцию обратного вызова,
//с помощью которой плагин сможет инициировать события
CommFortGetData := func2;
//указываем функцию обратного вызова,
//с помощью которой можно будет запрашивать необходимые данные от программы
//создаем виртуального пользователя
aDataToSend := fTextToAnsiString('Repeater')+ //имя
fTextToAnsiString('192.168.0.0')+ //IP-адрес
fIntegerToAnsiString(0)+ //пароль в открытом виде
fTextToAnsiString('bkjxzbibe47bed8w7')+ //пароль
fIntegerToAnsiString(0); //иконка мужская
CommFortProcess(dwPluginID, 1001, PAnsiChar(aDataToSend), Length(aDataToSend));
//Пример получения данных от программы (получение версии программы):
iSize := CommFortGetData(dwPluginID, 2001, nil, 0, nil, 0); //получаем объем буфера
SetLength(aData, iSize);
CommFortGetData(dwPluginID, 2001, PAnsiChar(aData), iSize, nil, 0);//заполняем буфер
iReadOffset := 0;
uVersion := fReadText(PAnsiChar(aData), iReadOffset);
ShowMessage('Плагин успешно запущен на сервере CommFort версии - ' + uVersion);
//Возвращаемые значения:
//TRUE - запуск прошел успешно
//FALSE - запуск невозможен
Result := Integer(TRUE);
end;
//---------------------------------------------------------------------------
procedure PluginStop();
begin
//данная функция вызывается при завершении работы плагина
end;
//---------------------------------------------------------------------------
procedure PluginProcess(dwID : DWORD; bInBuffer : PAnsiChar; dwInBufferSize : DWORD);
var iReadOffset, iSenderIcon, iMessageMode : Integer;
aDataToSend : AnsiString;
uVirtualUserLogin, uSenderLogin, uSenderIP, uChannel, uText : WideString;
begin
//Функция приема событий
//Параметры:
//dwID - идентификатор события
//bInBuffer - указатель на данные
//dwInBufferSize - объем данных в байтах
iReadOffset := 0;
if (dwID = 1070) then //сообщение в общий канал
begin
//Получаем данные о событии
uVirtualUserLogin := fReadText(bInBuffer, iReadOffset);
uSenderLogin := fReadText(bInBuffer, iReadOffset);
uSenderIP := fReadText(bInBuffer, iReadOffset);
iSenderIcon := fReadInteger(bInBuffer, iReadOffset);
uChannel := fReadText(bInBuffer, iReadOffset);
iMessageMode := fReadInteger(bInBuffer, iReadOffset);
uText := fReadText(bInBuffer, iReadOffset);
//отправляем личное сообщение
aDataToSend := fTextToAnsiString('Repeater')+ //имя виртуального пользователя
fIntegerToAnsiString(0)+ //тип важности
fTextToAnsiString(uSenderLogin)+
fTextToAnsiString(uText); //сообщение
CommFortProcess(dwPluginID, 1022, PAnsiChar(aDataToSend), Length(aDataToSend))
end;
end;
//---------------------------------------------------------------------------
function PluginGetData(dwID : DWORD; bInBuffer : PAnsiChar; dwInBufferSize : DWORD; bOutBuffer : PAnsiChar; dwOutBufferSize : DWORD): DWORD;
var iWriteOffset, iSize : Integer; //вспомогательные переменные для упрощения работы с блоком данных
uName : WideString;
begin
//функция передачи данных программе
iWriteOffset := 0;
//при значении dwOutBufferSize равным нулю функция должна вернуть объем данных, ничего не записывая
if (dwID = 2800) then //предназначение плагина
begin
if (dwOutBufferSize = 0) then
Result := 4 //объем памяти в байтах, которую необходимо выделить программе
else
begin
fWriteInteger(bOutBuffer, iWriteOffset, 1); //плагин подходит только для сервера
Result := 4;//объем заполненного буфера в байтах
end;
end
else
if (dwID = 2810) then //название плагина (отображается в списке)
begin
uName := 'Repeater (тестовый плагин)';//название плагина
iSize := Length(uName) * 2 + 4;
if (dwOutBufferSize = 0) then
Result := iSize //объем памяти в байтах, которую необходимо выделить программе
else
begin
fWriteText(bOutBuffer, iWriteOffset, uName);
Result := iSize;//объем заполненного буфера в байтах
end;
end
else
Result := 0;//возвращаемое значение - объем записанных данных
end;
//---------------------------------------------------------------------------
function PluginPremoderation(dwID : DWORD; wText : PWideChar; var dwTextLength : DWORD): Integer;
var uCheck, uRet : WideString;
begin
//функция пермодерации
//если Ваш плагин не использует премодерацию, рекомендуем исключить функцию из исходного кода, это сэкономит вычислительные ресурсы
//Важно! Буфер выделяется на 40000 символов. Нельзя вносить в него данные бОльшего объема.
if (dwID = 1000) then// обычный текст в общий канал
begin
uCheck := 'проверка премодерации текста в канале';
//если Delphi ниже 2009 то заменить строчку ниже на эту //if ( StrComp(PAnsiChar(wText), PAnsiChar(uCheck)) = 0) then
if ( StrComp(wText, PWideChar(uCheck)) = 0) then
begin
uRet := 'проверка премодерации текста в канале: успешно';
CopyMemory(wText, @uRet[1], Length(uRet) * 2);
dwTextLength := Length(uRet);//корректируем количество символов
Result := Integer(TRUE);//TRUE означает что буфер был модифицирован
end
else
Result := Integer(FALSE);
end
else
Result := Integer(FALSE);//важно вернуть FALSE в случае если буфер не был модифицирован
end;
//---------------------------------------------------------------------------
procedure PluginShowOptions();
begin
ShowMessage('Options dialog');
end;
//---------------------------------------------------------------------------
procedure PluginShowAbout();
begin
//данная функция вызывается при нажатии кнопки "О плагине" в списке плагинов
ShowMessage('Плагин повторяет личным сообщением все сообщения в общем канале.');
end;
end.