unit1.pas

千年外挂通用

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ShellApi, Buttons, Menus, jpeg;

const
WM_ICONMESSAGE=WM_USER+$100;    //自定义消息，用于处理用户在图标上点击鼠标的事件

type
  TForm1 = class(TForm)
    Image1: TImage;
    PopupMenu1: TPopupMenu;
    show: TMenuItem;
    exit: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
           Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure showClick(Sender: TObject);
    procedure exitClick(Sender: TObject);
private
    function CreateRegion(wMask: TBitmap; wColor: TColor; hControl: THandle): HRGN;
    procedure WMBarIcon(var Message:TMessage);message WM_ICONMESSAGE;
//自定义消息处理函数，处理鼠标点击图标事件
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;
lpData: PNotifyIconDataa;   //用于增加和删除系统状态图标

implementation

function sethook:bool; external 'xiaotutu.dll';
function endhook:bool; external 'xiaotutu.dll';

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  w1:TBitmap;
  w2:TColor;
  rgn: HRGN;
begin
  w1:=TBitmap.Create;
  w1.Assign(image1.Picture.Bitmap);
  w2:=w1.Canvas.Pixels[0,0];
  rgn := CreateRegion(w1,w2,Handle);
  if rgn<>0 then
  begin
     SetWindowRgn(Handle, rgn, true);
  end;
  w1.Free;
  //加载DLL
  sethook;
//-----------------创建任务栏图标----------------------
lpData := new(PNotifyIconDataA);             //指定lpData的长度
lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
lpData.Wnd := Form1.Handle;                 //取应用程序主窗体的句柄
lpData.hIcon := Application.Icon.handle;    //指定系统状态栏显示应用程序的图标句柄
lpData.uCallbackMessage := WM_ICONMESSAGE; //指定的窗口消息
lpData.uID :=0;
lpData.szTip := '我的野蛮女友 1.0';        //当鼠标停留在系统状态栏该图标上时出现该提示信息
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;//指定在该结构中uCallbackMessage、hIcon和szTip参数都有效
Shell_NotifyIcon(NIM_ADD,lpData);          //在系统状态栏增加一个新图标
dispose(lpData);

SetWindowLong(Application.Handle,GWL_EXSTYLE, WS_EX_TOOLWINDOW);//在任务条上隐藏
//ShowWindow (application.handle,SW_Hide); //在任务条上隐藏
//Application.ShowMainForm:=false;  窗体不可见
//SetWindowLong(Application.Handle,GWL_EXSTYLE, WS_EX_APPWINDOW);//在任务条上显示
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);  //删除任务栏图标
begin
endhook;   //卸载dll
lpData := new(PNotifyIconDataA);
lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
lpData.Wnd := Form1.Handle;
lpData.hIcon := Application.Icon.handle;
lpData.uCallbackMessage := WM_ICONMESSAGE;
lpData.uID :=0;
lpData.szTip := '我的野蛮女友 1.0';
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_DELETE,lpData);
dispose(lpData);
end;

function Tform1.CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN;
var
  dc, dc_c: HDC;
  rgn: HRGN;
  x, y: integer;
  coord: TPoint;
  line: boolean;
  color: TColor;
begin
  dc := GetWindowDC(hControl);
  dc_c := CreateCompatibleDC(dc);
  SelectObject(dc_c, wMask.Handle);
  BeginPath(dc);
  for x:=0 to wMask.Width-1 do
  begin
    line := false;
    for y:=0 to wMask.Height-1 do
    begin
      color := GetPixel(dc_c, x, y);
      if not (color = wColor) then
      begin
        if not line then
        begin
          line := true;
          coord.x := x;
          coord.y := y;
        end;
      end;
      if (color = wColor) or (y=wMask.Height-1) then
      begin
        if line then
        begin
          line := false;
          MoveToEx(dc, coord.x, coord.y, nil);
          LineTo(dc, coord.x, y);
          LineTo(dc, coord.x + 1, y);
          LineTo(dc, coord.x + 1, coord.y);
          CloseFigure(dc);
        end;
      end;
    end;
  end;
  EndPath(dc);
  rgn := PathToRegion(dc);
  ReleaseDC(hControl, dc);
  Result := rgn;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; //窗体移动
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  SendMessage(Handle, WM_SYSCOMMAND, $F012, 0);
  ShowWindow(Handle, SW_hide );
end;

procedure TForm1.WMBarIcon (var Message:TMessage);  //系统托盘执行的过程
var
  mousept: TPoint; //鼠标点击位置
begin
if message.LParam = wm_lbuttonup then begin      //用鼠标左键点击图标
      ShowWindow(Handle, SW_SHOW);               //显示应用程序窗口
end;
if message.LParam = wm_Rbuttonup then            //用鼠标左键点击图标
begin
Getcursorpos(mousept);                           //获取光标位置
popupmenu1.popup(mousept.x, mousept.y);          //在光标位置弹出选单
end;
end;

procedure TForm1.exitClick(Sender: TObject); //在托盘上的菜单 关闭
begin
endhook;
close;
end;

procedure TForm1.showClick(Sender: TObject);  //在托盘上的菜单 显示
begin
ShowWindow(Handle, SW_show );
end;

end.