来源： MySQL带参数的存储过程小例子 – IT徐胖子的专栏 – 博客频道 – CSDN.NET

MySQL存储过程详解  mySQL 存储过程_王者佳暮_新浪博客,王者佳暮,

来源： MySQL存储过程详解  mysql 存储过程_王者佳暮_新浪博客

mySQL存储过程详解

1.     存储过程简介

我们常用的操作数据库语言SQL语句在执行的时候需要要先编译，然后执行，而存储过程（Stored Procedure）是一组为了完成特定功能的SQL语句集，经编译后存储在数据库中，用户通过指定存储过程的名字并给定参数（如果该存储过程带有参数）来调用执行它。

一个存储过程是一个可编程的函数，它在数据库中创建并保存。它可以有SQL语句和一些特殊的控制结构组成。当希望在不同的应用程序或平台上执行相同的函数，或者封装特定功能时，存储过程是非常有用的。数据库中的存储过程可以看做是对编程中面向对象方法的模拟。它允许控制数据的访问方式。

存储过程通常有以下优点：

(1).存储过程增强了SQL语言的功能和灵活性。存储过程可以用流控制语句编写，有很强的灵活性，可以完成复杂的判断和较复杂的运算。

(2).存储过程允许标准组件是编程。存储过程被创建后，可以在程序中被多次调用，而不必重新编写该存储过程的SQL语句。而且数据库专业人员可以随时对存储过程进行修改，对应用程序源代码毫无影响。

(3).存储过程能实现较快的执行速度。如果某一操作包含大量的Transaction-SQL代码或分别被多次执行，那么存储过程要比批处理的执行速度快很多。因为存储过程是预编译的。在首次运行一个存储过程时查询，优化器对其进行分析优化，并且给出最终被存储在系统表中的执行计划。而批处理的Transaction-SQL语句在每次运行时都要进行编译和优化，速度相对要慢一些。

(4).存储过程能过减少网络流量。针对同一个数据库对象的操作（如查询、修改），如果这一操作所涉及的Transaction-SQL语句被组织程存储过程，那么当在客户计算机上调用该存储过程时，网络中传送的只是该调用语句，从而大大增加了网络流量并降低了网络负载。

(5).存储过程可被作为一种安全机制来充分利用。系统管理员通过执行某一存储过程的权限进行限制，能够实现对相应的数据的访问权限的限制，避免了非授权用户对数据的访问，保证了数据的安全。

2.     关于MySQL的存储过程

存储过程是数据库存储的一个重要的功能，但是MySQL在5.0以前并不支持存储过程，这使得MySQL在应用上大打折扣。好在MySQL 5.0终于开始已经支持存储过程，这样即可以大大提高数据库的处理速度，同时也可以提高数据库编程的灵活性。

3.     MySQL存储过程的创建

(1). 格式

MySQL存储过程创建的格式：CREATE PROCEDURE 过程名 ([过程参数[,…]])
[特性 …] 过程体

这里先举个例子：

1. mysql> DELIMITER //
2. mysql> CREATE PROCEDURE proc1(OUT s int)
3.     -> BEGIN
4.     -> SELECT COUNT(*) INTO s FROM user;
5.     -> END
6.     -> //
7. mysql> DELIMITER ;

注：

（1）这里需要注意的是DELIMITER //和DELIMITER ;两句，DELIMITER是分割符的意思，因为MySQL默认以”;”为分隔符，如果我们没有声明分割符，那么编译器会把存储过程当成SQL语句进行处理，则存储过程的编译过程会报错，所以要事先用DELIMITER关键字申明当前段分隔符，这样MySQL才会将”;”当做存储过程中的代码，不会执行这些代码，用完了之后要把分隔符还原。

（2）存储过程根据需要可能会有输入、输出、输入输出参数，这里有一个输出参数s，类型是int型，如果有多个参数用”,”分割开。

（3）过程体的开始与结束使用BEGIN与END进行标识。

这样，我们的一个MySQL存储过程就完成了，是不是很容易呢?看不懂也没关系，接下来，我们详细的讲解。

(2). 声明分割符

其实，关于声明分割符，上面的注解已经写得很清楚，不需要多说，只是稍微要注意一点的是：如果是用MySQL的Administrator管理工具时，可以直接创建，不再需要声明。

(3). 参数

MySQL存储过程的参数用在存储过程的定义，共有三种参数类型,IN,OUT,INOUT,形式如：

CREATE PROCEDURE([[IN |OUT |INOUT ] 参数名 数据类形…])

IN 输入参数:表示该参数的值必须在调用存储过程时指定，在存储过程中修改该参数的值不能被返回，为默认值

OUT 输出参数:该值可在存储过程内部被改变，并可返回

INOUT 输入输出参数:调用时指定，并且可被改变和返回

Ⅰ. IN参数例子

创建:

1. mysql > DELIMITER //
2. mysql > CREATE PROCEDURE demo_in_parameter(IN p_in int)
3. -> BEGIN
4. -> SELECT p_in;
5. -> SET p_in=2;
6. -> SELECT p_in;
7. -> END;
8. -> //
9. mysql > DELIMITER ;

执行结果:

1. mysql > SET @p_in=1;
2. mysql > CALL demo_in_parameter(@p_in);
3. +——+
4. | p_in |
5. +——+
6. |   1  |
7. +——+
9. +——+
10. | p_in |
11. +——+
12. |   2  |
13. +——+
15. mysql> SELECT @p_in;
16. +——-+
17. | @p_in |
18. +——-+
19. |  1    |
20. +——-+

以上可以看出，p_in虽然在存储过程中被修改，但并不影响@p_id的值

Ⅱ.OUT参数例子

创建:

1. mysql > DELIMITER //
2. mysql > CREATE PROCEDURE demo_out_parameter(OUT p_out int)
3. -> BEGIN
4. -> SELECT p_out;
5. -> SET p_out=2;
6. -> SELECT p_out;
7. -> END;
8. -> //
9. mysql > DELIMITER ;

执行结果:

1. mysql > SET @p_out=1;
2. mysql > CALL sp_demo_out_parameter(@p_out);
3. +——-+
4. | p_out |
5. +——-+
6. | NULL  |
7. +——-+
9. +——-+
10. | p_out |
11. +——-+
12. |   2   |
13. +——-+
15. mysql> SELECT @p_out;
16. +——-+
17. | p_out |
18. +——-+
19. |   2   |
20. +——-+

Ⅲ. INOUT参数例子

创建:

1. mysql > DELIMITER //
2. mysql > CREATE PROCEDURE demo_inout_parameter(INOUT p_inout int)
3. -> BEGIN
4. -> SELECT p_inout;
5. -> SET p_inout=2;
6. -> SELECT p_inout;
7. -> END;
8. -> //
9. mysql > DELIMITER ;

执行结果:

1. mysql > SET @p_inout=1;
2. mysql > CALL demo_inout_parameter(@p_inout) ;
3. +———+
4. | p_inout |
5. +———+
6. |    1    |
7. +———+
9. +———+
10. | p_inout |
11. +———+
12. |    2    |
13. +———+
15. mysql > SELECT @p_inout;
16. +———-+
17. | @p_inout |
18. +———-+
19. |    2     |
20. +———-+

(4). 变量

Ⅰ. 变量定义

DECLARE variable_name [,variable_name…] datatype [DEFAULT value];

其中，datatype为MySQL的数据类型，如:int, float, date, varchar(length)

例如:

1. DECLARE l_int int unsigned default 4000000;
2. DECLARE l_numeric number(8,2) DEFAULT 9.95;
3. DECLARE l_date date DEFAULT ‘1999-12-31’;
4. DECLARE l_datetime datetime DEFAULT ‘1999-12-31 23:59:59’;
5. DECLARE l_varchar varchar(255) DEFAULT ‘This will not be padded’;

Ⅱ. 变量赋值

SET 变量名 = 表达式值 [,variable_name = expression …]

Ⅲ. 用户变量

ⅰ. 在MySQL客户端使用用户变量

1. mysql > SELECT ‘Hello World’ into @x;
2. mysql > SELECT @x;
3. +————-+
4. |   @x        |
5. +————-+
6. | Hello World |
7. +————-+
8. mysql > SET @y=’Goodbye Cruel World’;
9. mysql > SELECT @y;
10. +———————+
11. |     @y              |
12. +———————+
13. | Goodbye Cruel World |
14. +———————+
16. mysql > SET @z=1+2+3;
17. mysql > SELECT @z;
18. +——+
19. | @z   |
20. +——+
21. |  6   |
22. +——+

ⅱ. 在存储过程中使用用户变量

1. mysql > CREATE PROCEDURE GreetWorld( ) SELECT CONCAT(@greeting,’ World’);
2. mysql > SET @greeting=’Hello’;
3. mysql > CALL GreetWorld( );
4. +—————————-+
5. | CONCAT(@greeting,’ World’) |
6. +—————————-+
7. |  Hello World               |
8. +—————————-+

ⅲ. 在存储过程间传递全局范围的用户变量

1. mysql> CREATE PROCEDURE p1()   SET @last_procedure=’p1′;
2. mysql> CREATE PROCEDURE p2() SELECT CONCAT(‘Last procedure was ‘,@last_proc);
3. mysql> CALL p1( );
4. mysql> CALL p2( );
5. +———————————————–+
6. | CONCAT(‘Last procedure was ‘,@last_proc  |
7. +———————————————–+
8. | Last procedure was p1                         |
9. +———————————————–+

注意:

①用户变量名一般以@开头

②滥用用户变量会导致程序难以理解及管理

(5). 注释

MySQL存储过程可使用两种风格的注释

双模杠：–

该风格一般用于单行注释

c风格： 一般用于多行注释

例如：

1. mysql > DELIMITER //
2. mysql > CREATE PROCEDURE proc1 –name存储过程名
3. -> (IN parameter1 INTEGER)
4. -> BEGIN
5. -> DECLARE variable1 CHAR(10);
6. -> IF parameter1 = 17 THEN
7. -> SET variable1 = ‘birds’;
8. -> ELSE
9. -> SET variable1 = ‘beasts’;
10. -> END IF;
11. -> INSERT INTO table1 VALUES (variable1);
12. -> END
13. -> //
14. mysql > DELIMITER ;

4.     MySQL存储过程的调用

用call和你过程名以及一个括号，括号里面根据需要，加入参数，参数包括输入参数、输出参数、输入输出参数。具体的调用方法可以参看上面的例子。

5.     MySQL存储过程的查询

我们像知道一个数据库下面有那些表，我们一般采用show tables;进行查看。那么我们要查看某个数据库下面的存储过程，是否也可以采用呢？答案是，我们可以查看某个数据库下面的存储过程，但是是令一钟方式。

我们可以用

select name from mysql.proc where db=’数据库名’;

或者

select routine_name from information_schema.routines where routine_schema=’数据库名’;

或者

show procedure status where db=’数据库名’;

进行查询。

如果我们想知道，某个存储过程的详细，那我们又该怎么做呢？是不是也可以像操作表一样用describe 表名进行查看呢？

答案是：我们可以查看存储过程的详细，但是需要用另一种方法：

SHOW CREATE PROCEDURE 数据库.存储过程名;

就可以查看当前存储过程的详细。

6.     MySQL存储过程的修改

ALTER PROCEDURE

更改用CREATE PROCEDURE 建立的预先指定的存储过程，其不会影响相关存储过程或存储功能。

7.     MySQL存储过程的删除

删除一个存储过程比较简单，和删除表一样：

DROP PROCEDURE

从MySQL的表格中删除一个或多个存储过程。

8.     MySQL存储过程的控制语句

(1). 变量作用域

内部的变量在其作用域范围内享有更高的优先权，当执行到end。变量时，内部变量消失，此时已经在其作用域外，变量不再可见了，应为在存储
过程外再也不能找到这个申明的变量，但是你可以通过out参数或者将其值指派
给会话变量来保存其值。

1. mysql > DELIMITER //
2. mysql > CREATE PROCEDURE proc3()
3.      -> begin
4.      -> declare x1 varchar(5) default ‘outer’;
5.      -> begin
6.      -> declare x1 varchar(5) default ‘inner’;
7.      -> select x1;
8.      -> end;
9.      -> select x1;
10.      -> end;
11.      -> //
12. mysql > DELIMITER ;

 (2). 条件语句

Ⅰ. if-then -else语句

1. mysql > DELIMITER //
2. mysql > CREATE PROCEDURE proc2(IN parameter int)
3.      -> begin
4.      -> declare var int;
5.      -> set var=parameter+1;
6.      -> if var=0 then
7.      -> insert into t values(17);
8.      -> end if;
9.      -> if parameter=0 then
10.      -> update t set s1=s1+1;
11.      -> else
12.      -> update t set s1=s1+2;
13.      -> end if;
14.      -> end;
15.      -> //
16. mysql > DELIMITER ;

Ⅱ. case语句：

1. mysql > DELIMITER //
2. mysql > CREATE PROCEDURE proc3 (in parameter int)
3.      -> begin
4.      -> declare var int;
5.      -> set var=parameter+1;
6.      -> case var
7.      -> when 0 then
8.      -> insert into t values(17);
9.      -> when 1 then
10.      -> insert into t values(18);
11.      -> else
12.      -> insert into t values(19);
13.      -> end case;
14.      -> end;
15.      -> //
16. mysql > DELIMITER ;

(3). 循环语句

Ⅰ. while ···· end while：

1. mysql > DELIMITER //
2. mysql > CREATE PROCEDURE proc4()
3.      -> begin
4.      -> declare var int;
5.      -> set var=0;
6.      -> while var<6 do
7.      -> insert into t values(var);
8.      -> set var=var+1;
9.      -> end while;
10.      -> end;
11.      -> //
12. mysql > DELIMITER ;

Ⅱ. repeat···· end repeat：

它在执行操作后检查结果，而while则是执行前进行检查。

1. mysql > DELIMITER //
2. mysql > CREATE PROCEDURE proc5 ()
3.      -> begin
4.      -> declare v int;
5.      -> set v=0;
6.      -> repeat
7.      -> insert into t values(v);
8.      -> set v=v+1;
9.      -> until v>=5
10.      -> end repeat;
11.      -> end;
12.      -> //
13. mysql > DELIMITER ;

 
Ⅲ. loop ·····end loop:

loop循环不需要初始条件，这点和while 循环相似，同时和repeat循环一样不需要结束条件, leave语句的意义是离开循环。

1. mysql > DELIMITER //
2. mysql > CREATE PROCEDURE proc6 ()
3.      -> begin
4.      -> declare v int;
5.      -> set v=0;
6.      -> LOOP_LABLE:loop
7.      -> insert into t values(v);
8.      -> set v=v+1;
9.      -> if v >=5 then
10.      -> leave LOOP_LABLE;
11.      -> end if;
12.      -> end loop;
13.      -> end;
14.      -> //
15. mysql > DELIMITER ;

Ⅳ. LABLES 标号：

标号可以用在begin repeat while 或者loop 语句前，语句标号只能在合法的语句前面使用。可以跳出循环，使运行指令达到复合语句的最后一步。

(4). ITERATE迭代

Ⅰ. ITERATE:

通过引用复合语句的标号,来从新开始复合语句

1. mysql > DELIMITER //
2. mysql > CREATE PROCEDURE proc10 ()
3.      -> begin
4.      -> declare v int;
5.      -> set v=0;
6.      -> LOOP_LABLE:loop
7.      -> if v=3 then
8.      -> set v=v+1;
9.      -> ITERATE LOOP_LABLE;
10.      -> end if;
11.      -> insert into t values(v);
12.      -> set v=v+1;
13.      -> if v>=5 then
14.      -> leave LOOP_LABLE;
15.      -> end if;
16.      -> end loop;
17.      -> end;
18.      -> //
19. mysql > DELIMITER ;

9.     MySQL存储过程的基本函数

(1).字符串类

CHARSET(str) //返回字串字符集
CONCAT (string2 [,… ]) //连接字串
INSTR (string ,substring ) //返回substring首次在string中出现的位置,不存在返回0
LCASE (string2 ) //转换成小写
LEFT (string2 ,length ) //从string2中的左边起取length个字符
LENGTH (string ) //string长度
LOAD_FILE (file_name ) //从文件读取内容
LOCATE (substring , string [,start_position ] ) 同INSTR,但可指定开始位置
LPAD (string2 ,length ,pad ) //重复用pad加在string开头,直到字串长度为length
LTRIM (string2 ) //去除前端空格
REPEAT (string2 ,count ) //重复count次
REPLACE (str ,search_str ,replace_str ) //在str中用replace_str替换search_str
RPAD (string2 ,length ,pad) //在str后用pad补充,直到长度为length
RTRIM (string2 ) //去除后端空格
STRCMP (string1 ,string2 ) //逐字符比较两字串大小,
SUBSTRING (str , position [,length ]) //从str的position开始,取length个字符,
注：mysql中处理字符串时，默认第一个字符下标为1，即参数position必须大于等于1

1. mysql> select substring(‘abcd’,0,2);
2. +———————–+
3. | substring(‘abcd’,0,2) |
4. +———————–+
5. |                       |
6. +———————–+
7. 1 row in set (0.00 sec)
9. mysql> select substring(‘abcd’,1,2);
10. +———————–+
11. | substring(‘abcd’,1,2) |
12. +———————–+
13. |     ab                |
14. +———————–+
15. 1 row in set (0.02 sec)

TRIM([[BOTH|LEADING|TRAILING] [padding] FROM]string2) //去除指定位置的指定字符
UCASE (string2 ) //转换成大写
RIGHT(string2,length) //取string2最后length个字符
SPACE(count) //生成count个空格

(2).数学类

ABS (number2 ) //绝对值
BIN (decimal_number ) //十进制转二进制
CEILING (number2 ) //向上取整
CONV(number2,from_base,to_base) //进制转换
FLOOR (number2 ) //向下取整
FORMAT (number,decimal_places ) //保留小数位数
HEX (DecimalNumber ) //转十六进制
注：HEX()中可传入字符串，则返回其ASC-11码，如HEX(‘DEF’)返回4142143
也可以传入十进制整数，返回其十六进制编码，如HEX(25)返回19
LEAST (number , number2 [,..]) //求最小值
MOD (numerator ,denominator ) //求余
POWER (number ,power ) //求指数
RAND([seed]) //随机数
ROUND (number [,decimals ]) //四舍五入,decimals为小数位数]

注：返回类型并非均为整数，如：
(1)默认变为整形值

1. mysql> select round(1.23);
2. +————-+
3. | round(1.23) |
4. +————-+
5. |           1 |
6. +————-+
7. 1 row in set (0.00 sec)
9. mysql> select round(1.56);
10. +————-+
11. | round(1.56) |
12. +————-+
13. |           2 |
14. +————-+
15. 1 row in set (0.00 sec)

(2)可以设定小数位数，返回浮点型数据

1. mysql> select round(1.567,2);
2. +—————-+
3. | round(1.567,2) |
4. +—————-+
5. |           1.57 |
6. +—————-+
7. 1 row in set (0.00 sec)

SIGN (number2 ) //

(3).日期时间类

ADDTIME (date2 ,time_interval ) //将time_interval加到date2
CONVERT_TZ (datetime2 ,fromTZ ,toTZ ) //转换时区
CURRENT_DATE ( ) //当前日期
CURRENT_TIME ( ) //当前时间
CURRENT_TIMESTAMP ( ) //当前时间戳
DATE (datetime ) //返回datetime的日期部分
DATE_ADD (date2 , INTERVAL d_value d_type ) //在date2中加上日期或时间
DATE_FORMAT (datetime ,FormatCodes ) //使用formatcodes格式显示datetime
DATE_SUB (date2 , INTERVAL d_value d_type ) //在date2上减去一个时间
DATEDIFF (date1 ,date2 ) //两个日期差
DAY (date ) //返回日期的天
DAYNAME (date ) //英文星期
DAYOFWEEK (date ) //星期(1-7) ,1为星期天
DAYOFYEAR (date ) //一年中的第几天
EXTRACT (interval_name FROM date ) //从date中提取日期的指定部分
MAKEDATE (year ,day ) //给出年及年中的第几天,生成日期串
MAKETIME (hour ,minute ,second ) //生成时间串
MONTHNAME (date ) //英文月份名
NOW ( ) //当前时间
SEC_TO_TIME (seconds ) //秒数转成时间
STR_TO_DATE (string ,format ) //字串转成时间,以format格式显示
TIMEDIFF (datetime1 ,datetime2 ) //两个时间差
TIME_TO_SEC (time ) //时间转秒数]
WEEK (date_time [,start_of_week ]) //第几周
YEAR (datetime ) //年份
DAYOFMONTH(datetime) //月的第几天
HOUR(datetime) //小时
LAST_DAY(date) //date的月的最后日期
MICROSECOND(datetime) //微秒
MONTH(datetime) //月
MINUTE(datetime) //分返回符号,正负或0
SQRT(number2) //开平方

来源： 键盘鼠标模拟全知道 – 北极星 – North Star – 博客园

本文目录如下

一、基于windows 消息机制的鼠标键盘模拟

 （一）、应用程序级模拟

 （二）、系统级模拟

        1、 用API函数keybd_event 模拟键盘事件

        2、 SendInput函数模拟全局键盘鼠标事件

        3、用全局钩子模拟键盘消息

二、驱动级模拟

*******************************************************************************************

一、基于windows 消息机制的鼠标键盘模拟

我们怎样才能用Delphi来写一个程序，用来代替人们按键的方法呢？那就让我们来先了解一下windows中响应键盘事件的机制。

当用户按下键盘上的一个键时，键盘内的芯片会检测到这个动作，并把这个信号传送到计算机。如何区别是哪一个键被按下了呢？键盘上的所有按键都有一个编 码，称作键盘扫描码。当你按下一个键时，这个键的扫描码就被传给系统。扫描码是跟具体的硬件相关的，同一个键，在不同键盘上的扫描码有可能不同。键盘控制 器就是将这个扫描码传给计算机，然后交给键盘驱动程序。键盘驱动程序会完成相关的工作，并把这个扫描码转换为键盘虚拟码。什么是虚拟码呢？因为扫描码与硬 件相关，不具有通用性，为了统一键盘上所有键的编码，于是就提出了虚拟码概念。无论什么键盘，同一个按键的虚拟码总是相同的，这样程序就可以识别了。简单 点说，虚拟码就是我们经常可以看到的像VK_A,VK_B这样的常数，比如键A的虚拟码是65，写成16进制就是&H41，注意，人们经常用16 进制来表示虚拟码。当键盘驱动程序把扫描码转换为虚拟码后，会把这个键盘操作的扫描码和虚拟码还有其它信息一起传递给操作系统。然后操作系统则会把这些信 息封装在一个消息中，并把这个键盘消息插入到消息列队。最后，要是不出意外的话，这个键盘消息最终会被送到当前的活动窗口那里，活动窗口所在的应用程序接 收到这个消息后，就知道键盘上哪个键被按下，也就可以决定该作出什么响应给用户了。

这个过程可以简单的如下表示：

用户按下键盘上的一个键 >>>>> 键盘控制器就把这个键的扫描码传给计算机，然后交给键盘驱动程序  >>>>> 键盘驱动程序会把这个扫描码转换为键盘虚拟码(VK_A,VK_B这样的常数，比如键A的虚拟码是65，写成16进制就是&H41)传给操作系统  >>>>>  操操作系统则会把这些信息封装在一个消息中，并把这个键盘消息插入到消息列队  >>>>> 键盘消息被发送到当前活动窗口

明白了这个过程，我们就可以编程实现在其中的某个环节来模拟键盘操作了。在Delphi中，有多种方法可以实现键盘模拟，我们就介绍几种比较典型的。

（一）、应用程序级模拟(只针对某个程序，我称之为局部模拟）

windows提供了几个这样的API函数可以实现直接向目标程序发送消息的功能，常用的有SendMessage和PostMessage，它们 的区别是PostMessage函数直接把消息仍给目标程序就不管了，而SendMessage把消息发出去后，还要等待目标程序返回些什么东西才好。这 里要注意的是，模拟键盘消息一定要用PostMessage函数才好，用SendMessage是不正确的(因为模拟键盘消息是不需要返回值的，不然目标 程序会没反应)，切记切记！

PostMessage函数的delphi声明如下：

PostMessage(

hWnd: HWND;                      {目标程序上某个控件的句柄}

Msg: UINT;                         {消息的类型}

wParam: WPARAM;                  {32位指定附加的消息特定的信息}

lParam: LPARAM                    {32位指定附加的消息特定的信息}

): BOOL;

参数hwnd 是你要发送消息的目标程序上某个控件的句柄，参数Msg 是消息的类型，表示你要发送什么样的消息，最后wParam 和lParam这两个参数是随消息附加的数据，具体内容要由消息决定。

再来看看Msg 这个参数，要模拟按键就靠这个了。

键盘消息常用的有如下几个：

WM_KEYDOWN      表示一个普通键被按下

WM_KEYUP          表示一个普通键被释放

WM_SYSKEYDOWN   表示一个系统键被按下，比如Alt键

WM_SYSKEYUP       表示一个系统键被释放，比如Alt键

如果你确定要发送以上几个键盘消息，那么再来看看如何确定键盘消息中的wParam 和lParam 这两个参数。在一个键盘消息中，wParam 参数的含义较简单，它表示你要发送的键盘事件的按键虚拟码，比如你要对目标程序模拟按下A键，那么wParam 参数的值就设为VK_A ,至于lParam 这个参数就比较复杂了，因为它包含了多个信息，一般可以把它设为0。即

PostMessage (MyHwnd, WM_KEYDOWN, key, 0);

但是如果你想要你的模拟更真实一些，那么建议你还是设置一下这个参数。那么我们就详细了解一下lParam 吧。

lParam 是一个32 bit的参数，它在内存中占4个字节，写成二进制就是

00000000 00000000 00000000 00000000

一共是32位，我们从右向左数，假设最右边那位为第0位(注意是从0而不是从1开始计数)，最左边的就是第31位。那么该参数的

0-15位表示键的发送次数等扩展信息，

16-23位为按键的扫描码，

24-31位表示是按下键还是释放键。

大家一般习惯写成16进制的，那么就应该是

&H00 00 00 00 ，

第0-15位一般为&H0001，如果是按下键，那么24-31位为&H00，释放键则为&HC0,

那么16-23位的扫描码怎么会得呢？这需要用到一个API函数MapVirtualKey，这个函数可以将虚拟码转换为扫描码，或将扫描码转换为虚拟码，还可以把虚拟码转换为对应字符的ASCII码。它的delphi 声明如下：

MapVirtualKey(

uCode: UINT;                        {key code, scan code or virtual key}

uMapType: UINT                     {flags for translation mode}

): UINT;                             {returns translated key code}

参数uCode 表示待转换的码，参数uMapType 表示从什么转换为什么，如果是虚拟码转扫描码，则uMapType 设置为0，如果是虚拟扫描码转虚拟码，则wMapType 设置为1，如果是虚拟码转ASCII码，则uMapType 设置为2.相信有了这些，我们就可以构造键盘事件的lParam参数了。

下面给出一个构造lParam参数的函数：

function VKB_param(VirtualKey:Integer;flag:Integer):Integer; //函数名

var

s,Firstbyte,Secondbyte:String;

S_code:Integer;

Begin

if flag=1 then  //按下键

begin

Firstbyte :=’00’

end

else         //弹起键

begin

Firstbyte :=’C0′

end;

S_code:= MapVirtualKey(VirtualKey, 0);

Secondbyte:=’00’+inttostr(s_code);

Secondbyte:=copy(Secondbyte,Length(Secondbyte)-1,2);

s:=’$’+Firstbyte + Secondbyte + ‘0001’;

Result:=strtoint(s);

End;

使用按键的方法：

说明：key为键值，如1键[不是数字键的1]的值是$31，flag传递的是按键状态，1是按下，0是弹起。

lparam := VKB_param(key, 1);      {按下键}

PostMessage (MyHwnd, WM_KEYDOWN, key, lParam);

lParam := VKB_param(key, 0);      {松开键}

PostMessage (MyHwnd, WM_KEYUP, key, lParam);

var

hwnd, lparam:Cardinal;

begin

hwnd:=FindWindowEx(FindWindow(nil,’无标题 – 记事本’),0,’edit’,nil);

lparam := VKB_param(97, 1);      {按下键}

PostMessage (hwnd,WM_KEYDOWN,vk_F3,lparam) ; //按下F3键

//PostMessage (hwnd,WM_CHAR,97,lparam);        //输入字符A （edit控件接收字符）

lParam := VKB_param(key, 0);      {松开键}

PostMessage (hwnd,WM_KEYUP,vk_F3,lparam);   //释放F3键

end;

模拟鼠标点击

Var

P1：Tpoint;

Lparam:integer;

begin

GetCursorPos(P1); // 获取屏幕坐标

   P1.X:= P1.X+100;

   P1.Y:=P1.Y+100;

lparam:=p1.X+ p1.Y shl 16;

sendmessage(h,messages.WM_LBUTTONDOWN ,0,lparam);// 按下鼠标左键

sendmessage(h,messages.WM_LBUTTONUP  ,0, lparam); //抬起鼠标左键

End;

（二）、系统级模拟（针对所有程序的窗口，我称之为全局模拟）

模拟全局键盘消息常见的可以有以下一些方法：

1、 用API函数keybd_event，这个函数可以用来模拟一个键盘事件

keybd_event(

bVk: Byte;                       {virtual-key code}

bScan: Byte;                      {scan-code}

dwFlags: DWORD;                {option flags}

dwExtraInfo: DWORD             {additional information about the key}

);                               {this procedure does not return a value}

keybd_event(VK_A, 0, 0, 0)   ‘按下A键

keybd_event (VK_A, 0, KEYEVENTF_KEYUP, 0)    ‘释放A键

注意有时候按键的速度不要太快，否则会出问题，可以用API函数Sleep来进行延时，delphi声明如下：

Sleep(

dwMilliseconds: DWORD                {specifies the number of milliseconds to pause}

);

参数dwMilliseconds表示延时的时间，以毫秒为单位。

那么如果要模拟按下功能键怎么做呢？比如要按下Ctrl+C实现拷贝这个功能，可以这样：

keybd_event (VK_Ctrl, 0, 0, 0 );   //按下Ctrl键

keybd_event (VK_C, 0, 0, 0);       //按下C键

Sleep(500 );          //延时500毫秒

keybd_event (VK_C, 0, KEYEVENTF_KEYUP, 0 );   //释放C键

keybd_event (VK_Ctrl, 0, KEYEVENTF_KEYUP, 0 );   //释放Ctrl键

好了，现在你可以试试是不是可以骗过目标程序了，这个函数对大部分的窗口程序都有效，可是仍然有一部分游戏对它产生的键盘事件熟视无睹，这时候，你 就要用上bScan这个参数了。一般的，bScan都传0，但是如果目标程序是一些DirectX游戏，那么你就需要正确使用这个参数传入扫描码，用了它 可以产生正确的硬件事件消息，以被游戏识别。这样的话，就可以写成这样：

keybd_event (VK_A, MapVirtualKey(VK_A, 0), 0, 0);   //按下A键

keybd_event (VK_A, MapVirtualKey(VK_A, 0), KEYEVENTF_KEYUP, 0 );   //释放A键

以上就是用keybd_event函数来模拟键盘事件。

模拟按下鼠标左键

mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);//鼠标左键按下mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);//鼠标左键弹起

2、 SendInput函数也可以模拟全局键盘鼠标事件。

SendInput可以直接把一条消息插入到消息队列中，算是比较底层的了。

SendInput的参数其实很简单，在Windows.pas就有函数的声明如下：

function SendInput (

cInputs: UINT;                   pInputs中记录数组的元素数目

var pInputs: TInput;               TInput类型记录数组的第1个元素

cbSize: Integer                   定义TInput的大小，一般为SizeOf(TInput)

): UINT; stdcall;

cInputs：定义pInputs中记录数组的元素数目。pInputs：TInput类型记录数组的第1个元素。每个元素代表插人到系统消 息队列的键盘或鼠标事件。cbSize：定义TInput的大小，一般为SizeOf(TInput)。函数返回成功插入系统消息队列中事件的数目，失败 返回0。调用SendInput关键的就是要搞清楚它的几个记录结构的意思，在Windows.pas中对TInput的声明如下：

tagINPUT = packed record

Itype: DWORD;

case Integer of

0: (mi: TMouseInput);

1: (ki: TKeybdInput);

2: (hi: THardwareInput);

end;

TInput = tagINPUT;

其中mi、ki、hi是3个共用型的记录结构，Itype指出记录结构中所使用的类型，它有3个值。INPUT_MOUSE：表示使用mi记录结构，忽略ki和hi；INPUT_KEYBOARD：表示使用ki记录结构，忽略mi和hi。

（1）、键盘模拟

TKeybdInput记录结构的声明如下：

tagKEYBDINPUT = packed record

wVk: WORD;                   是将要操作的按键的虚键码

wScan: WORD;                  是安全码，一般不用

dwFlags: DWORD;              指定键盘所进行的操作，为0时表示按下某键，KEYEVENTF_KEYUP表示放开某键

time: DWORD;

dwExtraInfo: DWORD;  是扩展信息，可以使用API函数GetMessageExtraInfo的返回值

end;

TKeybdInput = tagKEYBDINPUT;

其中wVk是将要操作的按键的虚键码。wScan是安全码，一般不用。dwFlags指定键盘所进行的操作，为0时表示按下某 键，KEYEVENTF_KEYUP表示放开某键。time是时间戳，可以使用API函数GetTickCount的返回值。dwExtraInfo是扩 展信息，可以使用API函数GetMessageExtraInfo的返回值。例如击键“A”的程序如下：

procedure KeyPressA;

var

Inputs : array [0..1] of TInput;

begin

Inputs[0].Itype:=INPUT_KEYBOARD;

with Inputs[0].ki do

begin

wVk:=VK_A;

wScan:=0;

dwFlags:=0;

time:=GetTickCount;

dwExtraInfo:=GetMessageExtraInfo;

end;

Inputs[1].Itype:=INPUT_KEYBOARD;

with Inputs[1].ki do

begin

wVk:=VK_A;

wScan:=0;

dwFlags:=KEYEVENTF_KEYUP;

time:=GetTickCount;

dwExtraInfo:=GetMessageExtraInfo;

end;

SendInput(2,Inputs[0],SizeOf(TInput));

end;

注意：在Windows.pas单元中并没有字母和数字的虚键码的声明，在我写的SIMouseKeyboard.pas单元文件中对所有的虚键码进行了重新声明，包含了字母、数字和标点符号。

（2）、鼠标模拟

TMouseInput记录结构的声明如下：

tagMOUSEINPUT = packed record

dx: Longint;

dy: Longint;

mouseData: DWORD;

dwFlags: DWORD;

time: DWORD;

dwExtraInfo: DWORD;

end;

TMouseInput = tagMOUSEINPUT;

其中dx、dy是鼠标移动时的坐标差（不是象素单位），在鼠标移动时有效。mouseData是鼠标滚轮滚动值，在滚动鼠标滚轮时有效。当 mouseData小于0时向下滚动，当mouseData大于0时向上滚动，mouseData的绝对值一般设为120。dwFlags指定鼠标所进行 的操作，例如，MOUSEEVENTF_MOVE表示移动鼠标，MOUSEEVENTF_LEFTDOWN表示按下鼠标左 键，MOUSEEVENTF_LEFTUP表示放开鼠标左键。time是时间戳，可以使用API函数GetTickCount的返回值。 dwExtraInfo是扩展信息，可以使用API函数GetMessageExtraInfo的返回值。例如单击鼠标左键的程序如下：

procedure MouseClick;

var

Inputs : array [0..1] of TInput;

begin

Inputs[0].Itype:=INPUT_MOUSE;

with Inputs[0].mi do

begin

dx:=0;

dy:=0;

mouseData:=0;

dwFlags:=MOUSEEVENTF_LEFTDOWN;

time:=GetTickCount;

dwExtraInfo:=GetMessageExtraInfo;

end;

Inputs[1].Itype:=INPUT_MOUSE;

with Inputs[1].mi do

begin

dx:=0;

dy:=0;

mouseData:=0;

dwFlags:=MOUSEEVENTF_LEFTUP;

time:=GetTickCount;

dwExtraInfo:=GetMessageExtraInfo;

end;

SendInput(2,Inputs[0],SizeOf(TInput));

end;

鼠标的移动总是很麻烦，上面的dx、dy不是以象素为单位的，而是以鼠标设备移动量为单位的，它们之间的比值受鼠标移动速度设置的影响。具体的 解决方法我已经在《Delphi下利用WinIo模拟鼠标键盘详解》一文中进行了讨论，这里不再重复。dwFlags可以设置一个 MOUSEEVENTF_ABSOLUTE标志，这使得可以用另外一种方法移动鼠标。当dwFlags设置了MOUSEEVENTF_ABSOLUTE标 志，dx、dy为屏幕坐标值，表示将鼠标移动到dx，dy的位置。但是这个坐标值也不是以象素为单位的。这个值的范围是0到65535（$FFFF），当 dx等于0、dy等于0时表示屏幕的最左上角，当dx等于65535、dy等于65535时表示屏幕的最右下角，相当于将屏幕的宽和高分别65536等 分。API函数GetSystemMetrics(SM_CXSCREEN)可以返回屏幕的宽度，函数 GetSystemMetrics(SM_CYSCREEN)可以返回屏幕的高度，利用屏幕的宽度和高度就可以将象素坐标换算成相应的dx、dy。注意： 这种换算最多会出现1象素的误差。例如：将鼠标指针移动到屏幕150,120坐标处的程序如下：

procedure MouseMove;

var

Input : TInput;

begin

Input.Itype:=INPUT_MOUSE;

with Input.mi do

begin

dx:=($FFFF div (GetSystemMetrics(SM_CXSCREEN)-1)) * 150;

dy:=($FFFF div (GetSystemMetrics(SM_CYSCREEN)-1)) * 120;

mouseData:=0;

dwFlags:=MOUSEEVENTF_MOVE or MOUSEEVENTF_ABSOLUTE;

time:=GetTickCount;

dwExtraInfo:=GetMessageExtraInfo;

end;

SendInput(1,Input,SizeOf(TInput));

end;

（3）、SendInput与WInIo的对比

在《Delphi下利用WinIo模拟鼠标键盘详解》一文中我已经说了WinIo的很多缺点，SendInput几乎没有这些缺点。 SendInput的模拟要比WinIo简单的多。事件是被直接插入到系统消息队列的，所以它的速度比WinIo要快。系统也会保证数据的完整性，不会出 现数据包混乱的情况。利用“绝对移动”可以将鼠标指针移动到准确的位置，同鼠标的配置隔离不会出现兼容性的问题。SendInput的缺点也是最要命的， 它会被一些程序屏蔽。所以说在SendInput与WInIo都可以使用的情况下优先考虑SendInput。另外SendInput与WInIo可以接 合使用，一些程序对鼠标左键单击敏感，可以使用WinIo模拟鼠标左键单击，其它操作由SendInput模拟。

3、用全局钩子也可以模拟键盘消息。如果你对windows中消息钩子的用 法已经有所了解，那么你可以通过设置一个全局HOOK来模拟键盘消息，比如，你可以用WH_JOURNALPLAYBACK这个钩子来模拟按键。 WH_JOURNALPLAYBACK是一个系统级的全局钩子，它和WH_JOURNALRECORD的功能是相对的，常用它们来记录并回放键盘鼠标操 作。WH_JOURNALRECORD钩子用来将键盘鼠标的操作忠实地记录下来，记录下来的信息可以保存到文件中，而 WH_JOURNALPLAYBACK则可以重现这些操作。当然亦可以单独使用WH_JOURNALPLAYBACK来模拟键盘操作。

SetWindowsHookEx函数，它可以用来安装消息钩子：

SetWindowsHookEx(

idHook: Integer;                                {hook type flag}

lpfn: TFNHookProc;                        {a pointer to the hook function}

hmod: HINST;                                {a handle to the module containing the hook function}

dwThreadId: DWORD                        {the identifier of the associated thread}

): HHOOK;

先安装WH_JOURNALPLAYBACK这个钩子，然后你需要自己写一个钩子函数，在系统调用它时，把你要模拟的事件传递给钩子参数 lParam所指向的EVENTMSG区域，就可以达到模拟按键的效果。不过用这个钩子模拟键盘事件有一个副作用，就是它会锁定真实的鼠标键盘，不过如果 你就是想在模拟的时候不会受真实键盘操作的干扰，那么用用它倒是个不错的主意。

在不需要监视系统消息时需要调用提供UnHookWindowsHookEx来解除对消息的监视。       下面来建立程序，在Delphi中建立一个工程，在Form1上添加3个按钮用于程序操作。另外再添加一个按钮控件和一个Edit控件用于验证操 作。

下面是Form1的全部代码

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Edit1: TEdit;

Button4: TButton;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

EventArr:array[0..1000]of EVENTMSG;

EventLog:Integer;

PlayLog:Integer;

hHook,hPlay:Integer;

recOK:Integer;

canPlay:Integer;

bDelay:Bool;

implementation

{$R *.DFM}

Function PlayProc(iCode:Integer;wParam:wParam;lParam:lParam):LRESULT;stdcall;

begin

canPlay:=1;

Result:=0;

if iCode < 0 then     // 必须将消息传递到消息链的下一个接受单元

Result := CallNextHookEx(hPlay,iCode,wParam,lParam)

else if iCode = HC_SYSMODALON then

canPlay:=0

else if iCode = HC_SYSMODALOFF then

canPlay:=1

else if ((canPlay =1 )and(iCode=HC_GETNEXT)) then begin

if bDelay then begin

bDelay:=False;

Result:=50;

end;

pEventMSG(lParam)^:=EventArr[PlayLog];

end

else if ((canPlay = 1)and(iCode = HC_SKIP))then begin

bDelay := True;

PlayLog:=PlayLog+1;

end;

if PlayLog>=EventLog then begin

UNHookWindowsHookEx(hPlay);

end;

end;

function HookProc(iCode:Integer;wParam:wParam;lParam:lParam):LRESULT;stdcall;

begin

recOK:=1;

Result:=0;

if iCode < 0 then

Result := CallNextHookEx(hHook,iCode,wParam,lParam)

else if iCode = HC_SYSMODALON then

recOK:=0

else if iCode = HC_SYSMODALOFF then

recOK:=1

else if ((recOK>0) and (iCode = HC_ACTION)) then begin

EventArr[EventLog]:=pEventMSG(lParam)^;

EventLog:=EventLog+1;

if EventLog>=1000 then begin

UnHookWindowsHookEx(hHook);

end;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Button1.Caption:= ‘纪录’;

Button2.Caption:=  ‘停止’;

Button3.Caption:= ‘回放’;

Button4.Caption:=  ‘范例’;

Button2.Enabled:=False;

Button3.Enabled:=False;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

EventLog:=0;    //   建立键盘鼠标操作消息纪录链

hHook:=SetwindowsHookEx(WH_JOURNALRECORD,HookProc,HInstance,0);

Button2.Enabled:=True;

Button1.Enabled:=False;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

UnHookWindowsHookEx(hHook);

hHook:=0;

Button1.Enabled:=True;

Button2.Enabled:=False;

Button3.Enabled:=True;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

PlayLog:=0;  //建立键盘鼠标操作消息纪录回放链

hPlay:=SetwindowsHookEx(WH_JOURNALPLAYBACK,PlayProc,

HInstance,0);

Button3.Enabled:=False;

end;

end.

二、驱动级模拟 （绕过了windows消息）

有一些使用DirectX接口的游戏程序，它们在读取键盘操作时绕过了windows的消息机制，而使用DirectInput.这是因为有些游戏 对实时性控制的要求比较高，比如赛车游戏，要求以最快速度响应键盘输入。而windows消息由于是队列形式的，消息在传递时会有不少延迟，有时1秒钟也 就传递十几条消息，这个速度达不到游戏的要求。而DirectInput则绕过了windows消息，直接与键盘驱动程序打交道，效率当然提高了不少。因 此也就造成，对这样的程序无论用PostMessage或者是keybd_event都不会有反应，因为这些函数都在较高层。对于这样的程序，只好用直接 读写键盘端口的方法来模拟硬件事件了。要用这个方法来模拟键盘，需要先了解一下键盘编程的相关知识。

在DOS时代，当用户按下或者放开一个键时，就会产生一个键盘中断(如果键盘中断是允许的)，这样程序会跳转到BIOS中的键盘中断处理程序去执 行。打开windows的设备管理器，可以查看到键盘控制器由两个端口控制。其中&H60是数据端口，可以读出键盘数据，而&H64是控 制端口，用来发出控制信号。也就是，从&H60号端口可以读此键盘的按键信息，当从这个端口读取一个字节，该字节的低7位就是按键的扫描码，而高 1位则表示是按下键还是释放键。当按下键时，最高位为0，称为通码，当释放键时，最高位为1，称为断码。既然从这个端口读数据可以获得按键信息，那么向这 个端口写入数据就可以模拟按键了！用过QbASIC4.5的朋友可能知道，QB中有个OUT命令可以向指定端口写入数据，而INP函数可以读取指定端口的 数据。那我们先看看如果用QB该怎么写代码：

假如你想模拟按下一个键，这个键的扫描码为&H50，那就这样

OUT &H64,&HD2    ‘把数据&HD2发送到&H64端口。这是一个KBC指令，表示将要向键盘写入数据

OUT &H60,&H50    ‘把扫描码&H50发送到&H60端口，表示模拟按下扫描码为&H50的这个键

那么要释放这个键呢？像这样，发送该键的断码：

OUT &H64,&HD2    ‘把数据&HD2发送到&H64端口。这是一个KBC指令，表示将要向键盘写入数据

OUT &H60,(&H50 or &H80)    ‘把扫描码&H50与数据&H80进行或运算，可以把它的高位置1，得到断码，表示释放这个键

好了，现在的问题就是在delphi中如何向端口写入数据了。因为在windows中，普通应用程序是无权操作端口的，于是我们就需要一个驱动程序 来帮助我们实现。在这里我们可以使用一个组件WINIO来完成读写端口操作。什么是WINIO？WINIO是一个全免费的、无需注册的、含源程序的 WINDOWS2000端口操作驱动程序组件(可以到http://www.internals.com/上去下载)。它不仅可以操作端口，还可以操作内 存；不仅能在VB下用，还可以在DELPHI、VC等其它环境下使用，性能特别优异。下载该组件，解压缩后可以看到几个文件夹，其中Release文件夹 下的3个文件就是我们需要的，这3个文件是WinIo.sys(用于win xp下的驱动程序)，WINIO.VXD(用于win 98下的驱动程序)，WinIo.dll(封装函数的动态链接库)，我们只需要调用WinIo.dll中的函数，然后WinIo.dll就会安装并调用驱 动程序来完成相应的功能。值得一提的是这个组件完全是绿色的，无需安装，你只需要把这3个文件复制到与你的程序相同的文件夹下就可以使用了。用法很简单， 先用里面的InitializeWinIo函数安装驱动程序，然后就可以用GetPortVal来读取端口或者用SetPortVal来写入端口了。好， 让我们来做一个驱动级的键盘模拟吧。先把winio的3个文件拷贝到你的程序的文件夹下。

下面给出使用WINIO模拟按键的单元和使用方法：

{****************************************************************************}

unit MNwinio;

interface

const

KBC_KEY_CMD = $64; //键盘命令端口

KBC_KEY_DATA = $60; //键盘数据端口

implementation

function InitializeWinIo: Boolean; stdcall; external ‘WinIo.dll’ name ‘InitializeWinIo’;

{

本函数初始化WioIO函数库。

必须在调用所有其它功能函数之前调用本函数。

如果函数调用成功，返回值为非零值。

如果调用失败，则返回值为0。

procedure TForm1.FormActivate(Sender: TObject); //通常在程序启动时调用

begin

if InitializeWinIo = False then

begin

Messagebox(handle, ‘初始化失败！’, ‘提示’, MB_OK + MB_IconError)

end;

end;

}

function InstallWinIoDriver(pszWinIoDriverPath: PString; IsDemandLoaded: boolean

= false): Boolean; stdcall; external ‘WinIo.dll’ name ‘InstallWinIoDriver’;

function RemoveWinIoDriver: Boolean; stdcall; external ‘WinIo.dll’ name

‘RemoveWinIoDriver’;

function GetPortVal(PortAddr: Word; PortVal: PDWord; bSize: Byte): Boolean;

stdcall; external ‘WinIo.dll’ name ‘GetPortVal’;

function SetPortVal(PortAddr: Word; PortVal: DWord; bSize: Byte): Boolean;

stdcall; external ‘WinIo.dll’ name ‘SetPortVal’;

function GetPhysLong(PhysAddr: PByte; PhysVal: PDWord): Boolean; stdcall;

external ‘WinIo.dll’ name ‘GetPhysLong’;

function SetPhysLong(PhysAddr: PByte; PhysVal: DWord): Boolean; stdcall; external

‘WinIo.dll’ name ‘SetPhysLong’;

function MapPhysToLin(PhysAddr: PByte; PhysSize: DWord; PhysMemHandle: PHandle):

PByte; stdcall; external ‘WinIo.dll’ name ‘MapPhysToLin’;

function UnMapPhysicalMemory(PhysMemHandle: THandle; LinAddr: PByte): Boolean;

stdcall; external ‘WinIo.dll’ name ‘UnmapPhysicalMemory’;

procedure ShutdownWinIo; stdcall; external ‘WinIo.dll’ name ‘ShutdownWinIo’;

{ 本函数在内存中清除WinIO库

本函数必须在中止应用函数之前或者不再需要WinIO库时调用

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); //通常在程序关闭时调用

begin

ShutdownWinIo;

end;

}

{**********以上为WINIO.dll中API函数的调用***************}

procedure KBCWait4IBE; //等待键盘缓冲区为空

var

dwVal: DWord;

begin

repeat

GetPortVal($64, @dwVal, 1);

{这句表示从&H64端口读取一个字节并把读出的数据放到变量dwVal中. GetPortVal函数的用法是 GetPortVal (端口号,存放读出数据的变量地址,读入的长度}

until (dwVal and $2) = 0;

{上面的是一个根据KBC规范写的过程，它的作用是在向键盘端口写入数据前等待一段时间，后面将会用到。}

end;

procedure MyKeyDown(vKeyCoad: Integer);    // 这个用来模拟按下键，参数vKeyCoad传入按键的虚拟码

var

btScancode: DWord;

begin

btScancode := MapVirtualKey(vKeyCoad, 0);

KBCWait4IBE;                           // 发送数据前应该先等待键盘缓冲区为空

SetPortVal($64, $D2, 1);               // 发送键盘写入命令

{SetPortVal函数用于向端口写入数据，它的用法是：SetPortVal(端口号,欲写入的数据，写入数据的长度)}

KBCWait4IBE;

SetPortVal($60, btScancode, 1);   //写入按键信息,按下键

end;

procedure MyKeyUp(vKeyCoad: Integer);     //这个用来模拟释放键，参数vKeyCoad传入按键的虚拟码

var

btScancode: DWord;

begin

btScancode := MapVirtualKey(vKeyCoad, 0);

KBCWait4IBE;

SetPortVal($64, $D2, 1);

KBCWait4IBE;

SetPortVal($64, (btScancode or $80), 1);

end;

end.

{

使用方法：

如模拟按键 1

MyKeyDown($31);

Sleep(50);

MyKeyUp($31);

}

来源： 使用delphi+intraweb进行微信开发5—准备实现微信API，先从获取AccessToken开始 – Delphi力量 – 博客园

1. 首先需要明确的是，微信的API都是通过https调用实现的，分为post方法调用和get方法调用。不需要上传数据的采用get方法（例如获取AccessToken），而需要向微信服务器提交数据的采用post方法（例如创建菜单）。
2. 微信方法调用均需传递AccessToken（URL参数方式），这个AccessToken不是我们微信接入时使用的Token，这个AccessToken专门用于微信API调用，AccessToken有过期时间，而且每天有请求次数限制，据说是为了防止不良的程序调用导致微信服务器出现异常。因此在这种情况下则必须在获取AccessToken后进行保存，在即将过期前再重新获取。

/// <summary>
/// 向指定URL发起Get请求
/// </summary>
/// <param name=”http”>TIdHTTP</param>
/// <param name=”URL”>指定URL</param>
/// <param name=”Max”>Get请求失败最大重试次数</param>
/// <returns>返回腾讯服务器响应(string类型的json格式数据)</returns>
function GetMethod(http: TIdHTTP; URL: String; Max: Integer): String;

var
RespData: TStringStream;
begin
RespData := TStringStream.Create(”, TEncoding.UTF8);
try
try
http.Get(URL, RespData);
http.Request.Referer := URL;
Result := RespData.DataString;
except
Dec(Max);
if Max = 0 then
begin
Result := ”;
exit;
end;
Result := GetMethod(http, URL, Max);
end;
finally
FreeAndNil(RespData);
end;
end;

/// <summary>
/// 向指定URL提交数据(Post)
/// </summary>
/// <param name=”http”>TIdHTTP</param>
/// <param name=”URL”>指定URL</param>
/// <param name=”Data”>要提交的数据(UTF8String)</param>
/// <param name=”Max”>Post请求失败最大重试次数</param>
/// <returns>返回腾讯服务器响应(string类型的json格式数据)</returns>
function PostMethod(http: TIdHTTP; URL: String; Data: UTF8String;
Max: Integer): String;

var
PostData, RespData: TStringStream;
begin
RespData := TStringStream.Create(”);
PostData := TStringStream.Create(Data);
try
try
if http = nil then
exit;
http.Post(URL, PostData, RespData);
Result := RespData.DataString;
http.Request.Referer := URL;
except
Dec(Max);
if Max = 0 then
begin
Result := ”;
exit;
end;
Result := PostMethod(http, URL, Data, Max);
end;
finally
http.Disconnect;
FreeAndNil(RespData);
FreeAndNil(PostData);
end;
end;

有了上面两个方法我们就可以开始测试微信API了。

♥ 不过你有没有注意到，微信请求是https， 不是http啊，所以似乎还需要让Indy支持ssl传输才行啊，这当然没有问题，上Indy官网下载SSL支持DLL即可，分为64位和32位版本不要 搞错，下载后和编译好的IW程序放置在同一目录下即可（说实在的下载网站我给忘了，大家可以百度一下，如果找不到给我留言，我把我下载的发出来）。

由于AccessToken在API调用中都需要使用，因此先来获取AccessToken吧，关于AccessToken的解释请看微信文档：http://mp.weixin.qq.com/wiki/14/9f9c82c1af308e3b14ba9b973f99a8ba.html

使用的微信命令URL是：https://api.weixin.qq.com/cgi-bin/token?grant_type=client_credential&appid=APPID&secret=APPSECRET

采用Get方法。

如你所见：

1、URL调用需传递【APPID】和【APPSECRET】两个参数，返回结果为Json格式字符串。

2、调用成功的情况下，微信会返回下述JSON数据包给公众号：

{"access_token":"ACCESS_TOKEN","expires_in":7200}

3、错误时微信会返回错误码等信息，JSON数据包示例如下（该示例为AppID无效错误）:

{"errcode":40013,"errmsg":"invalid appid"}

♥ 好吧，好像还得找个Json解析的组件，嗯嗯，够麻烦的，推荐使用第三方组件“SuperObject”进行Json格式解析，不过你要非得自行进行Json字符串编解码也行，嗯，可能会累点，相信我，最好找个封装完善的Json组件，工欲善其事必先利其器，否则创建菜单什么的时候有你受的。

简单说：“为了保密appsecrect，第三方需要一个access_token获取和刷新的中控服务器。而其他业务逻辑服务器所使用的access_token均来自于该中控服务器，不应该各自去刷新，否则会造成access_token覆盖而影响业务；”这个是微信文档原话，所以让我们看看怎么缓存这个东东。

先声明一个TAccessToken记录，然后利用一个全局公开的变量，再加上一个泛型容器，如此的简单：

/// <summary>
/// AccessToken记录，包含AccessToken值和过期时间
/// </summary>
TAccessToken = record
AccessToken: string;
AccessTokenExpiresDt: TDateTime;
end;

var
gAccessTokenLst: TDictionary<string, TAccessToken>;
gCS: TCriticalSection;

♥  声明成记录类型的好处是，可以当做简单变量来使用，要是声明成指针或者类，哦哦，创建再释放，太麻烦了。微信返回的json结果中是这个AccessToken还有多少秒过期，我们换算成时间类型会比较好用一些。

♥ 泛型我喜欢，让Hash表成为强类型的。

♥  如上gAccessTokenLst用来存储获取的AccessToken，key就是微信号的APPID，估计这个不会重复吧！上面还声明了一个临界区对象gCS，大约我不说你也能猜到，既然是全局的那就得上锁，防止写入混乱。

♥  上面那两个变量gAccessTokenLst和gCS我是在单元的initialization部分实例化的，并在finalization进行了释放，在这两个地方处理全局变量的好处是：运行时只执行一次。是初始化全局变量的绝佳地点。

procedure TWxSdkImp.GetAccessToken(const appid, appsecret: string;
var AccessToken: string; const GetNew: Boolean = false);
var
URL: string;
JSONObject: ISuperObject;
temp, sKey: string;
recAccessToken: TAccessToken;
begin
if (appid = ”) or (appsecret = ”) then
raise Exception.Create(‘TWxSdkImp.GetAccessToken执行出错，参数应用ID或者应用秘钥不能为空！’);

recAccessToken.AccessToken := ”;
sKey := appid;
if gAccessTokenLst.ContainsKey(sKey) then
recAccessToken := gAccessTokenLst.Items[sKey];

// 如果要求重新获取AccessToken 或者 尚未获取AccessToken 或者 已经获取了但是离过期不足30秒
gCS.Enter;
try
if GetNew or (recAccessToken.AccessToken = ”) or (SecondSpan(recAccessToken.AccessTokenExpiresDt, Now) < 30) then
begin
URL := Format(WxCmdUrl_GetAccessToken, [appid, appsecret]);
temp := GetMethod(http, URL, 3);
JSONObject := ParseJson(temp, [‘”access_token”‘, ‘”errcode”‘]);
if Pos(‘”access_token”‘, temp) > 0 then
begin
recAccessToken.AccessToken := JSONObject[‘access_token’].AsString;
recAccessToken.AccessTokenExpiresDt := IncSecond(Now, JSONObject[‘expires_in’].AsInteger);         if gAccessTokenLst.ContainsKey(sKey) then           gAccessTokenLst.Remove(sKey);         gAccessTokenLst.Add(sKey, recAccessToken);       end else         raise Exception.Create(‘TWxSdkImp.GetAccessToken执行出错，服务器返回错误代 码：’ + JSONObject[‘errcode’].AsString + ‘，错误信 息：’ + JSONObject[‘errmsg’].AsString + ‘！’);     end;   finally     gCS.Leave;   end;   AccessToken := recAccessToken.AccessToken; end;

需要获取AccessToken时，

var accessToken: string; 

GetAccessToken(‘YourAppID’, ‘YourAppSecret’, accessToken);

输出的accessToken字符串就是我们想要的结果。

♥  呵呵，如果想要用Delphi+iw进行微信开发的，看到这里应该算是有方向了吧，加油！希望早日看到各位的大作。

来源： 更新大数据的表结构的缓和做法 – 王森 – 博客园

ThinkPHP U方法

U 方法是 ThinkPHP 内置的一个快捷方法，可以根据系统 URL 模式配置动态的生成智能的 URL 地址。

由于 ThinkPHP 支持各种不同的 URL 模式，另外还有分组模式，因此当环境发生变化时，有时候可能会改变 URL 模式，而 U 方法正是解决不同配置情况下的 URL 统一问题。除了动态生成 URL 以自适应系统配置外，U 方法还有一个好处是可以自动加上伪静态后缀。

U方法语法

U 方法的定义规则如下：

U('[项目://][路由@][分组名-模块/]操作?参数1=值1[&参数N=值N]')
// 或者：
U('[项目://][路由@][分组名-模块/]操作',array('参数1'=>'值1' [,'参数N'=>'值N']))

U方法实例

假设当前为 Index 模块的 index 操作，生成当前模块的 list 操作 URL：

U('list?cat_id=1&status=1')

生成的 URL 为相对链接：index.php/Index/list/cat_id/1/status/1

模板中使用 U 方法

U 方法实际属于 ThinkPHP 系统函数，可以直接使用，更多可参见《ThinkPHP 模板中使用函数》。通常 U 方法用于模板生成超链接：

<a href="{:U('list?cat_id=1&status=1')}">超链接字符</a>

生成 URL 后实际的 html 代码为：

<a href="index.php/Index/list/cat_id/1/status/1">超链接字符</a>

U 方法中使用变量，需要用 . 连接符：

<a href="{:U('list?cat_id='.$catList['cat_id'].'&status=1')}">超链接字符</a>

各种 URL 模式下的对比

U 方法根据 URL 模式的不同而自适应的生成不同的 URL 格式，如上面例子在各模式下生成的 URL 对比如下：

• 普通兼容模式：index.php?m=Index&a=list&cat_id=1&status=1
• PATHINFO 模式：index.php/Index/list/cat_id/1/status/1
• REWRITE 模式：Index/list/cat_id/1/status/1
• REWRITE 模式，伪静态后缀为 .html：Index/list/cat_id/1/status/1.html
• REWRITE 模式，使用 – 分隔符与 .html 后缀：Index-list-cat_id-1-status-1.html

常见 U 方法使用例子

// 当前模块 list 操作
U('list?cat_id=1&status=1')
// 其他模块操作
U('Blog/read?id=1')        // 生成Blog模块的read操作，并且id为1的URL地址
// 其他分组
U('Admin-User/view?uid=1')    // 生成Admin分组的User模块的view操作的URL地址

U 方法也可以在操作中使用，与使用普通函数用法一致（不需要 $this->）。

来源： [转载]delphi之精确找图 – devlyn – 博客园

从网上找来的Delphi屏幕找图单元_淡淡的忧愁_新浪博客,淡淡的忧愁,

unit BitmapData;

//
//位图数据处理，主要用于位图的找图找色
//作者：yeye55　2009年5月29日
//
//版权 2009，由 yeye55 拥有，保留所有权利。
//本文件中的代码是免费程序，无需任何授权或许可即可用于个人和商业目的。使用者一切后果自负。
//
//如果你转载了本文件中的代码，请注明代码出处和代码作者；
//如果你修改了本文件中的代码，请注明修改位置和修改作者。
//
//本文件最早在http://www.programbbs.com/bbs/上发布
//

interface

uses
Windows, Classes, SysUtils, Graphics;

const
BD_COLORLESS = -1; //无色
BD_BITCOUNT = 24; //图象位数
BD_BYTECOUNT = BD_BITCOUNT shr 3; //每象素占用字节数
BD_LINEWIDTH = 32; //每行数据对齐宽度（位）

type
//字节数组
TByteAry = array [0..0] of Byte;
PByteAry = ^TByteAry;

//颜色变化范围，R、G、B三个通道的绝对差值
TBDColorRange = record
R : Integer;
G : Integer;
B : Integer;
end;

TBDColor = Integer; //BGR格式颜色

//转换函数
function BGR(B,G,R : Byte): TBDColor;
function RGBtoBGR(C : TColor): TBDColor;
function BGRtoRGB(C : TBDColor): TColor;
//比较颜色
function BDCompareColor(C1,C2 : TBDColor; const Range : TBDColorRange): Boolean;

type
TBDBitmapData = class; //位图数据

//枚举子图回调函数，查找多个子图时回调，返回是否继续枚举，
//Left：找到子图的左边距；
//Top：找到子图的顶边距；
//Bmp：找到子图数据；
//lParam：调用时设置的参数。
TBDEnumImageProc = function (Left,Top : Integer; Bmp : TBDBitmapData; lParam : Integer): Boolean;

//枚举颜色回调函数，查找多个颜色时回调，返回是否继续枚举，
//Left：找到颜色的左边距；
//Top：找到颜色的顶边距；
//Color：找到的颜色；
//lParam：调用时设置的参数。
TBDEnumColorProc = function (Left,Top : Integer; Color : TBDColor; lParam : Integer): Boolean;

//位图数据
TBDBitmapData = class
private
FName : String; //位图名称
FWidth : Integer; //位图宽度（象素）
FHeight : Integer; //位图高度（象素）
FBackColor : TBDColor; //背景颜色（BGR格式）
FLineWidth : Integer; //对齐后每行数据宽度（字节）
FSpareWidth : Integer; //对齐后每行数据多余宽度（字节）
FSize : Integer; //位图数据长度
FBufSize : Integer; //缓冲区实际长度
FBits : PByteAry; //位图数据缓冲区
function InitData(AWidth,AHeight : Integer): Boolean;
function GetPixels(Left,Top : Integer): TBDColor;
procedure SetPixels(Left,Top : Integer; Value : TBDColor);
public
Error : String;
constructor Create(const AName : String = ”);
destructor Destroy; override;
procedure Clear;
function LoadFromStream(Stream : TStream; ABackColor : TBDColor = BD_COLORLESS): Boolean;
function SaveToStream(Stream : TStream):Boolean;
function LoadFromFile(const FileName : string; ABackColor : TBDColor = BD_COLORLESS): Boolean;
function SaveToFile(const FileName : string): Boolean;
function LoadFromBitmap(Bitmap : TBitmap): Boolean;
function SaveToBitmap(Bitmap : TBitmap): Boolean;
function CopyFormScreen(Left : Integer = -1; Top : Integer = -1; AWidth : Integer = -1; AHeight : Integer = -1): Boolean;
function CopyFormCursor: Boolean;
function Compare(Bmp : TBDBitmapData; Left : Integer = 0; Top : Integer = 0): Boolean; overload;
function Compare(Bmp : TBDBitmapData; const Range : TBDColorRange; Left : Integer = 0; Top : Integer = 0): Boolean; overload;
function FindImage(Bmp : TBDBitmapData; var Left,Top : Integer): Boolean; overload;
function FindImage(Bmp : TBDBitmapData; const Range : TBDColorRange; var Left,Top : Integer): Boolean; overload;
function FindCenterImage(Bmp : TBDBitmapData; var Left,Top : Integer): Boolean; overload;
function FindCenterImage(Bmp : TBDBitmapData; const Range : TBDColorRange; var Left,Top : Integer): Boolean; overload;
function EnumImage(Bmp : TBDBitmapData; EnumImageProc : TBDEnumImageProc; lParam : Integer = 0): Boolean; overload;
function EnumImage(Bmp : TBDBitmapData; const Range : TBDColorRange; EnumImageProc : TBDEnumImageProc; lParam : Integer = 0): Boolean; overload;
function FindColor(Color : TBDColor; var Left,Top : Integer): Boolean; overload;
function FindColor(Color : TBDColor; const Range : TBDColorRange; var Left,Top : Integer): Boolean; overload;
function FindCenterColor(Color : TBDColor; var Left,Top : Integer): Boolean; overload;
function FindCenterColor(Color : TBDColor; const Range : TBDColorRange; var Left,Top : Integer): Boolean; overload;
function EnumColor(Color : TBDColor; EnumColorProc : TBDEnumColorProc; lParam : Integer = 0): Boolean; overload;
function EnumColor(Color : TBDColor; const Range : TBDColorRange; EnumColorProc : TBDEnumColorProc; lParam : Integer = 0): Boolean; overload;
property Name : String read FName write FName; //位图名称
property Width : Integer read FWidth; //位图宽度（象素）
property Height : Integer read FHeight; //位图高度（象素）
property BackColor : TBDColor read FBackColor write FBackColor; //背景颜色（BGR格式）
property LineWidth : Integer read FLineWidth; //对齐后每行数据宽度（字节）
property SpareWidth : Integer read FSpareWidth; //对齐后每行数据多余宽度（字节）
property Size : Integer read FSize; //位图数据长度
property Bits : PByteAry read FBits; //位图数据缓冲区
property Pixels[Left,Top : Integer] : TBDColor read GetPixels write SetPixels; default;
end;

implementation

type
//矩阵遍历方向
TAspect = (asLeft, asRight, asUp, asDown);

const
//移动坐标差，用于矩阵遍历
MoveVal : array [asLeft..asDown] of TPoint = (
(X : -1; Y : 0), //asLeft
(X : 1; Y : 0), //asRight
(X : 0; Y : -1), //asUp
(X : 0; Y : 1) //asDown
);

var
ScreenWidth : Integer;
ScreenHeight : Integer;
IconWidth : Integer;
IconHeight : Integer;

//根据B、G、R三个通道的值生成一个BGR格式颜色。
function BGR(B,G,R : Byte): TBDColor;
begin
result:=(B or (G shl 8) or (R shl 16));
end;

//RGB颜色格式转换到BGR颜色格式。
function RGBtoBGR(C : TColor): TBDColor;
begin
result:=((C and $FF0000) shr 16) or (C and $00FF00) or ((C and $0000FF) shl 16);
end;

//BGR颜色格式转换到RGB颜色格式。
function BGRtoRGB(C : TBDColor): TColor;
begin
result:=((C and $FF0000) shr 16) or (C and $00FF00) or ((C and $0000FF) shl 16);
end;

//根据颜色范围Range比较颜色C1和C2，返回C1和C2是否相似，
//C1,C2：BGR格式颜色；
//Range：为颜色变化范围。
function BDCompareColor(C1,C2 : TBDColor; const Range : TBDColorRange): Boolean;
var
C : Integer;
begin
result:=false;
//B
C:=(C1 and $FF)-(C2 and $FF);
if (C>Range.B) or (C< -Range.B) then exit; //G C:=((C1 and $FF00) shr 8)-((C2 and $FF00) shr 8); if (C>Range.G) or (C< -Range.G) then exit; //R C:=((C1 and $FF0000) shr 16)-((C2 and $FF0000) shr 16); if (C>Range.R) or (C< -Range.R) then exit; // result:=true; end; {TBDBitmapData} //位图数据 constructor TBDBitmapData.Create(const AName : String); begin self.FName:=AName; self.FWidth:=0; self.FHeight:=0; self.FBackColor:=BD_COLORLESS; self.FLineWidth:=0; self.FSize:=0; self.FBufSize:=0; self.FBits:=nil; self.Error:=''; end; destructor TBDBitmapData.Destroy; begin self.Clear; end; //根据当前的AWidth和AHeight初始化数据，分配内存，返回是否成功， //如果失败将设置self.Error说明情况， //AWidth：位图的宽度； //AHeight：位图的高度。 function TBDBitmapData.InitData(AWidth,AHeight : Integer): Boolean; var Align : Integer; begin self.Error:=''; result:=true; if (self.FWidth=AWidth) and (self.FHeight=AHeight) then exit; //计算对齐后的每行数据宽度 self.FWidth:=AWidth; self.FHeight:=AHeight; Align:=BD_LINEWIDTH-1; self.FLineWidth:=(((self.FWidth*BD_BITCOUNT)+Align) and ($7FFFFFFF-Align)) shr 3; self.FSpareWidth:=self.FLineWidth-(self.FWidth*BD_BYTECOUNT); self.FSize:=self.FLineWidth*self.FHeight; //分配内存 if self.FSize<=self.FBufSize then exit; if self.FBits<>nil then FreeMem(self.FBits);
try
GetMem(self.FBits,self.FSize);
except
on EOutOfMemory do begin
self.FSize:=0;
self.FBufSize:=0;
self.FBits:=nil;
self.Error:=’内存不足！’;
result:=false;
exit;
end;
end;
self.FBufSize:=self.FSize;
end;

//获取指定位置象素的颜色值，
//Left：象素的左边距；
//Top：象素的顶边距。
function TBDBitmapData.GetPixels(Left,Top : Integer): TBDColor;
begin
if (Left<0) or (Left>=self.FWidth) or
(Top<0) or (Top>=self.FHeight) then
begin
result:=0;
exit;
end;
result:=((PInteger(@(self.FBits[
((self.FHeight-Top-1)*self.FLineWidth)+(Left*BD_BYTECOUNT)
])))^ and $FFFFFF);
end;

//设置指定位置象素的颜色值，
//Left：象素的左边距；
//Top：象素的顶边距；
//Value：BGR格式颜色。
procedure TBDBitmapData.SetPixels(Left,Top : Integer; Value : TBDColor);
var
Off : Integer;
begin
if (Left<0) or (Left>=self.FWidth) or
(Top<0) or (Top>=self.FHeight) then exit;
Off:=((self.FHeight-Top-1)*self.FLineWidth)+(Left*BD_BYTECOUNT);
//B
self.FBits[Off]:=Byte(Value and $FF);
//G
self.FBits[Off+1]:=Byte((Value and $FF00) shr 8);
//R
self.FBits[Off+2]:=Byte((Value and $FF0000) shr 16);
end;

//清除当前的位图数据。
procedure TBDBitmapData.Clear;
begin
self.FWidth:=0;
self.FHeight:=0;
self.FBackColor:=BD_COLORLESS;
self.FLineWidth:=0;
self.FSize:=0;
self.FBufSize:=0;
if self.FBits<>nil then
begin
FreeMem(self.FBits);
self.FBits:=nil;
end;
self.Error:=”;
end;

//从数据流中导入位图数据，返回是否成功，
//如果失败将设置self.Error说明情况，
//数据流中的数据必需是24位BMP格式文件数据，
//Stream：数据流；
//ABackColor：位图的背景颜色，可省略。
function TBDBitmapData.LoadFromStream(Stream : TStream; ABackColor : TBDColor): Boolean;
var
FileHeader : TBitmapFileHeader;
InfoHeader : TBitmapInfoHeader;
begin
if Stream=nil then
begin
self.Error:=’没有指定数据流！’;
result:=false;
exit;
end;
//读取文件头
Stream.Read(FileHeader,SizeOf(TBitmapFileHeader));
Stream.Read(InfoHeader,SizeOf(TBitmapInfoHeader));
with FileHeader,InfoHeader do
begin
//确定位图格式
if (bfType<>$4D42) or (biSize<>SizeOf(TBitmapInfoHeader)) or
(biBitCount<>BD_BITCOUNT) or (biCompression<>BI_RGB) then
begin
self.Error:=’错误的数据格式！’;
result:=false;
exit;
end;
//数据初始化
self.FBackColor:=ABackColor;
if not self.InitData(biWidth,biHeight) then
begin
result:=false;
exit;
end;
end;
//读入数据
result:=Stream.Read((self.FBits)^,self.FSize)=self.FSize;
if result then self.Error:=”
else self.Error:=’读取的数据不完整！’;
end;

//将当前的位图数据导出到数据流中，返回是否成功，
//如果失败将设置self.Error说明情况，
//数据按24位BMP文件数据格式导出到数据流中，
//Stream：数据流。
function TBDBitmapData.SaveToStream(Stream : TStream):Boolean;
var
FileHeader : TBitmapFileHeader;
InfoHeader : TBitmapInfoHeader;
HeaderLen,n : Integer;
begin
if Stream=nil then
begin
self.Error:=’没有指定数据流！’;
result:=false;
exit;
end;
//初始化文件头
HeaderLen:=SizeOf(TBitmapFileHeader)+SizeOf(TBitmapInfoHeader);
with FileHeader,InfoHeader do
begin
bfType:=$4D42;
bfSize:=self.FSize+HeaderLen;
bfReserved1:=0;
bfReserved2:=0;
bfOffBits:=HeaderLen;
biSize:=SizeOf(TBitmapInfoHeader);
biWidth:=self.FWidth;
biHeight:=self.FHeight;
biPlanes:=1;
biBitCount:=BD_BITCOUNT;
biCompression:=BI_RGB;
biSizeImage:=self.FSize;
biXPelsPerMeter:=$EC4;
biYPelsPerMeter:=$EC4;
biClrUsed:=0;
biClrImportant:=0;
end;
//写入数据
n:=0;
n:=n+Stream.Write(FileHeader,SizeOf(TBitmapFileHeader));
n:=n+Stream.Write(InfoHeader,SizeOf(TBitmapInfoHeader));
n:=n+Stream.Write((self.FBits)^,self.FSize);
result:=n=(self.FSize+HeaderLen);
if result then self.Error:=”
else self.Error:=’写入的数据不完整！’;
end;

//从文件中导入位图数据，返回是否成功，
//如果失败将设置self.Error说明情况，
//文件必需是24位BMP格式文件，
//FileName：BMP文件名；
//ABackColor：位图的背景颜色，可省略。
function TBDBitmapData.LoadFromFile(const FileName : string; ABackColor : TBDColor): Boolean;
var
Stream : TFileStream;
begin
Stream:=TFileStream.Create(FileName,fmOpenRead);
result:=self.LoadFromStream(Stream,ABackColor);
Stream.Free;
end;

//将当前的位图数据导出到文件中，返回是否成功，
//如果失败将设置self.Error说明情况，
//数据按24位BMP文件数据格式导出到文件中，
//FileName：BMP文件名。
function TBDBitmapData.SaveToFile(const FileName : string): Boolean;
var
Stream : TFileStream;
begin
Stream:=TFileStream.Create(FileName,fmCreate);
result:=self.SaveToStream(Stream);
Stream.Free;
end;

//从一个TBitmap对象中导入数据，返回是否成功，位图的背景颜色由
//TBitmap.Transparent和TBitmap.TransparentColor决定，
//如果失败将设置self.Error说明情况，
//Bitmap：TBitmap对象。
function TBDBitmapData.LoadFromBitmap(Bitmap : TBitmap): Boolean;
var
Stream : TMemoryStream;
ABackColor : TBDColor;
begin
if Bitmap=nil then
begin
self.Error:=’没有指定位图！’;
result:=false;
exit;
end;
if Bitmap.Transparent then
ABackColor:=RGBtoBGR(Bitmap.TransparentColor)
else
ABackColor:=BD_COLORLESS;
Stream:=TMemoryStream.Create;
Bitmap.SaveToStream(Stream);
Stream.Position:=0;
result:=self.LoadFromStream(Stream,ABackColor);
Stream.Free;
end;

//将当前的位图数据导出到一个TBitmap对象中，返回是否成功，根据当前
//的背景颜色设置TBitmap.Transparent和TBitmap.TransparentColor成员，
//如果失败将设置self.Error说明情况，
//Bitmap：TBitmap对象。
function TBDBitmapData.SaveToBitmap(Bitmap : TBitmap): Boolean;
var
Stream : TMemoryStream;
begin
if Bitmap=nil then
begin
self.Error:=’没有指定位图！’;
result:=false;
exit;
end;
Stream:=TMemoryStream.Create;
result:=self.SaveToStream(Stream);
if not result then
begin
Stream.Free;
exit;
end;
Stream.Position:=0;
Bitmap.LoadFromStream(Stream);
if self.FBackColor<>BD_COLORLESS then
begin
Bitmap.TransparentColor:=BGRtoRGB(self.FBackColor);
Bitmap.Transparent:=true;
end
else Bitmap.Transparent:=false;
Stream.Free;
end;

//从屏幕上的指定范围中截图，并导入数据，返回是否成功，
//如果失败将设置self.Error说明情况，
//Left：截图的左边距，可省略；
//Top：截图的顶边距，可省略；
//AWidth：截图的宽度，可省略；
//AHeight：截图的高度，可省略。
function TBDBitmapData.CopyFormScreen(Left,Top,AWidth,AHeight : Integer): Boolean;
var
Wnd : HWND;
DC,MemDC : HDC;
Bitmap,OldBitmap : HBITMAP;
BitInfo : TBitmapInfo;
begin
//参数调整
if (Left<0) or (Left>=ScreenWidth) then Left:=0;
if (Top<0) or (Top>=ScreenHeight) then Top:=0;
if AWidth< =0 then AWidth:=ScreenWidth-Left; if AHeight<=0 then AHeight:=ScreenHeight-Top; //数据初始化 self.FBackColor:=BD_COLORLESS; if not self.InitData(AWidth,AHeight) then begin result:=false; exit; end; //截图 Wnd:=GetDesktopWindow(); DC:=GetWindowDC(Wnd); MemDC:=CreateCompatibleDC(DC); Bitmap:=CreateCompatibleBitmap(DC,self.FWidth,self.FHeight); OldBitmap:=SelectObject(MemDC,Bitmap); result:=BitBlt(MemDC,0,0,self.FWidth,self.FHeight,DC,Left,Top,SRCCOPY); Bitmap:=SelectObject(MemDC,OldBitmap); if not result then begin DeleteDC(MemDC); DeleteObject(Bitmap); ReleaseDC(Wnd,DC); self.Error:='截图失败！'; exit; end; //位图信息初始化 with BitInfo.bmiHeader do begin biSize:=SizeOf(TBitmapInfoHeader); biWidth:=self.FWidth; biHeight:=self.FHeight; biPlanes:=1; biBitCount:=BD_BITCOUNT; biCompression:=BI_RGB; biSizeImage:=0; biXPelsPerMeter:=0; biYPelsPerMeter:=0; biClrUsed:=0; biClrImportant:=0; end; //提取数据 result:=GetDIBits(DC,Bitmap,0,self.FHeight,Pointer(self.FBits),BitInfo,DIB_RGB_COLORS)<>0;
if result then self.Error:=”
else self.Error:=’提取数据失败！’;
DeleteDC(MemDC);
DeleteObject(Bitmap);
ReleaseDC(Wnd,DC);
end;

//截取鼠标指针的位图，并导入数据，返回是否成功，
//如果失败将设置self.Error说明情况，
//如果鼠标指针是动画指针，默认截取第一帧画面。
function TBDBitmapData.CopyFormCursor: Boolean;
var
Wnd : HWND;
DC,MemDC : HDC;
Bitmap,OldBitmap : HBITMAP;
CurInfo : TCursorInfo;
BitInfo : TBitmapInfo;
begin
//数据初始化
self.FBackColor:=BD_COLORLESS;
self.InitData(IconWidth,IconHeight);
//获取鼠标指针信息
FillChar(CurInfo,SizeOf(TCursorInfo),0);
CurInfo.cbSize:=SizeOf(TCursorInfo);
if not GetCursorInfo(CurInfo) then
begin
self.Error:=’获取鼠标指针信息失败！’;
result:=false;
exit;
end;
//截取鼠标指针位图
Wnd:=GetDesktopWindow();
DC:=GetWindowDC(Wnd);
MemDC:=CreateCompatibleDC(DC);
Bitmap:=CreateCompatibleBitmap(DC,self.FWidth,self.FHeight);
OldBitmap:=SelectObject(MemDC,Bitmap);
result:=DrawIconEx(MemDC,0,0,CurInfo.hCursor,0,0,0,0,DI_IMAGE);
Bitmap:=SelectObject(MemDC,OldBitmap);
if not result then
begin
DeleteDC(MemDC);
DeleteObject(Bitmap);
ReleaseDC(Wnd,DC);
self.Error:=’截取鼠标指针位图失败！’;
exit;
end;
//位图信息初始化
with BitInfo.bmiHeader do
begin
biSize:=SizeOf(TBitmapInfoHeader);
biWidth:=self.FWidth;
biHeight:=self.FHeight;
biPlanes:=1;
biBitCount:=BD_BITCOUNT;
biCompression:=BI_RGB;
biSizeImage:=0;
biXPelsPerMeter:=0;
biYPelsPerMeter:=0;
biClrUsed:=0;
biClrImportant:=0;
end;
//提取数据
result:=GetDIBits(DC,Bitmap,0,self.FHeight,Pointer(self.FBits),BitInfo,DIB_RGB_COLORS)<>0;
if result then self.Error:=”
else self.Error:=’提取数据失败！’;
DeleteDC(MemDC);
DeleteObject(Bitmap);
ReleaseDC(Wnd,DC);
end;

//在当前位图的指定位置比较Bmp位图，返回是否一致，
//无论是否一致都不会修改self.Error，
//Bmp位图面幅要小于等于当前位图的面幅，Bmp位图不能超出当前位图，
//Bmp：位图数据；
//Left：比较时的左边距，可省略；
//Top：比较时的顶边距，可省略。
function TBDBitmapData.Compare(Bmp : TBDBitmapData; Left,Top : Integer): Boolean;
var
x,y,Off1,Off2 : Integer;
c1,c2 : TBDColor;
begin
if ((Left+Bmp.FWidth)>self.FWidth) or
((Top+Bmp.FHeight)>self.FHeight) then
begin
result:=false;
exit;
end;
Off1:=((self.FHeight-Bmp.FHeight-Top)*self.FLineWidth)+(Left*BD_BYTECOUNT);
Off2:=0;
result:=true;
for y:=0 to Bmp.FHeight-1 do
begin
for x:=0 to Bmp.FWidth-1 do
begin
c1:=((PInteger(@(self.FBits[Off1])))^ and $FFFFFF);
c2:=((PInteger(@(Bmp.FBits[Off2])))^ and $FFFFFF);
if (c1<>self.FBackColor) and (c2<>Bmp.FBackColor) and
(c1<>c2) then
begin
result:=false;
break;
end;
Off1:=Off1+3;
Off2:=Off2+3;
end;
if not result then break;
Off1:=Off1+(self.FLineWidth-Bmp.FLineWidth)+Bmp.FSpareWidth;
Off2:=Off2+Bmp.FSpareWidth;
end;
end;

//在当前位图的指定位置模糊比较Bmp位图，返回是否一致，
//无论是否一致都不会修改self.Error，
//Bmp位图面幅要小于等于当前位图的面幅，Bmp位图不能超出当前位图，
//Bmp：位图数据；
//Range：为颜色变化范围
//Left：比较时的左边距，可省略；
//Top：比较时的顶边距，可省略。
function TBDBitmapData.Compare(Bmp : TBDBitmapData; const Range : TBDColorRange; Left,Top : Integer): Boolean;
var
x,y,Off1,Off2 : Integer;
c1,c2 : TBDColor;
begin
if ((Left+Bmp.FWidth)>self.FWidth) or
((Top+Bmp.FHeight)>self.FHeight) then
begin
result:=false;
exit;
end;
Off1:=((self.FHeight-Bmp.FHeight-Top)*self.FLineWidth)+(Left*BD_BYTECOUNT);
Off2:=0;
result:=true;
for y:=0 to Bmp.FHeight-1 do
begin
for x:=0 to Bmp.FWidth-1 do
begin
c1:=((PInteger(@(self.FBits[Off1])))^ and $FFFFFF);
c2:=((PInteger(@(Bmp.FBits[Off2])))^ and $FFFFFF);
if (c1<>self.FBackColor) and (c2<>Bmp.FBackColor) and
(not BDCompareColor(c1,c2,Range)) then
begin
result:=false;
break;
end;
Off1:=Off1+3;
Off2:=Off2+3;
end;
if not result then break;
Off1:=Off1+(self.FLineWidth-Bmp.FLineWidth)+Bmp.FSpareWidth;
Off2:=Off2+Bmp.FSpareWidth;
end;
end;

//从当前位图中查找与Bmp一致的子图，返回是否找到，
//无论是否找到都不会修改self.Error，
//按从左到右，从上到下的顺序查找，
//找到返回true，设置Left和Top为找到子图的位置，
//没找到返回false，设置Left和Top为-1。
//Bmp：子图数据；
//Left：找到子图的左边距；
//Top：找到子图的顶边距。
function TBDBitmapData.FindImage(Bmp : TBDBitmapData; var Left,Top : Integer): Boolean;
var
x,y : Integer;
begin
result:=false; x:=0;
for y:=0 to self.FHeight-Bmp.FHeight-1 do
begin
for x:=0 to self.FWidth-Bmp.FWidth-1 do
begin
if self.Compare(Bmp,x,y) then
begin
result:=true;
break;
end;
end;
if result then break;
end;
if result then
begin
Left:=x; Top:=y;
end
else
begin
Left:=-1; Top:=-1;
end;
end;

//从当前位图中模糊查找与Bmp一致的子图，返回是否找到，
//无论是否找到都不会修改self.Error，
//按从左到右，从上到下的顺序查找，
//找到返回true，设置Left和Top为找到的位置，
//没找到返回false，设置Left和Top为-1。
//Bmp：子图数据；
//Range：为颜色变化范围；
//Left：找到子图的左边距；
//Top：找到子图的顶边距。
function TBDBitmapData.FindImage(Bmp : TBDBitmapData; const Range : TBDColorRange; var Left,Top : Integer): Boolean;
var
x,y : Integer;
begin
result:=false; x:=0;
for y:=0 to self.FHeight-Bmp.FHeight-1 do
begin
for x:=0 to self.FWidth-Bmp.FWidth-1 do
begin
if self.Compare(Bmp,Range,x,y) then
begin
result:=true;
break;
end;
end;
if result then break;
end;
if result then
begin
Left:=x; Top:=y;
end
else
begin
Left:=-1; Top:=-1;
end;
end;

//从当前位图中查找与Bmp一致的子图，返回是否找到，
//无论是否找到都不会修改self.Error，
//以（Left，Top）为基点，从中心向四周查找，
//找到返回true，设置Left和Top为找到子图的位置，
//没找到返回false，设置Left和Top为-1。
//Bmp：子图数据；
//Left：找到子图的左边距；
//Top：找到子图的顶边距。
function TBDBitmapData.FindCenterImage(Bmp : TBDBitmapData; var Left,Top : Integer): Boolean;
var
Aspect : TAspect;
VisitCount,Count,i : Integer;
begin
result:=false;
VisitCount:=0;
Aspect:=asUp;
Count:=1;
while VisitCount< (self.FWidth*self.FHeight) do begin for i:=0 to Count-1 do begin if (Left>=0) and (Left=0) and (Top=0) and (Left=0) and (Top=0) and (Left=0) and (Top=0) and (Left=0) and (Top