in_mail_dll.pas

用Delphi实现Dll插件的方式

unit In_Mail_Dll;
{版权所有 枫叶在线 HTTP://WWW.SKYGZ.COM [e-mail] 风铃夜思雨}
interface

uses
  Windows, Forms, SysUtils, Controls, Classes,
  StdCtrls, Plugins, ExtCtrls, Graphics, ScktComp;

type
  THT = class
  private
    procedure Timer(Sender: TObject);
  end;

type
  TForm1 = class(TForm)
    FrmBG: TImage;
    ImgClose: TImage;
    LbMailID: TLabel;
    LbMailMsg: TLabel;
    TimerHide: TTimer;
    LbMove: TLabel;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ImgCloseClick(Sender: TObject);
    procedure LbMoveMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  end;

var
  Form1: TForm1;
  ExeHandle: Hwnd;
  StrExePath: string;
  V: Integer;
  IsRun: Boolean;
  HT: THT;
  Timer: TTimer;

function PluginInfo: PPluginInfo; cdecl; export;
function Getmodule: PPluginModule; cdecl;

function GetDllHandle(): Hwnd; cdecl;
function GetDllInstance(): THandle; cdecl;
function GetDllPath(): PChar; cdecl;
procedure SetExeInfo(This_Handle: Hwnd; This_ExePath: PChar); cdecl;
procedure SetAbout(This_Module: PPluginModule); cdecl;
procedure SetConfig(This_Module: PPluginModule); cdecl;
function Initialize(This_Module: PPluginModule): Integer; cdecl;
function Terminate(This_Module: PPluginModule): Integer; cdecl;
function Start(This_Module: PPluginModule): Integer; cdecl;
function Stop(This_Module: PPluginModule): Integer; cdecl;

function Base64Encode(const s: string): string;
function Base64Decode(const s: string): string;
implementation

uses Config;

{$R *.dfm}

const
  Ver = '1.00';

  Info: TPluginInfo = (
    Version: Ver;
    Description: '邮件检测插件';
    Module: Getmodule);

  DllModule: TPluginModule = (
    Description: '邮件检测插件';
    DllHandle: GetDllHandle;
    DllInstance: GetDllInstance;
    DllPath: GetDllPath;
    ExeInfo: SetExeInfo;
    About: SetAbout;
    Config: SetConfig;
    Initialize: Initialize;
    Terminate: Terminate;
    Start: Start;
    Stop: Stop);

function PluginInfo: PPluginInfo;
begin
  result := @Info;
end;

function Getmodule: PPluginModule;
begin
  result := @DllModule;
end;

procedure SetExeInfo(This_Handle: Hwnd; This_ExePath: PChar);
begin
  ExeHandle := This_Handle;
  StrExePath := StrPas(This_ExePath);
end;

function GetDllHandle(): Hwnd;
begin
  result := application.Handle;
end;

function GetDllInstance(): THandle;
begin
  result := HInstance;
end;

function GetDllPath(): PChar;
var //获取DLL路径
  ModuleName: string;
begin
  SetLength(ModuleName, 260);
  GetModuleFileName(HInstance, PChar(ModuleName), Length(ModuleName));
  result := PChar(ModuleName);
end;

procedure SetAbout(This_Module: PPluginModule);
begin
  MessageBox(ExeHandle, '风铃夜思雨制作', 'About', MB_ICONINFORMATION);
end;

procedure SetConfig(This_Module: PPluginModule);
begin
  frmconfig.RWINI(true);
  Timer.Enabled := false;
  frmconfig.ShowModal;
  if IsRun then Timer.Enabled := true;
end;

function Initialize(This_Module: PPluginModule): Integer;
begin
  application.CreateForm(TForm1, Form1);
  application.CreateForm(TFrmConfig, frmconfig);
  IsRun := false;
  result := 1;
end;

function Terminate(This_Module: PPluginModule): Integer;
begin
  if Assigned(frmconfig) then frmconfig.Free;
  if Assigned(Form1) then Form1.Free;
  result := 1;
end;

function Start(This_Module: PPluginModule): Integer;
begin
  frmconfig.RWINI(true);
  if IsRun = false then
  begin
    Timer.OnTimer := HT.Timer;
    Timer.Interval := 60000;
    V := 0;
    Timer.Enabled := true;
  end;
  IsRun := true;
  result := 1;
end;

function Stop(This_Module: PPluginModule): Integer;
begin
  if IsRun then
  begin
    Timer.Enabled := false;
    IsRun := false;
  end;
  result := 1;
end;

function Base64Encode(const s: string): string;
var //加密
  i, c1, c2, c3: Integer;
  m, n: Integer;
const
  Base64: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz+/~!@#$%^&*(){}[]<>?-\|`_';
begin
  result := '';
  m := 1;
  n := 0;
  for i := 1 to (Length(s) div 3) do
  begin
    c1 := Ord(s[m]);
    c2 := Ord(s[m + 1]);
    c3 := Ord(s[m + 2]);
    m := m + 3;
    result := result + Base64[(c1 shr 2) and $3F + 1];
    result := result + Base64[((c1 shl 4) and $30) or ((c2 shr 4) and $0F) + 1];
    result := result + Base64[((c2 shl 2) and $3C) or ((c3 shr 6) and $03) + 1];
    result := result + Base64[c3 and $3F + 1];
    n := n + 4;
    if (n = 76) then
    begin
      n := 0;
      // Result := Result+#13#10;
    end;
  end;
  if (Length(s) mod 3) = 1 then
  begin
    c1 := Ord(s[m]);
    result := result + Base64[(c1 shr 2) and $3F + 1];
    result := result + Base64[(c1 shl 4) and $30 + 1];
//    Result := Result+'=';
//    Result := Result+'=';
  end;
  if (Length(s) mod 3) = 2 then
  begin
    c1 := Ord(s[m]);
    c2 := Ord(s[m + 1]);
    result := result + Base64[(c1 shr 2) and $3F + 1];
    result := result + Base64[((c1 shl 4) and $30) or ((c2 shr 4) and $0F) + 1];
    result := result + Base64[(c2 shl 2) and $3C + 1];
//    Result := Result+ '=';
  end;
end;

function Base64Decode(const s: string): string;
var //解密
  i, m, n: Integer;
  c1, c2, c3, c4: Integer;
const
  Base64: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz+/~!@#$%^&*(){}[]<>?-\|`_';
begin
  result := '';
  n := 1;
  m := Length(s);
//  if s[m]='='then m:=m-1;
//  if s[m]='='then m:=m-1;
  for i := 1 to m div 4 do
  begin
    c1 := Pos(s[n], Base64) - 1;
    c2 := Pos(s[n + 1], Base64) - 1;
    c3 := Pos(s[n + 2], Base64) - 1;
    c4 := Pos(s[n + 3], Base64) - 1;
    n := n + 4;
    result := result + Chr(((c1 shl 2) and $FC) or ((c2 shr 4) and $3));
    result := result + Chr(((c2 shl 4) and $F0) or ((c3 shr 2) and $0F));
    result := result + Chr(((c3 shl 6) and $C0) or c4);
  end;
  if m mod 4 = 2 then
  begin
    c1 := Pos(s[n], Base64) - 1;
    c2 := Pos(s[n + 1], Base64) - 1;
    result := result + Chr(((c1 shl 2) and $FC) or ((c2 shr 4) and $3));
  end;

  if m mod 4 = 3 then
  begin
    c1 := Pos(s[n], Base64) - 1;
    c2 := Pos(s[n + 1], Base64) - 1;
    c3 := Pos(s[n + 2], Base64) - 1;
    result := result + Chr(((c1 shl 2) and $FC) or ((c2 shr 4) and $3));
    result := result + Chr(((c2 shl 4) and $F0) or ((c3 shr 2) and $0F));
  end;
end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
//  Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST or WS_EX_TOOLWINDOW;
  Params.WndParent := ExeHandle; //用于不用在任务栏上显示
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Hide;
  CanClose := false; //不能关闭，否则会整个程序退出
  Exit;
end;

function Pop3ChkMail(Host, User, Password: string; var MailList: TStringList): Boolean;
  function SocketRec(Socket: TCustomWinSocket; TimeOut: Integer; Crlf: string = #13#10): string;
  var
    Buf: array[0..4095] of Char;
    RR: Integer;
    TS: TStringStream; //保存所有的数据
    FSocketStream: TWinSocketStream;
  begin
    TS := TStringStream.Create('');
    FSocketStream := TWinSocketStream.Create(Socket, TimeOut);
    while (Socket.Connected = true) do
    begin
      if not FSocketStream.WaitForData(TimeOut) then Break;
      ZeroMemory(@Buf, SizeOf(Buf));
      RR := FSocketStream.Read(Buf, 1);
      if RR = 0 then Break;
      TS.Write(Buf, RR);
      if Pos(Crlf, TS.DataString) <> 0 then Break;
    end;
    result := TS.DataString;
    if Pos(Crlf, result) = 0 then result := '';
    TS.Free;
    FSocketStream.Free;
  end;

  function Pop3Response(Str: string): Boolean;
  begin
    if Pos('+OK', Str) > 0 then result := true else result := false;
  end;

  function ChkCommand(CS: TClientSocket): Boolean;
  var Cmd: string;
  begin
    while CS.Active do
    begin
      Cmd := SocketRec(CS.Socket, 60 * 1000);
      result := Pop3Response(Cmd);
      if result = false then
      begin
        CS.Socket.SendText('QUIT' + #13#10);
        CS.Active := false;
        CS.Free;
      end;
      Exit;
    end;
  end;
var CS: TClientSocket;
  Cmd: string;
begin
  try
    result := false;
    CS := TClientSocket.Create(nil);
    CS.ClientType := ctBlocking;
    CS.Host := Host;
    CS.Port := 110;
    CS.Active := true;
    if ChkCommand(CS) = false then Exit;

    CS.Socket.SendText('USER ' + User + #13#10);
    if ChkCommand(CS) = false then Exit;
    CS.Socket.SendText('PASS ' + Password + #13#10);
    if ChkCommand(CS) = false then Exit;
    CS.Socket.SendText('LIST' + #13#10);
    if ChkCommand(CS) = false then Exit;
    while true do
    begin
      Cmd := SocketRec(CS.Socket, 60 * 1000);
      MailList.Add(Cmd);
      if Pos('.', Cmd) > 0 then Break;
    end;
    CS.Socket.SendText('QUIT' + #13#10);
    CS.Active := false;
    CS.Free;
    result := true;
  except;
    CS.Free;
  end;
end;

procedure THT.Timer(Sender: TObject);
var i: Integer;
  MailList: TStringList;
  Frm: TForm1;
begin
  V := V + 1;
  with frmconfig do
  begin
    for i := 0 to ListView1.Items.Count - 1 do
    begin
      if V = StrToInt(ListView1.Items[i].SubItems.Strings[3]) then
      begin
        MailList := TStringList.Create;
        Pop3ChkMail(ListView1.Items[i].SubItems.Strings[0], ListView1.Items[i].SubItems.Strings[1], Base64Decode(ListView1.Items[i].SubItems.Strings[2]), MailList);
        if MailList.Count > 0 then
        begin
          Frm := TForm1.Create(nil);
          Frm.Top := screen.Height - Frm.Height;
          Frm.Left := screen.Width - Frm.Width;
          Frm.LbMailID.Caption := ListView1.Items[i].Caption;
          Frm.LbMailMsg.Caption := '你有 ' + IntToStr(MailList.Count - 1) + ' 封新邮件！';
          Frm.FormStyle := fsStayOnTop;
          Frm.Show;
          SetWindowRgn(Frm.Handle, CreateRoundRectRgn(0, 0, Frm.Width + 1, Frm.Height + 1, 5, 5), true);
          Frm.TimerHide.Enabled := true;
        end;
        MailList.Free;
      end;
    end;
    if V >= MaxTime then V := 0;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TForm1.ImgCloseClick(Sender: TObject);
begin
  TimerHide.Enabled := false;
  close;
end;

procedure TForm1.LbMoveMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  SendMessage(Handle, $0112, $F012, 0);
end;

initialization
  HT := THT.Create;
  Timer := TTimer.Create(nil);

finalization
  if Assigned(Timer) then Timer.Free;
  if Assigned(HT) then HT.Free;

end.