interface

//EngineConstants

//ServerURL=http://www.auto.ru/wwwboards/

//ForumConstansts

//ForumURL=vaz-newpart

const
HT_MESSAGE = '<HR SIZE=6 WIDTH=75%>#*#<HR SIZE=6 WIDTH=75%>#$<P>#*#</P>#$#1-"</P>"#<HR SIZE=6 WIDTH=75%>';
HT_CAPTION = '<!--BEGIN-->#1#<HR SIZE=6 WIDTH=75%>';
HT_CAPTION_BEG = '<!--BEGIN-->';
HT_CAPTION1 = ':</A><BR>#$<UL>#1#<BR><HR SIZE=6 WIDTH=75%>';
HT_HEADER = '<CENTER>[ <A HREF="#1#">#*#<BR>[ <A HREF="#2#"';
HT_ARCHIVE = '<TD align=#*-">"#><A#$href="#1#">#4#&#*#<TD align=#*-">"#>#2#</TD>#$<TD align=#*-">"#>#3#</TD>';
HT_BANNER = '<CENTER>#$#1#</CENTER>';
HT_RECLAMA = '<CENTER>#$#1#</CENTER>';
HT_NEWMESSAGE = '<CENTER>[ <A HREF="#*-"</A>"#</A> ] [ <A HREF="#1#"';
HT_MAIL = '<P>Отправлено : <A HREF="#1#">#2#</A>';

type
TForumServer=class
private
szHTML:String;
function AddToTree(Storage:TMStorage;Node:TMTreeItem;iPos:Integer):Integer;
function InternalUpdateForum(Storage:TMStorage; szURL:String):Integer;
protected
FBanner : String;
FArchiveURL : String;
FNewMessageURL : String;
public
Flags : Integer; //Флаги определяющие возможности сервера
procedure Init; //Инициализация скрипта
function UpdateForum(Storage:TMStorage):Integer;
function GetArchiveList(Archives:TArchives):Integer;
function UpdateForumFromArchive(Item:TArchiveItem):Integer;
function UpdateMessage(Msg:TMTreeItem):Integer;
function GetBanner:String;
function GetNewMessageURL:String;
end;

implementation

procedure TForumServer.Init;
begin
Flags := FC_BANNER or FC_ARCHIVE or FC_SENDLOGIN;
FNewMessageURL := '';
end;

function TForumServer.GetNewMessageURL:String;
begin
Result := FNewMessageURL;
end;

function TForumServer.UpdateForum(Storage:TMStorage):Integer;
var
szURL : String;
TmpStorage : TMStorage;
begin
szURL := ServerURL+ForumURL;
TmpStorage := CreateStorage;
InternalUpdateForum(TmpStorage,szURL);
StateString := 'Обновление форума завершено';
Storage.UpdateStorage(TmpStorage,nil,nil);
TmpStorage.Free;
SendProgress;
end;

function TForumServer.InternalUpdateForum(Storage:TMStorage; szURL:String):Integer;
var
HP : THTMLProcessor;
v :Variant;
i :Integer;
szTmp :String;
begin
StateString := 'Загрузка страницы';
SendProgress;
szHTML:= Inet.ReadURL(szURL,100);
if not IsError then
begin
StateString := 'Обработка страницы';
SendProgress;
HP := THTMLProcessor.Create;
HP.HTML := szHTML;

FBanner := '';

v := HP.FindTemplate(HT_BANNER);
if VarIsArray(v) then
begin
FBanner := '<CENTER>'+v[0]+'</CENTER>';
end;

v := HP.FindTemplate(HT_HEADER);
if VarIsArray(v) then
begin
FNewMessageURL := HostURL+v[0];
FArchiveURL := v[1];
end
else
begin
FArchiveURL := '';
end;

v := HP.FindTemplate(HT_CAPTION);
if not VarIsArray(v) then
begin
i := pos(HT_CAPTION_BEG,szHTML);
if i>0 then
begin
Inc(i,Length(HT_CAPTION_BEG));
v := VarArrayCreate([0,0],varVariant);
v[0] := Copy(szHTML,i,Length(szHTML));
end;
end;

if VarIsArray(v) then
begin
szHTML := v[0];
AddToTree(Storage,nil,1);
end;
HP.Free;
end;
end;

function TForumServer.GetArchiveList(Archives:TArchives):Integer;
begin
end;

function TForumServer.UpdateForumFromArchive(Item:TArchiveItem):Integer;
begin
end;


function TForumServer.UpdateMessage(Msg:TMTreeItem):Integer;
var
HP : THTMLProcessor;
v : Variant;
Author : TAddressItem;
szTmp : String;
tmpStorage : TMStorage;
begin
szHTML:= Inet.ReadURL(HostURL+Msg.URL,100);
if not IsError then
begin
StateString := 'Обработка сообщения';
SendProgress;
HP := THTMLProcessor.Create;
HP.HTML := szHTML;

v := HP.FindTemplate(HT_NEWMESSAGE);
if VarIsArray(v) then
begin
Msg.ReplyURL := HostURL+v[0];
end;

v := HP.FindTemplate(HT_MAIL);
if VarIsArray(v) then
begin
Author := Msg.Parent.Storage.AddressBook.ItemByID[Msg.AuthorID];
if not VarIsNull(Author) then
begin
Author.Name := v[1];
szTmp := v[0];
if pos('mailto:',szTmp)>0 then
szTmp := Copy(szTmp,8,Length(szTmp));
Author.Email:= szTmp;
end;
end;

HP.HTML := szHTML;

v := HP.FindTemplate(HT_MESSAGE);
if VarIsArray(v) then
begin
Msg.Loaded := True;
Msg.MessageText := V[0];
end
else
Msg.MessageText := '';

HP.HTML := szHTML;

v := HP.FindTemplate(HT_CAPTION1);
if VarIsArray(v) then
begin
szHTML := v[0];
tmpStorage := CreateStorage;
try
AddToTree(tmpStorage,nil,1);
Msg.Parent.Storage.UpdateStorage(tmpStorage,Msg.SubMessages,nil);
finally
tmpStorage.Free;
tmpStorage := nil;
end;
end;

HP.Free;
StateString := 'Сообщение успешно загружено';
end;
end;

function TForumServer.GetBanner:String;
begin
end;

function TForumServer.AddToTree(Storage:TMStorage;Node:TMTreeItem; iPos:Integer):Integer;
var
i : Integer;
NNode: TMTreeItem;
v : Variant;
HP : THTMLProcessor;
Author : TAddressItem;
begin
HP := THTMLProcessor.Create;
Result := 0;
i := PosEx('UL>',szHTML,iPos);
while i>0 do
begin
if szHTML[i-1]='/' then
begin
Result := i+2;
break;
end
else
begin
if (Node=nil) then
NNode := Storage.Tree.Add
else
NNode := Node.SubMessages.Add;
HP.HTML := Copy(szHTML,iPos,i+3-iPos);
v := HP.FindTemplate('<!--t: #1-">"#--><LI><A HREF="#2-">"#">#3-"</A>"#</A> - <B>#4-"</B>"#</B> <I>#5-"</I>"#</I>');
if varIsArray(v) then
begin
NNode.Caption := Inet.HTTPDecode(v[2]);
Author := Storage.AddressBook.ItemByName[v[3]];
if VarIsNull(Author) then
begin
Author := Storage.AddressBook.Add;
Author.Name := v[3];
end;
NNode.AuthorID := Author.ID;
try
NNode.Date := StrToDateTime(v[4]);
except
NNode.StringDate := v[4];
end;
NNode.ID := v[0];
NNode.URL := v[1];
NNode.State := msNew;

iPos := AddToTree(Storage,NNode,i+1);
if iPos=0 then
break;
end
else
begin
NNode.Free;
Inc(iPos);
end;
end;
i := PosEx('UL>',szHTML,iPos);
end;
HP.Free;
end;


end.