mainunit.pas

FoxMail信息自动填充

unit mainunit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    Label4: TLabel;
    Label3: TLabel;
    Edit4: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure SplitEmailAddress(EmailAddress:String);
    procedure FillPopnSmtp(SupplierAddress:String);
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
Procedure TForm1.SplitEmailAddress(EmailAddress:String);
var
 UserAccountStr:String;//用于保存用户帐号名称
 SupplierStr:String;//用于保存电子邮件服务提供商的地址
 Ptn:Integer;          //保存符号@的位置
begin
 Ptn:=Pos('@',EmailAddress);
 UserAccountStr:=Copy(EmailAddress,1,Ptn-1);
 Edit2.Text:=UserAccountStr;
 SupplierStr:=Copy(EmailAddress,Ptn+1,Length(EmailAddress)-Ptn);
 SupplierStr:=LowerCase(SupplierStr);
 FillPopnSmtp(SupplierStr);
end;

procedure TForm1.FillPopnSmtp(SupplierAddress:String);
var
 PopAndSmtpFile:TextFile;
 TableDir:String;
 TempStr,PopServerAddr,SmtpServerAddr:String;
 Ptn:Integer;
begin
 TableDir:=ExtractFilePath(application.ExeName)+'popnsmtp.txt';
 if FileExists(TableDir) then
  begin
   AssignFile(PopAndSmtpFile,TableDir);
   ReSet(PopAndSmtpFile);
   While Not Eof(PopAndSmtpFile) do
    begin
     Readln(PopAndSmtpFile,TempStr);
     if (Pos(SupplierAddress,TempStr)=1) then
      begin
       Ptn:=Pos('<p>',TempStr);
       Delete(TempStr,1,Ptn+2);
       Ptn:=Pos('<s>',TempStr);
       PopServerAddr:=Copy(TempStr,1,Ptn-1);
       Edit3.Text:=PopServerAddr;
       Delete(TempStr,1,Ptn+2);
       SmtpServerAddr:=TempStr;
       Edit4.Text:=SmtpServerAddr;
       break;
      end;
    end; 
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
 SplitEmailAddress(Edit1.Text);
end;

end.