main.pas

这是一套全面的网络组件

    Result := nil;
  end;
end;

function TMainForm.GetSelectedStatus: TclMailMessageStatus;
begin
  Assert(tvFolders.Selected <> nil);
  Result := TclMailMessageStatus(tvFolders.Selected.Data);
end;

procedure TMainForm.MarkasRead1Click(Sender: TObject);
begin
  if (GetSelectedMessage() <> nil) then
  begin
    GetSelectedMessage().MarkedAsRead := True;
  end;
end;

procedure TMainForm.MarkasUnread1Click(Sender: TObject);
begin
  if (GetSelectedMessage() <> nil) then
  begin
    GetSelectedMessage().MarkedAsRead := False;
  end;
end;

procedure TMainForm.Receive1Click(Sender: TObject);
var
  oldCur: TCursor;
begin
  oldCur := Screen.Cursor;
  try
    Screen.Cursor := crHourGlass;
    ReceiveMessages();
  finally
    Screen.Cursor := oldCur;
  end;
end;

procedure TMainForm.Send1Click(Sender: TObject);
var
  oldCur: TCursor;
begin
  oldCur := Screen.Cursor;
  try
    Screen.Cursor := crHourGlass;
    SendMessages();
  finally
    Screen.Cursor := oldCur;
  end;
end;

procedure TMainForm.ReceiveMessages;
var
  i: Integer;
  MsgItem: TclMailMessageItem;
  UIDList: TStrings;
begin
  if clPOP3.Active then Exit;
  try
    EnableWindow(Handle, False);
    FProgress.RetrProgress(1);
    FIsStop := False;
    clPOP3.Server := FAccounts.POP3Server;
    clPOP3.UserName := FAccounts.POP3User;
    clPOP3.Password := FAccounts.POP3Password;
    clPOP3.Port := FAccounts.POP3Port;
    clPOP3.UseTLS := cTlsMode[FAccounts.POP3UseSSL];
    clPOP3.UseSPA := FAccounts.POP3SPA;
    clPOP3.Open();
    UIDList := TStringList.Create();
    try
      clPOP3.GetUIDList(UIDList);
      FProgress.SetupProgress(clPOP3.MessageCount);
      for i := 0 to clPOP3.MessageCount - 1 do
      begin
        if FIsStop then Break;
        if (FMessageList.Find(UIDList[i]) = nil) then
        begin
          MsgItem := FMessageList.Add();
          MsgItem.Status := msInbox;
          MsgItem.UID := UIDList[i];
          clPOP3.Retrieve(i);
          MsgItem.MailMessage.Assign(clPOP3.Response);
          if not FAccounts.LeaveMessage then
          begin
            clPOP3.Delete(i);
          end;
        end else
        if not FAccounts.LeaveMessage then
        begin
          clPOP3.Delete(i);
        end;
        FProgress.StepProgress();
      end;
    finally
      UIDList.Free();
      clPOP3.Close();
    end;
  finally
    FProgress.Hide();
    EnableWindow(Handle, True);
  end;
end;

procedure TMainForm.SendMessages;
var
  i: Integer;
begin
  if clSMTP.Active then Exit;
  try
    EnableWindow(Handle, False);
    FProgress.SendProgress(GetMessageCount(msOutbox));
    FIsStop := False;
    clSMTP.Server := FAccounts.SMTPServer;
    clSMTP.UserName := FAccounts.SMTPUser;
    clSMTP.Password := FAccounts.SMTPPassword;
    clSMTP.Port := FAccounts.SMTPPort;
    clSMTP.UseTLS := cTlsMode[FAccounts.SMTPUseSSL];
    clSMTP.UseSPA := FAccounts.SMTPSPA;
    clSMTP.Open();
    try
      for i := 0 to FMessageList.Count - 1 do
      begin
        if FIsStop then Break;
        if (FMessageList[i].Status = msOutbox) then
        begin
          MessageParser.MessageSource := FMessageList[i].MailMessage;
          clSMTP.MailFrom := MessageParser.From;
          clSMTP.MailToList.Assign(MessageParser.ToList);
          clSMTP.MailToList.AddStrings(MessageParser.CCList);
          clSMTP.MailToList.AddStrings(MessageParser.BCCList);
          clSMTP.MailData.Assign(FMessageList[i].MailMessage);
          clSMTP.Send();
          FMessageList[i].Status := msSent;
          FProgress.StepProgress();
        end;
      end;
    finally
      clSMTP.Close();
    end;
  finally
    FProgress.Hide();
    EnableWindow(Handle, True);
  end;
end;

procedure TMainForm.SendMessage(AMessage: TclMailMessageItem);
var
  oldCur: TCursor;
begin
  if clSMTP.Active or (AMessage = nil) then Exit;
  AMessage.Status := msOutbox;
  if not FAccounts.SendImmediately then Exit;
  oldCur := Screen.Cursor;
  try
    Screen.Cursor := crHourGlass;
    EnableWindow(Handle, False);
    FProgress.SendProgress(1);
    FIsStop := False;
    clSMTP.Server := FAccounts.SMTPServer;
    clSMTP.UserName := FAccounts.SMTPUser;
    clSMTP.Password := FAccounts.SMTPPassword;
    clSMTP.Port := FAccounts.SMTPPort;
    clSMTP.UseTLS := cTlsMode[FAccounts.SMTPUseSSL];
    clSMTP.UseSPA := FAccounts.SMTPSPA;
    clSMTP.Open();
    try
      MessageParser.MessageSource := AMessage.MailMessage;
      clSMTP.MailFrom := MessageParser.From;
      clSMTP.MailToList.Assign(MessageParser.ToList);
      clSMTP.MailToList.AddStrings(MessageParser.CCList);
      clSMTP.MailToList.AddStrings(MessageParser.BCCList);
      clSMTP.MailData.Assign(AMessage.MailMessage);
      clSMTP.Send();
      AMessage.Status := msSent;
      FProgress.StepProgress();
    finally
      clSMTP.Close();
    end;
  finally
    FProgress.Hide();
    EnableWindow(Handle, True);
    Screen.Cursor := oldCur;
  end;
end;

procedure TMainForm.Accounts1Click(Sender: TObject);
begin
  TfrmAccounts.ShowAccounts(FAccounts);
  FPopVerified := False;
  FSmtpVerified := False;
  StoreAccounts();
end;

procedure TMainForm.LoadAccounts();
begin
  FAccounts.Load(GetAccountFileName());
end;

procedure TMainForm.StoreAccounts();
begin
  FAccounts.Store(GetAccountFileName());
end;

procedure TMainForm.About1Click(Sender: TObject);
begin
  ShowMessage('Clever Internet Suite Demos'#$D#$A'www.CleverComponents.com');
end;

procedure TMainForm.Properties1Click(Sender: TObject);
begin
  if (GetSelectedMessage() <> nil) then
  begin
    TfrmMessageSource.ShowMessageSource(GetSelectedMessage().MailMessage);
  end;
end;

procedure TMainForm.lvMessagesCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  i: Integer;
  R, R1: TRect;
begin
  if TclMailMessageItem(Item.Data).MarkedAsRead then
  begin
    Sender.Canvas.Font.Style := [];
  end else
  begin
    Sender.Canvas.Font.Style := [fsBold];
  end;
  if Item.Selected then
  begin
    if Sender.Focused then
    begin
      Sender.Canvas.Brush.Color := clHighlight;
      Sender.Canvas.Font.Color := clHighlightText;
    end else
    begin
      Sender.Canvas.Brush.Color := clBtnFace;
      Sender.Canvas.Font.Color := clWindowText;
    end;
  end else
  begin
    Sender.Canvas.Brush.Color := clWindow;
    Sender.Canvas.Font.Color := clWindowText;
  end;
  ListView_GetItemRect(Item.Handle, Item.Index, R, LVIR_SELECTBOUNDS);
  MessageImages.Draw(Sender.Canvas, R.Left, R.Top, Item.ImageIndex);
  ListView_GetItemRect(Item.Handle, Item.Index, R1, LVIR_ICON);
  R.Left := R.Left + R1.Right - R1.Left;
  Sender.Canvas.FillRect(R);
  for i := 0 to Item.SubItems.Count - 1 do
  begin
    ListView_GetSubItemRect(Item.Handle, Item.Index, i + 1, LVIR_LABEL, @R);
    R.Top := R.Top + ((R.Bottom - R.Top) - Sender.Canvas.TextHeight('W')) div 2;
    R.Bottom := R.Bottom + ((R.Bottom - R.Top) - Sender.Canvas.TextHeight('W')) div 2;
    DrawText(Sender.Canvas.Handle, PChar(Item.SubItems[i]),
      Length(Item.SubItems[i]), R, DT_END_ELLIPSIS);
  end;
  DefaultDraw := False;
end;

procedure TMainForm.lvMessagesKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  Msg: TclMailMessageItem;
begin
  if FEditMode then Exit;
  FEditMode := True;
  try
    if (Key = VK_RETURN) then
    begin
      Msg := GetSelectedMessage();
      if (Msg <> nil) then
      begin
        if TfrmMessage.ShowMessage(Msg) then
        begin
          SendMessage(Msg);
        end;
      end;
    end;
  finally
    FEditMode := False;
  end;
end;

procedure TMainForm.LoadMessage1Click(Sender: TObject);
var
  Msg: TclMailMessageItem;
begin
  if OpenDialog1.Execute() then
  begin
    Msg := FMessageList.Add();
    Msg.Status := msInbox;
    Msg.MailMessage.LoadFromFile(OpenDialog1.FileName);
  end;
end;

procedure TMainForm.SaveMessage1Click(Sender: TObject);
var
  Msg: TclMailMessageItem;
begin
  Msg := GetSelectedMessage();
  if (Msg <> nil) then
  begin
    SaveDialog1.FileName := Msg.Subject + '.' + SaveDialog1.DefaultExt;
    if SaveDialog1.Execute() then
    begin
      Msg.MailMessage.SaveToFile(SaveDialog1.FileName);
    end;
  end;
end;

procedure TMainForm.DoStopProcess(Sender: TObject);
begin
  FIsStop := True;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := not (clSMTP.Active or clPOP3.Active);
  if clSMTP.Active then
    MessageBox(0, 'Mail sending is in progress', 'Warning', MB_OK);
  if clPOP3.Active then
    MessageBox(0, 'Mail retrieving is in progress', 'Warning', MB_OK);
end;

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

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

end.