收到邮件乱码html,为什么我发的html格式邮件收到的是乱码呢?(100分)

我在网上找到现成的DEMO,只能发送文本格式邮件,网页的发出去收到的是乱码!

(我们经常收到很多广告(html格式),他们是如何实现的呢?

我知道indy控件可以实现,感觉效率低)

unit eMail;

interface

uses Windows, WinSock, SysUtils;

function SendMail1(Smtp, User, Pass, GetMail, ToMail, Subject, MailText: string): Bool;

implementation

var

SendBody: string;

const

CRLF = #13#10;

BaseTable: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';

// 查表

function FindInTable(CSource: Char): Integer;

begin

Result := Pos(string(CSource), BaseTable) - 1;

end;

// 编码

function EncodeBase64(const Source: string): string;

var

Times, LenSrc, j: Integer;

x1, x2, x3, x4: Char;

xt: Byte;

begin

Result := '';

LenSrc := Length(Source);

if (LenSrc mod 3 = 0) then

Times := LenSrc div 3 else

Times := LenSrc div 3 + 1;

for j := 0 to Times - 1do

begin

if LenSrc >= (3 + j * 3) then

begin

x1 := BaseTable[(Ord(Source[1 + j * 3]) shr 2) + 1];

xt := (Ord(Source[1 + j * 3]) shl 4) and 48;

xt := xt or (Ord(Source[2 + j * 3]) shr 4);

x2 := BaseTable[xt + 1];

xt := (Ord(Source[2 + j * 3]) shl 2) and 60;

xt := xt or (ord(Source[3 + j * 3]) shr 6);

x3 := BaseTable[xt + 1];

xt := (Ord(Source[3 + j * 3]) and 63);

x4 := BaseTable[xt + 1];

end

else

if LenSrc >= (2 + j * 3) then

begin

x1 := BaseTable[(Ord(Source[1 + j * 3]) shr 2) + 1];

xt := (Ord(Source[1 + j * 3]) shl 4) and 48;

xt := xt or (Ord(Source[2 + j * 3]) shr 4);

x2 := BaseTable[xt + 1];

xt := (Ord(Source[2 + j * 3]) shl 2) and 60;

x3 := BaseTable[xt + 1];

x4 := '=';

end else

begin

x1 := BaseTable[(Ord(Source[1 + j * 3]) shr 2) + 1];

xt := (Ord(Source[1 + j * 3]) shl 4) and 48;

x2 := BaseTable[xt + 1];

x3 := '=';

x4 := '=';

end;

Result := Result + x1 + x2 + x3 + x4;

end;

end;

function LookupName(const Name: string): TInAddr;

var

HostEnt: PHostEnt;

InAddr: TInAddr;

begin

HostEnt := GetHostByName(PChar(Name));

FillChar(InAddr, SizeOf(InAddr), 0);

if (HostEnt <> nil) then

begin

with InAddr, HostEnt^do

begin

S_un_b.s_b1 := h_addr^[0];

S_un_b.s_b2 := h_addr^[1];

S_un_b.s_b3 := h_addr^[2];

S_un_b.s_b4 := h_addr^[3];

end;

end;

Result := InAddr;

end;

function StartNet(Host: string;

Port: Integer;

var Sock: Integer): Bool;

var

WSAData: TWSAData;

FSocket: Integer;

SockAddrIn: TSockAddrIn;

Err: Integer;

begin

Result := False;

WSAStartup($0101, WSAData);

FSocket := Socket(PF_INET, SOCK_STREAM, IPPROTO_IP);

if (FSocket = INVALID_SOCKET) then

Exit;

SockAddrIn.sin_addr := LookupName(Host);

SockAddrIn.sin_family := PF_INET;

SockAddrIn.sin_port := htons(port);

Err := Connect(FSocket, SockAddrIn, SizeOf(SockAddrIn));

if (Err = 0) then

begin

Sock := FSocket;

Result := True;

end;

end;

procedure StopNet(Fsocket: integer);

begin

CloseSocket(FSocket);

WSACleanup();

end;

function SendData(FSocket: Integer;

SendStr: string): Integer;

var

DataBuf: array[0..4096] of Char;

Err: Integer;

begin

StrCopy(DataBuf, PChar(SendStr));

Err := Send(FSocket, DataBuf, StrLen(DataBuf), MSG_DONTROUTE);

Result := Err;

end;

function GetData(FSocket: Integer): string;

const

MaxSize = 1024;

var

DataBuf: array[0..MaxSize] of Char;

begin

Recv(FSocket, DataBuf, MaxSize, 0);

Result := StrPas(DataBuf);

end;

function SendMail1(Smtp, User, Pass, Getmail, ToMail, Subject, MailText: string): Bool;

var

FSocket, Res: Integer;

begin

Result := False;

if StartNet(Smtp, 25, FSocket) then

begin

SendData(FSocket, 'HELO ' + User + CRLF);

GetData(FSocket);

SendData(FSocket, 'AUTH LOGIN' + CRLF);

GetData(FSocket);

SendData(FSocket, EncodeBase64(User) + CRLF);

GetData(FSocket);

SendData(FSocket, EncodeBase64(Pass) + CRLF);

GetData(FSocket);

SendData(FSocket, 'MAIL FROM: ' + CRLF);

GetData(FSocket);

SendData(FSocket, 'RCPT TO: ' + CRLF);

Getdata(FSocket);

SendData(FSocket, 'DATA' + CRLF);

GetData(FSocket);

SendBody :=

'From: ' + CRLF +

'To: ' + CRLF +

'Subject: ' + Subject + CRLF +

CRLF + MailText + CRLF + '.' + CRLF;

Res := SendData(FSocket, SendBody);

GetData(FSocket);

SendData(FSocket, 'QUIT' + CRLF);

GetData(FSocket);

StopNet(Fsocket);

Result := (Res <> SOCKET_ERROR);

end;

end;

end.

//主界面

unit Main;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls;

type

TFormMain = class(TForm)

Open: TButton;

Send: TButton;

OpenDialog: TOpenDialog;

GroupBox2: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

sendmail: TEdit;

tomail: TEdit;

user: TEdit;

pasw: TEdit;

smtp: TEdit;

MailList: TRichEdit;

procedure OpenClick(Sender: TObject);

procedure SendClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FormMain: TFormMain;

implementation

uses eMail66, UrlPost, eMail;

{$R *.dfm}

//加在网页html

procedure TFormMain.OpenClick(Sender: TObject);

begin

if OpenDialog.Execute then

begin

MailList.Clear;

MailList.Lines.LoadFromFile(OpenDialog.FileName);

end;

end;

//发送邮件

procedure TFormMain.SendClick(Sender: TObject);

var

s: string;

begin

try

s := MailList.Lines.Text;

//PostURL(pchar(asp.text), 'num=' + HtmlEncode(pchar(s)));

SendMail1(trim(smtp.Text), trim(user.text), trim(Pasw.Text), trim(sendmail.text), trim(tomail.text), s, s);

messagebox(0, '测试完毕，请检查信箱或空间！', '测试', 0);

except

Application.ProcessMessages;

end;

end;

end.