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

📄 mainunit.pas

📁 邮箱探测原程序,可以在远程对他人的邮箱进行探测,得到其号码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, ExtCtrls, Menus, Buttons, StdCtrls,Registry,ShellApi, ComCtrls,inifiles;

const
	ID_CALLICON = WM_USER+100;
    MSG_CHECK_MAIL = WM_USER+101;

type
  TMainForm = class(TForm)
    PopMenu: TPopupMenu;
    EnableMenu: TMenuItem;
    CheckNowMenu: TMenuItem;
    N2: TMenuItem;
    OptionMenu: TMenuItem;
    AboutMenu: TMenuItem;
    N1: TMenuItem;
    ExitMenu: TMenuItem;
    Timer1: TTimer;
    MailClient: TClientSocket;
    Bevel2: TBevel;
    Label1: TStaticText;
    Label2: TStaticText;
    Bevel4: TBevel;
    ReceBtn: TSpeedButton;
    MoreBtn: TSpeedButton;
    OpenMailMenu: TMenuItem;
    N3: TMenuItem;
    MailInfoBox: TComboBox;
    MailInfoList: TListView;
    DeleteMenu: TMenuItem;
    N4: TMenuItem;
    HideSpyMenu: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure EnableMenuClick(Sender: TObject);
    procedure CheckNowMenuClick(Sender: TObject);
    procedure OptionMenuClick(Sender: TObject);
    procedure AboutMenuClick(Sender: TObject);
    procedure ExitMenuClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MailClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure MailClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ReceBtnClick(Sender: TObject);
    procedure MailClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure MoreBtnClick(Sender: TObject);
    procedure SocketExitStat;
    procedure FormActivate(Sender: TObject);
    procedure GetMailInfo(str:String;Count:Integer);
    procedure MailInfoListMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DeleteMenuClick(Sender: TObject);
    procedure CheckMail(var Msg:TMessage);message MSG_CHECK_MAIL;
    procedure HideSpyMenuClick(Sender: TObject);
    procedure MailClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    UserID,
    Password			:shortstring;
    TaskIcon 	        :NOTIFYICONDATA;
    bShowForm,
    bNewMail,
    bReType				:Boolean;
    ReceiverFile     	:string;
    nStepCount			:integer;
    bAutoAgain			:Boolean;
    nMailCount			:integer;

    MailInfoStr         :TStringList;//put more mail info into this list.

    bMore               :Boolean;//if MailInfoList be shown.
    bIsMore             :Boolean;//if User want to get more mailinfo.
    bAutoMore           :Boolean;//if Auto show more mailinfo.
    nMailInfoCount      :Integer;//which mail info that want to get.
    nDeleteMailNo       :Integer;
    bDeleteMail         :Boolean;
    procedure SysCommandMenu(var Msg:TWMSYSCOMMAND);message WM_SYSCOMMAND;
    procedure CallIcon(var Msg:TMessage);message ID_CALLICON;
    procedure GetMailProc(Socket: TCustomWinSocket;Buf : array of char);
    procedure DeleteMailProc(Socket: TCustomWinSocket;Buf:array of char;Num:integer);
	function AuthenticationFailed:integer;
  end;

var
  MainForm: TMainForm;
  function DecodeBase64_Char2Byte(org:Char):Byte;
  function DecodeBase64_Sub(substr:string):string;
  function DecodeBase64(org:string):string;

implementation

uses AboutUnit, AuFail;

{$R *.DFM}
{$I DecodeBase64Unit.pas}
procedure TMainForm.SysCommandMenu(var Msg:TWMSYSCOMMAND);
begin
//     Label1.Caption :='Detect...';
     if (Msg.CmdType = SC_MINIMIZE) then //or (Msg.CmdType = SC_CLOSE) then
     begin
        Shell_NotifyIcon(NIM_ADD,@TaskIcon);
//        MailInfoBox.Clear;
        Hide;
     end
     else
        Inherited;
end;
procedure TMainForm.CallIcon(var Msg:TMessage);
var
   MPos:TPoint;
begin
     if Msg.LParam = WM_LBUTTONDOWN then
     begin
        TaskIcon.hIcon:=LoadIcon(hInstance,'MAINICON');
        TaskIcon.szTip :='eMail Spy !-侦测..';
        Shell_NotifyIcon(NIM_MODIFY,@TaskIcon);
        Label1.Caption :='侦测..';
        if WinExec(PChar(ReceiverFile),SW_SHOWNORMAL)<31 then
        begin
            MessageDlg('不能够找到邮件接受程序,请运行 Spysetup.exe ,设置其参数。',mtWarning,[mbYes],0);
            exit;
        end;
        if EnableMenu.Caption ='禁用(&D)' then
        begin
            TaskIcon.hIcon :=LoadIcon(hInstance,'MAINICON');
            Shell_NotifyIcon(NIM_MODIFY,@TaskIcon);
            Label1.Caption :='侦测..';
            Timer1.Enabled:=True;
        end
        else
        begin
           TaskIcon.hIcon:=LoadIcon(hInstance,'ZENABLEDICON');
           TaskIcon.szTip :='eMail Spy !-停止.';
           Shell_NotifyIcon(NIM_MODIFY,@TaskIcon);
           Label1.Caption :='停止.';
           Timer1.Enabled :=False;
        end;
        bNewMail:=False;
     end
     else
     begin
          if Msg.LParam = WM_RBUTTONDOWN then
          begin
               GetCursorPos(MPos);

               DeleteMenu.Visible :=False;
               EnableMenu.Visible :=True;
//               OpenMailMenu.Visible :=True;
               HideSpyMenu.Visible :=False;
               OptionMenu.Visible :=True;
               AboutMenu.Visible :=True;
               ExitMenu.Visible :=True;
               CheckNowMenu.Visible :=True;

               PopMenu.Popup(MPos.x,MPos.y);
               SetCapture(Handle);
          end;
     end;

end;
procedure TMainForm.FormCreate(Sender: TObject);
var
   IniFile:TRegIniFile;
   i:integer;
   str:shortstring;
   tempBmp:TBitmap;
begin
     IniFile:=TRegIniFile.Create('Jie Application');
     str:=IniFile.ReadString('eMail Spy !','Password','');
     for i:=1 to length(str)do
         str[i]:=char((ord(str[i])-65) mod 256);
     Password :=str;
     UserID :=IniFile.ReadString('eMail Spy !','UserID','');
     MailClient.Address :=IniFile.ReadString('eMail Spy !','Mail Server','10.0.0.2');
     MailClient.Port :=IniFile.ReadInteger('eMail Spy !','Server Port',110);
     ReceiverFile:=IniFile.ReadString('eMail Spy !','Receiver','');
     tempBmp:=TBitmap.Create ;
     ReCeiverFile:=UpperCase(ReceiverFile);
     if Pos('FOXMAIL',ReceiverFile)>0 then
     begin
       try
          tempBmp.LoadFromResourceName(HInstance,'FOXMAIL');
       except
          MessageDlg('''FOXMAIL''位图装载错误。',mtError,[mbYes],0);
          exit;
       end;
     end
     else
     begin
       try
          tempBmp.LoadFromResourceName(HInstance,'OUTLOOK');
       except
          MessageDlg('''OUTLOOK''位图装载错误。',mtError,[mbYes],0);
          exit;
       end;
     end;
     ReceBtn.Glyph.Assign(tempBmp);
     Timer1.Interval :=IniFile.ReadInteger('eMail Spy !','Timer Interval',5);
     Timer1.Interval :=Timer1.Interval *60000;
     if IniFile.ReadInteger('eMail Spy !','ShowWindow',1)=1 then
        bShowForm:=True
     else
        bShowForm:=False;
     if IniFile.ReadInteger('eMail Spy !','Retype',1)=1 then
        bRetype:=True
     else
        bRetype:=False;
     if IniFile.ReadInteger('eMail Spy !','IsMore',1)=1 then
	     bIsMore:=True
     else
	     bIsMore:=False;
     if (IniFile.ReadInteger('eMail Spy !','AutoMore',1)=1)and (bIsMore) then
	     bAutoMore:=True
     else
	     bAutoMore:=False;
     IniFile.Free;
     if bIsMore then
     begin
        tempBmp.LoadFromResourceName(HInstance,'MOREDOWN');
        MoreBtn.Hint := '邮件的详细信息..';
     end
     else
     begin
        tempBmp.LoadFromResourceName(HInstance,'OPTIONS');
        MoreBtn.Hint := '设置eMailSpy的参数..';
     end;
     MoreBtn.Glyph.Assign(tempBmp);
     tempBmp.Free;
     TaskIcon.cbSize :=sizeof(NOTIFYICONDATA);
     TaskIcon.Wnd :=Handle;
     TaskIcon.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
     TaskIcon.uCallbackMessage :=ID_CALLICON;
     TaskIcon.hIcon :=LoadIcon(Hinstance,'MainIcon');
     TaskIcon.szTip :='eMail Spy !-侦测..';

     bNewMail:=False;
     nStepCount:=0;
     nMailCount:=-1;
     nMailInfoCount:=-1;
     bMore := False;
     Shell_NotifyIcon(NIM_ADD,@TaskIcon);
     Label1.Caption :='开始侦测!';
end;

procedure TMainForm.EnableMenuClick(Sender: TObject);
begin
     if EnableMenu.Caption ='启用(&E)' then
     begin
        TaskIcon.hIcon:=LoadIcon(hInstance,'MAINICON');
        TaskIcon.szTip :='eMail Spy !-侦测..';
        Shell_NotifyIcon(NIM_MODIFY,@TaskIcon);
        Label1.Caption :='侦测..';
        EnableMenu.Caption :='禁用(&D)';
        Timer1.Enabled :=True;
     end
     else
     begin
        TaskIcon.hIcon:=LoadIcon(hInstance,'ZENABLEDICON');
        TaskIcon.szTip :='eMail Spy !-停止.';
        Shell_NotifyIcon(NIM_MODIFY,@TaskIcon);
        Label1.Caption :='停止.';
        EnableMenu.Caption :='启用(&E)';
        MailClient.Active :=False;
        Timer1.Enabled :=False;
     end;
end;

procedure TMainForm.CheckNowMenuClick(Sender: TObject);
begin
     Timer1Timer(Sender);
     if EnableMenu.Caption ='启用(&E)' then
     begin
        Timer1.Enabled :=False;
     end;
end;

procedure TMainForm.OptionMenuClick(Sender: TObject);
begin
     if WinExec('SpySetup.exe',SW_SHOWNORMAL)<31 then
     begin
        MessageDlg('无法定位Sypsetup.exe程序,请检查其是否与eMailSpy.exe在同一个目录下',mtWarning,[mbYes],0);
        Exit;
     end;
end;

procedure TMainForm.AboutMenuClick(Sender: TObject);
begin
     Application.CreateForm(TAboutForm,AboutForm);
     AboutForm.ShowModal;
end;

procedure TMainForm.ExitMenuClick(Sender: TObject);
begin
     Timer1.Enabled :=False;
     MailClient.Active :=False;
     Close;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
     Timer1.Enabled :=False;
     TaskIcon.hIcon :=LoadIcon(hInstance,'RUNICON1');
     Shell_NotifyIcon(NIM_MODIFY,@TaskIcon);
   	 MailClient.Active :=True;
     Label2.Caption :='侦测..';
     Timer1.Enabled :=True;
end;
function TMainForm.AuthenticationFailed:integer;
begin
	Timer1.Enabled :=False;
    Application.CreateForm(TAuFailForm,AuFailForm);
    result:=AuFailForm.ShowModal;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if MailClient.Active then
    	MailClient.Active :=False;
    Shell_NotifyIcon(NIM_DELETE,@TaskIcon);
end;

procedure TMainForm.MailClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
	Label2.Caption :='连接..';
    MailInfoStr:=TStringList.Create;
	Refresh;
end;

procedure TMainForm.MailClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
	Label2.Caption :='完成. ';
    nStepCount:=0;
    MailInfoStr.Free;
	Refresh;
    if bDeleteMail then
    begin
        ShowMessage('删除第'+IntToStr(nDeleteMailNo)+'封邮件完成 !');
        bDeleteMail := False;
        nDeleteMailNo := -1;
        Label1.Caption := '侦测..';
        MoreBtnClick(Sender);
        bNewMail :=False;
        MailInfoBox.Clear;
        MailInfoBox.Enabled := False;
        PostMessage(Handle,MSG_CHECK_MAIL,0,0);
    end;
    if bMore then
        MoreBtnClick(nil);
end;

procedure TMainForm.ReceBtnClick(Sender: TObject);
begin
        if WinExec(PChar(ReceiverFile),SW_SHOWNORMAL)<31 then
        begin
            MessageDlg('不能够找到邮件接受程序,请运行 Spysetup.exe ,设置其参数。',mtWarning,[mbYes],0);
            exit;
        end;
        if EnableMenu.Caption ='禁用(&D)' then
        begin
            TaskIcon.hIcon :=LoadIcon(hInstance,'MAINICON');
           TaskIcon.szTip :='eMail Spy ! -侦测..';
            Shell_NotifyIcon(NIM_MODIFY,@TaskIcon);
            Label1.Caption :='侦测..';
            Timer1.Enabled:=True;
        end
        else
        begin
           TaskIcon.hIcon:=LoadIcon(hInstance,'ZENABLEDICON');
           TaskIcon.szTip :='eMail Spy ! -停止.';
           Shell_NotifyIcon(NIM_MODIFY,@TaskIcon);
           Label1.Caption :='停止.';
           Timer1.Enabled :=False;
        end;
        bNewMail:=False;
        MoreBtnClick(nil);
        Hide;
end;
procedure TMainForm.GetMailInfo(str:String;Count:integer);
var
    tempItem:TListItem;
    substr:string;
    UpStr:string;
    tempStr:string;
begin
    UpStr:=UpperCase(str);
    substr:=Copy(str,Pos('FROM:',UpStr)+5,Length(UpStr));
    tempstr := Copy(substr,1,Pos(#13#10,substr)-1);
    if (Pos('=?gb2312?B?',tempstr)<>0) then
    begin
        tempStr := Copy(tempstr,Pos('?B?',tempstr)+3,(Pos('?=',tempstr)-Pos('?B?',tempstr)-2));

⌨️ 快捷键说明

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