由于在工作中需要，用汇编写了一个字符串转16进制的函数，有详细注释，应该对想学习的人有所帮助的。呵呵
{功能：字符串转16进制
作者：不得闲}
function StrToHex(Const str: string): string;
asm
push ebx
push esi
push edi
test eax,eax
jz @@Exit
mov esi,edx //保存edx值，用来产生新字符串的地址
mov edi,eax //保存原字符串
mov edx,[eax-4] //获得字符串长度
mov ecx,edx //保存长度
Push ecx
add edx,edx
mov eax,esi
call System.@LStrSetLength //设置新串长度
mov eax,esi //新字符串地址
Call UniqueString //产生一个唯一的新字符串，串位置在eax中
Pop ecx
@@SetHex:
xor edx,edx //清空edx
mov dl, [edi] //Str字符串字符
mov ebx,edx //保存当前的字符
shr edx,4 //右移4字节，得到高8位
mov dl,byte ptr[edx+@@HexChar] //转换成字符
mov [eax],dl //将字符串输入到新建串中存放
and ebx,$0F //获得低8位
mov dl,byte ptr[ebx+@@HexChar] //转换成字符
inc eax //移动一个字节,存放低位
mov [eax],dl
inc edi
inc eax
loop @@SetHex
@@Exit:
pop edi
pop esi
pop ebx
ret
@@HexChar: db '0123456789ABCDEF'
end;
在群中，有人说要指针转16进制的函数，其实字符串本身就是按照指针的形式保存的，所以稍微修改一下就是指针区信息转16进制的函数了如下:
{功能：指针区信息转16进制
参数： Ptr指定指针，Len指定取得的数据长度
作者：不得闲}
function PointToHex(Const Ptr: pointer;Const Len: integer): string;
asm
Push ebx
push esi
push edi
test eax,eax
jz @@Exit
mov edi,eax
mov esi,ecx
mov ecx,edx
push ecx
add edx,edx
mov eax,esi
call System.@LStrSetLength //设置新串长度
mov eax,esi //新字符串地址
Call UniqueString //产生一个唯一的新字符串，串位置在eax中
pop ecx
@@SetHex:
xor edx,edx //清空edx
mov dl, [edi] //Str字符串字符
mov ebx,edx //保存当前的字符
shr edx,4 //右移4字节，得到高8位
mov dl,byte ptr[edx+@@HexChar] //转换成字符
mov [eax],dl //将字符串输入到新建串中存放
and ebx,$0F //获得低8位
mov dl,byte ptr[ebx+@@HexChar] //转换成字符
inc eax //移动一个字节,存放低位
mov [eax],dl
inc edi
inc eax
loop @@SetHex
@@Exit:
pop edi
pop esi
pop ebx
ret
@@HexChar: db '0123456789ABCDEF'
end;
使用比如：
var
Stream:TMemoryStream;
s: String;
i: integer;
begin
Stream := TMemoryStream.Create;
s := '不得闲';
i := 511;
Stream.WriteBuffer(pointer(s)^,Length(s));
ShowMessage(PointToHex(Stream.Memory,Stream.size));
Stream.free;
这样就把整个Stream都转换成16进制了.
2008年7月22日星期二
2008年7月13日星期日
关于函数调用得到传递参数的想法
不得闲于 2008-3-29
起源：
近日来，一直致力于扩充公司的脚本解析引擎！脚本引擎的大致扩充功能如下：
1、可在脚本中由用户自定义函数功能了，原来只有一个程序入口所有代码都在Begin..End之间写
Begin
//代码脚本
end
现在分成主脚本入口（既原Begin..End）与函数定义如
function GetMax(x,y: integer): integer;
begin
if x > y then
result := x
else
result := y;
end;
begin
MessageBox(GetMax(2,3));
end;
2、可支持在脚本中动态创建对象于对象之间传递引用
原引擎只能固定的使用一些对象，其间不可赋值与引用如
在Delphi中固定好一个对象 Button，则在脚本中使用就只能使用
Button.Caption := 'sdf';
而不支持 B := Button; 然后操作B；
现在扩充如：
MyBtn := TButton.Create(self);//支持了动态创建
MyBtn.caption := 'test';
MyBtn.parent := self;
CBtn := MyBtn;//支持了引用
MessageBox(CBtn.Caption);
3、可支持在脚本中使用编译预处理指令了如
{$I MyFuncLib} //引用外部库，相当于Include
{$IFDEF gg}
{$ELSEIFDEF bb}
{$ENDIF}
{$IFNDEF cc}
等编译预处理指令
现在问题就出现于第四点的实现方式上了！
那就是 动态的指定对象的事件了！
此时，由于事件的类型有很多种！如果一个个的定义下来处理的话，实在太过繁琐！所以想到使用一个函数来实现
调用所有对象事件的实现！而这些对象事件的的实现代码出现在脚本中，所以所有的事件执行都通过一个函数
DoEvent来实现，该函数中只处理某对象事件属性对应的函数脚本。那么就需要传递触发该事件的时候传递到事件中的
事件参数了！于是一个如何得到传递参数值的想法产生！
实践！
定义两个窗体，Form1,form2,在Form1中定义一个事件
TTestEvent = procedure(Sender: TObject;x,y,z: integer) of object;
property OnTest: TTestEvent read FonTest Write FOnTest;
然后在窗体创建的时候设定OnTest属性的值！
var
Method: TMethod;
begin
MeThod.Data := Sender;
Method.Code := @Test;
SetMethodProp(self,'OnTest',Method)
end;
Test过程没有任何参数,此时的目的就是要在Test中得到由触发该事件的时候传递过来的各个参数的值！
如
procedure Test;
begin
//这里要求得到参数值！
end;
一段触发该事件的代码如下：
Form1.OnTest(form1,1,2,3);
打个断点。运行到这里的时候打开CPU窗口得到如下代码：
{说明：对于一般的函数或过程，前三个参数分别放在 EAX、EDX、ECX，后面如果还有更多参数的话，就在堆栈
里面；对于类的方法，EAX 固定用于存放类实例的地址，EDX、ECX 分别存放前两个参数，其余参数进栈。在堆
栈中每个元素占用 4 Bytes，而前面说了，TVarRec 中储存的数据也是 4 Bytes，刚好一个参数在堆栈里面占
一个位子，处理方便。另外，结果返回到 EAX 中。
对于调用类的方法，其实有一个默认的隐藏参数 Self 作为第一个参数传入，放入EAX寄存器。
因此我们看到的第一参数其实是第二个，因此我们处理的时候要注意。}
Unit2.pas.36: Form1.OnTest(form1,1,2,3);
00461481 6A02 push $02 //这里可知道是第三个参数压栈，2
00461483 6A03 push $03 //第四个参数压栈，3
00461485 8B1DA83C4600 mov ebx,[$00463ca8] //这里的[$00463ca8]则为存放form1的地址的值
0046148B 8B1B mov ebx,[ebx] //取得form1的值
0046148D 8B15A83C4600 mov edx,[$00463ca8]
00461493 8B12 mov edx,[edx]//这一句和上面一句，完全可用 mov edx,ebx来代替，就是传递入form1参数值
00461495 B901000000 mov ecx,$00000001 //这里是第二个参数的值
0046149A 8B8304030000 mov eax,[ebx+$00000304]//本是作为form1的self指针传递，其实这里是按扭事件中的Button的值
//也就是OnTest事件转化为TMethod后中的Data数据段
{TMethod = record
Code, Data: Pointer;
end;如此可知道其代码还是指针偏移位置为$00000304-4则为下面的$00000300}
004614A0 FF9300030000 call dword ptr [ebx+$00000300] //调用Tmethod中的Code函数，该处程序指令执行的位置为
//EIP = 004614A0 注意调用了该方法之后堆栈的变化 ，此时程序为了在调用了该事件处理函数之后能够正确的处理下一条
//指令，所以必须将当前的指令位置的下一条指令位置保存起来，所以调用事件处理函数的同时，会将当前指令指针EIP的值
加上当前指令的长度作为下一条指令位置压入栈保存起
//来，所以此时又有一个入栈的操作了。
Unit2.pas.37: end;
到这里整个触发过程完成！此时程序接受Call指令后进入到另一个函数栈空间，我们为了在另一个函数的栈空间中得到事件
触发时候传递过来的参数，就必须要记下参数的位置了。
通过上面可知道，其共传递了4个参数，由于隐含一个Self操作，也就是说传递了5个参数
其操作过程为，三个在寄存器中，另外两个参数存在于堆栈中！由于调用函数要保存当前指令运行位置便于返回！所以此时
多进行一次入栈操作。
下面进入到 Test过程代码分析段,
程序进入到了Test段，先得到最后两个参数（堆栈中的参数）
通过上面分析，此时必须要将当前的栈顶指针向后移动一个才可访问到最后一个参数
//初步写下如下试验代码
procedure Test
begin
Pop Eax
Pop Eax //此时则得到了最后一个参数的值了
end;
如果这样写的话，就存在一个很大的问题了，如果全部出栈，出栈，那么调用事件处理函数之前入栈的事件处理函数完成之后
的下条指令执行的位置丢失了！所以，在出栈其他参数之前，务必要先将调用事件处理函数完成之后的指令位置保存起来，才
可出栈！而且将入栈的参数全部出栈得到之后，再将刚刚出栈的下条指令地址入栈，就能使程序ret时候得到正确的指令执行
位置了。代码如下：
procedure Test;
begin
Pop EDX //指令执行位置保存到ESI
Pop EAX //最后一个参数3
Pop EAX //倒数第二个参数2
Push EDX //指令执行位置入栈，然后下面Delphi自动调用一个ret过程，也就是一个出栈的过程弹出下条执行指令位置
ret //该句可加可不加
end;
如此看来，通过这里可看出ret指令其实包含有两个过程，首先 出栈执行指令位置，然后跳转到那个位置，那么代码应该是
如下方式：
Pop NextAddr
Jmp NextAddr
分析透了，所以上面的Test函数还可再减化一下，都是跳到下个地方执行，所以直接使用跳转指令jmp来改变EIP位置
代码如下：
procedure Test;
begin
Pop EDX
Pop EAX
Pop EAX
Jmp EDX //这样就省去了他的一个入栈和一个出栈操作而直接跳转
end;
至于其他的几个参数还是在EAX,EDX,ECX中，如果你不动的话！
将传递的参数的值显示出来,那么如果要显示的话，就需要定义局部参数了！
定义了局部参数，则栈空间就会增加，然后将声明的局部变量分别入栈。
想想要使程序不报错！就必须得使得调用事件出来函数前后的栈平衡，所以就需要将前面入的参数
全部Pop弹出来，来改变堆栈栈顶指针。以达到堆栈平衡。
procedure Test
var
x,y,z: integer;
begin
//这里声明了三个变量x,y,z，一般做操作如下：
{Push Ebp //触发调用该函数的EBP值！也就是那个函数的入口栈基址。入栈保存
Mov Ebp,Esp //然后将当前的函数的入口栈基址给EBP保存
Add ESP,-12 //将堆栈扩充3个变量的位置
Push X
Push Y
Push Z //然后再将局部变量入栈
如此的话，则可通过基地址EBP来得到堆栈中的参数值了
}
asm
push esi //保存Esi值,注意了，此时又添加了一个栈变量了Esp在原来的基础上减4
mov esi,[ebp+8] //Ebp将自己入栈之后才是本入口栈的基地址，所以[Ebp+4]为程序返回跳转指令的位置，
mov z,esi
mov esi,[ebp+12] //同理类推
mov y,esi
mov x,ecx //由于x是第三个参数值，所以没有入栈
pop esi //返回上面的保存的esi内容的值
mov ecx,ebp
sub ecx,esp //此时ecx保存着基本地址和栈顶指针的差距，用来后面进行出栈循环用
end;
ShowMessage(IntToStr(x)); //得到的x值
ShowMessage(IntToStr(y)); //得到的y值
ShowMessage(IntToStr(z)); //得到的z值
//这个函数由于没有参数，而为了达到堆栈平衡，所以下面必须使用代码来手动达到目的
asm
@PopUp:
pop eax //根据基地址与当前地址的距离进行出栈，使堆栈到达基地址的位置。
sub ecx,4
jnz @PopUp //为0了则说明到达本函数的入口基栈地址了
pop ebp //由于在最开始初始化的时候压入了该函数的返回后地址，所以这里出栈该地址到ebp中
//此时已经回到了该函数的入口地址时候了，然后再由于传递过来的两个参数入栈占据了8大小的位置
//所以这里直接使用 ret 8则可返回到当前的堆栈位置+8的地方那就是原来触发函数的位置了。
ret 8
end;
end;
总体归纳说来的话，就是出栈到函数的入口基址，然后ret 到其入栈参数所占据的空间
然而最后函数地址返回那里 ，我使用
push ebx //用这段注释代码却也可通过，只是不知道原因何在了！
push [ebp+4]
ret
也可通过！只是不晓得，其原因在哪里了！
代码：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, RzButton;
type
TTestEvent = procedure(Sender: TObject;x,y,z,t: integer) of object;
TForm1 = class(TForm)
RzButton1: TRzButton;
RzButton2: TRzButton;
procedure RzButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure RzButton2Click(Sender: TObject);
private
FonTest: TTestEvent;
{ Private declarations }
procedure MyTest(Sender: TObject;x,y,z: integer);
public
{ Public declarations }
published
property OnTest: TTestEvent read FonTest Write FOnTest;
end;
var
Form1: TForm1;
implementation
uses typinfo;
{$R *.dfm}
procedure Test();
var
x,y,z: integer;
begin
asm
push esi
mov esi,[ebp+8]
mov z,esi
mov esi,[ebp+12]
mov y,esi
mov x,ecx
pop esi
mov ecx,ebp
sub ecx,esp
push ecx
end;
ShowMessage(IntToStr(x));
ShowMessage(IntToStr(y));
ShowMessage(IntToStr(z));
asm
pop ecx
@PopUp:
pop eax
sub ecx,4
jnz @PopUp
pop ebp
ret 12
end;
end;
function GetMax(x,y: integer): integer;
begin
if x > y then result := x
else result := y;
end;
procedure TForm1.RzButton1Click(Sender: TObject);
begin
GetMax(2,3);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
procedure TForm1.MyTest(Sender: TObject; x, y, z: integer);
var
a,b,c: integer;
begin
a := x;
b:=y;
c:=z;
if a > b then
a := a+1;
//showmessage(inttostr(x));
end;
procedure TForm1.RzButton2Click(Sender: TObject);
var
Method: TMethod;
begin
MeThod.Data := Sender;
Method.Code := @Test;
SetMethodProp(self,'OnTest',Method)
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, RzEdit;
type
TForm2 = class(TForm)
RzEdit1: TRzEdit;
procedure RzEdit1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure Test(Sender: TObject;x,y,z: integer);
end;
var
Form2: TForm2;
implementation
uses unit1;
{$R *.dfm}
{ TForm2 }
procedure TForm2.Test(Sender: TObject; x, y, z: integer);
begin
end;
procedure TForm2.RzEdit1Change(Sender: TObject);
begin
Form1.OnTest(form1,6,72,33,99);
end;
end.
起源：
近日来，一直致力于扩充公司的脚本解析引擎！脚本引擎的大致扩充功能如下：
1、可在脚本中由用户自定义函数功能了，原来只有一个程序入口所有代码都在Begin..End之间写
Begin
//代码脚本
end
现在分成主脚本入口（既原Begin..End）与函数定义如
function GetMax(x,y: integer): integer;
begin
if x > y then
result := x
else
result := y;
end;
begin
MessageBox(GetMax(2,3));
end;
2、可支持在脚本中动态创建对象于对象之间传递引用
原引擎只能固定的使用一些对象，其间不可赋值与引用如
在Delphi中固定好一个对象 Button，则在脚本中使用就只能使用
Button.Caption := 'sdf';
而不支持 B := Button; 然后操作B；
现在扩充如：
MyBtn := TButton.Create(self);//支持了动态创建
MyBtn.caption := 'test';
MyBtn.parent := self;
CBtn := MyBtn;//支持了引用
MessageBox(CBtn.Caption);
3、可支持在脚本中使用编译预处理指令了如
{$I MyFuncLib} //引用外部库，相当于Include
{$IFDEF gg}
{$ELSEIFDEF bb}
{$ENDIF}
{$IFNDEF cc}
等编译预处理指令
现在问题就出现于第四点的实现方式上了！
那就是 动态的指定对象的事件了！
此时，由于事件的类型有很多种！如果一个个的定义下来处理的话，实在太过繁琐！所以想到使用一个函数来实现
调用所有对象事件的实现！而这些对象事件的的实现代码出现在脚本中，所以所有的事件执行都通过一个函数
DoEvent来实现，该函数中只处理某对象事件属性对应的函数脚本。那么就需要传递触发该事件的时候传递到事件中的
事件参数了！于是一个如何得到传递参数值的想法产生！
实践！
定义两个窗体，Form1,form2,在Form1中定义一个事件
TTestEvent = procedure(Sender: TObject;x,y,z: integer) of object;
property OnTest: TTestEvent read FonTest Write FOnTest;
然后在窗体创建的时候设定OnTest属性的值！
var
Method: TMethod;
begin
MeThod.Data := Sender;
Method.Code := @Test;
SetMethodProp(self,'OnTest',Method)
end;
Test过程没有任何参数,此时的目的就是要在Test中得到由触发该事件的时候传递过来的各个参数的值！
如
procedure Test;
begin
//这里要求得到参数值！
end;
一段触发该事件的代码如下：
Form1.OnTest(form1,1,2,3);
打个断点。运行到这里的时候打开CPU窗口得到如下代码：
{说明：对于一般的函数或过程，前三个参数分别放在 EAX、EDX、ECX，后面如果还有更多参数的话，就在堆栈
里面；对于类的方法，EAX 固定用于存放类实例的地址，EDX、ECX 分别存放前两个参数，其余参数进栈。在堆
栈中每个元素占用 4 Bytes，而前面说了，TVarRec 中储存的数据也是 4 Bytes，刚好一个参数在堆栈里面占
一个位子，处理方便。另外，结果返回到 EAX 中。
对于调用类的方法，其实有一个默认的隐藏参数 Self 作为第一个参数传入，放入EAX寄存器。
因此我们看到的第一参数其实是第二个，因此我们处理的时候要注意。}
Unit2.pas.36: Form1.OnTest(form1,1,2,3);
00461481 6A02 push $02 //这里可知道是第三个参数压栈，2
00461483 6A03 push $03 //第四个参数压栈，3
00461485 8B1DA83C4600 mov ebx,[$00463ca8] //这里的[$00463ca8]则为存放form1的地址的值
0046148B 8B1B mov ebx,[ebx] //取得form1的值
0046148D 8B15A83C4600 mov edx,[$00463ca8]
00461493 8B12 mov edx,[edx]//这一句和上面一句，完全可用 mov edx,ebx来代替，就是传递入form1参数值
00461495 B901000000 mov ecx,$00000001 //这里是第二个参数的值
0046149A 8B8304030000 mov eax,[ebx+$00000304]//本是作为form1的self指针传递，其实这里是按扭事件中的Button的值
//也就是OnTest事件转化为TMethod后中的Data数据段
{TMethod = record
Code, Data: Pointer;
end;如此可知道其代码还是指针偏移位置为$00000304-4则为下面的$00000300}
004614A0 FF9300030000 call dword ptr [ebx+$00000300] //调用Tmethod中的Code函数，该处程序指令执行的位置为
//EIP = 004614A0 注意调用了该方法之后堆栈的变化 ，此时程序为了在调用了该事件处理函数之后能够正确的处理下一条
//指令，所以必须将当前的指令位置的下一条指令位置保存起来，所以调用事件处理函数的同时，会将当前指令指针EIP的值
加上当前指令的长度作为下一条指令位置压入栈保存起
//来，所以此时又有一个入栈的操作了。
Unit2.pas.37: end;
到这里整个触发过程完成！此时程序接受Call指令后进入到另一个函数栈空间，我们为了在另一个函数的栈空间中得到事件
触发时候传递过来的参数，就必须要记下参数的位置了。
通过上面可知道，其共传递了4个参数，由于隐含一个Self操作，也就是说传递了5个参数
其操作过程为，三个在寄存器中，另外两个参数存在于堆栈中！由于调用函数要保存当前指令运行位置便于返回！所以此时
多进行一次入栈操作。
下面进入到 Test过程代码分析段,
程序进入到了Test段，先得到最后两个参数（堆栈中的参数）
通过上面分析，此时必须要将当前的栈顶指针向后移动一个才可访问到最后一个参数
//初步写下如下试验代码
procedure Test
begin
Pop Eax
Pop Eax //此时则得到了最后一个参数的值了
end;
如果这样写的话，就存在一个很大的问题了，如果全部出栈，出栈，那么调用事件处理函数之前入栈的事件处理函数完成之后
的下条指令执行的位置丢失了！所以，在出栈其他参数之前，务必要先将调用事件处理函数完成之后的指令位置保存起来，才
可出栈！而且将入栈的参数全部出栈得到之后，再将刚刚出栈的下条指令地址入栈，就能使程序ret时候得到正确的指令执行
位置了。代码如下：
procedure Test;
begin
Pop EDX //指令执行位置保存到ESI
Pop EAX //最后一个参数3
Pop EAX //倒数第二个参数2
Push EDX //指令执行位置入栈，然后下面Delphi自动调用一个ret过程，也就是一个出栈的过程弹出下条执行指令位置
ret //该句可加可不加
end;
如此看来，通过这里可看出ret指令其实包含有两个过程，首先 出栈执行指令位置，然后跳转到那个位置，那么代码应该是
如下方式：
Pop NextAddr
Jmp NextAddr
分析透了，所以上面的Test函数还可再减化一下，都是跳到下个地方执行，所以直接使用跳转指令jmp来改变EIP位置
代码如下：
procedure Test;
begin
Pop EDX
Pop EAX
Pop EAX
Jmp EDX //这样就省去了他的一个入栈和一个出栈操作而直接跳转
end;
至于其他的几个参数还是在EAX,EDX,ECX中，如果你不动的话！
将传递的参数的值显示出来,那么如果要显示的话，就需要定义局部参数了！
定义了局部参数，则栈空间就会增加，然后将声明的局部变量分别入栈。
想想要使程序不报错！就必须得使得调用事件出来函数前后的栈平衡，所以就需要将前面入的参数
全部Pop弹出来，来改变堆栈栈顶指针。以达到堆栈平衡。
procedure Test
var
x,y,z: integer;
begin
//这里声明了三个变量x,y,z，一般做操作如下：
{Push Ebp //触发调用该函数的EBP值！也就是那个函数的入口栈基址。入栈保存
Mov Ebp,Esp //然后将当前的函数的入口栈基址给EBP保存
Add ESP,-12 //将堆栈扩充3个变量的位置
Push X
Push Y
Push Z //然后再将局部变量入栈
如此的话，则可通过基地址EBP来得到堆栈中的参数值了
}
asm
push esi //保存Esi值,注意了，此时又添加了一个栈变量了Esp在原来的基础上减4
mov esi,[ebp+8] //Ebp将自己入栈之后才是本入口栈的基地址，所以[Ebp+4]为程序返回跳转指令的位置，
mov z,esi
mov esi,[ebp+12] //同理类推
mov y,esi
mov x,ecx //由于x是第三个参数值，所以没有入栈
pop esi //返回上面的保存的esi内容的值
mov ecx,ebp
sub ecx,esp //此时ecx保存着基本地址和栈顶指针的差距，用来后面进行出栈循环用
end;
ShowMessage(IntToStr(x)); //得到的x值
ShowMessage(IntToStr(y)); //得到的y值
ShowMessage(IntToStr(z)); //得到的z值
//这个函数由于没有参数，而为了达到堆栈平衡，所以下面必须使用代码来手动达到目的
asm
@PopUp:
pop eax //根据基地址与当前地址的距离进行出栈，使堆栈到达基地址的位置。
sub ecx,4
jnz @PopUp //为0了则说明到达本函数的入口基栈地址了
pop ebp //由于在最开始初始化的时候压入了该函数的返回后地址，所以这里出栈该地址到ebp中
//此时已经回到了该函数的入口地址时候了，然后再由于传递过来的两个参数入栈占据了8大小的位置
//所以这里直接使用 ret 8则可返回到当前的堆栈位置+8的地方那就是原来触发函数的位置了。
ret 8
end;
end;
总体归纳说来的话，就是出栈到函数的入口基址，然后ret 到其入栈参数所占据的空间
然而最后函数地址返回那里 ，我使用
push ebx //用这段注释代码却也可通过，只是不知道原因何在了！
push [ebp+4]
ret
也可通过！只是不晓得，其原因在哪里了！
代码：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, RzButton;
type
TTestEvent = procedure(Sender: TObject;x,y,z,t: integer) of object;
TForm1 = class(TForm)
RzButton1: TRzButton;
RzButton2: TRzButton;
procedure RzButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure RzButton2Click(Sender: TObject);
private
FonTest: TTestEvent;
{ Private declarations }
procedure MyTest(Sender: TObject;x,y,z: integer);
public
{ Public declarations }
published
property OnTest: TTestEvent read FonTest Write FOnTest;
end;
var
Form1: TForm1;
implementation
uses typinfo;
{$R *.dfm}
procedure Test();
var
x,y,z: integer;
begin
asm
push esi
mov esi,[ebp+8]
mov z,esi
mov esi,[ebp+12]
mov y,esi
mov x,ecx
pop esi
mov ecx,ebp
sub ecx,esp
push ecx
end;
ShowMessage(IntToStr(x));
ShowMessage(IntToStr(y));
ShowMessage(IntToStr(z));
asm
pop ecx
@PopUp:
pop eax
sub ecx,4
jnz @PopUp
pop ebp
ret 12
end;
end;
function GetMax(x,y: integer): integer;
begin
if x > y then result := x
else result := y;
end;
procedure TForm1.RzButton1Click(Sender: TObject);
begin
GetMax(2,3);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
procedure TForm1.MyTest(Sender: TObject; x, y, z: integer);
var
a,b,c: integer;
begin
a := x;
b:=y;
c:=z;
if a > b then
a := a+1;
//showmessage(inttostr(x));
end;
procedure TForm1.RzButton2Click(Sender: TObject);
var
Method: TMethod;
begin
MeThod.Data := Sender;
Method.Code := @Test;
SetMethodProp(self,'OnTest',Method)
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, RzEdit;
type
TForm2 = class(TForm)
RzEdit1: TRzEdit;
procedure RzEdit1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure Test(Sender: TObject;x,y,z: integer);
end;
var
Form2: TForm2;
implementation
uses unit1;
{$R *.dfm}
{ TForm2 }
procedure TForm2.Test(Sender: TObject; x, y, z: integer);
begin
end;
procedure TForm2.RzEdit1Change(Sender: TObject);
begin
Form1.OnTest(form1,6,72,33,99);
end;
end.
SQL Server下字符串，整数转换成16进制字符串的方法
今天，由于需要模拟一个RFID卡的过车记录过程！其中有一个需要模拟RFID标签的！
由于RFID标签数量有限！而BOSS又要我一下搞30万条数据到数据库中去（变态）！RFID卡由16进制组成。
于是在SQL Server中写下了两个关于16进制转换的函数，以随机的来生成所需RFID数据
/****************************
字符串转成16进制
作者：不得闲
QQ: 75492895
Email: appleak46@yahoo.com.cn
****************************/
Create Function VarCharToHex(@Str Varchar(400))
returns varchar(800)
as
begin
declare @i int,@Asi int,@ModS int,@res varchar(800),@Len int,@Cres varchar(4),@tempstr varbinary(400)
select @i = 1,@res='',@len=datalength(@str),@tempStr = Convert(varbinary,@str)
while @i<=@len
begin
Select @Asi = substring(@tempstr,1,1),@Cres=''
while @Asi <> 0
begin
select @Mods = @Asi %16,
@Cres=Case when (@Mods > 9) then Char(Ascii('A')+@Mods-10)+@Cres else Cast(@Mods as varchar(4)) + @Cres end,
@Asi = @Asi/16
end
Select @res = @res + @Cres,@tempStr = substring(@tempStr,2,@len-1),@i = @i+1
end
return @res
end
/****************************
整数转换成16进制
作者：不得闲
QQ: 75492895
Email: appleak46@yahoo.com.cn
****************************/
Create Function IntToHex(@IntNum int)
returns varchar(16)
as
begin
declare @Mods int,@res varchar(16)
set @res=''
while @IntNum <> 0
begin
set @Mods =@IntNum % 16
if @Mods > 9
set @res = Char(Ascii('A')+@Mods-10)+@res
else
set @res = Cast(@Mods as varchar(4)) + @res
set @IntNum = @IntNum/16
end
return @res
end 具体使用，直接传递要转换的信息进去则可如Select Dbo.VarcharToHex('不得闲')select Dbo.IntToHex(125)
由于RFID标签数量有限！而BOSS又要我一下搞30万条数据到数据库中去（变态）！RFID卡由16进制组成。
于是在SQL Server中写下了两个关于16进制转换的函数，以随机的来生成所需RFID数据
/****************************
字符串转成16进制
作者：不得闲
QQ: 75492895
Email: appleak46@yahoo.com.cn
****************************/
Create Function VarCharToHex(@Str Varchar(400))
returns varchar(800)
as
begin
declare @i int,@Asi int,@ModS int,@res varchar(800),@Len int,@Cres varchar(4),@tempstr varbinary(400)
select @i = 1,@res='',@len=datalength(@str),@tempStr = Convert(varbinary,@str)
while @i<=@len
begin
Select @Asi = substring(@tempstr,1,1),@Cres=''
while @Asi <> 0
begin
select @Mods = @Asi %16,
@Cres=Case when (@Mods > 9) then Char(Ascii('A')+@Mods-10)+@Cres else Cast(@Mods as varchar(4)) + @Cres end,
@Asi = @Asi/16
end
Select @res = @res + @Cres,@tempStr = substring(@tempStr,2,@len-1),@i = @i+1
end
return @res
end
/****************************
整数转换成16进制
作者：不得闲
QQ: 75492895
Email: appleak46@yahoo.com.cn
****************************/
Create Function IntToHex(@IntNum int)
returns varchar(16)
as
begin
declare @Mods int,@res varchar(16)
set @res=''
while @IntNum <> 0
begin
set @Mods =@IntNum % 16
if @Mods > 9
set @res = Char(Ascii('A')+@Mods-10)+@res
else
set @res = Cast(@Mods as varchar(4)) + @res
set @IntNum = @IntNum/16
end
return @res
end 具体使用，直接传递要转换的信息进去则可如Select Dbo.VarcharToHex('不得闲')select Dbo.IntToHex(125)
2008年7月9日星期三
发一个专门操作任务栏的类
忽然在CSDN上看到别人问怎样操作windows任务栏上的元素，如隐藏任务栏、获得任务栏上的所有托盘图标等信息。在闲暇的时候用Spy++捕捉了一下任务栏的相关消息和各控件句柄。于是将各种操作封装到了一个类中。大致代码如下：
(******************************************************)
(* WindowsOperate Unit *)
(* Copyright(c) 2007 不得闲 *)
(* email:appleak46@yahoo.com.cn QQ:75492895 *)
(******************************************************)
unit WindowsOperate;
interface
uses windows,Classes,Messages,SysUtils,forms,ComObj,winsvc, shellapi,CommCtrl,Graphics;
type
{任务栏上的任务按扭}
TSysToolbarBtn = class(TPersistent)
private
FBtnInfo: TTBButton;
FBtnIndex: integer;
FBtnCaption: string;
SysHide: boolean;//是否为系统隐藏图标
EventHandle: THandle; //事件处理句柄
FPicture: TBitmap; //图标
FBtnRect: TRect; //区域
FVisible: boolean;
function GetBtnInfo: TTBButton;
procedure SetVisible(const Value: boolean);
public
Constructor Create;
Destructor Destroy;override;
property BtnInfo: TTBButton read GetBtnInfo;
property BtnIndex: integer read FBtnIndex;
property BtnCaption: string read FBtnCaption;
property BtnRect: TRect read FBtnRect;
procedure AssignBtnInfo(Info: TTBButton);
property isSysHide: boolean read SysHide;
property Picture: TBitmap read FPicture;
property Visible: boolean read FVisible write SetVisible;
procedure Click;
procedure DbClick;
procedure RClick;
end;
TSysTaskBarOperate = Class(TComponent) //任务栏操作类
private
FTrayBtnList,FTaskBtnList: TStringList;
HigherThenXp: boolean; //是否为xp以上的系统版本
FTrayBarHandle: THandle;
FTaskBarHandle: THandle;
FStartBtnHandle: THandle;
FQuitLauchHandle: THandle;
FReBarHandle: THandle;
FProgramToolBarHandle: THandle;
FImeRecHandle: THandle;
FProgramContrainerHandle: THandle; //任务栏容器
FHideTrayBtnHandle: THandle;
FTrayNotifyHandle: THandle;
FClockHandle: THandle;
FShowHideBtn: boolean;
FVisible: boolean;
FquickBarVisible: boolean;
FTaskToolBarVisible: boolean;
FTaskBarVisible: boolean;
FRegBarVisible: boolean;
FStartBtnVisible: boolean;
FImeBarVisible: boolean;
FTrayBarVisible: boolean;
procedure GetIconList;
procedure GetTaskList;
function GetTrayBtnCount: integer;
function IsSysBtnHide(BtnState: Dword): boolean;
procedure SetShowHideBtn(const Value: boolean);
function GetTrayBtns(Index: integer): TSysToolbarBtn;
function GetTaskBtnCount: integer;
function GetTaskBtns(Index: integer): TSysToolbarBtn;
procedure SetVisible(const Value: boolean);
procedure SetquickBarVisible(const Value: boolean);
procedure SetTaskToolBarVisible(const Value: boolean);
procedure SetTaskBarVisible(const Value: boolean);
procedure SetReBaVisible(const Value: boolean);
procedure SetStartBtnVisible(const Value: boolean);
procedure SetImeBarVisible(const Value: boolean);
procedure SetTrayBarVisible(const Value: boolean);
protected
procedure StartBtnWndProc(var Message: TMessage);
public
Constructor Create(AOwner: TComponent);override;
Destructor Destroy;override;
property TrayBarHandle: THandle read FTrayBarHandle;//托盘区句柄
property TaskBarHandle: THandle read FTaskBarHandle;//任务栏句柄
property StartBtnHandle: THandle read FStartBtnHandle;//开始按扭句柄
property QuitLauchHandle: THandle read FQuitLauchHandle;//快速启动栏句柄
property ImeRecHandle: THandle read FImeRecHandle;//输入法选择区域句柄
property ProgramToolBarHandle: THandle read FProgramToolBarHandle;//程序最小化按扭容器
property HideTrayBtnHandle: THandle read FHideTrayBtnHandle;//显示隐藏图标的按扭
property ClockHandle: THandle read FClockHandle;//时钟显示区域句柄
procedure SetTimeDlg; //设置时间对话框
procedure HideTrayBtnClick; //显示隐藏按扭单击
procedure ImeRectBtnClick;//输入法按扭单击
procedure ClearTrayBtnList; //清除托盘区列表
procedure ClearTaskBtnList;
procedure ShowTime;
procedure StartBtnClick;
procedure HideOn;
procedure ShowOn;
property TrayBarVisible: boolean read FTrayBarVisible write SetTrayBarVisible;
property ImeBarVisible: boolean read FImeBarVisible write SetImeBarVisible;
property StartBtnVisible: boolean read FStartBtnVisible write SetStartBtnVisible;
property ReBarVisible: boolean read FRegBarVisible write SetReBaVisible;
property TaskToolBarVisible: boolean read FTaskToolBarVisible write SetTaskToolBarVisible;
property TaskBarVisible: boolean read FTaskBarVisible write SetTaskBarVisible;
property quickBarVisible: boolean read FquickBarVisible write SetquickBarVisible;
property Visible: boolean read FVisible write SetVisible; //是否隐藏任务栏
property ShowHideBtn: boolean read FShowHideBtn Write SetShowHideBtn;//是否显示系统隐藏的托盘按扭
property TrayBtnCount: integer read GetTrayBtnCount;//托盘图标的个数
property TaskBtnCount: integer Read GetTaskBtnCount;
property TrayBtnList: TStringList read FTrayBtnList;
property TaskBtnList: TStringList Read FTaskBtnList;
property TrayBtns[Index: integer]: TSysToolbarBtn read GetTrayBtns; //托盘按扭
Property TaskBtns[Index: integer]: TSysToolbarBtn read GetTaskBtns; //任务栏按扭
end;
implementation
{ TSysTaskbarOperate }
procedure TSysTaskBarOperate.ClearTaskBtnList;
begin
while FTaskBtnList.Count > 0 do
begin
FTaskBtnList.Objects[FTaskBtnList.Count - 1].Free;
FTaskBtnList.Delete(FTaskBtnList.Count - 1);
end;
end;
procedure TSysTaskBarOperate.ClearTrayBtnList;
begin
while FTrayBtnList.Count > 0 do
begin
FTrayBtnList.Objects[FTrayBtnList.Count - 1].Free;
FTrayBtnList.Delete(FTrayBtnList.Count - 1);
end;
end;
constructor TSysTaskbarOperate.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTrayBtnList := TStringList.Create;
FTaskBtnList := TStringList.Create;
HigherThenXp := (Win32MajorVersion > 5) or ((Win32MajorVersion = 5) and (Win32MinorVersion > 0));
FTaskBarHandle := FindWindow('Shell_TrayWnd',nil);
FStartBtnHandle := FindWindowEx(FTaskBarHandle,0,'Button',nil);
//if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 10) then //98系统
FReBarHandle := FindWindowEx(FTaskBarHandle,0,'ReBarWindow32',nil);
FQuitLauchHandle := FReBarHandle;
FProgramContrainerHandle := FindWindowEx(FQuitLauchHandle,0,'MSTaskSwWClass',nil);
FImeRecHandle := FindWindowEx(FQuitLauchHandle,0,'CiceroUIWndFrame',nil);
if HigherThenXp then
FProgramToolBarHandle := FindWindowEx(FProgramContrainerHandle,0,'ToolbarWindow32',nil)
else FProgramToolBarHandle := FProgramContrainerHandle;
FTrayBarHandle := FindWindowEx(FTaskBarHandle,0,'TrayNotifyWnd',nil);
FTrayNotifyHandle := FTrayBarHandle;
FClockHandle := FindWindowEx(FTrayBarHandle,0,'TrayClockWClass',nil);
FHideTrayBtnHandle := FindWindowEx(FTrayBarHandle,0,'Button',nil);
if HigherThenXp then
FTrayBarHandle := FindWindowEx(FTrayBarHandle,0,'SysPager',nil);
if (Win32MajorVersion = 5) and (Win32MinorVersion >= 0) then
FTrayBarHandle := FindWindowEx(FTrayBarHandle,0,'ToolbarWindow32',nil);
FQuitLauchHandle := FindWindowEx(FQuitLauchHandle,0,'ToolbarWindow32',nil);//快速启动栏
//SetWindowLong(FStartBtnHandle, GWL_WNDPROC, Longint(MakeObjectInstance(StartBtnWndProc)));
GetIconList;
GetTaskList;
Visible := true;
ReBarVisible := true;
TaskBarVisible := true;
quickBarVisible := true;
TaskToolBarVisible := true;
StartBtnVisible := true;
TrayBarVisible := true;
ImeBarVisible := true;
end;
destructor TSysTaskbarOperate.Destroy;
begin
ClearTrayBtnList;
FTrayBtnList.Free;
ClearTaskBtnList;
FTaskBtnList.Free;
inherited;
end;
procedure TSysTaskBarOperate.GetIconList;
var
ThreadID: THandle;
ThreadHandle: THandle; //线程句柄
Buff: pchar;
i,BtnCount: integer;
R: Cardinal;
BtnInfo: TTBButton;
SysHide: boolean;
SysToolBtn: TSysToolbarBtn;
S: array[0..512] of char;
BtnRect: TRect;
begin
GetWindowThreadProcessId(FTrayBarHandle, @ThreadID);//获取托盘窗口的线程 ID
ThreadHandle := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, False, ThreadID);//得到线程句柄
Buff := VirtualAllocEx(ThreadHandle,nil,4096,MEM_RESERVE or MEM_COMMIT,PAGE_READWRITE);//指定进程的虚拟空间保留或提交内存区域，除非指定MEM_RESET参数，否则将该内存区域置0
BtnCount := SendMessage(FTrayBarHandle,TB_BUTTONCOUNT, 0, 0);//得到托盘按扭个数
//SendMessage(FTrayBarHandle,TB_GETIMAGELIST,0,0);
//SendMessage(FTrayBarHandle,TB_GETBITMAPFLAGS,0,0);
try
for i := 0 to BtnCount - 1 do
begin
WriteProcessMemory(ThreadHandle, Buff, @BtnInfo, SizeOf(BtnInfo), R);
SendMessage(FTrayBarHandle, TB_GETBUTTON, i,integer(Buff));
ReadProcessMemory(ThreadHandle, Buff, @BtnInfo, SizeOf(BtnInfo), R);
SysHide := IsSysBtnHide(BtnInfo.fsState);
if SysHide and (not FShowHideBtn) then
Continue;
SysToolBtn := TSysToolbarBtn.Create;
SysToolBtn.SysHide := SysHide;
SysToolBtn.FVisible := not SysHide;
SysToolBtn.AssignBtnInfo(BtnInfo);
//SysToolBtn.FPicture.Canvas
SysToolBtn.FBtnIndex := BtnInfo.idCommand;
SendMessage(FTrayBarHandle,TB_GETBUTTONTEXT,SysToolBtn.FBtnInfo.idCommand,integer(integer(@Buff[0]) + SizeOf(@SysToolBtn.FBtnInfo)));
ReadProcessMemory(ThreadHandle, Pointer(integer(@Buff[0]) + SizeOf(@SysToolBtn.FBtnInfo)),@S[0],SizeOf(S), R);
//if SysToolBtn.FBtnInfo.fsState = 12 then
SysToolBtn.FBtnCaption := String(s);
SysToolBtn.EventHandle := FTrayBarHandle;
if not SysHide then
begin
SendMessage(FTrayBarHandle,TB_GETRECT,BtnInfo.idCommand,integer(integer(@Buff[0]) + SizeOf(BtnInfo)));
ReadProcessMemory(ThreadHandle,Pointer(integer(@Buff[0]) + SizeOf(BtnInfo)), @BtnRect,SizeOf(BtnRect),R);//得到Rect信息
SysToolBtn.FBtnRect := BtnRect;
SysToolBtn.FPicture.Width := BtnRect.Right - BtnRect.Left;
SysToolBtn.FPicture.Height := BtnRect.Bottom - BtnRect.Top;
BitBlt(SysToolBtn.FPicture.Canvas.Handle,0,0,SysToolBtn.FPicture.Width,SysToolBtn.FPicture.Height,
GetDc(FTrayBarHandle),BtnRect.Left,BtnRect.Top,SRCCOPY); //抓图
end;
FTrayBtnList.AddObject(SysToolBtn.FBtnCaption,SysToolBtn);
{if BtnInfo.fsState <> TBSTATE_HIDDEN then //如果是隐藏的，则不显示出来
begin
//FTrayBtnList.Add(s)
end;}
end;
finally
VirtualFreeEx(ThreadHandle, Buff, 0, MEM_RELEASE);
CloseHandle(ThreadHandle);
end;
end;
function TSysTaskBarOperate.GetTaskBtnCount: integer;
begin
result := FTaskBtnList.Count;
end;
function TSysTaskBarOperate.GetTaskBtns(Index: integer): TSysToolbarBtn;
begin
if (Index > -1 ) and (Index < FTaskBtnList.Count) then
result := TSysToolbarBtn(FTaskBtnList.Objects[Index])
else result := nil;
end;
procedure TSysTaskBarOperate.GetTaskList;
var
i,BtnCount: integer;
ThreadId: LongInt;
ThreadHandle: THandle;
vBuffer: array[0..255] of Char;
SysToolBtn: TSysToolbarBtn;
BtnInfo: TTBButton;
Buff: pointer;
BtnRect: TRect;
WriteNum: Cardinal;
SysHide: boolean;
begin
BtnCount := SendMessage(FProgramToolBarHandle, TB_BUTTONCOUNT,0,0);
GetWindowThreadProcessId(FProgramToolBarHandle,@ThreadId);
ThreadHandle := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE, False, ThreadId);
Buff := VirtualAllocEx(ThreadHandle, nil,4096, MEM_RESERVE or MEM_COMMIT,PAGE_READWRITE);
try
for i := 0 to BtnCount - 1 do
begin
WriteProcessMemory(ThreadHandle,Buff,@BtnInfo,Sizeof(BtnInfo),WriteNum);
SendMessage(FProgramToolBarHandle,TB_GETBUTTON, i,integer(Buff));
ReadProcessMemory(ThreadHandle, Buff, @BtnInfo, SizeOf(BtnInfo), WriteNum);
SendMessage(FProgramToolBarHandle,TB_GETRECT,BtnInfo.idCommand,integer(integer(Buff) + SizeOf(BtnInfo)));
ReadProcessMemory(ThreadHandle,Pointer(integer(Buff) + SizeOf(BtnInfo)), @BtnRect,SizeOf(BtnRect),WriteNum);//得到Rect信息
SysHide := (BtnRect.Right - BtnRect.Left = 0) and (BtnRect.Bottom - BtnRect.Top = 0);
SysHide := IsSysBtnHide(BtnInfo.fsState) or SysHide;
if SysHide and (not FShowHideBtn) then
Continue;
SysToolBtn := TSysToolbarBtn.Create;
SysToolBtn.SysHide := SysHide;
SysToolBtn.FVisible := not SysHide;
SysToolBtn.AssignBtnInfo(BtnInfo);
//SysToolBtn.FPicture.Canvas
SysToolBtn.FBtnIndex := BtnInfo.idCommand;
SendMessage(FProgramToolBarHandle,TB_GETBUTTONTEXT,SysToolBtn.FBtnInfo.idCommand,integer(integer(Buff) + SizeOf(@SysToolBtn.FBtnInfo)));
ReadProcessMemory(ThreadHandle, Pointer(integer(Buff) + SizeOf(@SysToolBtn.FBtnInfo)),@VBuffer,SizeOf(VBuffer), WriteNum);
SysToolBtn.FBtnCaption := String(VBuffer);
SysToolBtn.EventHandle := FProgramToolBarHandle;
SysToolBtn.FBtnRect := BtnRect;
FTaskBtnList.AddObject(SysToolBtn.FBtnCaption,SysToolBtn);
end;
finally
VirtualFreeEx(ThreadHandle, Buff,0, MEM_RELEASE);
CloseHandle(ThreadHandle);
end;
end;
function TSysTaskBarOperate.GetTrayBtnCount: integer;
begin
result := FTrayBtnList.Count;
end;
function TSysTaskBarOperate.GetTrayBtns(Index: integer): TSysToolbarBtn;
begin
if (Index > -1 ) and (Index < FTrayBtnList.Count) then
result := TSysToolbarBtn(FTrayBtnList.Objects[Index])
else result := nil;
end;
procedure TSysTaskBarOperate.HideTrayBtnClick;
begin
PostMessage(FHideTrayBtnHandle,WM_LButtonDown,0,0);
PostMessage(FHideTrayBtnHandle,WM_LButtonUp,0,0);
end;
procedure TSysTaskBarOperate.ImeRectBtnClick;
begin
PostMessage(FImeRecHandle,WM_LButtonDown,0,MakeLParam(4,5));
PostMessage(FImeRecHandle,WM_LButtonUp,0,MakeLParam(4,5));
end;
function TSysTaskBarOperate.IsSysBtnHide(BtnState: Dword): boolean;
begin
result := GetBitNum(4,BtnState) = 1;
end;
procedure TSysTaskBarOperate.SetReBaVisible(const Value: boolean);
begin
if (FRegBarVisible <> Value) and Visible then
begin
FRegBarVisible := Value;
if Value then
ShowWindow(FReBarHandle,SW_Normal)
else
ShowWindow(FReBarHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.SetquickBarVisible(const Value: boolean);
begin
if (FquickBarVisible <> Value) and TaskBarVisible then
begin
FquickBarVisible := Value;
if Value then
ShowWindow(FQuitLauchHandle,SW_Normal)
else
ShowWindow(FQuitLauchHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.SetShowHideBtn(const Value: boolean);
begin
if FShowHideBtn <> Value then
begin
FShowHideBtn := Value;
ClearTrayBtnList;
GetIconList;
ClearTaskBtnList;
GetTaskList;
end;
end;
procedure TSysTaskBarOperate.SetTaskBarVisible(const Value: boolean);
begin
if (FTaskBarVisible <> Value) and FRegBarVisible then
begin
FTaskBarVisible := Value;
if Value then
ShowWindow(FProgramContrainerHandle,SW_Normal)
else
ShowWindow(FProgramContrainerHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.SetTaskToolBarVisible(const Value: boolean);
begin
if (FTaskToolBarVisible <> Value) and (FTaskBarVisible) then
begin
FTaskToolBarVisible := Value;
if Value then
ShowWindow(FProgramToolBarHandle,SW_Normal)
else
ShowWindow(FProgramToolBarHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.SetTimeDlg;
begin
winexec('rundll32.exe shell32.dll,Control_RunDLL timedate.cpl',9);
// SendMessage(FClockHandle, WM_LBUTTONDBLCLK,0,MakeLong(2,2));
// SendMessage(FClockHandle,WM_LBUTTONUP,0,MakeLong(2,2));
end;
procedure TSysTaskBarOperate.SetVisible(const Value: boolean);
begin
if FVisible <> Value then
begin
FVisible := Value;
if FVisible then
ShowWindow(FTaskBarHandle,SW_NORMAL)
else
ShowWindow(FTaskBarHandle,SW_HIDE);
end;
end;
procedure TSysTaskBarOperate.ShowTime;
begin
AddTipTool({FClockHandle}FProgramToolBarHandle,1,pchar('时间显示'), PChar(DateToStr(now)),$00FFBFBF,$00A60053);//添加气泡提示
end;
procedure TSysTaskBarOperate.StartBtnClick;
begin
SendMessage(self.FStartBtnHandle,WM_LBUTTONDOWN,0,0);
SendMessage(self.FStartBtnHandle,WM_LBUTTONUP,0,0);
end;
procedure TSysTaskBarOperate.StartBtnWndProc(var Message: TMessage);
begin
if Message.Msg = WM_LButtonup then
ShowMessage('sdf');
end;
procedure TSysTaskBarOperate.SetStartBtnVisible(const Value: boolean);
begin
if (FStartBtnVisible <> Value) and Visible then
begin
FStartBtnVisible := Value;
if Value then
ShowWindow(FStartBtnHandle,SW_Normal)
else
ShowWindow(FStartBtnHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.SetImeBarVisible(const Value: boolean);
begin
if (FImeBarVisible <> Value) and FRegBarVisible then
begin
FImeBarVisible := Value;
if Value then
ShowWindow(FImeRecHandle,SW_Normal)
else
ShowWindow(FImeRecHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.SetTrayBarVisible(const Value: boolean);
begin
if (FTrayBarVisible <> Value) and FVisible then
begin
FTrayBarVisible := Value;
if Value then
ShowWindow(FTrayNotifyHandle,SW_Normal)
else
ShowWindow(FTrayNotifyHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.HideOn;
begin
ReBarVisible := false;
TrayBarVisible := false;
StartBtnVisible := false;
end;
procedure TSysTaskBarOperate.ShowOn;
begin
ReBarVisible := true;
TaskBarVisible := true;
quickBarVisible := true;
TaskToolBarVisible := true;
StartBtnVisible := true;
TrayBarVisible := true;
ImeBarVisible := true;
end;
{ TSysToolbarBtn }
procedure TSysToolbarBtn.AssignBtnInfo(Info: TTBButton);
begin
FBtnInfo.iBitmap := Info.iBitmap;
FBtnInfo.idCommand := Info.idCommand;
FBtnInfo.fsState := Info.fsState;
FBtnInfo.fsStyle := Info.fsStyle;
FBtnInfo.bReserved := Info.bReserved;
FBtnInfo.dwData := Info.dwData;
FBtnInfo.iString := Info.iString;
end;
procedure TSysToolbarBtn.Click;
begin
SendMessage(EventHandle,WM_LBUTTONDOWN,0,MakeLong(FBtnRect.Left + 2,FBtnRect.Top + 2));
SendMessage(EventHandle,WM_LBUTTONUP,0,MakeLong(FBtnRect.Left + 2,FBtnRect.Top + 2));
end;
constructor TSysToolbarBtn.Create;
begin
Inherited Create;
FillChar(FBtnInfo,SizeOf(FBtnInfo), 0);
FPicture := TBitMap.Create;
end;
procedure TSysToolbarBtn.DbClick;
begin
SendMessage(EventHandle, WM_LBUTTONDBLCLK,0,MakeLong(FBtnRect.Left + 2,FBtnRect.Top + 2));
SendMessage(EventHandle,WM_LBUTTONUP,0,MakeLong(FBtnRect.Left + 2,FBtnRect.Top + 2));
end;
destructor TSysToolbarBtn.Destroy;
begin
FPicture.Free;
if (not isSysHide) and (not FVisible) then
Visible := true
else if IsSysHide and FVisible then
Visible := false;
ZeroMemory(Pointer(@FBtnInfo),Sizeof(FBtnInfo));
inherited;
end;
function TSysToolbarBtn.GetBtnInfo: TTBButton;
begin
result := FBtnInfo;
end;
procedure TSysToolbarBtn.RClick;
begin
SendMessage(EventHandle,WM_RBUTTONDOWN,0,MakeLong(FBtnRect.Left + 2,FBtnRect.Top + 2));
SendMessage(EventHandle,WM_RBUTTONUP,0,MakeLong(FBtnRect.Left + 2,FBtnRect.Top + 2));
end;
procedure TSysToolbarBtn.SetVisible(const Value: boolean);
begin
if FVisible <> Value then
begin
FVisible := Value;
if FVisible then
SendMessage(EventHandle,TB_HIDEBUTTON,BtnInfo.idCommand,0)
else
SendMessage(EventHandle,TB_HIDEBUTTON,BtnInfo.idCommand,1);
end;
end;
end.
使用Demo
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, RzButton, StdCtrls, RzLstBox, ExtCtrls, RzPanel, ToolWin,
ComCtrls,WindowsOperate, RzChkLst, RzRadChk, RzLabel, RzTabs;
type
TForm1 = class(TForm)
RzPageControl1: TRzPageControl;
TabSheet1: TRzTabSheet;
RzCheckList1: TRzCheckList;
RzLabel1: TRzLabel;
RzRadioButton1: TRzRadioButton;
RzRadioButton2: TRzRadioButton;
TabSheet2: TRzTabSheet;
Image2: TImage;
RzLabel2: TRzLabel;
RzCheckList2: TRzCheckList;
RzLabel3: TRzLabel;
RzRadioButton4: TRzRadioButton;
RzRadioButton3: TRzRadioButton;
RzButton1: TRzButton;
procedure FormCreate(Sender: TObject);
procedure RzCheckList1Change(Sender: TObject; Index: Integer;
NewState: TCheckBoxState);
procedure RzRadioButton1Click(Sender: TObject);
procedure RzCheckList1Click(Sender: TObject);
procedure RzButton2Click(Sender: TObject);
procedure RzRadioButton3Click(Sender: TObject);
procedure RzCheckList2Change(Sender: TObject; Index: Integer;
NewState: TCheckBoxState);
procedure RzCheckList2DblClick(Sender: TObject);
procedure RzButton1Click(Sender: TObject);
procedure RzCheckList1DblClick(Sender: TObject);
private
{ Private declarations }
OldProc:FARPROC;
procedure StartBtnWndProc(var Message: TMessage);
procedure ReSetList(ShowHideBtn: boolean=false);
public
{ Public declarations }
nn: TSysTaskBarOperate;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses CommCtrl,ShellApi;
procedure TForm1.FormCreate(Sender: TObject);
begin
nn := TSysTaskBarOperate.Create(self);
RzRadioButton2.Checked := true;
RzRadioButton3.Checked := true;
end;
procedure TForm1.StartBtnWndProc(var Message: TMessage);
begin
end;
procedure TForm1.RzCheckList1Change(Sender: TObject; Index: Integer;
NewState: TCheckBoxState);
begin
if NewState = CbChecked then
TSysToolbarBtn(nn.TrayBtnList.Objects[index]).Visible := true
else
TSysToolbarBtn(nn.TrayBtnList.Objects[index]).Visible := false;
nn.HideTrayBtnClick;
end;
procedure TForm1.RzRadioButton1Click(Sender: TObject);
begin
ReSetList(not RzRadioButton2.Checked);
RzRadioButton3.Checked := RzRadioButton2.Checked;
RzRadioButton4.Checked := RzRadioButton1.Checked;
end;
procedure TForm1.ReSetList(ShowHideBtn: boolean);
var
i: integer;
begin
nn.ShowHideBtn := ShowHideBtn;
self.RzCheckList1.Items := nn.TrayBtnList;
self.RzCheckList2.Items := nn.TaskBtnList;
for i := 0 to RzCheckList1.Items.Count - 1 do
RzCheckList1.ItemChecked := not TSysToolbarBtn(nn.TrayBtnList.Objects).isSysHide;
for i := 0 to RzCheckList2.Items.Count - 1 do
RzCheckList2.ItemChecked := not nn.TaskBtns.isSysHide
end;
procedure TForm1.RzCheckList1Click(Sender: TObject);
begin
if RzCheckList1.ItemIndex <> -1 then
begin
Image2.Width := nn.TrayBtns[RzCheckList1.ItemIndex].Picture.Width;
Image2.Height := nn.TrayBtns[RzCheckList1.ItemIndex].Picture.Height;
Image2.Picture.Assign(nn.TrayBtns[RzCheckList1.ItemIndex].Picture);
end;
end;
procedure TForm1.RzCheckList1DblClick(Sender: TObject);
begin
if RzCheckList1.ItemIndex <> -1 then
nn.TrayBtns[RzCheckList1.ItemIndex].Click;
end;
procedure TForm1.RzButton2Click(Sender: TObject);
begin
nn.TrayBtns[RzCheckList1.ItemIndex].DbClick
end;
procedure TForm1.RzRadioButton3Click(Sender: TObject);
begin
RzRadioButton2.Checked := RzRadioButton3.Checked;
RzRadioButton1.Checked := RzRadioButton4.Checked;
end;
procedure TForm1.RzCheckList2Change(Sender: TObject; Index: Integer;
NewState: TCheckBoxState);
begin
if NewState = CbChecked then
nn.TaskBtns[index].Visible := true
else
nn.TaskBtns[index].Visible := false;
end;
procedure TForm1.RzCheckList2DblClick(Sender: TObject);
begin
if RzCheckList2.ItemIndex <> -1 then
nn.TaskBtns[RzCheckList2.ItemIndex].Click;
end;
procedure TForm1.RzButton1Click(Sender: TObject);
begin
nn.HideOn;
end;
end.
(******************************************************)
(* WindowsOperate Unit *)
(* Copyright(c) 2007 不得闲 *)
(* email:appleak46@yahoo.com.cn QQ:75492895 *)
(******************************************************)
unit WindowsOperate;
interface
uses windows,Classes,Messages,SysUtils,forms,ComObj,winsvc, shellapi,CommCtrl,Graphics;
type
{任务栏上的任务按扭}
TSysToolbarBtn = class(TPersistent)
private
FBtnInfo: TTBButton;
FBtnIndex: integer;
FBtnCaption: string;
SysHide: boolean;//是否为系统隐藏图标
EventHandle: THandle; //事件处理句柄
FPicture: TBitmap; //图标
FBtnRect: TRect; //区域
FVisible: boolean;
function GetBtnInfo: TTBButton;
procedure SetVisible(const Value: boolean);
public
Constructor Create;
Destructor Destroy;override;
property BtnInfo: TTBButton read GetBtnInfo;
property BtnIndex: integer read FBtnIndex;
property BtnCaption: string read FBtnCaption;
property BtnRect: TRect read FBtnRect;
procedure AssignBtnInfo(Info: TTBButton);
property isSysHide: boolean read SysHide;
property Picture: TBitmap read FPicture;
property Visible: boolean read FVisible write SetVisible;
procedure Click;
procedure DbClick;
procedure RClick;
end;
TSysTaskBarOperate = Class(TComponent) //任务栏操作类
private
FTrayBtnList,FTaskBtnList: TStringList;
HigherThenXp: boolean; //是否为xp以上的系统版本
FTrayBarHandle: THandle;
FTaskBarHandle: THandle;
FStartBtnHandle: THandle;
FQuitLauchHandle: THandle;
FReBarHandle: THandle;
FProgramToolBarHandle: THandle;
FImeRecHandle: THandle;
FProgramContrainerHandle: THandle; //任务栏容器
FHideTrayBtnHandle: THandle;
FTrayNotifyHandle: THandle;
FClockHandle: THandle;
FShowHideBtn: boolean;
FVisible: boolean;
FquickBarVisible: boolean;
FTaskToolBarVisible: boolean;
FTaskBarVisible: boolean;
FRegBarVisible: boolean;
FStartBtnVisible: boolean;
FImeBarVisible: boolean;
FTrayBarVisible: boolean;
procedure GetIconList;
procedure GetTaskList;
function GetTrayBtnCount: integer;
function IsSysBtnHide(BtnState: Dword): boolean;
procedure SetShowHideBtn(const Value: boolean);
function GetTrayBtns(Index: integer): TSysToolbarBtn;
function GetTaskBtnCount: integer;
function GetTaskBtns(Index: integer): TSysToolbarBtn;
procedure SetVisible(const Value: boolean);
procedure SetquickBarVisible(const Value: boolean);
procedure SetTaskToolBarVisible(const Value: boolean);
procedure SetTaskBarVisible(const Value: boolean);
procedure SetReBaVisible(const Value: boolean);
procedure SetStartBtnVisible(const Value: boolean);
procedure SetImeBarVisible(const Value: boolean);
procedure SetTrayBarVisible(const Value: boolean);
protected
procedure StartBtnWndProc(var Message: TMessage);
public
Constructor Create(AOwner: TComponent);override;
Destructor Destroy;override;
property TrayBarHandle: THandle read FTrayBarHandle;//托盘区句柄
property TaskBarHandle: THandle read FTaskBarHandle;//任务栏句柄
property StartBtnHandle: THandle read FStartBtnHandle;//开始按扭句柄
property QuitLauchHandle: THandle read FQuitLauchHandle;//快速启动栏句柄
property ImeRecHandle: THandle read FImeRecHandle;//输入法选择区域句柄
property ProgramToolBarHandle: THandle read FProgramToolBarHandle;//程序最小化按扭容器
property HideTrayBtnHandle: THandle read FHideTrayBtnHandle;//显示隐藏图标的按扭
property ClockHandle: THandle read FClockHandle;//时钟显示区域句柄
procedure SetTimeDlg; //设置时间对话框
procedure HideTrayBtnClick; //显示隐藏按扭单击
procedure ImeRectBtnClick;//输入法按扭单击
procedure ClearTrayBtnList; //清除托盘区列表
procedure ClearTaskBtnList;
procedure ShowTime;
procedure StartBtnClick;
procedure HideOn;
procedure ShowOn;
property TrayBarVisible: boolean read FTrayBarVisible write SetTrayBarVisible;
property ImeBarVisible: boolean read FImeBarVisible write SetImeBarVisible;
property StartBtnVisible: boolean read FStartBtnVisible write SetStartBtnVisible;
property ReBarVisible: boolean read FRegBarVisible write SetReBaVisible;
property TaskToolBarVisible: boolean read FTaskToolBarVisible write SetTaskToolBarVisible;
property TaskBarVisible: boolean read FTaskBarVisible write SetTaskBarVisible;
property quickBarVisible: boolean read FquickBarVisible write SetquickBarVisible;
property Visible: boolean read FVisible write SetVisible; //是否隐藏任务栏
property ShowHideBtn: boolean read FShowHideBtn Write SetShowHideBtn;//是否显示系统隐藏的托盘按扭
property TrayBtnCount: integer read GetTrayBtnCount;//托盘图标的个数
property TaskBtnCount: integer Read GetTaskBtnCount;
property TrayBtnList: TStringList read FTrayBtnList;
property TaskBtnList: TStringList Read FTaskBtnList;
property TrayBtns[Index: integer]: TSysToolbarBtn read GetTrayBtns; //托盘按扭
Property TaskBtns[Index: integer]: TSysToolbarBtn read GetTaskBtns; //任务栏按扭
end;
implementation
{ TSysTaskbarOperate }
procedure TSysTaskBarOperate.ClearTaskBtnList;
begin
while FTaskBtnList.Count > 0 do
begin
FTaskBtnList.Objects[FTaskBtnList.Count - 1].Free;
FTaskBtnList.Delete(FTaskBtnList.Count - 1);
end;
end;
procedure TSysTaskBarOperate.ClearTrayBtnList;
begin
while FTrayBtnList.Count > 0 do
begin
FTrayBtnList.Objects[FTrayBtnList.Count - 1].Free;
FTrayBtnList.Delete(FTrayBtnList.Count - 1);
end;
end;
constructor TSysTaskbarOperate.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTrayBtnList := TStringList.Create;
FTaskBtnList := TStringList.Create;
HigherThenXp := (Win32MajorVersion > 5) or ((Win32MajorVersion = 5) and (Win32MinorVersion > 0));
FTaskBarHandle := FindWindow('Shell_TrayWnd',nil);
FStartBtnHandle := FindWindowEx(FTaskBarHandle,0,'Button',nil);
//if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 10) then //98系统
FReBarHandle := FindWindowEx(FTaskBarHandle,0,'ReBarWindow32',nil);
FQuitLauchHandle := FReBarHandle;
FProgramContrainerHandle := FindWindowEx(FQuitLauchHandle,0,'MSTaskSwWClass',nil);
FImeRecHandle := FindWindowEx(FQuitLauchHandle,0,'CiceroUIWndFrame',nil);
if HigherThenXp then
FProgramToolBarHandle := FindWindowEx(FProgramContrainerHandle,0,'ToolbarWindow32',nil)
else FProgramToolBarHandle := FProgramContrainerHandle;
FTrayBarHandle := FindWindowEx(FTaskBarHandle,0,'TrayNotifyWnd',nil);
FTrayNotifyHandle := FTrayBarHandle;
FClockHandle := FindWindowEx(FTrayBarHandle,0,'TrayClockWClass',nil);
FHideTrayBtnHandle := FindWindowEx(FTrayBarHandle,0,'Button',nil);
if HigherThenXp then
FTrayBarHandle := FindWindowEx(FTrayBarHandle,0,'SysPager',nil);
if (Win32MajorVersion = 5) and (Win32MinorVersion >= 0) then
FTrayBarHandle := FindWindowEx(FTrayBarHandle,0,'ToolbarWindow32',nil);
FQuitLauchHandle := FindWindowEx(FQuitLauchHandle,0,'ToolbarWindow32',nil);//快速启动栏
//SetWindowLong(FStartBtnHandle, GWL_WNDPROC, Longint(MakeObjectInstance(StartBtnWndProc)));
GetIconList;
GetTaskList;
Visible := true;
ReBarVisible := true;
TaskBarVisible := true;
quickBarVisible := true;
TaskToolBarVisible := true;
StartBtnVisible := true;
TrayBarVisible := true;
ImeBarVisible := true;
end;
destructor TSysTaskbarOperate.Destroy;
begin
ClearTrayBtnList;
FTrayBtnList.Free;
ClearTaskBtnList;
FTaskBtnList.Free;
inherited;
end;
procedure TSysTaskBarOperate.GetIconList;
var
ThreadID: THandle;
ThreadHandle: THandle; //线程句柄
Buff: pchar;
i,BtnCount: integer;
R: Cardinal;
BtnInfo: TTBButton;
SysHide: boolean;
SysToolBtn: TSysToolbarBtn;
S: array[0..512] of char;
BtnRect: TRect;
begin
GetWindowThreadProcessId(FTrayBarHandle, @ThreadID);//获取托盘窗口的线程 ID
ThreadHandle := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, False, ThreadID);//得到线程句柄
Buff := VirtualAllocEx(ThreadHandle,nil,4096,MEM_RESERVE or MEM_COMMIT,PAGE_READWRITE);//指定进程的虚拟空间保留或提交内存区域，除非指定MEM_RESET参数，否则将该内存区域置0
BtnCount := SendMessage(FTrayBarHandle,TB_BUTTONCOUNT, 0, 0);//得到托盘按扭个数
//SendMessage(FTrayBarHandle,TB_GETIMAGELIST,0,0);
//SendMessage(FTrayBarHandle,TB_GETBITMAPFLAGS,0,0);
try
for i := 0 to BtnCount - 1 do
begin
WriteProcessMemory(ThreadHandle, Buff, @BtnInfo, SizeOf(BtnInfo), R);
SendMessage(FTrayBarHandle, TB_GETBUTTON, i,integer(Buff));
ReadProcessMemory(ThreadHandle, Buff, @BtnInfo, SizeOf(BtnInfo), R);
SysHide := IsSysBtnHide(BtnInfo.fsState);
if SysHide and (not FShowHideBtn) then
Continue;
SysToolBtn := TSysToolbarBtn.Create;
SysToolBtn.SysHide := SysHide;
SysToolBtn.FVisible := not SysHide;
SysToolBtn.AssignBtnInfo(BtnInfo);
//SysToolBtn.FPicture.Canvas
SysToolBtn.FBtnIndex := BtnInfo.idCommand;
SendMessage(FTrayBarHandle,TB_GETBUTTONTEXT,SysToolBtn.FBtnInfo.idCommand,integer(integer(@Buff[0]) + SizeOf(@SysToolBtn.FBtnInfo)));
ReadProcessMemory(ThreadHandle, Pointer(integer(@Buff[0]) + SizeOf(@SysToolBtn.FBtnInfo)),@S[0],SizeOf(S), R);
//if SysToolBtn.FBtnInfo.fsState = 12 then
SysToolBtn.FBtnCaption := String(s);
SysToolBtn.EventHandle := FTrayBarHandle;
if not SysHide then
begin
SendMessage(FTrayBarHandle,TB_GETRECT,BtnInfo.idCommand,integer(integer(@Buff[0]) + SizeOf(BtnInfo)));
ReadProcessMemory(ThreadHandle,Pointer(integer(@Buff[0]) + SizeOf(BtnInfo)), @BtnRect,SizeOf(BtnRect),R);//得到Rect信息
SysToolBtn.FBtnRect := BtnRect;
SysToolBtn.FPicture.Width := BtnRect.Right - BtnRect.Left;
SysToolBtn.FPicture.Height := BtnRect.Bottom - BtnRect.Top;
BitBlt(SysToolBtn.FPicture.Canvas.Handle,0,0,SysToolBtn.FPicture.Width,SysToolBtn.FPicture.Height,
GetDc(FTrayBarHandle),BtnRect.Left,BtnRect.Top,SRCCOPY); //抓图
end;
FTrayBtnList.AddObject(SysToolBtn.FBtnCaption,SysToolBtn);
{if BtnInfo.fsState <> TBSTATE_HIDDEN then //如果是隐藏的，则不显示出来
begin
//FTrayBtnList.Add(s)
end;}
end;
finally
VirtualFreeEx(ThreadHandle, Buff, 0, MEM_RELEASE);
CloseHandle(ThreadHandle);
end;
end;
function TSysTaskBarOperate.GetTaskBtnCount: integer;
begin
result := FTaskBtnList.Count;
end;
function TSysTaskBarOperate.GetTaskBtns(Index: integer): TSysToolbarBtn;
begin
if (Index > -1 ) and (Index < FTaskBtnList.Count) then
result := TSysToolbarBtn(FTaskBtnList.Objects[Index])
else result := nil;
end;
procedure TSysTaskBarOperate.GetTaskList;
var
i,BtnCount: integer;
ThreadId: LongInt;
ThreadHandle: THandle;
vBuffer: array[0..255] of Char;
SysToolBtn: TSysToolbarBtn;
BtnInfo: TTBButton;
Buff: pointer;
BtnRect: TRect;
WriteNum: Cardinal;
SysHide: boolean;
begin
BtnCount := SendMessage(FProgramToolBarHandle, TB_BUTTONCOUNT,0,0);
GetWindowThreadProcessId(FProgramToolBarHandle,@ThreadId);
ThreadHandle := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE, False, ThreadId);
Buff := VirtualAllocEx(ThreadHandle, nil,4096, MEM_RESERVE or MEM_COMMIT,PAGE_READWRITE);
try
for i := 0 to BtnCount - 1 do
begin
WriteProcessMemory(ThreadHandle,Buff,@BtnInfo,Sizeof(BtnInfo),WriteNum);
SendMessage(FProgramToolBarHandle,TB_GETBUTTON, i,integer(Buff));
ReadProcessMemory(ThreadHandle, Buff, @BtnInfo, SizeOf(BtnInfo), WriteNum);
SendMessage(FProgramToolBarHandle,TB_GETRECT,BtnInfo.idCommand,integer(integer(Buff) + SizeOf(BtnInfo)));
ReadProcessMemory(ThreadHandle,Pointer(integer(Buff) + SizeOf(BtnInfo)), @BtnRect,SizeOf(BtnRect),WriteNum);//得到Rect信息
SysHide := (BtnRect.Right - BtnRect.Left = 0) and (BtnRect.Bottom - BtnRect.Top = 0);
SysHide := IsSysBtnHide(BtnInfo.fsState) or SysHide;
if SysHide and (not FShowHideBtn) then
Continue;
SysToolBtn := TSysToolbarBtn.Create;
SysToolBtn.SysHide := SysHide;
SysToolBtn.FVisible := not SysHide;
SysToolBtn.AssignBtnInfo(BtnInfo);
//SysToolBtn.FPicture.Canvas
SysToolBtn.FBtnIndex := BtnInfo.idCommand;
SendMessage(FProgramToolBarHandle,TB_GETBUTTONTEXT,SysToolBtn.FBtnInfo.idCommand,integer(integer(Buff) + SizeOf(@SysToolBtn.FBtnInfo)));
ReadProcessMemory(ThreadHandle, Pointer(integer(Buff) + SizeOf(@SysToolBtn.FBtnInfo)),@VBuffer,SizeOf(VBuffer), WriteNum);
SysToolBtn.FBtnCaption := String(VBuffer);
SysToolBtn.EventHandle := FProgramToolBarHandle;
SysToolBtn.FBtnRect := BtnRect;
FTaskBtnList.AddObject(SysToolBtn.FBtnCaption,SysToolBtn);
end;
finally
VirtualFreeEx(ThreadHandle, Buff,0, MEM_RELEASE);
CloseHandle(ThreadHandle);
end;
end;
function TSysTaskBarOperate.GetTrayBtnCount: integer;
begin
result := FTrayBtnList.Count;
end;
function TSysTaskBarOperate.GetTrayBtns(Index: integer): TSysToolbarBtn;
begin
if (Index > -1 ) and (Index < FTrayBtnList.Count) then
result := TSysToolbarBtn(FTrayBtnList.Objects[Index])
else result := nil;
end;
procedure TSysTaskBarOperate.HideTrayBtnClick;
begin
PostMessage(FHideTrayBtnHandle,WM_LButtonDown,0,0);
PostMessage(FHideTrayBtnHandle,WM_LButtonUp,0,0);
end;
procedure TSysTaskBarOperate.ImeRectBtnClick;
begin
PostMessage(FImeRecHandle,WM_LButtonDown,0,MakeLParam(4,5));
PostMessage(FImeRecHandle,WM_LButtonUp,0,MakeLParam(4,5));
end;
function TSysTaskBarOperate.IsSysBtnHide(BtnState: Dword): boolean;
begin
result := GetBitNum(4,BtnState) = 1;
end;
procedure TSysTaskBarOperate.SetReBaVisible(const Value: boolean);
begin
if (FRegBarVisible <> Value) and Visible then
begin
FRegBarVisible := Value;
if Value then
ShowWindow(FReBarHandle,SW_Normal)
else
ShowWindow(FReBarHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.SetquickBarVisible(const Value: boolean);
begin
if (FquickBarVisible <> Value) and TaskBarVisible then
begin
FquickBarVisible := Value;
if Value then
ShowWindow(FQuitLauchHandle,SW_Normal)
else
ShowWindow(FQuitLauchHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.SetShowHideBtn(const Value: boolean);
begin
if FShowHideBtn <> Value then
begin
FShowHideBtn := Value;
ClearTrayBtnList;
GetIconList;
ClearTaskBtnList;
GetTaskList;
end;
end;
procedure TSysTaskBarOperate.SetTaskBarVisible(const Value: boolean);
begin
if (FTaskBarVisible <> Value) and FRegBarVisible then
begin
FTaskBarVisible := Value;
if Value then
ShowWindow(FProgramContrainerHandle,SW_Normal)
else
ShowWindow(FProgramContrainerHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.SetTaskToolBarVisible(const Value: boolean);
begin
if (FTaskToolBarVisible <> Value) and (FTaskBarVisible) then
begin
FTaskToolBarVisible := Value;
if Value then
ShowWindow(FProgramToolBarHandle,SW_Normal)
else
ShowWindow(FProgramToolBarHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.SetTimeDlg;
begin
winexec('rundll32.exe shell32.dll,Control_RunDLL timedate.cpl',9);
// SendMessage(FClockHandle, WM_LBUTTONDBLCLK,0,MakeLong(2,2));
// SendMessage(FClockHandle,WM_LBUTTONUP,0,MakeLong(2,2));
end;
procedure TSysTaskBarOperate.SetVisible(const Value: boolean);
begin
if FVisible <> Value then
begin
FVisible := Value;
if FVisible then
ShowWindow(FTaskBarHandle,SW_NORMAL)
else
ShowWindow(FTaskBarHandle,SW_HIDE);
end;
end;
procedure TSysTaskBarOperate.ShowTime;
begin
AddTipTool({FClockHandle}FProgramToolBarHandle,1,pchar('时间显示'), PChar(DateToStr(now)),$00FFBFBF,$00A60053);//添加气泡提示
end;
procedure TSysTaskBarOperate.StartBtnClick;
begin
SendMessage(self.FStartBtnHandle,WM_LBUTTONDOWN,0,0);
SendMessage(self.FStartBtnHandle,WM_LBUTTONUP,0,0);
end;
procedure TSysTaskBarOperate.StartBtnWndProc(var Message: TMessage);
begin
if Message.Msg = WM_LButtonup then
ShowMessage('sdf');
end;
procedure TSysTaskBarOperate.SetStartBtnVisible(const Value: boolean);
begin
if (FStartBtnVisible <> Value) and Visible then
begin
FStartBtnVisible := Value;
if Value then
ShowWindow(FStartBtnHandle,SW_Normal)
else
ShowWindow(FStartBtnHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.SetImeBarVisible(const Value: boolean);
begin
if (FImeBarVisible <> Value) and FRegBarVisible then
begin
FImeBarVisible := Value;
if Value then
ShowWindow(FImeRecHandle,SW_Normal)
else
ShowWindow(FImeRecHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.SetTrayBarVisible(const Value: boolean);
begin
if (FTrayBarVisible <> Value) and FVisible then
begin
FTrayBarVisible := Value;
if Value then
ShowWindow(FTrayNotifyHandle,SW_Normal)
else
ShowWindow(FTrayNotifyHandle,SW_Hide);
end;
end;
procedure TSysTaskBarOperate.HideOn;
begin
ReBarVisible := false;
TrayBarVisible := false;
StartBtnVisible := false;
end;
procedure TSysTaskBarOperate.ShowOn;
begin
ReBarVisible := true;
TaskBarVisible := true;
quickBarVisible := true;
TaskToolBarVisible := true;
StartBtnVisible := true;
TrayBarVisible := true;
ImeBarVisible := true;
end;
{ TSysToolbarBtn }
procedure TSysToolbarBtn.AssignBtnInfo(Info: TTBButton);
begin
FBtnInfo.iBitmap := Info.iBitmap;
FBtnInfo.idCommand := Info.idCommand;
FBtnInfo.fsState := Info.fsState;
FBtnInfo.fsStyle := Info.fsStyle;
FBtnInfo.bReserved := Info.bReserved;
FBtnInfo.dwData := Info.dwData;
FBtnInfo.iString := Info.iString;
end;
procedure TSysToolbarBtn.Click;
begin
SendMessage(EventHandle,WM_LBUTTONDOWN,0,MakeLong(FBtnRect.Left + 2,FBtnRect.Top + 2));
SendMessage(EventHandle,WM_LBUTTONUP,0,MakeLong(FBtnRect.Left + 2,FBtnRect.Top + 2));
end;
constructor TSysToolbarBtn.Create;
begin
Inherited Create;
FillChar(FBtnInfo,SizeOf(FBtnInfo), 0);
FPicture := TBitMap.Create;
end;
procedure TSysToolbarBtn.DbClick;
begin
SendMessage(EventHandle, WM_LBUTTONDBLCLK,0,MakeLong(FBtnRect.Left + 2,FBtnRect.Top + 2));
SendMessage(EventHandle,WM_LBUTTONUP,0,MakeLong(FBtnRect.Left + 2,FBtnRect.Top + 2));
end;
destructor TSysToolbarBtn.Destroy;
begin
FPicture.Free;
if (not isSysHide) and (not FVisible) then
Visible := true
else if IsSysHide and FVisible then
Visible := false;
ZeroMemory(Pointer(@FBtnInfo),Sizeof(FBtnInfo));
inherited;
end;
function TSysToolbarBtn.GetBtnInfo: TTBButton;
begin
result := FBtnInfo;
end;
procedure TSysToolbarBtn.RClick;
begin
SendMessage(EventHandle,WM_RBUTTONDOWN,0,MakeLong(FBtnRect.Left + 2,FBtnRect.Top + 2));
SendMessage(EventHandle,WM_RBUTTONUP,0,MakeLong(FBtnRect.Left + 2,FBtnRect.Top + 2));
end;
procedure TSysToolbarBtn.SetVisible(const Value: boolean);
begin
if FVisible <> Value then
begin
FVisible := Value;
if FVisible then
SendMessage(EventHandle,TB_HIDEBUTTON,BtnInfo.idCommand,0)
else
SendMessage(EventHandle,TB_HIDEBUTTON,BtnInfo.idCommand,1);
end;
end;
end.
使用Demo
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, RzButton, StdCtrls, RzLstBox, ExtCtrls, RzPanel, ToolWin,
ComCtrls,WindowsOperate, RzChkLst, RzRadChk, RzLabel, RzTabs;
type
TForm1 = class(TForm)
RzPageControl1: TRzPageControl;
TabSheet1: TRzTabSheet;
RzCheckList1: TRzCheckList;
RzLabel1: TRzLabel;
RzRadioButton1: TRzRadioButton;
RzRadioButton2: TRzRadioButton;
TabSheet2: TRzTabSheet;
Image2: TImage;
RzLabel2: TRzLabel;
RzCheckList2: TRzCheckList;
RzLabel3: TRzLabel;
RzRadioButton4: TRzRadioButton;
RzRadioButton3: TRzRadioButton;
RzButton1: TRzButton;
procedure FormCreate(Sender: TObject);
procedure RzCheckList1Change(Sender: TObject; Index: Integer;
NewState: TCheckBoxState);
procedure RzRadioButton1Click(Sender: TObject);
procedure RzCheckList1Click(Sender: TObject);
procedure RzButton2Click(Sender: TObject);
procedure RzRadioButton3Click(Sender: TObject);
procedure RzCheckList2Change(Sender: TObject; Index: Integer;
NewState: TCheckBoxState);
procedure RzCheckList2DblClick(Sender: TObject);
procedure RzButton1Click(Sender: TObject);
procedure RzCheckList1DblClick(Sender: TObject);
private
{ Private declarations }
OldProc:FARPROC;
procedure StartBtnWndProc(var Message: TMessage);
procedure ReSetList(ShowHideBtn: boolean=false);
public
{ Public declarations }
nn: TSysTaskBarOperate;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses CommCtrl,ShellApi;
procedure TForm1.FormCreate(Sender: TObject);
begin
nn := TSysTaskBarOperate.Create(self);
RzRadioButton2.Checked := true;
RzRadioButton3.Checked := true;
end;
procedure TForm1.StartBtnWndProc(var Message: TMessage);
begin
end;
procedure TForm1.RzCheckList1Change(Sender: TObject; Index: Integer;
NewState: TCheckBoxState);
begin
if NewState = CbChecked then
TSysToolbarBtn(nn.TrayBtnList.Objects[index]).Visible := true
else
TSysToolbarBtn(nn.TrayBtnList.Objects[index]).Visible := false;
nn.HideTrayBtnClick;
end;
procedure TForm1.RzRadioButton1Click(Sender: TObject);
begin
ReSetList(not RzRadioButton2.Checked);
RzRadioButton3.Checked := RzRadioButton2.Checked;
RzRadioButton4.Checked := RzRadioButton1.Checked;
end;
procedure TForm1.ReSetList(ShowHideBtn: boolean);
var
i: integer;
begin
nn.ShowHideBtn := ShowHideBtn;
self.RzCheckList1.Items := nn.TrayBtnList;
self.RzCheckList2.Items := nn.TaskBtnList;
for i := 0 to RzCheckList1.Items.Count - 1 do
RzCheckList1.ItemChecked := not TSysToolbarBtn(nn.TrayBtnList.Objects).isSysHide;
for i := 0 to RzCheckList2.Items.Count - 1 do
RzCheckList2.ItemChecked := not nn.TaskBtns.isSysHide
end;
procedure TForm1.RzCheckList1Click(Sender: TObject);
begin
if RzCheckList1.ItemIndex <> -1 then
begin
Image2.Width := nn.TrayBtns[RzCheckList1.ItemIndex].Picture.Width;
Image2.Height := nn.TrayBtns[RzCheckList1.ItemIndex].Picture.Height;
Image2.Picture.Assign(nn.TrayBtns[RzCheckList1.ItemIndex].Picture);
end;
end;
procedure TForm1.RzCheckList1DblClick(Sender: TObject);
begin
if RzCheckList1.ItemIndex <> -1 then
nn.TrayBtns[RzCheckList1.ItemIndex].Click;
end;
procedure TForm1.RzButton2Click(Sender: TObject);
begin
nn.TrayBtns[RzCheckList1.ItemIndex].DbClick
end;
procedure TForm1.RzRadioButton3Click(Sender: TObject);
begin
RzRadioButton2.Checked := RzRadioButton3.Checked;
RzRadioButton1.Checked := RzRadioButton4.Checked;
end;
procedure TForm1.RzCheckList2Change(Sender: TObject; Index: Integer;
NewState: TCheckBoxState);
begin
if NewState = CbChecked then
nn.TaskBtns[index].Visible := true
else
nn.TaskBtns[index].Visible := false;
end;
procedure TForm1.RzCheckList2DblClick(Sender: TObject);
begin
if RzCheckList2.ItemIndex <> -1 then
nn.TaskBtns[RzCheckList2.ItemIndex].Click;
end;
procedure TForm1.RzButton1Click(Sender: TObject);
begin
nn.HideOn;
end;
end.
非QQ会员突破会员限制进行QQ表情编辑
好象Delphi版现在是越来越少的人气了啊！郁闷的紧张啊！都没人来看哈，莫非现在都处在高端层面？
得想个法子来提升一下人气。怎么提呢？就从QQ开刀吧!哈哈。
最新版的QQ出来了一个新的特性，就是可以编辑QQ表情，向其中添加一些自己要说的话语。
但是这个特性好象需要开通会员吧！想想腾讯的策划部到是会抓商机呢。下面我将说说怎样使用非会员来使用QQ表情的编辑工具呢。
我们打开QQ表情编辑的那个对话框，可以看出，他根本不会触发任何的网络的消息出去！ 只是在最开始打开的时候会判断一下当前
用户是否为会员，如果不是的话，那么很多项目则不可用，我们可以很轻易的想到一个API函数EnableWindow函数可以解除那些Enable
为false的控件（只要知道他的消息句柄则可）。现在我们先假定一下，QQ表情编辑在编辑好了之后，用户点完成不会向腾讯服务器发送
询问的（想想他应该不会抠门到这个程度吧！搞个编辑也要发个会员验证），先用Spy++一下，可以轻易的找到那些Enable为false的消息句柄，那 么现在就好办了，直接使用enableWindow(Handle)，看一下则解除禁止了。很简单。然后测试一下效果，果然可以。呵呵。那么我们只用写个 代码来找句柄，然后在Enable他，则完了。
{代码中使用了Raize控件包，如果有兴趣的话，自己写一个HOOK挂到QQ进程，这样就不用每次打开都去点一下解除禁止了。}
代码如下：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, RzCommon,RzLabel, RzButton, ExtCtrls, RzPanel;
Const
WM_DESTROYPN = WM_USER + 100;
type
TRzPanel = Class(RzPanel.TRzPanel)
protected
Procedure WndProc(Var Msg: TMessage);override;
public
Constructor Create(AOwner: TComponent);override;
end;
TForm1 = class(TForm)
RzLabel1: TRzLabel;
btn1: TRzButton;
procedure btn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
BegPos: TPoint;
EdtHandle: THandle;
Pn: TRzPanel;
procedure DestroyPn(Var Msg: TMessage);message WM_DESTROYPN;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
HsFree: Boolean=false;
HsJieChu: boolean=false;
{$R *.dfm}
procedure SetControlOwner(Component: TComponent;NewOwner: TComponent);
var
tempOwner: ^integer;
begin
tempOwner := @(integer(Component.Owner));
tempOwner^ := integer(NewOwner);
end;
procedure EnabledQQEdit;
procedure BlHandle(ParentHandle: THandle);
var
backHwnd,tempHwnd:hWnd;
begin
backHwnd:=Getwindow(ParentHandle,GW_CHILD);
while backHwnd<>0 do
begin
EnableWindow(backHwnd,true);
tempHwnd := backHwnd;
BlHandle(tempHwnd);
backhwnd:=Getwindow(backhwnd,GW_HWNDNEXT);
end;
end;
var
FrmHandle: THandle;
begin
FrmHandle := FindWindow('#32770','编辑涂鸦表情');
if FrmHandle <> 0 then
begin
SendMessage(FrmHandle,wm_settext,0,integer(Pchar('不得闲QQ表情编辑解禁！作者：不得闲！QQ: 75492895')));
Application.MessageBox('QQ表情编辑工具解除禁止成功！','消息',64);
SetForegroundWindow(FrmHandle);
BlHandle(FrmHandle);
end
else
Application.MessageBox('您没有打开QQ表情编辑工具！','消息',64);
end;
procedure EnabledQQEdit1;
var
FrmHandle,ModHandle: THandle;
rec: TRect;
Pn: TRzPanel;
OldWidth: integer;
procedure BlHandle(ParentHandle: THandle);
var
backHwnd,tempHwnd:hWnd;
begin
backHwnd:=Getwindow(ParentHandle,GW_CHILD);
while backHwnd<>0 do
begin
EnableWindow(backHwnd,true);
tempHwnd := backHwnd;
BlHandle(tempHwnd);
backhwnd:=Getwindow(backhwnd,GW_HWNDNEXT);
end;
end;
begin
FrmHandle := FindWindow('#32770','编辑涂鸦表情');
if (FrmHandle <> 0) and (not HsJieChu) then
begin
SendMessage(FrmHandle,wm_settext,0,integer(Pchar('不得闲QQ表情编辑解禁！作者：不得闲！QQ: 75492895')));
Form1.EdtHandle := FrmHandle;
GetWindowRect(FrmHandle,Rec);
Form1.BegPos.X := Rec.Right - Rec.Left;
Form1.BegPos.Y := Rec.Bottom - Rec.Top;
OldWidth := Rec.Right - Rec.Left + 2;
SetWindowPos(FrmHandle,0,0,0,48 + OldWidth,rec.Bottom - rec.Top,6);
Pn := TRzPanel.Create(nil);
HsFree := false;
Pn.Parent := Form1;
Form1.Pn := Pn;
Pn.Top := 25;
SetParent(Pn.Handle,FrmHandle);
SetControlOwner(Pn,Pn.Parent);
FrmHandle := FindWindowEx(FrmHandle,0,'#32770','');
if FrmHandle <> 0 then
begin
GetWindowRect(FrmHandle,Rec);
Pn.Left := OldWidth - 10;
Pn.Height := rec.Bottom - rec.Top - 34;
Pn.Width := 55;
SetWindowPos(FrmHandle,0,0,0,OldWidth-2,rec.Bottom - rec.Top,6);
ModHandle := FindWindowEx(FrmHandle,0,'Edit','');
if ModHandle <> 0 then
EnableWindow(ModHandle,true);
ModHandle := FindWindowEx(FrmHandle,0,'Static','');
if ModHandle <> 0 then
EnableWindow(ModHandle,True);
ModHandle := FindWindowEx(FrmHandle,0,'Button','完成');
if ModHandle <> 0 then
EnableWindow(ModHandle,true);
ModHandle := FindWindowEx(FrmHandle,0,'Static','您还不是会员，开通QQ会员即可使用');
if ModHandle <> 0 then
SetWindowText(ModHandle,'不得闲QQ表情编辑解禁工具1.0');
Application.MessageBox('QQ表情编辑工具解除禁止成功！','消息',64);
SetForegroundWindow(FrmHandle);
HsJieChu := true;
end;
end;
end;
procedure TForm1.btn1Click(Sender: TObject);
begin
EnabledQQEdit1
end;
procedure TForm1.DestroyPn(var Msg: TMessage);
begin
pn := TRzPanel(Msg.WParam);
if not HsFree then
begin
HsFree := true;
HsJieChu := false;
FreeAndNil(pn);
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if not HsFree then
begin
HsFree := true;
Pn.Free;
SetWindowPos(EdtHandle,0,0,0,BegPos.X,BegPos.Y,6);
end;
end;
{ TRzPanel }
constructor TRzPanel.Create(AOwner: TComponent);
var
Rz1,Rz2: TRzLabel;
begin
inherited Create(AOwner);
HsFree := false;
Rz1 := TRzLabel.Create(self);
Rz1.Parent := self;
Rz1.Caption :='欢'#13#10'迎'#13#10'使'#13#10'用'#13#10'QQ'#13#10'表'#13#10'情'#13#10'编 '#13#10'辑'#13#10'禁'#13#10'止'#13#10'解'#13#10'除'#13#10'工'#13#10'具 '#13#10'V1';
Rz1.Align := AlTOp;
Rz1.AutoSize := false;
Rz1.Alignment := taCenter;
Rz1.TextStyle := tsRaised;
Rz1.Height := 196;
Rz1.Font.Name := '宋体';
Rz1.Font.Charset := GB2312_CHARSET;
Rz1.Font.Size := 9;
Rz1.Transparent := true;
Rz1.Font.Color := clMaroon;
Rz1.Font.Style := [fsbold];
Width := 57;
Rz2 := TRzLabel.Create(self);
Rz2.Parent := self;
Rz2.Align := AlBottom;
Rz2.AutoSize := false;
Rz2.Caption := '作者：'#13#10' 不得闲'#13#10'QQ：'#13#10'75492895';
Rz2.Height := 57;
Rz2.Font.Assign(Rz1.Font);
Rz2.TextStyle := tsRaised;
Rz2.Transparent := true;
VisualStyle := vsGradient;
GradientColorStyle := gcsCustom;
GradientColorStart := $00FFAA55;
GradientColorStop := $00FFAA55;
BorderOuter := fsNone;
end;
procedure TRzPanel.WndProc(var Msg: TMessage);
begin
if Msg.Msg = WM_DESTROY then
SendMessage(Form1.Handle,WM_DESTROYPN,integer(self),0);
Inherited
end;
end.
得想个法子来提升一下人气。怎么提呢？就从QQ开刀吧!哈哈。
最新版的QQ出来了一个新的特性，就是可以编辑QQ表情，向其中添加一些自己要说的话语。
但是这个特性好象需要开通会员吧！想想腾讯的策划部到是会抓商机呢。下面我将说说怎样使用非会员来使用QQ表情的编辑工具呢。
我们打开QQ表情编辑的那个对话框，可以看出，他根本不会触发任何的网络的消息出去！ 只是在最开始打开的时候会判断一下当前
用户是否为会员，如果不是的话，那么很多项目则不可用，我们可以很轻易的想到一个API函数EnableWindow函数可以解除那些Enable
为false的控件（只要知道他的消息句柄则可）。现在我们先假定一下，QQ表情编辑在编辑好了之后，用户点完成不会向腾讯服务器发送
询问的（想想他应该不会抠门到这个程度吧！搞个编辑也要发个会员验证），先用Spy++一下，可以轻易的找到那些Enable为false的消息句柄，那 么现在就好办了，直接使用enableWindow(Handle)，看一下则解除禁止了。很简单。然后测试一下效果，果然可以。呵呵。那么我们只用写个 代码来找句柄，然后在Enable他，则完了。
{代码中使用了Raize控件包，如果有兴趣的话，自己写一个HOOK挂到QQ进程，这样就不用每次打开都去点一下解除禁止了。}
代码如下：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, RzCommon,RzLabel, RzButton, ExtCtrls, RzPanel;
Const
WM_DESTROYPN = WM_USER + 100;
type
TRzPanel = Class(RzPanel.TRzPanel)
protected
Procedure WndProc(Var Msg: TMessage);override;
public
Constructor Create(AOwner: TComponent);override;
end;
TForm1 = class(TForm)
RzLabel1: TRzLabel;
btn1: TRzButton;
procedure btn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
BegPos: TPoint;
EdtHandle: THandle;
Pn: TRzPanel;
procedure DestroyPn(Var Msg: TMessage);message WM_DESTROYPN;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
HsFree: Boolean=false;
HsJieChu: boolean=false;
{$R *.dfm}
procedure SetControlOwner(Component: TComponent;NewOwner: TComponent);
var
tempOwner: ^integer;
begin
tempOwner := @(integer(Component.Owner));
tempOwner^ := integer(NewOwner);
end;
procedure EnabledQQEdit;
procedure BlHandle(ParentHandle: THandle);
var
backHwnd,tempHwnd:hWnd;
begin
backHwnd:=Getwindow(ParentHandle,GW_CHILD);
while backHwnd<>0 do
begin
EnableWindow(backHwnd,true);
tempHwnd := backHwnd;
BlHandle(tempHwnd);
backhwnd:=Getwindow(backhwnd,GW_HWNDNEXT);
end;
end;
var
FrmHandle: THandle;
begin
FrmHandle := FindWindow('#32770','编辑涂鸦表情');
if FrmHandle <> 0 then
begin
SendMessage(FrmHandle,wm_settext,0,integer(Pchar('不得闲QQ表情编辑解禁！作者：不得闲！QQ: 75492895')));
Application.MessageBox('QQ表情编辑工具解除禁止成功！','消息',64);
SetForegroundWindow(FrmHandle);
BlHandle(FrmHandle);
end
else
Application.MessageBox('您没有打开QQ表情编辑工具！','消息',64);
end;
procedure EnabledQQEdit1;
var
FrmHandle,ModHandle: THandle;
rec: TRect;
Pn: TRzPanel;
OldWidth: integer;
procedure BlHandle(ParentHandle: THandle);
var
backHwnd,tempHwnd:hWnd;
begin
backHwnd:=Getwindow(ParentHandle,GW_CHILD);
while backHwnd<>0 do
begin
EnableWindow(backHwnd,true);
tempHwnd := backHwnd;
BlHandle(tempHwnd);
backhwnd:=Getwindow(backhwnd,GW_HWNDNEXT);
end;
end;
begin
FrmHandle := FindWindow('#32770','编辑涂鸦表情');
if (FrmHandle <> 0) and (not HsJieChu) then
begin
SendMessage(FrmHandle,wm_settext,0,integer(Pchar('不得闲QQ表情编辑解禁！作者：不得闲！QQ: 75492895')));
Form1.EdtHandle := FrmHandle;
GetWindowRect(FrmHandle,Rec);
Form1.BegPos.X := Rec.Right - Rec.Left;
Form1.BegPos.Y := Rec.Bottom - Rec.Top;
OldWidth := Rec.Right - Rec.Left + 2;
SetWindowPos(FrmHandle,0,0,0,48 + OldWidth,rec.Bottom - rec.Top,6);
Pn := TRzPanel.Create(nil);
HsFree := false;
Pn.Parent := Form1;
Form1.Pn := Pn;
Pn.Top := 25;
SetParent(Pn.Handle,FrmHandle);
SetControlOwner(Pn,Pn.Parent);
FrmHandle := FindWindowEx(FrmHandle,0,'#32770','');
if FrmHandle <> 0 then
begin
GetWindowRect(FrmHandle,Rec);
Pn.Left := OldWidth - 10;
Pn.Height := rec.Bottom - rec.Top - 34;
Pn.Width := 55;
SetWindowPos(FrmHandle,0,0,0,OldWidth-2,rec.Bottom - rec.Top,6);
ModHandle := FindWindowEx(FrmHandle,0,'Edit','');
if ModHandle <> 0 then
EnableWindow(ModHandle,true);
ModHandle := FindWindowEx(FrmHandle,0,'Static','');
if ModHandle <> 0 then
EnableWindow(ModHandle,True);
ModHandle := FindWindowEx(FrmHandle,0,'Button','完成');
if ModHandle <> 0 then
EnableWindow(ModHandle,true);
ModHandle := FindWindowEx(FrmHandle,0,'Static','您还不是会员，开通QQ会员即可使用');
if ModHandle <> 0 then
SetWindowText(ModHandle,'不得闲QQ表情编辑解禁工具1.0');
Application.MessageBox('QQ表情编辑工具解除禁止成功！','消息',64);
SetForegroundWindow(FrmHandle);
HsJieChu := true;
end;
end;
end;
procedure TForm1.btn1Click(Sender: TObject);
begin
EnabledQQEdit1
end;
procedure TForm1.DestroyPn(var Msg: TMessage);
begin
pn := TRzPanel(Msg.WParam);
if not HsFree then
begin
HsFree := true;
HsJieChu := false;
FreeAndNil(pn);
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if not HsFree then
begin
HsFree := true;
Pn.Free;
SetWindowPos(EdtHandle,0,0,0,BegPos.X,BegPos.Y,6);
end;
end;
{ TRzPanel }
constructor TRzPanel.Create(AOwner: TComponent);
var
Rz1,Rz2: TRzLabel;
begin
inherited Create(AOwner);
HsFree := false;
Rz1 := TRzLabel.Create(self);
Rz1.Parent := self;
Rz1.Caption :='欢'#13#10'迎'#13#10'使'#13#10'用'#13#10'QQ'#13#10'表'#13#10'情'#13#10'编 '#13#10'辑'#13#10'禁'#13#10'止'#13#10'解'#13#10'除'#13#10'工'#13#10'具 '#13#10'V1';
Rz1.Align := AlTOp;
Rz1.AutoSize := false;
Rz1.Alignment := taCenter;
Rz1.TextStyle := tsRaised;
Rz1.Height := 196;
Rz1.Font.Name := '宋体';
Rz1.Font.Charset := GB2312_CHARSET;
Rz1.Font.Size := 9;
Rz1.Transparent := true;
Rz1.Font.Color := clMaroon;
Rz1.Font.Style := [fsbold];
Width := 57;
Rz2 := TRzLabel.Create(self);
Rz2.Parent := self;
Rz2.Align := AlBottom;
Rz2.AutoSize := false;
Rz2.Caption := '作者：'#13#10' 不得闲'#13#10'QQ：'#13#10'75492895';
Rz2.Height := 57;
Rz2.Font.Assign(Rz1.Font);
Rz2.TextStyle := tsRaised;
Rz2.Transparent := true;
VisualStyle := vsGradient;
GradientColorStyle := gcsCustom;
GradientColorStart := $00FFAA55;
GradientColorStop := $00FFAA55;
BorderOuter := fsNone;
end;
procedure TRzPanel.WndProc(var Msg: TMessage);
begin
if Msg.Msg = WM_DESTROY then
SendMessage(Form1.Handle,WM_DESTROYPN,integer(self),0);
Inherited
end;
end.
无边框窗体拖动大小
今天有一个朋友问我怎样可以拖拽一个没有边框的窗体，使其改变大小。于是很快想到一个消息
WM_NCHITTEST
该消息用来描述，当关标移动或当按下或当释放了鼠标按扭的时候，就会发送一个WM_NCHITTEST消息给一个窗口若鼠标未被捕获，则这条消息发送给光标所在的窗口。否则，这条消息公布给捕获鼠标的窗口。
参数
xPos = LOWORD(Lparam);//LParam低位字的值。指出光标的X坐标。该坐标值是相对于屏幕左上角的坐标。
yPos = HIWORD(LParam);//LParam高位字的值。指出光标的y坐标。
返回值 DefWindowProc函数的返回值是下列值之一，以指示光标热点的位置：
HTBORDER 光标热点在一个窗口的边界上，该窗口不具有可变大小的边界
HBOTTOM 在一个窗口下面的水平边界上
HBOTTOMLEFT 在一个窗口的边界的左下角
HBOTTOMRIGHT 在边界右下脚
HTCAPTION 在标题栏中
HTCLIENT 在客户区
HTERROR 在屏幕北京或窗口之间的分界线上(与HTNOWHERE类似，所不同的是DefWindowProc函数产生一个系统响铃以指示出错)
HTGROWBOX 在尺寸框中(与HTSIZE相同)
HTHSCROLL 在水平滚动栏
HTLEFT 在左边界
HTMENU 在菜单中
HTNOWHERE 在屏幕或窗口之间的分界线上
HTREDUCE 在一个最小化的按扭上
HTRIGHT 在窗口右边界
HTSIZE 在尺寸框中
HTSYSMENU 在一个System菜单或在一个子窗口的Close按扭中
HTTOP 在上边界
HTTOPLEFT 在左上角
HTTOPRIGHT 在右上角
HTTRANSPARENT 在当前被其他窗口覆盖的窗口中
HTVSCROLL 在垂直滚动栏中
HTZOOM 在最大化按扭上
注释 可使用MAKEPOINTS宏将lParam参数转换为一个Points结构
参见 DefWindowProc，GetCapture
于是我们可知道要可拖动窗体主要就是要截获该消息，然后让消息的结果返回为HBOTTOM, HBOTTOMLEFT, HBOTTOMRIGHT,HTLEFT , HTTOP ,HTTOPLEFT ,HTTOPRIGHT 等则可。于是写下如下代码：
procedure TForm1.WMNchist(var Msg: TMessage);
var
MouseX,MouseY: integer;
begin
MouseX := LOWORD(Msg.LParam);
MouseY := HIWORD(Msg.LParam);
if(MouseX >= Left + Width - 2) and (MouseY >= Top + Height - 2) then
Msg.Result := HTBOTTOMRIGHT
else if (MouseX <= Left + 2) and (MouseY <= Top + 3) then
Msg.Result := HTTOPLEFT
else if (MouseX <= Left + 2) and (MouseY<= Top + Height - 2) then
Msg.Result := HTBOTTOMLEFT
else if MouseX >= Left + Width -2 then
Msg.Result := HTRIGHT
else if MouseY >= Top + Height - 2 then
Msg.Result := HTBOTTOM
else if Mousex <= Left + 2 then
Msg.Result := HTLEFT
else if MouseY <= Top + 2 then
Msg.Result := HTTOP
else Inherited;
end;
这样，这个窗体就可实现了无边框拖动改变大小了。
于是我将程序发给了他！结果他说他那边运行没有效果，消息没有触发！原来他说，他在窗体上放了一个
Panel为Client占据了窗体，于是自然就触发不了窗体的WM_NCHITTEST消息了。
在看看，该消息的消息返回结果，发现有一个HTTRANSPARENT，该结果就表示透明掉当前的这个窗口
这样，他就会将消息向下继续传递给他的Parent窗口。
于是写下如下
procedure TPanel.WMNchist(var Msg: TMessage);
begin
Inherited;
Msg.Result := HTTRANSPARENT;
end;
这样消息就被传递到了Form窗体了。
整体代码如下：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TPanel = Class(ExtCtrls.TPanel)
procedure WMNchist(var Msg: TMessage);message WM_NCHITTEST;
end;
TForm1 = class(TForm)
pnl1: TPanel;
private
{ Private declarations }
protected
procedure WMNchist(var Msg: TMessage);message WM_NCHITTEST;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WMNchist(var Msg: TMessage);
var
MouseX,MouseY: integer;
begin
MouseX := LOWORD(Msg.LParam);
MouseY := HIWORD(Msg.LParam);
if(MouseX >= Left + Width - 2) and (MouseY >= Top + Height - 2) then
Msg.Result := HTBOTTOMRIGHT
else if (MouseX <= Left + 2) and (MouseY <= Top + 3) then
Msg.Result := HTTOPLEFT
else if (MouseX <= Left + 2) and (MouseY<= Top + Height - 2) then
Msg.Result := HTBOTTOMLEFT
else if MouseX >= Left + Width -2 then
Msg.Result := HTRIGHT
else if MouseY >= Top + Height - 2 then
Msg.Result := HTBOTTOM
else if Mousex <= Left + 2 then
Msg.Result := HTLEFT
else if MouseY <= Top + 2 then
Msg.Result := HTTOP
else Inherited;
end;
{ TPanel }
procedure TPanel.WMNchist(var Msg: TMessage);
begin
Inherited;
Msg.Result := HTTRANSPARENT;
end;
end.
WM_NCHITTEST
该消息用来描述，当关标移动或当按下或当释放了鼠标按扭的时候，就会发送一个WM_NCHITTEST消息给一个窗口若鼠标未被捕获，则这条消息发送给光标所在的窗口。否则，这条消息公布给捕获鼠标的窗口。
参数
xPos = LOWORD(Lparam);//LParam低位字的值。指出光标的X坐标。该坐标值是相对于屏幕左上角的坐标。
yPos = HIWORD(LParam);//LParam高位字的值。指出光标的y坐标。
返回值 DefWindowProc函数的返回值是下列值之一，以指示光标热点的位置：
HTBORDER 光标热点在一个窗口的边界上，该窗口不具有可变大小的边界
HBOTTOM 在一个窗口下面的水平边界上
HBOTTOMLEFT 在一个窗口的边界的左下角
HBOTTOMRIGHT 在边界右下脚
HTCAPTION 在标题栏中
HTCLIENT 在客户区
HTERROR 在屏幕北京或窗口之间的分界线上(与HTNOWHERE类似，所不同的是DefWindowProc函数产生一个系统响铃以指示出错)
HTGROWBOX 在尺寸框中(与HTSIZE相同)
HTHSCROLL 在水平滚动栏
HTLEFT 在左边界
HTMENU 在菜单中
HTNOWHERE 在屏幕或窗口之间的分界线上
HTREDUCE 在一个最小化的按扭上
HTRIGHT 在窗口右边界
HTSIZE 在尺寸框中
HTSYSMENU 在一个System菜单或在一个子窗口的Close按扭中
HTTOP 在上边界
HTTOPLEFT 在左上角
HTTOPRIGHT 在右上角
HTTRANSPARENT 在当前被其他窗口覆盖的窗口中
HTVSCROLL 在垂直滚动栏中
HTZOOM 在最大化按扭上
注释 可使用MAKEPOINTS宏将lParam参数转换为一个Points结构
参见 DefWindowProc，GetCapture
于是我们可知道要可拖动窗体主要就是要截获该消息，然后让消息的结果返回为HBOTTOM, HBOTTOMLEFT, HBOTTOMRIGHT,HTLEFT , HTTOP ,HTTOPLEFT ,HTTOPRIGHT 等则可。于是写下如下代码：
procedure TForm1.WMNchist(var Msg: TMessage);
var
MouseX,MouseY: integer;
begin
MouseX := LOWORD(Msg.LParam);
MouseY := HIWORD(Msg.LParam);
if(MouseX >= Left + Width - 2) and (MouseY >= Top + Height - 2) then
Msg.Result := HTBOTTOMRIGHT
else if (MouseX <= Left + 2) and (MouseY <= Top + 3) then
Msg.Result := HTTOPLEFT
else if (MouseX <= Left + 2) and (MouseY<= Top + Height - 2) then
Msg.Result := HTBOTTOMLEFT
else if MouseX >= Left + Width -2 then
Msg.Result := HTRIGHT
else if MouseY >= Top + Height - 2 then
Msg.Result := HTBOTTOM
else if Mousex <= Left + 2 then
Msg.Result := HTLEFT
else if MouseY <= Top + 2 then
Msg.Result := HTTOP
else Inherited;
end;
这样，这个窗体就可实现了无边框拖动改变大小了。
于是我将程序发给了他！结果他说他那边运行没有效果，消息没有触发！原来他说，他在窗体上放了一个
Panel为Client占据了窗体，于是自然就触发不了窗体的WM_NCHITTEST消息了。
在看看，该消息的消息返回结果，发现有一个HTTRANSPARENT，该结果就表示透明掉当前的这个窗口
这样，他就会将消息向下继续传递给他的Parent窗口。
于是写下如下
procedure TPanel.WMNchist(var Msg: TMessage);
begin
Inherited;
Msg.Result := HTTRANSPARENT;
end;
这样消息就被传递到了Form窗体了。
整体代码如下：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TPanel = Class(ExtCtrls.TPanel)
procedure WMNchist(var Msg: TMessage);message WM_NCHITTEST;
end;
TForm1 = class(TForm)
pnl1: TPanel;
private
{ Private declarations }
protected
procedure WMNchist(var Msg: TMessage);message WM_NCHITTEST;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WMNchist(var Msg: TMessage);
var
MouseX,MouseY: integer;
begin
MouseX := LOWORD(Msg.LParam);
MouseY := HIWORD(Msg.LParam);
if(MouseX >= Left + Width - 2) and (MouseY >= Top + Height - 2) then
Msg.Result := HTBOTTOMRIGHT
else if (MouseX <= Left + 2) and (MouseY <= Top + 3) then
Msg.Result := HTTOPLEFT
else if (MouseX <= Left + 2) and (MouseY<= Top + Height - 2) then
Msg.Result := HTBOTTOMLEFT
else if MouseX >= Left + Width -2 then
Msg.Result := HTRIGHT
else if MouseY >= Top + Height - 2 then
Msg.Result := HTBOTTOM
else if Mousex <= Left + 2 then
Msg.Result := HTLEFT
else if MouseY <= Top + 2 then
Msg.Result := HTTOP
else Inherited;
end;
{ TPanel }
procedure TPanel.WMNchist(var Msg: TMessage);
begin
Inherited;
Msg.Result := HTTRANSPARENT;
end;
end.
关于在procedure中的Pchar参
Pchar是一个指针类型，他指向一个Char类型的指针相当于C语言中的 *Char类型。
pinteger也同样是指向一个整数的指针
前段时间，公司里面要使用一个用PB写的DLL，而他公开的参数是一个Pchar类型的，而且该参数的值需要返回。
但是他的声明类型中既没有加 Var也没有加Out来指定其为输出参数。现在我们来讨论一下，如何使Pchar类型的参数将使用后的值返回出来。
先看一个例子：
我们写一过程：
procedure SetInteger(ss: pinteger);
begin
ss^ := 3;
end;
然后我们调用
procedure Button1Click(Sender: TObject);
var
i: pinteger;
begin
SetInteger(@i); //设置i对应地址中的值为3了，此时i的值就为3了
end;
那么是否Pchar参数一样的返回呢？
我们写过程如下：
procedure SetPchar(p: pchar)
begin
p := '不得闲测试';
end;
然后同样的方法调用之，你会发现他并没有将结果 返回来，这是因为，你传递的时候指针指向一个地址，而当你使用了
p := '不得闲测试';
这个语句之后则p的指向为该字符串地址（他只是为地址赋值，却并没有复制值到该地址中来），但他本身地址并没有得到值，但程序返回的时候，其内部的字符串会自动释放的，所以在程序返回的时候，他本身指向的地址中的值并没有变，所以我们得不到正确的值。
此时我们如果能够将要返回的值复制到 P进入的时候的地址中的话，那么就能够得到正确的值了。此时最简单的一个方法就是使用StrLCopy函数。
所以函数改写如下：
procedure SetPchar(p: pchar)
begin
StrLCopy(p,'不得闲测试',10);
end;
此时我们在调用方式如下
var
p: pchar
begin
setPchar(p);
//此时的p则可以返回一个正确的值了.
end;
pinteger也同样是指向一个整数的指针
前段时间，公司里面要使用一个用PB写的DLL，而他公开的参数是一个Pchar类型的，而且该参数的值需要返回。
但是他的声明类型中既没有加 Var也没有加Out来指定其为输出参数。现在我们来讨论一下，如何使Pchar类型的参数将使用后的值返回出来。
先看一个例子：
我们写一过程：
procedure SetInteger(ss: pinteger);
begin
ss^ := 3;
end;
然后我们调用
procedure Button1Click(Sender: TObject);
var
i: pinteger;
begin
SetInteger(@i); //设置i对应地址中的值为3了，此时i的值就为3了
end;
那么是否Pchar参数一样的返回呢？
我们写过程如下：
procedure SetPchar(p: pchar)
begin
p := '不得闲测试';
end;
然后同样的方法调用之，你会发现他并没有将结果 返回来，这是因为，你传递的时候指针指向一个地址，而当你使用了
p := '不得闲测试';
这个语句之后则p的指向为该字符串地址（他只是为地址赋值，却并没有复制值到该地址中来），但他本身地址并没有得到值，但程序返回的时候，其内部的字符串会自动释放的，所以在程序返回的时候，他本身指向的地址中的值并没有变，所以我们得不到正确的值。
此时我们如果能够将要返回的值复制到 P进入的时候的地址中的话，那么就能够得到正确的值了。此时最简单的一个方法就是使用StrLCopy函数。
所以函数改写如下：
procedure SetPchar(p: pchar)
begin
StrLCopy(p,'不得闲测试',10);
end;
此时我们在调用方式如下
var
p: pchar
begin
setPchar(p);
//此时的p则可以返回一个正确的值了.
end;
订阅：
博文 (Atom)