MODULE IMAPClient;
IMPORT
Configuration, Streams, Strings, KernelLog, Classes := TFClasses, Kernel, IMAP, IMAPUtilities, XML, XMLObjects;
CONST
DEBUG = FALSE;
KEEPALIVE = 20 * 1000 * 1;
Port = 143;
OK* = 0;
ERROR* = 1;
DEAD* = -1;
ONLINE* = 0;
OFFLINE * = 1;
DISCONNECTED *= 2;
CONNECTIONERROR* = 3;
AUTHENTICATIONERROR* = 4;
CWFINISHED* = 0;
CWCONNECTING *= 1;
CWLOADING *= 2;
CWCREATING *= 3;
CWRENAMING *= 4;
CWDELETINGFOLDER *= 5;
CWSEARCHING *= 6;
CWCOPYING *= 7;
CWDELETINGMESSAGE *= 8;
CWAPPENDING *= 9;
CWCLOSING *= 10;
CWSAVINGACCOUNT *= 11;
CWLOADINGACCOUNT *= 12;
CWPOLLING *= 13;
CWEXPUNGING *= 14;
CWRESTORING *= 15;
TNothing *= 0;
TLoadAllMessages *= 1;
VAR
globalR: LONGINT;
TYPE
String = Strings.String;
EventListener* = PROCEDURE { DELEGATE };
ErrorListener* = PROCEDURE{ DELEGATE} (CONST s:ARRAY OF CHAR);
Message* = OBJECT
VAR
header*: HeaderElement;
message*: String;
bodystructure*: Bodystructure;
internalDate*: String;
size*: LONGINT;
flags*: Flags;
uID*: LONGINT;
PROCEDURE ToString*():String;
VAR
buffer: Strings.Buffer;
w: Streams.Writer;
s: String;
result: String;
BEGIN
NEW(buffer, 16);
w := buffer.GetWriter();
IF header.date # NIL THEN
w.String("Date: "); w.String(header.date^); w.Ln();
END;
IF header.subject # NIL THEN
w.String("Subject: "); w.String(header.subject^); w.Ln();
END;
IF header.from # NIL THEN
IMAPUtilities.AddressesToString(header.from, s); w.String("From: "); w.String(s^); w.Ln();
END;
IF header.sender # NIL THEN
IMAPUtilities.AddressesToString(header.sender, s); w.String("Sender: "); w.String(s^); w.Ln();
END;
IF header.replyTo # NIL THEN
IMAPUtilities.AddressesToString(header.replyTo, s); w.String("Reply-To: "); w.String(s^); w.Ln();
END;
IF header.to # NIL THEN
IMAPUtilities.AddressesToString(header.to, s); w.String("To: "); w.String(s^); w.Ln();
END;
IF header.cc # NIL THEN
IMAPUtilities.AddressesToString(header.cc, s); w.String("Cc: "); w.String(s^); w.Ln();
END;
IF header.bcc # NIL THEN
IMAPUtilities.AddressesToString(header.from, s); w.String("Bcc: "); w.String(s^); w.Ln();
END;
w.String("Content-type: text/plain; charset="); w.Char(CHR(34)); w.String("utf-8"); w.Char(CHR(34)); w.Ln();
w.String("Content-Transfer-Encoding: quoted-printable"); w.Ln();
w.Ln();
s := IMAPUtilities.NewString(message^);
IMAPUtilities.encodeQuotedPrintable(s);
w.String(s^);
result := buffer.GetString();
RETURN result;
END ToString;
END Message;
Client* = OBJECT
VAR
status-: LONGINT;
currentWork-: LONGINT;
abort*, userAbort*: BOOLEAN;
c: IMAP.Connection;
currentFolder-: Folder;
mailboxContent-: Folder;
getSubFoldersContext: Folder;
FolderIsSynchronized: BOOLEAN;
FolderComplete: BOOLEAN;
Task*: LONGINT;
searchResult-: POINTER TO ARRAY OF LONGINT;
timer*: Kernel.Timer;
observer: EventListener;
errorHandler: ErrorListener;
applySearchFilter*: BOOLEAN;
ret: Classes.List;
numberOfMessages: LONGINT;
preferences*: AccountPreferences;
PROCEDURE &Init*(obs: EventListener; error: ErrorListener);
BEGIN
NEW(preferences);
preferences.LoadStandardConfig();
abort := FALSE; userAbort := FALSE;
observer := obs;
errorHandler := error;
applySearchFilter := FALSE;
FolderIsSynchronized := TRUE;
Task := TNothing;
NEW(timer);
NEW(mailboxContent,"Folders");
mailboxContent.Noselect := TRUE;
currentFolder := mailboxContent;
status := DISCONNECTED;
currentWork := CWFINISHED;
c := NIL;
END Init;
PROCEDURE SetObserverMethod*(m: EventListener);
BEGIN
observer := m;
END SetObserverMethod;
PROCEDURE CallObserverMethod;
BEGIN
IF observer # NIL THEN
observer();
END;
END CallObserverMethod;
PROCEDURE SetErrorHandler*(m: ErrorListener);
BEGIN
errorHandler:= m;
END SetErrorHandler;
PROCEDURE CallErrorHandler(CONST string: ARRAY OF CHAR);
BEGIN
IF errorHandler # NIL THEN
IF DEBUG THEN KernelLog.String(string); KernelLog.Ln(); END;
errorHandler(string);
END;
END CallErrorHandler;
PROCEDURE Connect*(CONST host, user, pass: ARRAY OF CHAR): LONGINT;
BEGIN {EXCLUSIVE}
RETURN ConnectUnlocked(host, user, pass);
END Connect;
PROCEDURE ConnectUnlocked(host, user, pass: ARRAY OF CHAR):LONGINT;
VAR
r: LONGINT;
buffer: Strings.Buffer;
w: Streams.Writer;
errorString: String;
inbox: Folder;
BEGIN
applySearchFilter := FALSE;
userAbort := FALSE;
abort := FALSE;
preferences.IMAPServer := IMAPUtilities.NewString(host);
preferences.UserName := IMAPUtilities.NewString(user);
r := 0;
NEW(c, host, Port, r);
IF r # IMAP.OK THEN
NEW(buffer, 16);
w := buffer.GetWriter();
w.String("Connection to host: ");
w.String(host);
w.String(" could not be estabilshed.");
errorString := buffer.GetString();
CallErrorHandler(errorString^);
status := CONNECTIONERROR;
c := NIL;
RETURN ERROR;
END;
IF c.GetCurrentState() = IMAP.NOAUTH THEN
r := c.Login(user, pass);
IF r # IMAP.OK THEN
CallErrorHandler("Username or Password wrong!");
r := c.Logout();
c := NIL;
status := AUTHENTICATIONERROR;
RETURN ERROR;
END;
END;
status := ONLINE;
currentWork := CWLOADING;
currentFolder := mailboxContent;
r := GetSubFolders(currentFolder);
IF r # OK THEN
currentWork := CWFINISHED;
RETURN r;
END;
inbox := mailboxContent.FindSubFolder("INBOX");
IF inbox # NIL THEN
r := SelectFolderUnlocked(inbox);
ELSE
r := SelectFolderUnlocked(currentFolder);
END;
currentWork := CWFINISHED;
IF r # OK THEN RETURN r; END;
CallObserverMethod();
RETURN OK;
END ConnectUnlocked;
PROCEDURE Disconnect*;
VAR
r: LONGINT;
BEGIN {EXCLUSIVE}
IF status = ONLINE THEN
r := c.Logout();
c := NIL;
END;
NEW(mailboxContent,"Folders");
mailboxContent.Noselect := TRUE;
currentFolder := mailboxContent;
status := DISCONNECTED;
CallObserverMethod();
END Disconnect;
PROCEDURE SwitchToOffline*;
VAR
r: LONGINT;
BEGIN {EXCLUSIVE}
IF status = ONLINE THEN
r := c.Logout();
status := OFFLINE;
CallObserverMethod();
END;
END SwitchToOffline;
PROCEDURE SwitchToOnline*(CONST password: ARRAY OF CHAR);
VAR
r: LONGINT;
BEGIN {EXCLUSIVE}
IF status = OFFLINE THEN
r := ConnectUnlocked(preferences.IMAPServer^, preferences.UserName^, password);
IF r = OK THEN
status := ONLINE;
ELSE
status := OFFLINE;
END;
CallObserverMethod();
END;
END SwitchToOnline;
PROCEDURE CheckAnswer(ret: Classes.List);
VAR
i: LONGINT;
answerP: ANY;
answer: IMAP.Entry;
BEGIN
i := 0;
WHILE i < ret.GetCount() DO
answerP := ret.GetItem(i);
answer := answerP(IMAP.Entry);
IF (answer.command = "EXISTS") THEN
CheckExists(answer);
ELSIF (answer.command = "RECENT") THEN
CheckRecent(answer);
ELSIF (answer.command = "EXPUNGE") THEN
CheckExpunge(answer);
ELSIF answer.command = "SEARCH" THEN
CheckSearch(answer);
ELSIF answer.command = "STATUS" THEN
CheckStatus(answer);
ELSIF answer.command = "LIST" THEN
CheckList(answer);
ELSIF answer.command = "FETCH" THEN
CheckFetch(answer);
ELSIF answer.command = "BYE" THEN
CallErrorHandler("The server kicked us out by sending the BYE command. The client is disconnected.");
c := NIL;
NEW(mailboxContent,"Folders");
mailboxContent.Noselect := TRUE;
currentFolder := mailboxContent;
status := DISCONNECTED;
CallObserverMethod();
END;
INC(i);
END;
CallObserverMethod();
END CheckAnswer;
PROCEDURE CheckExists(answer: IMAP.Entry);
BEGIN
numberOfMessages := answer.number;
FolderIsSynchronized := FALSE;
timer.Wakeup();
END CheckExists;
PROCEDURE CheckRecent(answer: IMAP.Entry);
BEGIN
FolderIsSynchronized := FALSE;
timer.Wakeup();
END CheckRecent;
PROCEDURE CheckExpunge(answer: IMAP.Entry);
VAR
messageP: ANY;
BEGIN
messageP := currentFolder.messages.GetItem(answer.number - 1);
currentFolder.messages.Remove(messageP);
DEC(numberOfMessages);
END CheckExpunge;
PROCEDURE CheckSearch(answer: IMAP.Entry);
VAR
list: Classes.List;
j, count, number: LONGINT;
entP: ANY;
ent: IMAP.Entry;
BEGIN
list := answer.list;
j := 0;
count := list.GetCount();
NEW(searchResult, count);
WHILE j < count DO
entP := list.GetItem(j);
ent := entP(IMAP.Entry);
Strings.StrToInt(ent.data^, number);
searchResult[j] := number-1;
INC(j);
END;
END CheckSearch;
PROCEDURE CheckStatus(answer: IMAP.Entry);
VAR
list: Classes.List;
j: LONGINT;
entP: ANY;
ent: IMAP.Entry;
BEGIN
list := answer.list;
FOR j := 0 TO list.GetCount()-1 BY 2 DO
entP := list.GetItem(j);
ent := entP(IMAP.Entry);
IF ent.data^ = "MESSAGES" THEN
entP := list.GetItem(j+1);
ent := entP(IMAP.Entry);
Strings.StrToInt(ent.data^, numberOfMessages);
END;
END;
END CheckStatus;
PROCEDURE CheckList(answer: IMAP.Entry);
VAR
j: LONGINT;
list, flags: Classes.List;
entP, flagP: ANY;
ent, flag: IMAP.Entry;
path, name: String;
folder, temp: Folder;
BEGIN
folder := getSubFoldersContext;
list := answer.list;
entP := list.GetItem(2);
ent := entP(IMAP.Entry);
IF getSubFoldersContext # mailboxContent THEN
NEW(path, IMAPUtilities.StringLength(folder.path^)+IMAPUtilities.StringLength(folder.name^)+2);
IF folder.parent = mailboxContent THEN
IMAPUtilities.StringCopy(folder.name^, 0, IMAPUtilities.StringLength(folder.name^), path^);
ELSE
IMAPUtilities.StringCopy(folder.path^, 0, IMAPUtilities.StringLength(folder.path^), path^);
path^[IMAPUtilities.StringLength(folder.path^)] := folder.hierarchyDelimiter;
Strings.Append(path^, folder.name^);
END;
name := Strings.Substring2(IMAPUtilities.StringLength(path^) + 1, ent.data^);
ELSE
NEW(path, 1);
path^[0] := 0X;
name := IMAPUtilities.NewString(ent.data^);
END;
temp := folder.FindSubFolder(name^);
IF temp = NIL THEN
NEW(temp, name^);
temp.path := path;
temp.parent := folder;
folder.children.Add(temp);
END;
temp.alive := TRUE;
entP := list.GetItem(0);
ent := entP(IMAP.Entry);
flags := ent.list;
j := 0;
WHILE j < flags.GetCount() DO
flagP := flags.GetItem(j);
flag := flagP(IMAP.Entry);
IF flag.data^ = "Noselect" THEN
temp.Noselect := TRUE;
ELSIF flag.data^ = "Noinferiors" THEN
temp.Noinferiors := TRUE;
ELSIF flag.data^ = "Marked" THEN
temp.Marked := TRUE;
ELSIF flag.data^ = "Unmarked" THEN
temp.Unmarked := TRUE;
END;
INC(j);
END;
entP := list.GetItem(1);
ent := entP(IMAP.Entry);
temp.hierarchyDelimiter := ent.data^[0];
END CheckList;
PROCEDURE CheckFetch(answer: IMAP.Entry);
VAR
list, envList, structureList, subStructureList: Classes.List;
entP, envEntP, structureP: ANY;
ent, envEnt, structure: IMAP.Entry;
j, l: LONGINT;
message: Message;
header: HeaderElement;
bodystructure: Bodystructure;
messageP: ANY;
PROCEDURE Imap2AdrList(entry:IMAP.Entry):Classes.List;
VAR
k: LONGINT;
ent,temp: IMAP.Entry;
entP, tempP:ANY;
inlist, outlist: Classes.List;
address: IMAPUtilities.Address;
BEGIN
NEW(outlist);
IF entry.type # IMAP.LIST THEN RETURN outlist; END;
inlist := entry.list;
FOR k := 0 TO inlist.GetCount()-1 DO
NEW(address);
entP := inlist.GetItem(k);ent := entP(IMAP.Entry);
ASSERT(ent.type = IMAP.LIST,1001);
tempP := ent.list.GetItem(0); temp := tempP(IMAP.Entry);
IF temp.data^ = "NIL" THEN
NEW(address.realName, 1);
COPY("",address.realName^);
ELSE
address.realName := temp.data;
END;
tempP := ent.list.GetItem(2);
temp := tempP(IMAP.Entry);
address.namePart := temp.data;
tempP := ent.list.GetItem(3);
temp := tempP(IMAP.Entry);
address.domainPart := temp.data;
outlist.Add(address);
END;
RETURN outlist;
END Imap2AdrList;
BEGIN
messageP := currentFolder.messages.GetItem(answer.number - 1);
message := messageP(Message);
list := answer.list;
FOR j := 0 TO list.GetCount()-1 BY 2 DO
entP := list.GetItem(j);
ent := entP(IMAP.Entry);
Strings.UpperCase(ent.data^);
IF ent.data^ = "FLAGS" THEN
entP := list.GetItem(j+1);
ent := entP(IMAP.Entry);
NEW(message.flags);
message.flags.ParseList(ent.list);
ELSIF ent.data^ = "INTERNALDATE" THEN
entP := list.GetItem(j+1);
ent := entP(IMAP.Entry);
message.internalDate := ent.data;
ELSIF ent.data^ = "RFC822.SIZE" THEN
entP := list.GetItem(j+1);
ent := entP(IMAP.Entry);
Strings.StrToInt(ent.data^,message.size);
ELSIF ent.data^ = "UID" THEN
entP := list.GetItem(j+1);
ent := entP(IMAP.Entry);
Strings.StrToInt(ent.data^,message.uID);
ELSIF ent.data^ = "ENVELOPE" THEN
NEW(header);
message.header := header;
entP := list.GetItem(j+1);
ent := entP(IMAP.Entry);
envList := ent.list;
envEntP := envList.GetItem(0); envEnt := envEntP(IMAP.Entry); header.date := envEnt.data;
envEntP := envList.GetItem(1); envEnt := envEntP(IMAP.Entry); header.subject := envEnt.data;
envEntP := envList.GetItem(8); envEnt := envEntP(IMAP.Entry); header.inReplyTo := envEnt.data;
envEntP := envList.GetItem(9); envEnt := envEntP(IMAP.Entry); header.messageID := envEnt.data;
envEntP := envList.GetItem(2); envEnt := envEntP(IMAP.Entry); header.from := Imap2AdrList(envEnt);
envEntP := envList.GetItem(3); envEnt := envEntP(IMAP.Entry); header.sender := Imap2AdrList(envEnt);
envEntP := envList.GetItem(4); envEnt := envEntP(IMAP.Entry); header.replyTo := Imap2AdrList(envEnt);
envEntP := envList.GetItem(5); envEnt := envEntP(IMAP.Entry); header.to := Imap2AdrList(envEnt);
envEntP := envList.GetItem(6); envEnt := envEntP(IMAP.Entry); header.cc := Imap2AdrList(envEnt);
envEntP := envList.GetItem(7); envEnt := envEntP(IMAP.Entry); header.bcc := Imap2AdrList(envEnt);
ELSIF ent.data^ = "RFC822.TEXT" THEN
entP := list.GetItem(j+1);
ent := entP(IMAP.Entry);
message.message := IMAPUtilities.NewString(ent.data^);
ELSIF ent.data^ = "BODYSTRUCTURE" THEN
entP := list.GetItem(j+1);
ent := entP(IMAP.Entry);
structureList := ent.list;
structureP := structureList.GetItem(0);
structure := structureP(IMAP.Entry);
NEW(bodystructure);
IF structure.type = IMAP.LIST THEN
Strings.Copy("MULTIPART", 0, 9, bodystructure.type);
bodystructure.subpart := NIL;
ELSE
structureP := structureList.GetItem(0);
structure := structureP(IMAP.Entry);
IMAPUtilities.StringCopy(structure.data^, 0, IMAPUtilities.StringLength(structure.data^), bodystructure.type);
structureP := structureList.GetItem(1);
structure := structureP(IMAP.Entry);
IMAPUtilities.StringCopy(structure.data^, 0, IMAPUtilities.StringLength(structure.data^), bodystructure.subtype);
structureP := structureList.GetItem(5);
structure := structureP(IMAP.Entry);
IMAPUtilities.StringCopy(structure.data^, 0, IMAPUtilities.StringLength(structure.data^), bodystructure.encoding);
structureP := structureList.GetItem(2);
structure := structureP(IMAP.Entry);
subStructureList := structure.list;
IF subStructureList # NIL THEN
FOR l := 0 TO subStructureList.GetCount()-1 BY 2 DO
structureP := subStructureList.GetItem(l);
structure := structureP(IMAP.Entry);
Strings.UpperCase(structure.data^);
IF structure.data^ = "CHARSET" THEN
structureP := subStructureList.GetItem(l+1);
structure := structureP(IMAP.Entry);
IMAPUtilities.StringCopy(structure.data^, 0, IMAPUtilities.StringLength(structure.data^), bodystructure.charset);
END;
END;
END;
bodystructure.subpart := NIL;
END;
message.bodystructure := bodystructure;
END;
END;
END CheckFetch;
PROCEDURE Synchronize(): LONGINT;
VAR
path, items: String;
r, i: LONGINT;
count, step, start, stop, single, fetchStart, fetchStop: LONGINT;
oldMessages, newMessages: Classes.List;
p, pOld: ANY;
message, oldMsg: Message;
found, found2, findable: BOOLEAN;
sortedList: Classes.SortedList;
BEGIN
path := currentFolder.GetPath();
items := Strings.NewString("(MESSAGES RECENT UIDNEXT UIDVALIDITY UNSEEN)");
r := c.Status(path^, items^, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to get the status from the server");
abort := TRUE;
RETURN ERROR;
END;
CheckAnswer(ret);
oldMessages := currentFolder.messages;
NEW(newMessages);
i := 0;
WHILE i < numberOfMessages DO
NEW(message);
newMessages.Add(message);
INC(i);
END;
currentFolder.messages := newMessages;
i := 0;
WHILE i < oldMessages.GetCount() DO
p := oldMessages.GetItem(i);
message := p(Message);
IF message.header = NIL THEN
oldMessages.Remove(p);
ELSE
INC(i);
END;
END;
NEW(sortedList, BiggestUIDFirst);
FOR i := 0 TO oldMessages.GetCount()-1 DO
p := oldMessages.GetItem(i);
message := p(Message);
sortedList.Add(message);
END;
count := numberOfMessages - 1;
step := (numberOfMessages DIV 20) + 1;
WHILE (count >= 0) & (~abort) & (~userAbort) DO
stop := count;
start := count - step + 1;
IF start < 0 THEN
start := 0;
END;
IF ~FolderComplete THEN
r := FetchSomeUIDs(start, stop-start+1);
IF r # OK THEN
abort := TRUE;
RETURN r;
END;
END;
single := stop;
WHILE (single >= start) DO
p := newMessages.GetItem(single);
message := p(Message);
i := 0;
found := FALSE;
findable := TRUE;
WHILE (i < sortedList.GetCount()) & (~found) & (findable) DO
pOld := sortedList.GetItem(i);
oldMsg := pOld(Message);
IF oldMsg.uID = message.uID THEN
found := TRUE;
ELSIF oldMsg.uID < message.uID THEN
findable := FALSE;
ELSE
INC(i);
END;
END;
IF found THEN
oldMsg.flags := message.flags;
newMessages.Replace(p, pOld);
sortedList.Remove(pOld);
END;
DEC(single);
END;
single := stop;
WHILE (single >= start) DO
found := FALSE;
WHILE ((single >= start) & (~found)) DO
p := newMessages.GetItem(single);
message := p(Message);
IF message.header = NIL THEN
found := TRUE;
fetchStop := single;
fetchStart := single;
END;
DEC(single);
END;
found2 := FALSE;
WHILE ((single >= start) & (~found2)) DO
p := newMessages.GetItem(single);
message := p(Message);
IF message.header = NIL THEN
fetchStart := single;
ELSE
found2 := TRUE;
END;
DEC(single);
END;
IF found THEN
r := FetchSomeHeaders(fetchStart, fetchStop-fetchStart+1);
IF r # OK THEN
abort := TRUE;
RETURN r;
END;
END;
END;
count := count - step;
END;
FolderComplete := TRUE;
FolderIsSynchronized := TRUE;
RETURN OK;
END Synchronize;
PROCEDURE DownloadAllMessages(): LONGINT;
VAR
r, count, step: LONGINT;
start, end: LONGINT;
message: Message;
p: ANY;
BEGIN
Task := TNothing;
count := currentFolder.messages.GetCount() - 1;
step := (count DIV 20) + 1;
WHILE (count >= 0) & (~abort) & (~userAbort) DO
p := currentFolder.messages.GetItem(count);
message := p(Message);
WHILE (message.message # NIL) & (message.header # NIL) & (count >= 0) DO
DEC(count);
IF count >= 0 THEN
p := currentFolder.messages.GetItem(count);
message := p(Message);
END;
END;
end := count;
start := count - step + 1;
IF start < 0 THEN
start := 0;
END;
IF count < 0 THEN
RETURN OK;
END;
p := currentFolder.messages.GetItem(count);
message := p(Message);
WHILE ((message.message = NIL) OR (message.header = NIL)) & (count >= start) DO
DEC(count);
IF count >= 0 THEN
p := currentFolder.messages.GetItem(count);
message := p(Message);
END;
END;
start := count;
IF start < 0 THEN
start := 0;
END;
r := FetchSomeMessages(start, end-start+1);
END;
RETURN OK;
END DownloadAllMessages;
PROCEDURE FetchSomeHeaders(idx, len: LONGINT): LONGINT;
VAR
ret: Classes.List;
r: LONGINT;
start, end, set: ARRAY 64 OF CHAR;
BEGIN
Strings.IntToStr(idx+1, start);
Strings.IntToStr(idx+len, end);
IMAPUtilities.StringCopy(start, 0, IMAPUtilities.StringLength(start), set);
Strings.Append(set, ":");
Strings.Append(set, end);
r := c.Fetch(set, "(FLAGS INTERNALDATE RFC822.SIZE ENVELOPE UID)", ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to fetch some headers.");
RETURN ERROR;
END;
CheckAnswer(ret);
RETURN OK;
END FetchSomeHeaders;
PROCEDURE FetchSomeUIDs(idx, len: LONGINT): LONGINT;
VAR
ret: Classes.List;
r: LONGINT;
start, end, set: ARRAY 64 OF CHAR;
BEGIN
Strings.IntToStr(idx+1, start);
Strings.IntToStr(idx+len, end);
IMAPUtilities.StringCopy(start, 0, IMAPUtilities.StringLength(start), set);
Strings.Append(set, ":");
Strings.Append(set, end);
r := c.Fetch(set, "(FLAGS UID)", ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to fetch some UIDs.");
RETURN ERROR;
END;
CheckAnswer(ret);
RETURN OK;
END FetchSomeUIDs;
PROCEDURE FetchSomeMessages(idx, len: LONGINT): LONGINT;
VAR
ret: Classes.List;
r: LONGINT;
start, end, set: ARRAY 64 OF CHAR;
BEGIN
Strings.IntToStr(idx+1, start);
Strings.IntToStr(idx+len, end);
IMAPUtilities.StringCopy(start, 0, IMAPUtilities.StringLength(start), set);
Strings.Append(set, ":");
Strings.Append(set, end);
r := c.Fetch(set, "(FLAGS INTERNALDATE RFC822.SIZE ENVELOPE UID RFC822.TEXT BODYSTRUCTURE)", ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to fetch some messages.");
RETURN ERROR;
END;
CheckAnswer(ret);
RETURN OK;
END FetchSomeMessages;
PROCEDURE FetchMessage*(message: Message): LONGINT;
VAR
i: LONGINT;
number: ARRAY 20 OF CHAR;
ret: Classes.List;
BEGIN {EXCLUSIVE}
IF status # ONLINE THEN
CallErrorHandler("An error happend while trying to fetch a message. The Client is not online.");
RETURN ERROR;
END;
currentWork := CWLOADING;
Strings.IntToStr(message.uID, number);
i := c.UIDFetch(number, "(RFC822.TEXT BODYSTRUCTURE)", ret);
IF i # IMAP.OK THEN
CallErrorHandler("An error happend while trying to fetch a message.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
currentWork := CWFINISHED;
CallObserverMethod();
RETURN OK;
END FetchMessage;
PROCEDURE DeleteMessage*(message: Message; expunge: BOOLEAN): LONGINT;
VAR
set: ARRAY 20 OF CHAR;
ret: Classes.List;
r: LONGINT;
BEGIN {EXCLUSIVE}
IF status # ONLINE THEN
CallErrorHandler("An error happend while trying to delete a message. The Client is not online.");
RETURN ERROR;
END;
currentWork := CWDELETINGMESSAGE;
Strings.IntToStr(message.uID, set);
r := c.UIDStore(set, "\Deleted", TRUE, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to delete a message.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
IF expunge THEN
r := ExpungeUnlocked();
IF r # IMAP.OK THEN
currentWork := CWFINISHED;
RETURN ERROR;
END;
END;
currentWork := CWFINISHED;
CallObserverMethod();
RETURN OK;
END DeleteMessage;
PROCEDURE MoveMessageToTrashBin*(message: Message): LONGINT;
VAR
set: ARRAY 20 OF CHAR;
ret: Classes.List;
r: LONGINT;
folder: String;
BEGIN {EXCLUSIVE}
IF preferences.TrashBin^ = "" THEN
CallErrorHandler("Trash bin is not specified in Preferences.");
RETURN ERROR;
END;
currentWork := CWDELETINGMESSAGE;
Strings.IntToStr(message.uID, set);
folder := currentFolder.GetPath();
IF folder^ # preferences.TrashBin^ THEN
r := CopyMessageUnlocked(message, preferences.TrashBin);
IF r # OK THEN
CallErrorHandler("An error happend while trying to move a message to the trash bin.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
r := c.UIDStore(set, "\Deleted", TRUE, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to delete a message.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
r := ExpungeUnlocked();
IF r # OK THEN
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
currentWork := CWFINISHED;
CallObserverMethod();
RETURN OK;
END;
r := c.UIDStore(set, "\Deleted", TRUE, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to delete a message.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
IF (preferences.ExpungeOnDelete) THEN
r := ExpungeUnlocked();
IF r # OK THEN
currentWork := CWFINISHED;
RETURN ERROR;
END;
END;
currentWork := CWFINISHED;
CallObserverMethod();
RETURN OK;
END MoveMessageToTrashBin;
PROCEDURE RestoreMessage*(message: Message): LONGINT;
VAR
set: ARRAY 20 OF CHAR;
ret: Classes.List;
r: LONGINT;
BEGIN {EXCLUSIVE}
IF status # ONLINE THEN
CallErrorHandler("An error happend while trying to restore a message. The Client is not online.");
RETURN ERROR;
END;
currentWork := CWRESTORING;
Strings.IntToStr(message.uID, set);
r := c.UIDStore(set, "\Deleted", FALSE, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to restore a message.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
currentWork := CWFINISHED;
CallObserverMethod();
RETURN OK;
END RestoreMessage;
PROCEDURE CopyMessage*(message: Message; path: String): LONGINT;
BEGIN {EXCLUSIVE}
RETURN CopyMessageUnlocked(message, path);
END CopyMessage;
PROCEDURE CopyMessageUnlocked*(message: Message; path: String): LONGINT;
VAR
r: LONGINT;
set: ARRAY 20 OF CHAR;
ret: Classes.List;
BEGIN
IF path^ = "" THEN
CallErrorHandler("The Target Folder is not specified. Select a Target Folder before trying to copy!");
RETURN ERROR;
END;
IF status # ONLINE THEN
CallErrorHandler("An error happend while trying to copy a message. The Client is not online.");
RETURN ERROR;
END;
currentWork := CWCOPYING;
Strings.IntToStr(message.uID, set);
r := c.UIDCopy(set, path^, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to copy a message.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
currentWork := CWFINISHED;
CallObserverMethod();
RETURN OK;
END CopyMessageUnlocked;
PROCEDURE AppendMessage*(message: Message; path: String): LONGINT;
VAR
string: String;
r: LONGINT;
ret: Classes.List;
BEGIN {EXCLUSIVE}
IF status # ONLINE THEN
CallErrorHandler("An error happend while trying to append a message. The Client is not online.");
RETURN ERROR;
END;
currentWork := CWAPPENDING;
string := message.ToString();
r := c.Append(path^, string^, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to append a message.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
currentWork := CWFINISHED;
CallObserverMethod();
RETURN OK;
END AppendMessage;
PROCEDURE SetAnsweredFlag*(message: Message): LONGINT;
VAR
set: ARRAY 20 OF CHAR;
ret: Classes.List;
r: LONGINT;
BEGIN {EXCLUSIVE}
IF status # ONLINE THEN
CallErrorHandler("An error happend while trying to set the answered flag of a message. The Client is not online.");
RETURN ERROR;
END;
Strings.IntToStr(message.uID, set);
r := c.UIDStore(set, "\Answered", TRUE, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to set the answered flag of a message.");
RETURN ERROR;
END;
CheckAnswer(ret);
currentWork := CWFINISHED;
CallObserverMethod();
RETURN OK;
END SetAnsweredFlag;
PROCEDURE SaveSentMessage*(message: Message):LONGINT;
VAR
r: LONGINT;
string: String;
ret: Classes.List;
BEGIN {EXCLUSIVE}
IF status # ONLINE THEN
CallErrorHandler("An error happend while trying to save the message. The Client is not online.");
RETURN ERROR;
END;
IF preferences.SentFolder^ = "" THEN
CallErrorHandler("You didn't specify in your Preferences where to store a sent Message.");
RETURN ERROR;
END;
currentWork := CWAPPENDING;
string := message.ToString();
r := c.Append(preferences.SentFolder^, string^, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to save the message.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
currentWork := CWFINISHED;
CallObserverMethod();
RETURN OK;
END SaveSentMessage;
PROCEDURE Expunge*(): LONGINT;
BEGIN {EXCLUSIVE}
RETURN ExpungeUnlocked();
END Expunge;
PROCEDURE ExpungeUnlocked(): LONGINT;
VAR
r: LONGINT;
ret: Classes.List;
BEGIN
IF status # ONLINE THEN
CallErrorHandler("An error happend while trying to expunge. The Client is not online.");
RETURN ERROR;
END;
currentWork := CWEXPUNGING;
r := c.Expunge(ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to expunge.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
currentWork := CWFINISHED;
CallObserverMethod();
RETURN OK;
END ExpungeUnlocked;
PROCEDURE SelectFolder*(folder: Folder): LONGINT;
BEGIN {EXCLUSIVE}
RETURN SelectFolderUnlocked(folder);
END SelectFolder;
PROCEDURE SelectFolderUnlocked(folder: Folder): LONGINT;
VAR
ret: Classes.List;
i: LONGINT;
path: String;
BEGIN
currentWork := CWLOADING;
IF status = OFFLINE THEN
currentFolder := folder;
numberOfMessages := currentFolder.messages.GetCount();
currentWork := CWFINISHED;
ELSIF status = ONLINE THEN
IF currentFolder = folder THEN
currentWork := CWFINISHED;
ELSE
IF (c.GetCurrentState() = IMAP.SELECT) & preferences.ExpungeOnFolderChange THEN
i := c.Close();
END;
i := GetSubFolders(folder);
IF i # OK THEN
CallErrorHandler("An error happend while trying to the subfolders of the Folder.");
currentWork := CWFINISHED;
RETURN i;
END;
IF folder.Noselect = FALSE THEN
path := folder.GetPath();
i := c.Select(path^, ret);
IF i # IMAP.OK THEN
CallErrorHandler("An error happend while trying to select a Folder.");
currentWork := CWFINISHED;
CallObserverMethod();
RETURN ERROR;
END;
currentFolder := folder;
FolderIsSynchronized := FALSE;
FolderComplete := FALSE;
currentWork := CWFINISHED;
timer.Wakeup();
ELSE
currentFolder := folder;
FolderIsSynchronized := TRUE;
currentWork := CWFINISHED;
END;
END;
END;
CallObserverMethod();
RETURN OK;
END SelectFolderUnlocked;
PROCEDURE GetSubFolders(VAR folder: Folder): LONGINT;
VAR
i: LONGINT;
p: ANY;
r: LONGINT;
temp: Folder;
path: String;
ret: Classes.List;
nameLen, pathLen: LONGINT;
BEGIN
i := 0;
WHILE i < folder.children.GetCount() DO
p := folder.children.GetItem(i);
temp := p(Folder);
temp.alive := FALSE;
INC(i);
END;
temp := folder;
path := Strings.NewString("");
WHILE(temp # mailboxContent) & (temp # NIL) DO
temp := temp.parent;
END;
IF (temp = NIL) THEN
CallErrorHandler("An error happend while trying to get the subfolders of a folder which does not belong to the client's folder structure.");
RETURN ERROR;
END;
IF folder = mailboxContent THEN
path := Strings.NewString("%");
ELSE
pathLen := IMAPUtilities.StringLength(folder.path^);
nameLen := IMAPUtilities.StringLength(folder.name^);
IF pathLen = 0 THEN
NEW(path, nameLen + 3);
IMAPUtilities.StringCopy(folder.name^, 0, nameLen, path^);
path[nameLen] := folder.hierarchyDelimiter;
path[nameLen + 1] := "%";
path[nameLen + 2] := 0X;
ELSE
NEW(path, nameLen+pathLen+4);
IMAPUtilities.StringCopy(folder.path^, 0, pathLen, path^);
path[pathLen] := folder.hierarchyDelimiter;
Strings.Append(path^, folder.name^);
path[nameLen + pathLen + 1] := folder.hierarchyDelimiter;
path[nameLen + pathLen + 2] := "%";
path[nameLen + pathLen + 3] := 0X;
END;
END;
IF DEBUG THEN KernelLog.String("Before c.List"); KernelLog.Ln(); END;
r := c.List("", path^, ret);
IF DEBUG THEN KernelLog.String("After c.List r= "); KernelLog.Int(r,0); KernelLog.String(" state= "); KernelLog.Int(c.GetCurrentState(),0); KernelLog.Ln(); END;
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to get the sub folders of a Folder.");
RETURN ERROR;
END;
getSubFoldersContext := folder;
CheckAnswer(ret);
i := 0;
WHILE i < folder.children.GetCount() DO
p := folder.children.GetItem(i);
temp := p(Folder);
IF temp.alive = FALSE THEN
folder.children.Remove(p);
ELSE
INC(i);
END;
END;
CallObserverMethod();
RETURN OK;
END GetSubFolders;
PROCEDURE Close*;
VAR
r: LONGINT;
BEGIN {EXCLUSIVE}
IF DEBUG THEN KernelLog.String("Client is closing..."); KernelLog.Ln(); END;
currentWork := CWCLOSING;
IF status = ONLINE THEN
r := c.Logout();
CheckAnswer(ret);
c := NIL;
END;
status := DEAD;
timer.Wakeup();
END Close;
PROCEDURE Update(): LONGINT;
VAR
i, count: LONGINT;
p: ANY;
message: Message;
ret: Classes.List;
BEGIN
i := c.Noop(ret);
IF i # IMAP.OK THEN
CallErrorHandler("An error happend while trying to get update information from the server.");
RETURN ERROR;
END;
CheckAnswer(ret);
count := 0;
WHILE count < currentFolder.messages.GetCount() DO
p := currentFolder.messages.GetItem(count);
message := p(Message);
IF message.header = NIL THEN
IF DEBUG THEN KernelLog.String("In Update. Message header is NIL"); KernelLog.Ln(); END;
FolderIsSynchronized := FALSE;
END;
INC(count);
END;
CallObserverMethod();
RETURN OK;
END Update;
PROCEDURE Rename*(folder: Folder; VAR name: ARRAY OF CHAR): LONGINT;
VAR
newName: String;
oldName: String;
r: LONGINT;
pathLen: LONGINT;
ret: Classes.List;
parent: Folder;
BEGIN {EXCLUSIVE}
IF status # ONLINE THEN
CallErrorHandler("An error happend while trying to rename a Folder. The Client is not online.");
RETURN ERROR;
END;
currentWork := CWRENAMING;
parent := folder.parent;
oldName := folder.GetPath();
pathLen := IMAPUtilities.StringLength(folder.path^);
IF pathLen = 0 THEN
newName := IMAPUtilities.NewString(name);
ELSE
NEW(newName, pathLen + IMAPUtilities.StringLength(name) + 2);
IMAPUtilities.StringCopy(folder.path^, 0, pathLen, newName^);
newName^[pathLen] := folder.hierarchyDelimiter;
Strings.Append(newName^, name);
END;
IF DEBUG THEN
KernelLog.String("Renaming folder"); KernelLog.Ln();
KernelLog.String("old Name: "); KernelLog.String(oldName^); KernelLog.Ln();
KernelLog.String("new Name: "); KernelLog.String(newName^); KernelLog.Ln();
END;
r := c.Rename(oldName^, newName^, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to rename a Folder.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
r := OK;
IF parent # NIL THEN
r := GetSubFolders(parent);
ELSE
r := GetSubFolders(currentFolder);
END;
currentWork := CWFINISHED;
CallObserverMethod();
RETURN r;
END Rename;
PROCEDURE Delete*(folder: Folder): LONGINT;
VAR
r: LONGINT;
path: String;
ret: Classes.List;
parent: Folder;
BEGIN {EXCLUSIVE}
IF status # ONLINE THEN
CallErrorHandler("An error happend while trying to delete a Folder. The Client is not online.");
RETURN ERROR;
END;
currentWork := CWDELETINGFOLDER;
parent := folder.parent;
path := folder.GetPath();
r := c.Delete(path^, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to delete a Folder.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
r := OK;
IF parent # NIL THEN
r := GetSubFolders(parent);
ELSE
r := GetSubFolders(currentFolder);
END;
currentWork := CWFINISHED;
CallObserverMethod();
RETURN r;
END Delete;
PROCEDURE Create*(folder: Folder; name: ARRAY OF CHAR): LONGINT;
VAR
r: LONGINT;
string: String;
newName: String;
len, pos: LONGINT;
ret: Classes.List;
BEGIN {EXCLUSIVE}
IF status # ONLINE THEN
CallErrorHandler("An error happend while trying to create a Folder. The Client is not online.");
RETURN ERROR;
END;
currentWork := CWCREATING;
string := folder.GetPath();
pos := IMAPUtilities.StringLength(string^);
len := pos + IMAPUtilities.StringLength(name) + 2;
NEW(newName, len);
IMAPUtilities.StringCopy(string^, 0, pos, newName^);
newName^[pos] := folder.hierarchyDelimiter;
newName^[pos+1] := 0X;
Strings.Append(newName^, name);
r := c.Create(newName^, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to create a Folder.");
currentWork := CWFINISHED;
RETURN ERROR;
END;
CheckAnswer(ret);
r := OK;
r := GetSubFolders(folder);
currentWork := CWFINISHED;
CallObserverMethod();
RETURN r;
END Create;
PROCEDURE Search*(string: ARRAY OF CHAR): LONGINT;
VAR
r: LONGINT;
ret: Classes.List;
BEGIN {EXCLUSIVE}
IF status = OFFLINE THEN
RETURN OfflineSearch(string);
END;
IF status # ONLINE THEN
CallErrorHandler("An error happend while trying to search. The Client is not online.");
RETURN ERROR;
END;
currentWork := CWSEARCHING;
r := c.Search(string, ret);
IF r # IMAP.OK THEN
CallErrorHandler("An error happend while trying to search.");
currentWork := CWFINISHED;
CallObserverMethod();
RETURN -1;
END;
CheckAnswer(ret);
applySearchFilter := TRUE;
currentWork := CWFINISHED;
CallObserverMethod();
RETURN LEN(searchResult);
END Search;
PROCEDURE OfflineSearch(string: ARRAY OF CHAR): LONGINT;
VAR
i, count: LONGINT;
reader: Streams.StringReader;
command: String;
Result: POINTER TO ARRAY OF BOOLEAN;
PROCEDURE CheckCommand(CONST command: ARRAY OF CHAR);
VAR
p: ANY;
message: Message;
string, string2: String;
value: LONGINT;
date, internalDate: Date;
temp1, temp2: POINTER TO ARRAY OF BOOLEAN;
BEGIN
NEW(date); NEW(internalDate);
IF DEBUG THEN KernelLog.String("Checking Command: "); KernelLog.String(command); KernelLog.Ln(); END;
IF command = "ANSWERED" THEN
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (~message.flags.answered) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "UNANSWERED" THEN
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (message.flags.answered) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "DELETED" THEN
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (~message.flags.deleted) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "UNDELETED" THEN
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (message.flags.deleted) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "DRAFT" THEN
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (~message.flags.draft) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "UNDRAFT" THEN
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (message.flags.draft) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "FLAGGED" THEN
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (~message.flags.flagged) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "UNFLAGGED" THEN
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (message.flags.flagged) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "SEEN" THEN
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (~message.flags.seen) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "UNSEEN" THEN
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (message.flags.seen) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "RECENT" THEN
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (~message.flags.recent) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "OLD" THEN
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (message.flags.recent) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "SUBJECT" THEN
GetString(string);
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (~IMAPUtilities.StringContains(message.header.subject, string)) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "FROM" THEN
GetString(string);
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IMAPUtilities.AddressesToString(message.header.from, string2);
IF Result[i] & (~IMAPUtilities.StringContains(string2, string)) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "BODY" THEN
GetString(string);
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (~IMAPUtilities.StringContains(message.message, string)) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "LARGER" THEN
GetString(string);
Strings.StrToInt(string^, value);
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (~(message.size > value)) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "SMALLER" THEN
GetString(string);
Strings.StrToInt(string^, value);
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
IF Result[i] & (~(message.size < value)) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "BEFORE" THEN
GetString(string);
date.FromInternalDate(string);
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
internalDate.FromInternalDate(message.internalDate);
IF Result[i] & (~(internalDate.Before(date))) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "ON" THEN
GetString(string);
date.FromInternalDate(string);
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
internalDate.FromInternalDate(message.internalDate);
IF Result[i] & (~(internalDate.Equal(date))) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "SINCE" THEN
GetString(string);
date.FromInternalDate(string);
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
p := currentFolder.messages.GetItem(i);
message := p(Message);
internalDate.FromInternalDate(message.internalDate);
IF Result[i] & (~(date.Before(internalDate))) THEN
Result[i] := FALSE;
END;
END;
ELSIF command= "OR" THEN
reader.SkipWhitespace();
NEW(string, reader.Available() + 1);
reader.Token(string^);
NEW(temp1, currentFolder.messages.GetCount());
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
temp1[i] := Result[i];
Result[i] := TRUE;
END;
CheckCommand(string^);
reader.SkipWhitespace();
reader.Token(string^);
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
temp2[i] := Result[i];
Result[i] := TRUE;
END;
CheckCommand(string^);
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
IF (~Result[i]) & (~temp2[i]) THEN
Result[i] := FALSE;
ELSE
Result[i] := temp1[i];
END;
END;
ELSE
CallErrorHandler("Unknown Search command");
END;
END CheckCommand;
PROCEDURE GetString(VAR string: String);
VAR
s: String;
buffer: Strings.Buffer;
w: Streams.Writer;
c: CHAR;
BEGIN
NEW(buffer, 16);
w := buffer.GetWriter();
reader.SkipWhitespace();
reader.Char(c);
IF c = '"' THEN
reader.Char(c);
WHILE (ORD(c) # 34) DO
w.Char(c);
reader.Char(c);
END;
ELSE
w.Char(c);
NEW(s, reader.Available()+1);
reader.Token(s^);
w.String(s^);
END;
string := buffer.GetString();
END GetString;
BEGIN
currentWork := CWSEARCHING;
IF DEBUG THEN KernelLog.String("Performing offline search. Search string: "); KernelLog.String(string); KernelLog.Ln(); END;
NEW(Result, currentFolder.messages.GetCount());
FOR i := 0 TO currentFolder.messages.GetCount()-1 BY 1 DO
Result[i] := TRUE;
END;
NEW(reader, IMAPUtilities.StringLength(string)+1);
reader.SetRaw(string, 0, IMAPUtilities.StringLength(string));
NEW(command, IMAPUtilities.StringLength(string)+1);
reader.SkipWhitespace();
WHILE reader.Available() > 0 DO
reader.Token(command^);
CheckCommand(command^);
reader.SkipWhitespace();
END;
count := 0;
FOR i := 0 TO LEN(Result)-1 BY 1 DO
IF Result[i] THEN
INC(count);
END;
END;
NEW(searchResult, count);
count := 0;
FOR i := 0 TO LEN(Result) - 1 BY 1 DO
IF Result[i] THEN
searchResult[count] := i;
INC(count);
END;
END;
applySearchFilter := TRUE;
currentWork := CWFINISHED;
CallObserverMethod();
RETURN LEN(searchResult);
END OfflineSearch;
PROCEDURE Save*(VAR doc: XML.Document): LONGINT;
VAR
element, sub: XML.Element;
buf: Strings.Buffer;
w: Streams.Writer;
BEGIN {EXCLUSIVE}
IF DEBUG THEN KernelLog.String("Starting Save"); KernelLog.Ln(); END;
IF (status # ONLINE) & (status # OFFLINE) THEN
CallErrorHandler("An error happend while trying to save the account. The Client is disconnected.");
RETURN ERROR;
END;
currentWork := CWSAVINGACCOUNT;
NEW(doc);
NEW(element);
NEW(sub);
NEW(buf, 16);
w := buf.GetWriter();
element.SetName("account");
doc.AddContent(element);
SavePreferences(element);
ExtractMailboxContent(mailboxContent, element);
currentWork := CWFINISHED;
CallObserverMethod();
RETURN OK;
END Save;
PROCEDURE SavePreferences(element: XML.Element);
VAR
pref, sub: XML.Element;
cdata: XML.CDataSect;
value: String;
PROCEDURE GetBoolean(b: BOOLEAN);
BEGIN
IF b THEN value := Strings.NewString("TRUE"); ELSE value := Strings.NewString("FALSE"); END;
END GetBoolean;
BEGIN
NEW(pref); pref.SetName("preferences");
NEW(sub); sub.SetName("IMAPServer");
NEW(cdata); cdata.SetStr(preferences.IMAPServer^);
sub.AddContent(cdata); pref.AddContent(sub);
NEW(sub); sub.SetName("UserName");
NEW(cdata); cdata.SetStr(preferences.UserName^);
sub.AddContent(cdata); pref.AddContent(sub);
NEW(sub); sub.SetName("SMTPServer");
NEW(cdata); cdata.SetStr(preferences.SMTPServer^);
sub.AddContent(cdata); pref.AddContent(sub);
NEW(sub); sub.SetName("SMTPThisHost");
NEW(cdata); cdata.SetStr(preferences.SMTPThisHost^);
sub.AddContent(cdata); pref.AddContent(sub);
NEW(sub); sub.SetName("SentFolder");
NEW(cdata); cdata.SetStr(preferences.SentFolder^);
sub.AddContent(cdata); pref.AddContent(sub);
NEW(sub); sub.SetName("DraftFolder");
NEW(cdata); cdata.SetStr(preferences.DraftFolder^);
sub.AddContent(cdata); pref.AddContent(sub);
NEW(sub); sub.SetName("TrashBin");
NEW(cdata); cdata.SetStr(preferences.TrashBin^);
sub.AddContent(cdata); pref.AddContent(sub);
NEW(sub); sub.SetName("From");
NEW(cdata); cdata.SetStr(preferences.From^);
sub.AddContent(cdata); pref.AddContent(sub);
NEW(sub); sub.SetName("ExpungeOnFolderChange");
GetBoolean(preferences.ExpungeOnFolderChange);
NEW(cdata); cdata.SetStr(value^);
sub.AddContent(cdata); pref.AddContent(sub);
NEW(sub); sub.SetName("ExpungeOnDelete");
GetBoolean(preferences.ExpungeOnDelete);
NEW(cdata); cdata.SetStr(value^);
sub.AddContent(cdata); pref.AddContent(sub);
NEW(sub); sub.SetName("UseDragNDropAsMove");
GetBoolean(preferences.UseDragNDropAsMove);
NEW(cdata); cdata.SetStr(value^);
sub.AddContent(cdata); pref.AddContent(sub);
NEW(sub); sub.SetName("ExpungeOnMove");
GetBoolean(preferences.ExpungeOnMove);
NEW(cdata); cdata.SetStr(value^);
sub.AddContent(cdata); pref.AddContent(sub);
NEW(sub); sub.SetName("UseATrashBin");
GetBoolean(preferences.UseATrashBin);
NEW(cdata); cdata.SetStr(value^);
sub.AddContent(cdata); pref.AddContent(sub);
element.AddContent(pref)
END SavePreferences;
PROCEDURE ExtractMailboxContent(folder: Folder; element: XML.Element);
VAR
att: XML.Attribute;
string: ARRAY 30 OF CHAR;
sub, subSub: XML.Element;
subFolders: Classes.List;
subFolderP, messageP, addressP: ANY;
subFolder: Folder;
address: IMAPUtilities.Address;
messages: Classes.List;
message: Message;
cdata: XML.CDataSect;
i: LONGINT;
PROCEDURE ExtractAddresses(addresses: Classes.List; CONST tag: ARRAY OF CHAR);
VAR
i: LONGINT;
part: XML.Element;
BEGIN
i := 0;
IF addresses # NIL THEN
WHILE i < addresses.GetCount() DO
addressP := addresses.GetItem(i);
address := addressP(IMAPUtilities.Address);
NEW(subSub);
subSub.SetName(tag);
NEW(part); part.SetName("realName");
NEW(cdata); cdata.SetStr(address.realName^); subSub.AddContent(part); part.AddContent(cdata);
NEW(part); part.SetName("namePart");
NEW(cdata); cdata.SetStr(address.namePart^); subSub.AddContent(part); part.AddContent(cdata);
NEW(part); part.SetName("domainPart");
NEW(cdata); cdata.SetStr(address.domainPart^); subSub.AddContent(part); part.AddContent(cdata);
sub.AddContent(subSub);
INC(i);
END;
END;
END ExtractAddresses;
BEGIN
subFolders := folder.children;
i := 0;
WHILE i < subFolders.GetCount() DO
subFolderP := subFolders.GetItem(i);
subFolder := subFolderP(Folder);
IF DEBUG THEN KernelLog.String("In ExtractMailboxContent: subfolder: "); KernelLog.String(subFolder.name^); KernelLog.Ln(); END;
NEW(sub);
sub.SetName("folder");
NEW(subSub); subSub.SetName("name");
NEW(cdata); cdata.SetStr(subFolder.name^); sub.AddContent(subSub); subSub.AddContent(cdata);
NEW(subSub); subSub.SetName("hierarchyDelimiter");
string[0] := subFolder.hierarchyDelimiter; string[1] := 0X;
NEW(cdata); cdata.SetStr(string); sub.AddContent(subSub); subSub.AddContent(cdata);
ExtractMailboxContent(subFolder, sub);
element.AddContent(sub);
INC(i);
END;
messages := folder.messages;
i := 0;
WHILE i < messages.GetCount() DO
IF DEBUG THEN KernelLog.String("In ExtractMailboxContent: message "); KernelLog.Ln(); END;
messageP := messages.GetItem(i);
message := messageP(Message);
NEW(sub);
sub.SetName("message");
IF message.header # NIL THEN
NEW(subSub); subSub.SetName("date"); sub.AddContent(subSub);
NEW(cdata); cdata.SetStr(message.header.date^); subSub.AddContent(cdata);
NEW(subSub); subSub.SetName("subject"); sub.AddContent(subSub);
NEW(cdata); cdata.SetStr(message.header.subject^); subSub.AddContent(cdata);
NEW(subSub); subSub.SetName("inReplyTo"); sub.AddContent(subSub);
NEW(cdata); cdata.SetStr(message.header.inReplyTo^); subSub.AddContent(cdata);
NEW(subSub); subSub.SetName("messageID"); sub.AddContent(subSub);
NEW(cdata); cdata.SetStr(message.header.messageID^); subSub.AddContent(cdata);
NEW(subSub); subSub.SetName("internalDate"); sub.AddContent(subSub);
NEW(cdata); cdata.SetStr(message.internalDate^); subSub.AddContent(cdata);
NEW(att); string := "size"; att.SetName(string); Strings.IntToStr(message.size, string); att.SetValue(string); sub.AddAttribute(att);
NEW(att); string := "uid"; att.SetName(string); Strings.IntToStr(message.uID, string); att.SetValue(string); sub.AddAttribute(att);
NEW(att); string := "Answered"; att.SetName(string); IF message.flags.answered THEN string := "TRUE" ELSE string := "FALSE" END; att.SetValue(string); sub.AddAttribute(att);
NEW(att); string := "Flagged"; att.SetName(string); IF message.flags.flagged THEN string := "TRUE" ELSE string := "FALSE" END; att.SetValue(string); sub.AddAttribute(att);
NEW(att); string := "Deleted"; att.SetName(string); IF message.flags.deleted THEN string := "TRUE" ELSE string := "FALSE" END; att.SetValue(string); sub.AddAttribute(att);
NEW(att); string := "Seen"; att.SetName(string); IF message.flags.seen THEN string := "TRUE" ELSE string := "FALSE" END; att.SetValue(string); sub.AddAttribute(att);
NEW(att); string := "Recent"; att.SetName(string); IF message.flags.recent THEN string := "TRUE" ELSE string := "FALSE" END; att.SetValue(string); sub.AddAttribute(att);
NEW(att); string := "Draft"; att.SetName(string); IF message.flags.draft THEN string := "TRUE" ELSE string := "FALSE" END; att.SetValue(string); sub.AddAttribute(att);
ExtractAddresses(message.header.from, "from");
ExtractAddresses(message.header.sender, "sender");
ExtractAddresses(message.header.replyTo, "replyTo");
ExtractAddresses(message.header.to, "to");
ExtractAddresses(message.header.cc, "cc");
ExtractAddresses(message.header.bcc, "bcc");
IF message.message # NIL THEN
NEW(subSub); subSub.SetName("text"); sub.AddContent(subSub);
NEW(cdata); cdata.SetStr(message.message^); subSub.AddContent(cdata);
END;
IF message.bodystructure # NIL THEN
NEW(subSub); subSub.SetName("bodystructureType"); sub.AddContent(subSub);
NEW(cdata); cdata.SetStr(message.bodystructure.type); subSub.AddContent(cdata);
NEW(subSub); subSub.SetName("bodystructureSubType"); sub.AddContent(subSub);
NEW(cdata); cdata.SetStr(message.bodystructure.subtype); subSub.AddContent(cdata);
NEW(subSub); subSub.SetName("bodystructureEncoding"); sub.AddContent(subSub);
NEW(cdata); cdata.SetStr(message.bodystructure.encoding); subSub.AddContent(cdata);
NEW(subSub); subSub.SetName("bodystructureCharset"); sub.AddContent(subSub);
NEW(cdata); cdata.SetStr(message.bodystructure.charset); subSub.AddContent(cdata);
END;
element.AddContent(sub);
END;
INC(i);
END;
END ExtractMailboxContent;
PROCEDURE Load*(document:XML.Document): LONGINT;
VAR
buffer: Strings.Buffer;
writer: Streams.Writer;
string: String;
i, r: LONGINT;
element, subElement: XML.Element;
subElements, subSubElements, data: XMLObjects.Enumerator;
cdata: XML.CDataSect;
elementP: ANY;
folder: Folder;
BEGIN {EXCLUSIVE}
currentWork := CWLOADINGACCOUNT;
status := OFFLINE;
NEW(buffer,16);
writer := buffer.GetWriter();
IF document # NIL THEN
element := document.GetRoot();
string := element.GetName();
IF ~Strings.Equal(string, Strings.NewString("account")) THEN
CallErrorHandler("An error happend while trying to load an Account. The file is not compatible");
currentWork := CWFINISHED;
CallObserverMethod();
RETURN ERROR;
END;
subElements := element.GetContents();
WHILE subElements.HasMoreElements() DO
elementP := subElements.GetNext();
subElement := elementP(XML.Element);
string := subElement.GetName();
IF string^ = "preferences" THEN
r := LoadPreferences(subElement);
IF r # OK THEN
CallErrorHandler("An error happend while trying to load the Preferences");
currentWork := CWFINISHED;
RETURN r;
END;
ELSIF string^ = "folder" THEN
subSubElements := subElement.GetContents();
elementP := subSubElements.GetNext();
element := elementP(XML.Element);
data := element.GetContents();
elementP := data.GetNext();
cdata := elementP(XML.CDataSect);
string := cdata.GetStr();
NEW(folder, string^);
elementP := subSubElements.GetNext();
element := elementP(XML.Element);
data := element.GetContents();
elementP := data.GetNext();
cdata := elementP(XML.CDataSect);
string := cdata.GetStr();
folder.hierarchyDelimiter := string^[0];
folder.parent := mailboxContent;
mailboxContent.children.Add(folder);
r := InsertMailboxContent(folder, subElement);
IF r # OK THEN
currentWork := CWFINISHED;
RETURN r;
END;
currentFolder := mailboxContent;
END;
END;
i := mailboxContent.children.GetCount();
IF DEBUG THEN KernelLog.String("Reading File successful"); KernelLog.Ln(); END;
ELSE
CallErrorHandler("Reading failed");
currentWork := CWFINISHED;
RETURN ERROR;
END;
currentWork := CWFINISHED;
CallObserverMethod();
RETURN OK;
END Load;
PROCEDURE LoadPreferences(element: XML.Element): LONGINT;
VAR
subElements, data: XMLObjects.Enumerator;
subElement: XML.Element;
cdata: XML.CDataSect;
p: ANY;
string, value: String;
PROCEDURE GetBoolean(): BOOLEAN;
BEGIN
value := cdata.GetStr();
IF value^ = "TRUE" THEN RETURN TRUE; ELSE RETURN FALSE; END;
END GetBoolean;
BEGIN
IF DEBUG THEN KernelLog.String("In LoadPreferences"); KernelLog.Ln(); END;
subElements := element.GetContents();
WHILE subElements.HasMoreElements() DO
p := subElements.GetNext();
subElement := p(XML.Element);
string := subElement.GetName();
data := subElement.GetContents();
p := data.GetNext();
cdata := p(XML.CDataSect);
IF string^ = "IMAPServer" THEN
preferences.IMAPServer := cdata.GetStr();
ELSIF string^ = "UserName" THEN
preferences.UserName := cdata.GetStr();
ELSIF string^ = "SMTPServer" THEN
preferences.SMTPServer := cdata.GetStr();
ELSIF string^ = "SMTPThisHost" THEN
preferences.SMTPThisHost := cdata.GetStr();
ELSIF string^ = "ExpungeOnFolderChange" THEN
preferences.ExpungeOnFolderChange := GetBoolean();
ELSIF string^ = "ExpungeOnDelete" THEN
preferences.ExpungeOnDelete := GetBoolean();
ELSIF string^ = "UseDragNDropAsMove" THEN
preferences.UseDragNDropAsMove := GetBoolean();
ELSIF string^ = "ExpungeOnMove" THEN
preferences.ExpungeOnMove := GetBoolean();
ELSIF string^ = "UseATrashBin" THEN
preferences.UseATrashBin := GetBoolean();
ELSIF string^ = "SentFolder" THEN
preferences.SentFolder := cdata.GetStr();
ELSIF string^ = "DraftFolder" THEN
preferences.DraftFolder := cdata.GetStr();
ELSIF string^ = "TrashBin" THEN
preferences.TrashBin := cdata.GetStr();
ELSIF string^ = "From" THEN
preferences.From := cdata.GetStr();
ELSE
CallErrorHandler("Invalid name for an XML Element detected");
CallErrorHandler(string^);
RETURN ERROR;
END;
END;
RETURN OK;
END LoadPreferences;
PROCEDURE InsertMailboxContent(folder: Folder; element: XML.Element): LONGINT;
VAR
subElements, messageElements, data: XMLObjects.Enumerator;
elementP: ANY;
subElem, messageElement: XML.Element;
cdata: XML.CDataSect;
address: IMAPUtilities.Address;
elementName, string: String;
subFolder: Folder;
message: Message;
header: HeaderElement;
flag : Flags;
i, r: LONGINT;
PROCEDURE GetAddress(element: XML.Element): IMAPUtilities.Address;
VAR
addressParts: XMLObjects.Enumerator;
part: XML.Element;
address: IMAPUtilities.Address;
i: LONGINT;
BEGIN
NEW(address);
addressParts := element.GetContents();
FOR i := 0 TO 2 DO
elementP := addressParts.GetNext();
part := elementP(XML.Element);
data := part.GetContents();
elementP := data.GetNext();
cdata := elementP(XML.CDataSect);
IF i = 0 THEN address.realName := cdata.GetStr();
ELSIF i = 1 THEN address.namePart := cdata.GetStr();
ELSIF i = 2 THEN address.domainPart := cdata.GetStr();
END;
END;
RETURN address;
END GetAddress;
BEGIN
subElements := element.GetContents();
WHILE subElements.HasMoreElements() DO
elementP := subElements.GetNext();
subElem := elementP(XML.Element);
elementName := subElem.GetName();
IF elementName^ = "name" THEN
data := subElem.GetContents();
elementP := data.GetNext();
cdata := elementP(XML.CDataSect);
folder.name := cdata.GetStr();
ELSIF elementName^ = "hierarchyDelimiter" THEN
data := subElem.GetContents();
elementP := data.GetNext();
cdata := elementP(XML.CDataSect);
string := cdata.GetStr();
folder.hierarchyDelimiter := string^[0];
ELSIF elementName^ = "folder" THEN
NEW(subFolder, "temp");
subFolder.parent := folder;
folder.children.Add(subFolder);
r := InsertMailboxContent(subFolder, subElem);
IF r # OK THEN
currentWork := CWFINISHED;
RETURN ERROR;
END;
ELSIF elementName^ = "message" THEN
NEW(message);
NEW(header);
message.header := header;
NEW(message.header.from);
NEW(message.header.sender);
NEW(message.header.replyTo);
NEW(message.header.to);
NEW(message.header.cc);
NEW(message.header.bcc);
messageElements := subElem.GetContents();
WHILE messageElements.HasMoreElements() DO
elementP := messageElements.GetNext();
messageElement := elementP(XML.Element);
elementName := messageElement.GetName();
IF (elementName^ = "date") OR (elementName^ = "subject") OR (elementName^ = "inReplyTo") OR (elementName^ = "messageID") OR (elementName^ = "internalDate") OR (elementName^ = "text") OR (elementName^ = "bodystructureType") OR (elementName^ = "bodystructureSubType") OR (elementName^ = "bodystructureEncoding") OR (elementName^ = "bodystructureCharset") THEN
data := messageElement.GetContents();
elementP := data.GetNext();
cdata := elementP(XML.CDataSect);
IF elementName^ = "date" THEN
message.header.date := cdata.GetStr();
ELSIF elementName^ = "subject" THEN
message.header.subject := cdata.GetStr();
ELSIF elementName^ = "inReplyTo" THEN
message.header.inReplyTo := cdata.GetStr();
ELSIF elementName^ = "messageID" THEN
message.header.messageID := cdata.GetStr();
ELSIF elementName^ = "internalDate" THEN
message.internalDate := cdata.GetStr();
ELSIF elementName^ = "size" THEN
string := cdata.GetStr();
Strings.StrToInt(string^, message.size);
ELSIF elementName^ = "uid" THEN
string := cdata.GetStr();
Strings.StrToInt(string^, message.uID);
ELSIF elementName^ = "text" THEN
message.message := cdata.GetStr();
ELSIF elementName^ = "bodystructureType" THEN
IF message.bodystructure = NIL THEN
NEW(message.bodystructure);
END;
string := cdata.GetStr();
IMAPUtilities.StringCopy(string^, 0, IMAPUtilities.StringLength(string^), message.bodystructure.type);
ELSIF elementName^ = "bodystructureSubType" THEN
IF message.bodystructure = NIL THEN
NEW(message.bodystructure);
END;
string := cdata.GetStr();
IMAPUtilities.StringCopy(string^, 0, IMAPUtilities.StringLength(string^), message.bodystructure.subtype);
ELSIF elementName^ = "bodystructureEncoding" THEN
IF message.bodystructure = NIL THEN
NEW(message.bodystructure);
END;
string := cdata.GetStr();
IMAPUtilities.StringCopy(string^, 0, IMAPUtilities.StringLength(string^), message.bodystructure.encoding);
ELSIF elementName^ = "bodystructureCharset" THEN
IF message.bodystructure = NIL THEN
NEW(message.bodystructure);
END;
string := cdata.GetStr();
IMAPUtilities.StringCopy(string^, 0, IMAPUtilities.StringLength(string^), message.bodystructure.charset);
END;
ELSIF (elementName^ = "from") OR (elementName^ = "sender") OR (elementName^ = "replyTo") OR (elementName^ = "to") OR (elementName^ = "cc") OR (elementName^ = "bcc") THEN
address := GetAddress(messageElement);
IF elementName^ = "from" THEN
message.header.from.Add(address);
ELSIF elementName^ = "sender" THEN
message.header.sender.Add(address);
ELSIF elementName^ = "replyTo" THEN
message.header.replyTo.Add(address);
ELSIF elementName^ = "to" THEN
message.header.to.Add(address);
ELSIF elementName^ = "cc" THEN
message.header.cc.Add(address);
ELSIF elementName^ = "bcc" THEN
message.header.bcc.Add(address);
END;
ELSE
CallErrorHandler("Invalid XML element name");
RETURN ERROR;
END;
END;
string := subElem.GetAttributeValue("size"); Strings.StrToInt(string^, i); message.size := i;
string := subElem.GetAttributeValue("uid"); Strings.StrToInt(string^, i); message.uID := i;
NEW(flag);
string := subElem.GetAttributeValue("Answered"); IF string^ = "TRUE" THEN flag.answered := TRUE; ELSE flag.answered := FALSE; END;
string := subElem.GetAttributeValue("Flagged"); IF string^ = "TRUE" THEN flag.flagged := TRUE; ELSE flag.flagged := FALSE; END;
string := subElem.GetAttributeValue("Deleted"); IF string^ = "TRUE" THEN flag.deleted := TRUE; ELSE flag.deleted := FALSE; END;
string := subElem.GetAttributeValue("Seen"); IF string^ = "TRUE" THEN flag.seen := TRUE; ELSE flag.seen := FALSE; END;
string := subElem.GetAttributeValue("Recent"); IF string^ = "TRUE" THEN flag.recent := TRUE; ELSE flag.recent := FALSE; END;
string := subElem.GetAttributeValue("Draft"); IF string^ = "TRUE" THEN flag.draft := TRUE; ELSE flag.draft := FALSE; END;
message.flags := flag;
folder.messages.Add(message);
END;
END;
RETURN OK;
END InsertMailboxContent;
BEGIN {ACTIVE} (* keepalive *)
NEW(timer);
WHILE status # DEAD DO
timer.Sleep(KEEPALIVE);
BEGIN {EXCLUSIVE}
IF status = ONLINE THEN
IF Task = TLoadAllMessages THEN
currentWork := CWLOADING;
globalR := DownloadAllMessages();
ELSE
IF FolderIsSynchronized OR abort OR userAbort THEN
currentWork := CWPOLLING;
globalR := Update();
END;
WHILE (~FolderIsSynchronized) & (~abort) & (~userAbort) DO
currentWork := CWLOADING;
globalR := Synchronize();
END;
END;
currentWork := CWFINISHED;
END; (* IF *)
CallObserverMethod();
END (* EXCLUSIVE *);
END (* WHILE *);
IF DEBUG THEN KernelLog.String("Client Activitiy finished"); KernelLog.Ln(); END;
END Client;
Folder* = OBJECT
VAR
name*: String;
path*: String;
hierarchyDelimiter*: CHAR;
parent*: Folder;
children*: Classes.List;
Noinferiors*: BOOLEAN;
Noselect*: BOOLEAN;
Marked*: BOOLEAN;
Unmarked*: BOOLEAN;
messages*: Classes.List;
alive: BOOLEAN;
PROCEDURE &Init*(n: ARRAY OF CHAR);
BEGIN
NEW(name,IMAPUtilities.StringLength(n)+1 );
IMAPUtilities.StringCopy(n,0, IMAPUtilities.StringLength(n), name^);
NEW(path,1);
path^[0] := 0X;
hierarchyDelimiter := 0X;
parent := NIL;
NEW(children);
Noinferiors := FALSE;
Noselect := FALSE;
Marked := FALSE;
Unmarked := FALSE;
NEW(messages);
alive := TRUE;
END Init;
PROCEDURE FindSubFolder(CONST n: ARRAY OF CHAR): Folder;
VAR
i: LONGINT;
sub: Folder;
p: ANY;
BEGIN
i := 0;
WHILE i < children.GetCount() DO
p := children.GetItem(i);
sub := p (Folder);
IF sub.name^ = n THEN
RETURN sub;
END;
INC(i);
END;
RETURN NIL;
END FindSubFolder;
PROCEDURE GetPath*(): String;
VAR
path: String;
pathLen, nameLen: LONGINT;
BEGIN
pathLen := IMAPUtilities.StringLength(SELF.path^);
nameLen := IMAPUtilities.StringLength(SELF.name^);
IF pathLen = 0 THEN
path := IMAPUtilities.NewString(SELF.name^);
ELSE
NEW(path, pathLen + nameLen + 2);
IMAPUtilities.StringCopy(SELF.path^, 0, pathLen, path^);
path^[pathLen] := SELF.hierarchyDelimiter;
path^[pathLen+1] := 0X;
Strings.Append(path^, SELF.name^);
END;
RETURN path;
END GetPath;
END Folder;
HeaderElement* = POINTER TO RECORD
date*: String;
subject*: String;
from*: Classes.List;
sender*: Classes.List;
replyTo*: Classes.List;
to*: Classes.List;
cc*: Classes.List;
bcc*: Classes.List;
inReplyTo*: String;
messageID*: String;
END;
Flags* = OBJECT
VAR
answered*: BOOLEAN;
flagged*: BOOLEAN;
deleted*: BOOLEAN;
seen*: BOOLEAN;
recent*: BOOLEAN;
draft*: BOOLEAN;
PROCEDURE Clear*;
BEGIN
answered := FALSE;
flagged := FALSE;
deleted := FALSE;
seen := FALSE;
recent := FALSE;
draft := FALSE;
END Clear;
PROCEDURE ParseList*(list: Classes.List);
VAR
i: LONGINT;
ent: IMAP.Entry;
entP: ANY;
BEGIN
Clear;
FOR i := 0 TO list.GetCount() - 1 DO
entP := list.GetItem(i); ent := entP(IMAP.Entry);
IMAPUtilities.UpperCase(ent.data^);
IF ent.data^ = "\ANSWERED" THEN answered := TRUE END;
IF ent.data^ = "\FLAGGED" THEN flagged := TRUE END;
IF ent.data^ = "\DELETED" THEN deleted := TRUE END;
IF ent.data^ = "\SEEN" THEN seen := TRUE END;
IF ent.data^ = "\RECENT" THEN recent := TRUE END;
IF ent.data^ = "\DRAFT" THEN draft := TRUE END
END
END ParseList;
PROCEDURE ToString*(VAR string: ARRAY OF CHAR);
BEGIN
string[0] := 0X;
IF answered THEN Strings.Append(string, "A"); ELSE Strings.Append(string, "-") END;
IF flagged THEN Strings.Append(string, "F"); ELSE Strings.Append(string, "-") END;
IF deleted THEN Strings.Append(string, "D"); ELSE Strings.Append(string, "-") END;
IF seen THEN Strings.Append(string, "-"); ELSE Strings.Append(string, "N") END;
IF recent THEN Strings.Append(string, "R"); ELSE Strings.Append(string, "-") END;
IF draft THEN Strings.Append(string, "S"); ELSE Strings.Append(string, "-") END
END ToString;
END Flags;
Bodystructure* = POINTER TO RECORD
type* : ARRAY 32 OF CHAR;
subtype* : ARRAY 32 OF CHAR;
encoding* : ARRAY 32 OF CHAR;
charset*: ARRAY 32 OF CHAR;
subpart* : Classes.List
END;
AccountPreferences* = OBJECT
VAR
IMAPServer*: String;
UserName*: String;
SMTPServer*: String;
SMTPThisHost*: String;
ExpungeOnFolderChange*: BOOLEAN;
ExpungeOnDelete*: BOOLEAN;
UseDragNDropAsMove*: BOOLEAN;
ExpungeOnMove*: BOOLEAN;
UseATrashBin*: BOOLEAN;
SentFolder*: String;
DraftFolder*: String;
TrashBin*: String;
From *: String;
PROCEDURE &New*;
BEGIN
IMAPServer := Strings.NewString("");
UserName := Strings.NewString("");
SMTPServer := Strings.NewString("");
SMTPThisHost := Strings.NewString("");
SentFolder := Strings.NewString("");
DraftFolder := Strings.NewString("");
TrashBin := Strings.NewString("");
From := Strings.NewString("");
END New;
PROCEDURE LoadStandardConfig;
VAR
config : XML.Element;
enum: XMLObjects.Enumerator;
p: ANY;
e: XML.Element;
name, value: XML.String;
PROCEDURE GetBoolean(): BOOLEAN;
BEGIN
IF value^ = "TRUE" THEN RETURN TRUE; ELSE RETURN FALSE; END;
END GetBoolean;
BEGIN
IF DEBUG THEN KernelLog.String("In LoadStandardConfig"); KernelLog.Ln(); END;
config := Configuration.GetSection("Applications.MailClient");
IF config # NIL THEN
enum := config.GetContents();
WHILE enum.HasMoreElements() DO
p := enum.GetNext();
IF p IS XML.Element THEN
e := p(XML.Element);
name := e.GetAttributeValue("name");
value := e.GetAttributeValue("value");
IF name^ = "IMAPServer" THEN
IMAPServer := value;
ELSIF name^ = "UserName" THEN
UserName := value;
ELSIF name^ = "SMTPServer" THEN
SMTPServer := value;
ELSIF name^ = "SMTPThisHost" THEN
SMTPThisHost := value;
ELSIF name^ = "ExpungeOnFolderChange" THEN
ExpungeOnFolderChange := GetBoolean();
ELSIF name^ = "ExpungeOnDelete" THEN
ExpungeOnDelete := GetBoolean();
ELSIF name^ = "UseDragNDropAsMove" THEN
UseDragNDropAsMove := GetBoolean();
ELSIF name^ = "ExpungeOnMove" THEN
ExpungeOnMove := GetBoolean();
ELSIF name^ = "UseATrashBin" THEN
UseATrashBin := GetBoolean();
ELSIF name^ = "SentFolder" THEN
SentFolder := value;
ELSIF name^ = "DraftFolder" THEN
DraftFolder := value;
ELSIF name^ = "TrashBin" THEN
TrashBin := value;
ELSIF name^ = "From" THEN
From := value;
ELSE
IF DEBUG THEN KernelLog.String("Unknown Setting in Configuration.XML Section: IMAP Setting: "); KernelLog.String(name^); KernelLog.Ln(); END;
END;
END;
END;
END;
END LoadStandardConfig;
END AccountPreferences;
Date* = OBJECT
VAR
day, month, year: LONGINT;
PROCEDURE Equal*(otherDate: Date): BOOLEAN;
BEGIN
RETURN (otherDate.day = day) & (otherDate.month = month) & (otherDate.year = year);
END Equal;
PROCEDURE Before*(otherDate: Date): BOOLEAN;
BEGIN
IF year < otherDate.year THEN
RETURN TRUE;
ELSIF otherDate.year < year THEN
RETURN FALSE;
END;
IF month < otherDate.month THEN
RETURN TRUE;
ELSIF otherDate.month < month THEN
RETURN FALSE;
END;
IF day < otherDate.day THEN
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END Before;
PROCEDURE FromInternalDate(string: String);
VAR
d: ARRAY 3 OF CHAR;
m: ARRAY 4 OF CHAR;
y: ARRAY 5 OF CHAR;
BEGIN
IF string^[1] = "-" THEN
Strings.Copy(string^, 0,1, d);
Strings.Copy(string^, 2, 3, m);
Strings.Copy(string^, 6, 4, y);
ELSIF string^[2] = "-" THEN
IF string^[0] = " " THEN
Strings.Copy(string^, 1, 1, d);
ELSE
Strings.Copy(string^, 0, 2, d);
END;
Strings.Copy(string^, 3, 3, m);
Strings.Copy(string^, 7, 4, y);
ELSE
END;
Strings.StrToInt(d, day);
IF m = "Jan" THEN
month := 1;
ELSIF m = "Feb" THEN
month := 2;
ELSIF m = "Mar" THEN
month := 3;
ELSIF m = "Apr" THEN
month := 4;
ELSIF m = "May" THEN
month := 5;
ELSIF m = "Jun" THEN
month := 6;
ELSIF m = "Jul" THEN
month := 7;
ELSIF m = "Aug" THEN
month := 8;
ELSIF m = "Sep" THEN
month := 9;
ELSIF m = "Oct" THEN
month := 10;
ELSIF m = "Nov" THEN
month := 11;
ELSIF m = "Dec" THEN
month := 12;
END;
Strings.StrToInt(y, year);
END FromInternalDate;
END Date;
Time *= OBJECT
VAR
hour, minute, second: LONGINT;
PROCEDURE Equal*(otherTime: Time): BOOLEAN;
BEGIN
RETURN (otherTime.hour = hour) & (otherTime.minute = minute) & (otherTime.second = second);
END Equal;
PROCEDURE Before*(otherTime: Time): BOOLEAN;
BEGIN
IF hour < otherTime.hour THEN
RETURN TRUE;
ELSIF otherTime.hour < hour THEN
RETURN FALSE;
END;
IF minute < otherTime.minute THEN
RETURN TRUE;
ELSIF otherTime.minute < minute THEN
RETURN FALSE;
END;
IF second < otherTime.second THEN
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END Before;
PROCEDURE FromInternalDate(string: String);
VAR
h, m, s: ARRAY 3 OF CHAR;
str: String;
BEGIN
str := string;
Strings.Copy(string^, 12, 2, h);
Strings.Copy(string^, 15, 2, m);
Strings.Copy(string^, 18, 2, s);
Strings.StrToInt(h, hour);
Strings.StrToInt(m, minute);
Strings.StrToInt(s, second);
END FromInternalDate;
END Time;
DateTime *= OBJECT
VAR
time: Time;
date: Date;
PROCEDURE &New*;
BEGIN
NEW(time);
NEW(date);
END New;
PROCEDURE Equal*(otherDateTime: DateTime): BOOLEAN;
BEGIN
RETURN date.Equal(otherDateTime.date) & time.Equal(otherDateTime.time);
END Equal;
PROCEDURE Before*(otherDateTime:DateTime): BOOLEAN;
BEGIN
IF date.Before(otherDateTime.date) THEN
RETURN TRUE;
ELSIF otherDateTime.date.Before(date) THEN
RETURN FALSE;
ELSE
IF time.Before(otherDateTime.time) THEN
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END;
END Before;
PROCEDURE FromInternalDate*(string: String);
BEGIN
time.FromInternalDate(string);
date.FromInternalDate(string);
END FromInternalDate;
END DateTime;
PROCEDURE OldestFirst*(x,y: ANY): LONGINT;
VAR
m1, m2: Message;
h1, h2: HeaderElement;
dt1, dt2: DateTime;
BEGIN
m1 := x(Message);
m2 := y(Message);
h1 := m1.header;
h2 := m2.header;
IF h1 = NIL THEN
RETURN 1;
END;
IF h2 = NIL THEN
RETURN -1;
END;
IF (m1.internalDate = NIL) OR (m1.internalDate^ = "") THEN
RETURN 1;
END;
IF (m2.internalDate = NIL) OR (m2.internalDate^ = "") THEN
RETURN -1;
END;
NEW(dt1); NEW(dt2);
dt1.FromInternalDate(m1.internalDate);
dt2.FromInternalDate(m2.internalDate);
IF dt1.Equal(dt2) THEN RETURN 0; END;
IF dt1.Before(dt2) THEN
RETURN 1;
ELSE
RETURN -1;
END;
END OldestFirst;
PROCEDURE BiggestUIDFirst*(x,y: ANY): LONGINT;
VAR
m1, m2: Message;
h1, h2: HeaderElement;
BEGIN
m1 := x(Message);
m2 := y(Message);
h1 := m1.header;
h2 := m2.header;
IF h1 = NIL THEN
RETURN 1;
END;
IF h2 = NIL THEN
RETURN -1;
END;
IF m1.uID < m2.uID THEN
RETURN 1;
ELSE
RETURN -1;
END;
END BiggestUIDFirst;
END IMAPClient.