Все здравствуйте.
Есть такая проблема: пишу на object pascal плагин для The Bat!, с версией бата 3.0.1.1 он работает, с версией бата 4,0,14 а также 3.99.29
нет. Сбой происходит при вызове функции TBPGetDataProc которая позволяет обратится к полученному письму.
Ниже код плагина. Напрашивается вывод, что между 3.0.1.1 и 4.0.14 произошло изменение в батовском API, но не могу найти новую документацию.
Кто умеет писать плагины к бату, помогите пожалуйста (можно не безвозмездно).
Код:
library for_tb;
uses
SysUtils,
Classes,
Dialogs,
Unit1 in 'Unit1.pas' {Form1},
lun in 'lun.pas',
funct in 'funct.pas';
const
midxSubject = 1;
midxDate = 2;
midxComment = 3;
midxInReplyTo = 4;
midxMessageID = 5;
midxNewsgroups = 6;
midxMailer = 7;
midxContentType = 8;
midxContentSubType = 9;
midxExpireDate = 10;
midxOrganization = 11;
midxContentID = 12;
midxContentMD5 = 13;
midxPriority = 14;
midxImportance = 15;
midxContentLocation= 16;
midxEncoding = 17;
midxCharset = 18;
midxBoundary = 19;
midxMsgEncoding = 20;
midxC_Name = 21;
midxCD_Name = 22;
midxReportType = 23;
midxReferences = 24;
midxC_Description = 25;
midxContentDisposition = 26;
midxContentLanguage = 27;
midxC_ID = 29;
midxC_AccessType = 30;
midxC_Expiration = 31;
midxC_Size = 32;
midxC_Permission = 33;
midxC_Site = 34;
midxC_Directory = 35;
midxC_Mode = 36;
midxC_Server = 37;
midxC_Subject = 38;
midx_Files = 39;
midx_Msgs = 40;
midxReturnPath = 41;
midxFromName = 42;
midxFromAddr = 43;
midxReplyName = 44;
midxReplyAddr = 45;
midxToName = 46;
midxToAddr = 47;
midxServerID = 48;
midxRRC = 49;
midxRRQ = 50;
midxFileSubst = 51;
midxC_Number = 52;
midxC_Total = 53;
midxXCFile = 54;
midxMDN_To = 55;
midxMDN_Options = 56;
midxRefList = 57;
midxC_MICAlg = 58;
midxC_SMIMEType = 59;
midxC_Protocol = 60;
midxC_ProtocolType = 61;
midxC_ProtocolSubType=62;
midxMatter = 63;
midxListHelp = 64;
midxListUnsub = 65;
midxListSub = 66;
midxListPost = 67;
midxListOwner = 68;
midxListArchive = 69;
midxDecodedFrom = 70;
midxDecodedTo = 71;
midxDecodedSubj = 72;
midxDecodedToEtc = 73;
mpidMessageHeader = 100000; // raw message RFC 822 header
mpidMessageBody = 100001; // decoded message body (not available yet)
mpidMessageAttachments = 100002; // a CR-delimited list of attachments
mpidMessageSender = 100003; // decoded message sender (FROM)
mpidMessageSubject = 100004; // decoded message subject
mpidRawMessage = 100005; // raw message body
tpxQuotePrefix = 200;
tpxWrapJustify = 201;
tpxClear = 202;
tpxIsSignature = 203;
tpxSignComplete = 204;
tpxEncryptComplete = 205;
tpxUseSMIME = 206;
tpxUsePGP = 207;
tpxRCR = 208;
tpxRRQ = 209;
tpxSplit = 210;
tpxCharset = 211;
tpxPriority = 212;
tpxAttachVCard = 213;
tpxAccount = 214;
tpxFrom = 215;
tpxReplyTo = 216;
tpxReturnPath = 217;
tpxTo = 218;
tpxCC = 219;
tpxBCC = 220;
tpxOrg = 221;
tpxSubject = 222;
tpxFullSubject = 223;
tpxComment = 224;
tpxOldTo = 225;
tpxOldFrom = 226;
tpxOldReplyTo = 227;
tpxOldCC = 228;
tpxOldBCC = 229;
tpxOldSubject = 230;
tpxOldComment = 231;
tpxMatter = 232;
tpxOldMatter = 233;
tpxMsgID = 234;
tpxOldMsgID = 235;
tpxOldDate = 236;
tpxOldRcvDate = 237;
tpxOldReturn = 238;
tpxOldOrg = 239;
tpxOldText = 240;
tpxText = 241;
tpxSingleRe = 242;
tpxHeaders = 243;
tpxAttachments = 244;
tpxOldAttachments = 245;
tpxCookieCount = 246;
tpxOldCharset = 247;
tpxTotalPages = 248;
tpxCurrentPage = 249;
tpxTracking = 248;
tpxQuoteStyle = 249;
tpxTextLF = 250;
tpxRegExpPattern = 251;
tpxRegExpText = 252;
{$E TBP}
{$R *.res}
type
TBPGetDataProc = function(ID, DataID: Integer; Buf: PChar; BufSize: Integer): Integer; stdcall;
type
ITBPDataProvider = interface ['{9DD91B89-A551-4180-8A81-2CCF584CD4BF}']
function GetDataByID(ID: Integer; B: Pointer; BSize: Integer): Integer; stdcall;
function SetDataByID(ID: Integer; B: Pointer; BSize: Integer): Integer; stdcall;
function GetIntValue(ID: Integer): Integer; stdcall;
function SetIntValue(ID, Value: Integer): Integer; stdcall;
function GetIDType(ID: Integer): Integer; stdcall;
function ItemCount: Integer; stdcall;
function ExecuteMacro(AMacro: PChar; MaxLen: Integer; InData, OutData: ITBPDataProvider): HResult; stdcall;
end;
procedure TBP_Initialize; stdcall;
begin
//showMessage('Мой плагин загружен');
Form1 := TForm1.Create(form1);
end;
procedure TBP_Finalize; stdcall;
begin
Form1.Free;
end;
function TBP_GetName(ABuf: PChar; ABufSize: Integer): Integer; stdcall;
var buf:PChar;
begin
if abuf = nil then
begin
//showMessage('не могу передать название: buf указывает на ноль');
result := 60;
exit;
end;
if abufsize < 0 then
begin
//showMessage('не могу передать название: размер буфера менее чем 0');
result := 60;
exit;
end;
//showMessage('передаю название');
Buf := 'Тест-плагин от';
move(buf[0], abuf[0], abufsize);
aBufSize := 60;
result := 60;
//-----------------
//obj.executeMacro('%ACCOUNTNAME',100,ida, oda);
//------------------
exit;
end;
function TBP_GetStatus: Integer; stdcall;
begin
result := 0;
end;
function TBP_NeedCOM: Integer; stdcall;
begin
Result := 1;
end;
function TBP_NeedConfig: Integer; stdcall;
begin
result := 1;
end;
function TBP_Setup: Integer; stdcall;
begin
Form1.Visible := true;
result := 0;
end;
//----------------------------------------------------------------------------
function GetDataStr(Idx, MsgID: Integer; GetData: TBPGetDataProc): String;
var
I, J: Integer;
P: PChar;
Sz: Integer;
begin
P := nil;
Sz := 0;
Result := '';
try
showmessage('Перед первым вызовом (IDx == ' + inttostr(Idx) + ')');
I := GetData(MsgID, Idx, nil, 0);
showmessage('После первого вызова');
if I > 0 then
begin
showmessage('I > 0');
if I > Sz then
begin
ReallocMem(P, I);
Sz := I;
end;
showmessage('Перед вторичным вызовом');
I := GetData(MsgID, Idx, P, Sz);
showmessage('Посторичнгогозова');
if I > 0 then SetString(Result, P, I);
showmessage('После setStr');
end;// else result := '';
except
showmessage('Наше исключение');
Result := '';
end;
FreeMem(P);
end;
//----------------------------------------------------------------------
function TBP_GetSpamScore(MsgID: Integer; GetData: TBPGetDataProc): Integer; stdcall;
var i : Integer;
s,q : string;
tf : textfile;
begin
s :='Пришло какое то письмо, его тема ' + GetDataStr(mpidMessageSubject, MsgID, GetData);
s := s + #13 + 'в ящик ' + GetDataStr(75, MsgID, GetData);
s := s + #13 + 'его отправитель ' + GetDataStr(mpidMessageSender, MsgID, GetData);
q := GetDataStr(mpidMessageBody, MsgID, GetData);
// q := Win_KoiConvert(q);
s := s + 'текст ' + #13 + q;
s := s + #13 + 'ИЛИ: ' + #13 + GetDataStr(mpidRawMessage, MsgID, GetData);
s := s + #13 + 'кодировка '+ GetDataStr( midxmsgEncoding, MsgID, GetData);
s := s + #13 + 'ИЛИ: ' + #13 + GetDataStr(midxCharset, MsgID, GetData);
showmessage(s);
result := -1;
end;
exports TBP_GetSpamScore, TBP_NeedCOM, TBP_Setup, TBP_Initialize, TBP_Finalize, TBP_GetName, TBP_GetStatus, TBP_NeedConfig;
begin
end.