⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 demoform.pas

📁 Documentation included in source code (mail2000.pas).
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  bRefreshClick(Sender);
end;

procedure TForm1.bDelLabelClick(Sender: TObject);
begin

  Msg.SetLabelValue(eLabel.Text, '');
  bRefreshClick(Sender);
end;

procedure TForm1.bSaveHeaderClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;

  Msg.ToList.Clear;
  Msg.CcList.Clear;
  Msg.SetFrom(eFromName.Text, eFromAddress.Text);
  Msg.SetReplyTo(eReplyName.Text, eReplyAddress.Text);
  Msg.Subject := eSubject.Text;
  Msg.Date := Int(dtDate.DateTime) + dtTime.DateTime - Int(dtTime.DateTime);

  if mToNames.Items.Count > 0 then
    Msg.ToList.SetAll(mToNames.Items.CommaText, mToAddresses.Items.CommaText);

  if mCcNames.Items.Count > 0 then
    Msg.CcList.SetAll(mCcNames.Items.CommaText, mCcAddresses.Items.CommaText);

  Screen.Cursor := crDefault;
  bRefreshClick(Sender);
end;

procedure TForm1.bSaveClick(Sender: TObject);
begin

  SaveDialog.FileName := Msg.AttachList[lbFiles.ItemIndex].FileName;

  if SaveDialog.Execute then
  begin

    Screen.Cursor := crHourglass;
    Msg.AttachList[lbFiles.ItemIndex].Decoded.SaveToFile(SaveDialog.FileName);
    Screen.Cursor := crDefault;
  end;
end;

procedure TForm1.bAttachClick(Sender: TObject);
begin

  if OpenDialog.Execute then
  begin

    Screen.Cursor := crHourglass;
    Msg.AttachFile(OpenDialog.FileName, '', etBase64, cbEmbedded.Checked);
    bRefreshClick(Sender);
    Screen.Cursor := crDefault;
  end;
end;

procedure TForm1.bPlainClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  Msg.SetTextPlain(mTextPlain.Lines.Text);
  bRefreshClick(Sender);
  Screen.Cursor := crDefault;
end;

procedure TForm1.bHtmlClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  Msg.SetTextHTML(mTextHtml.Lines.Text);
  bRefreshClick(Sender);
  Screen.Cursor := crDefault;
end;

procedure TForm1.FormShow(Sender: TObject);
begin

  PageControl1.ActivePage := PageControl1.Pages[0];
  PageControl2.ActivePage := PageControl2.Pages[0];
  dtDate.DateTime := Now;
  dtTime.DateTime := Now;
  bRefreshClick(Sender);
end;

procedure TForm1.bSaveMsgClick(Sender: TObject);
begin

  SaveDialog.FileName := 'message.eml';

  if SaveDialog.Execute then
  begin

    Screen.Cursor := crHourglass;
    Msg.SaveToFile(SaveDialog.FileName);
    Screen.Cursor := crDefault;
  end;
end;

procedure TForm1.bSmtpConnectClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  SMTP.Host := eSmtpHost.Text;
  SMTP.Port := StrToInt(eSmtpPort.Text);

  if SMTP.Connect then
  begin

    lSmtpStatus.Caption := 'Connected';
    bSmtpDisconnect.Enabled := True;
    bSmtpConnect.Enabled := False;
    bSend.Enabled := True;
  end
  else
  begin

    SMTP.Abort;
    lSmtpStatus.Caption := 'Failed on connect';
  end;

  mSmtpResponse.Lines.Text := SMTP.LastResponse;
  Screen.Cursor := crDefault;
end;

procedure TForm1.bSmtpDisconnectClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;

  if SMTP.Quit then
  begin

    lSmtpStatus.Caption := 'Disconnected';
  end
  else
  begin

    SMTP.Abort;
    lSmtpStatus.Caption := 'Failed on quit';
  end;

  mSmtpResponse.Lines.Text := SMTP.LastResponse;
  bSmtpDisconnect.Enabled := False;
  bSmtpConnect.Enabled := True;
  bSend.Enabled := False;
  Screen.Cursor := crDefault;
end;

procedure TForm1.bSendClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;

  if Msg.NeedRebuild then
  begin

    lSmtpStatus.Caption := 'Message body needs rebuild';
    Exit;
  end;

  if SMTP.SendMessage then
  begin

    lSmtpStatus.Caption := 'Message sent';
  end
  else
  begin

    lSmtpStatus.Caption := 'Failed on send';
  end;

  mSmtpResponse.Lines.Text := SMTP.LastResponse;
  Screen.Cursor := crDefault;
end;

procedure TForm1.bLoadMsgClick(Sender: TObject);
begin

  if OpenDialog.Execute then
  begin

    Screen.Cursor := crHourglass;
    Msg.LoadFromFile(OpenDialog.FileName);
    Screen.Cursor := crDefault;

    bRefreshClick(Sender);
  end;
end;

procedure TForm1.bRemoveClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  Msg.DetachFileIndex(lbFiles.ItemIndex);
  Screen.Cursor := crDefault;
  bRefreshClick(Sender);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin

  if POP.SessionConnected or SMTP.SessionConnected then Action := caNone;
end;

procedure TForm1.POPProgress(Sender: TObject; Total, Current: Integer);
begin

  ProgressBar1.Max := Total;
  ProgressBar1.Position := Current;
end;

procedure TForm1.MsgProgress(Sender: TObject; Total, Current: Integer);
begin

  ProgressBar2.Max := Total;
  ProgressBar2.Position := Current;
end;

procedure TForm1.SMTPProgress(Sender: TObject; Total, Current: Integer);
begin

  ProgressBar3.Max := Total;
  ProgressBar3.Position := Current;
end;

procedure TForm1.bPlainRemoveClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  Msg.RemoveTextPlain;
  Screen.Cursor := crDefault;
  bRefreshClick(Sender);
end;

procedure TForm1.bHtmlRemoveClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  Msg.RemoveTextHTML;
  Screen.Cursor := crDefault;
  bRefreshClick(Sender);
end;

procedure TForm1.bAddToClick(Sender: TObject);
begin

  mToNames.Items.Add(eToName.Text);
  mToAddresses.Items.Add(eToAddress.Text);
  eToName.Text := '';
  eToAddress.Text := '';
end;

procedure TForm1.bAddCcClick(Sender: TObject);
begin

  mCcNames.Items.Add(eToName.Text);
  mCcAddresses.Items.Add(eToAddress.Text);
  eToName.Text := '';
  eToAddress.Text := '';
end;

procedure TForm1.bClearToClick(Sender: TObject);
begin

  mToNames.Clear;
  mToAddresses.Clear;
end;

procedure TForm1.bClearCcClick(Sender: TObject);
begin

  mCcNames.Clear;
  mCcAddresses.Clear;
end;

procedure TForm1.mToNamesClick(Sender: TObject);
begin

  mToAddresses.ItemIndex := mToNames.ItemIndex;
end;

procedure TForm1.mToAddressesClick(Sender: TObject);
begin

  mToNames.ItemIndex := mToAddresses.ItemIndex;
end;

procedure TForm1.mCcNamesClick(Sender: TObject);
begin

  mCcAddresses.ItemIndex := mCcNames.ItemIndex;
end;

procedure TForm1.mCcAddressesClick(Sender: TObject);
begin

  mCcNames.ItemIndex := mCcAddresses.ItemIndex;
end;

procedure TForm1.bNormalizeClick(Sender: TObject);
begin

  Msg.AddHop('somewhere', 'mail2000', '', '');
  Msg.Normalize;
  bRefreshClick(Sender);
end;

procedure TForm1.bDeleteClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;

  if POP.DeleteMessage(StrToInt(eMsgNum.Text)) then
  begin

    mResponse.Lines.Text := Copy(POP.LastResponse, 1, 10000);
    Screen.Cursor := crDefault;
  end
  else
  begin

    ShowMessage('Failed on delete');
    Screen.Cursor := crDefault;
  end;
end;

procedure TForm1.bUIDLClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  POP.GetUIDL(StrToInt(eMsgNum.Text));
  mResponse.Lines.Text := Copy(POP.LastResponse, 1, 10000);
  Screen.Cursor := crDefault;
end;

procedure TForm1.bAbortClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  POP.Abort;
  lStatus.Caption := 'Aborted';
  bDisconnect.Enabled := False;
  bRetrieve.Enabled := False;
  bDelete.Enabled := False;
  bUIDL.Enabled := False;
  bConnect.Enabled := True;
  mResponse.Lines.Text := '';
  Screen.Cursor := crDefault;
end;

procedure TForm1.bSmtpAbortClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  SMTP.Abort;
  mSmtpResponse.Lines.Text := '';
  bSmtpDisconnect.Enabled := False;
  bSmtpConnect.Enabled := True;
  bSend.Enabled := False;
  lSmtpStatus.Caption := 'Aborted';
  Screen.Cursor := crDefault;
end;

procedure TForm1.bFindPartsClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  Msg.FindParts;
  bRefreshClick(Sender);
  Screen.Cursor := crDefault;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -