main.pas

这是一套全面的网络组件

end;

procedure TMainWindow.GetFoldersList;
var All, Sub: TStrings;
    i: integer;
begin
  All := TStringList.Create;
  Sub := TStringList.Create;
  try
    Folders.Items.BeginUpdate;
    Folders.Items.Clear;
    if (not clIMAP4.Active) then Exit;
    clIMAP4.GetMailBoxes(All);
    clIMAP4.GetSubscribedMailBoxes(Sub);
    if (FViewMode = clIMAPViewAll) then
      for i:=0 to All.Count-1 do AddFolderToList(All[i], Sub.IndexOf(All[i]) <> -1)
    else
      for i:=0 to Sub.Count-1 do AddFolderToList(Sub[i], True);
  finally
    Folders.Items.EndUpdate;
    All.Free;
    Sub.Free;
  end;
end;

procedure TMainWindow.AddFolderToList(Name: string; Subscribed: boolean);
var Papa, N: TTreeNode;
    S: string;
    i: integer;
begin
  Papa := nil;
  N := Folders.Items.GetFirstNode;
  if Name[1] = clIMAP4.MailBoxSeparator then Delete(Name,1,1);
  while True do begin
    i := Pos(clIMAP4.MailBoxSeparator, Name);
    if (i=0) then begin
      Papa := Folders.Items.AddChild(Papa, Name);
      Papa.ImageIndex := integer(Subscribed);
      Papa.SelectedIndex := integer(Subscribed);
      Break;
    end else begin
      S := Copy(Name, 1, i-1);
      Delete(Name, 1, i);
      while ((N <> nil) and (N.Text <> S)) do N := N.getNextSibling;
      if (N = nil) then begin
        Papa := Folders.Items.AddChild(Papa, S);
      end else
        Papa := N;
      N := Papa.getFirstChild;
    end;
  end;
end;

function TMainWindow.GetFolderName(Node: TTreeNode): string;
begin
  if (Node = nil) then
    Result := ''
  else begin
    Result := Node.Text;
    while (Node.Parent <> nil) do begin
      Node := Node.Parent;
      Result := Node.Text + clImap4.MailBoxSeparator + Result;
    end;
  end;
end;


procedure TMainWindow.UpdateMailboxInfo;
begin
  if not clIMAP4.Active then Exit;
  if Assigned(clIMAP4.CurrentMailBox) and
     (clIMAP4.CurrentMailBox.Name = GetFolderName(Folders.Selected)) then begin
    edFldName.Text := clIMAP4.CurrentMailBox.Name;
    if Folders.Selected.ImageIndex = 1 then
      edSubscribed.Text := 'Yes'
    else
      edSubscribed.Text := 'No';
    if (clIMAP4.CurrentMailBox.ReadOnly) then
      edFldRO.Text := 'Yes'
    else
      edFldRO.Text := 'No';
    edFldExists.Text := IntToStr(clIMAP4.CurrentMailBox.ExistsMessages);
    edFldResent.Text := IntToStr(clIMAP4.CurrentMailBox.RecentMessages);
    edFld1Unseen.Text := IntToStr(clIMAP4.CurrentMailBox.FirstUnseen);
  end else begin
    edFldName.Text := NAStr;
    edSubscribed.Text := NAStr;
    edFldRO.Text := NAStr;
    edFldExists.Text := NAStr;
    edFldResent.Text := NAStr;
    edFld1Unseen.Text := NAStr;
  end;
end;

procedure TMainWindow.actMsgAppendUpdate(Sender: TObject);
begin
  actMsgAppend.Enabled := (clIMAP4.Active and Assigned(clIMAP4.CurrentMailBox));
end;

procedure TMainWindow.actMsgAppendExecute(Sender: TObject);
var Body: TStrings;
    From: string;
begin
  if (clIMAP4.CurrentMailBox.Name = '') then
  begin
    ShowMessage('The mailbox folder is not selected.');
    Exit;
  end;
  Body := TStringList.Create;
  try
    with TAccountData.Create do
      try
        From := EMail;
      finally
        Free;
      end;
    if TfrmMessage.NewMessage(Body, From) then
    begin
      clIMAP4.MailMessage.MessageSource := Body;
      clIMAP4.AppendMessage(clIMAP4.CurrentMailBox.Name, []);
    end;
  finally
    Body.Free;
  end;
  UpdateMailboxInfo;
  UpdateMessages;
end;

procedure TMainWindow.actMsgCopyUpdate(Sender: TObject);
begin
  actMsgCopy.Enabled := (clIMAP4.Active and Assigned(clIMAP4.CurrentMailBox)
                         and Assigned(MsgList.Selected));
end;

procedure TMainWindow.actMsgCopyExecute(Sender: TObject);
begin
  with TCopyDialog.Create(Self) do try
    clIMAP4.GetMailBoxes(cbFolder.Items);
    if (ShowModal = mrOk) then begin
      clIMAP4.CopyMessage(integer(MsgList.Selected.Data), cbFolder.Text);
      UpdateMailboxInfo;
    end;
  finally
    Release;
  end;
end;

procedure TMainWindow.actMsgDeleteUpdate(Sender: TObject);
begin
  actMsgDelete.Enabled := (clIMAP4.Active and Assigned(clIMAP4.CurrentMailBox)
                           and Assigned(MsgList.Selected));
end;

procedure TMainWindow.actMsgDeleteExecute(Sender: TObject);
begin
  clIMAP4.DeleteMessage(integer(MsgList.Selected.Data));
  UpdateMessage(MsgList.Selected);
  UpdateMailboxInfo;
end;

procedure TMainWindow.actMsgPurgeUpdate(Sender: TObject);
begin
  actMsgPurge.Enabled := (clIMAP4.Active and Assigned(clIMAP4.CurrentMailBox));
end;

procedure TMainWindow.actMsgPurgeExecute(Sender: TObject);
begin
  if MessageDlg('Purge all messages in selected folder?', mtConfirmation,
                [mbYes,mbNo], 0) <> mrYes then Abort;
  clIMAP4.PurgeMessages;
  FoldersChange(nil, nil);
end;

procedure TMainWindow.actMsgViewUpdate(Sender: TObject);
begin
  actMsgView.Enabled := (clIMAP4.Active and Assigned(clIMAP4.CurrentMailBox)
                         and Assigned(MsgList.Selected));
  actMsgViewSrc.Enabled := actMsgView.Enabled;
end;

procedure TMainWindow.actMsgViewExecute(Sender: TObject);
var Body: TStrings;
begin
  if (MsgList.Selected = nil) then Exit;
  Body := TStringList.Create;
  try
    clIMAP4.RetrieveMessage(integer(MsgList.Selected.Data));
    TfrmMessage.ShowMessage(clIMAP4.Response, True);
    clIMAP4.SetMessageFlags(integer(MsgList.Selected.Data), fmAdd, [mfSeen]);
    UpdateMessage(MsgList.Selected);
  finally
    Body.Free;
  end;
end;

procedure TMainWindow.actMsgViewSrcExecute(Sender: TObject);
var Body: TStrings;
begin
  if (MsgList.Selected = nil) then Exit;
  Body := TStringList.Create;
  try
    clIMAP4.RetrieveMessage(integer(MsgList.Selected.Data));
    TfrmMessageSource.ShowMessageSource(clIMAP4.Response);
    clIMAP4.SetMessageFlags(integer(MsgList.Selected.Data), fmAdd, [mfSeen]);
    UpdateMessage(MsgList.Selected);
  finally
    Body.Free;
  end;
end;

procedure TMainWindow.actMsgSearchUpdate(Sender: TObject);
begin
  actMsgSearch.Enabled := (clIMAP4.Active and Assigned(clIMAP4.CurrentMailBox));
end;

procedure TMainWindow.actMsgSearchExecute(Sender: TObject);
var S: string;
    List: TStrings;
begin
  if not TSearchDialog.GetSearchCriteria(S) then Exit;
  List := TStringList.Create;
  try
    clIMAP4.SearchMessages(S, List);
    if List.Count = 0 then
      ShowMessage('No messages found.')
    else
      ShowMessage(Format('Found %d message(s).'#$D#$A' Message numbers: %s',
                  [List.Count, StringReplace(List.Text, #$D#$A, ' ', [rfReplaceAll])]));
  finally
    List.Free();
  end;
end;

procedure TMainWindow.UpdateMessage(Item:TListItem);
var Index: integer;
    MF: TclMailMessageFlags;
    Flags: string;
begin
  Index := integer(Item.Data);
  clImap4.RetrieveHeader(Index);
  Item.Caption := IntToStr(Index);
  Item.SubItems.Clear;
  Item.SubItems.Add(IntToStr(clIMAP4.GetMessageSize(Index)));
  Item.SubItems.Add(DateTimeToStr(Parser.Date));
  Item.SubItems.Add(Parser.From);
  Item.SubItems.Add(StringReplace(Parser.ToList.Text,#$0D#$0A, ',', [rfReplaceAll]));
  Item.SubItems.Add(Parser.Subject);
  MF := clIMAP4.GetMessageFlags(Index);
  Flags := '';
  if (mfAnswered in MF) then Flags := Flags + 'Answered,';
  if (mfFlagged in MF) then Flags := Flags + 'Flagged,';
  if (mfDeleted in MF) then Flags := Flags + 'Deleted,';
  if (mfSeen in MF) then Flags := Flags + 'Seen,';
  if (mfDraft in MF) then Flags := Flags + 'Draft,';
  if (mfRecent in MF) then Flags := Flags + 'Recent,';
  if (Flags <> '') and (Flags[Length(Flags)] = ',') then Delete(Flags, Length(Flags), 1);
  Item.SubItems.Add(Flags);
end;

procedure TMainWindow.UpdateMessages;
var Item: TListItem;
    i: integer;
begin
  MsgList.Items.Clear;
  for i:=1 to clIMAP4.CurrentMailBox.ExistsMessages do begin
    Item := MsgList.Items.Add;
    Item.Data := pointer(i);
    UpdateMessage(Item);
  end;
end;

procedure TMainWindow.FoldersChange(Sender: TObject; Node: TTreeNode);
begin
  if Assigned(Folders.Selected) then
    clIMAP4.SelectMailBox(GetFolderName(Folders.Selected));
  UpdateMailboxInfo;
  UpdateMessages;
end;

procedure TMainWindow.clIMAP4Close(Sender: TObject);
begin
  Events.Lines.Add('Disconnect.');
  Folders.Items.Clear;
  UpdateMailboxInfo;
end;

procedure TMainWindow.clIMAP4SendCommand(Sender: TObject; const AText: String);
begin
  Events.Lines.Add(Trim(AText));
end;

procedure TMainWindow.clIMAP4ReceiveResponse(Sender: TObject; AList: TStrings);
begin
  if (AList.Count > 0) and (AList[0] <> '') then
  begin
    Events.Lines.Add(AList[0]);
  end;
end;

procedure TMainWindow.FormDestroy(Sender: TObject);
begin
  clIMAP4.Close();
end;

procedure TMainWindow.clIMAP4VerifyServer(Sender: TObject;
  ACertificate: TclCertificate; const AStatusText: String;
  AStatusCode: Integer; var AVerified: Boolean);
begin
  if not AVerified then
  begin
    AVerified := FCertificateVerified;
  end;
  if not AVerified and (MessageDlg(AStatusText + #13#10' Do you wish to proceed ?',
    mtWarning, [mbYes, mbNo], 0) = mrYes) then
  begin
    AVerified := True;
    FCertificateVerified := True;
  end;
end;

end.