精华内容
下载资源
问答
  • VB 字符和ASCII码间的相互转换

    热门讨论 2010-06-07 10:45:41
    VB 字符和ASCII码间的相互转换 VB 字符和ASCII码间的相互转换
  • 我们在工控软件中,会经常使用到网口和串口,去接受和发送...发送的时候会将字符‘0’的ASCII码和字符‘6’的ASCII码发送出去,即是0x30和0x36。当我们以文本模式(ASCII)接收时就会收到06,当我们以16进制(HXE)接收时

    我们在工控软件中,会经常使用到网口和串口,去接受和发送数据。通常我们发送数据的模式有两种,一种16进制,一种是ASCII码。16进制的的经常会用来和仪器PLC等设备通讯。ACSII码是一种文本模式。

    1、当我们不点选16进制时,按文本模式发送。这是我们输入的文本区的内容是一个个字符。比如输入06,这时06为‘0’和‘6’两个字符。发送的时候会将字符‘0’的ASCII码和字符‘6’的ASCII码发送出去,即是0x30和0x36。当我们以文本模式(ASCII)接收时就会收到06,当我们以16进制(HXE)接收时就会收到0X30,0X36,其中0x代表16进制,不会在串口调试助手上显示出来,只会显示 30 36

    2、当我们按16进制发送06时,这时06为一个16进制数即0x06。当我们以文本模式(ASCII)接收时就会收到的为乱码,因为16进制的0x06的ASCII码是不可显示字符为ACK。当我们以16进制(HXE)接收时就会收到0X06,其中0x代表16进制,不会在串口调试助手上显示出来,只会显示06

     这就是为什么按16进制发送的效率要高于ASCII码的效率。从中我们也可以看出计算机底层发送数据是一个个数。

    注意:串口和网口接收回来,当你用char 类型的buf去接收的时候,其实已经进行一次转换了。这是它的十进制范围是-128—127。如果我们要将其变成无符号的数就要用byte类型的buf去接收,或者用char接收,强制转化为unsigned char类型。这样的它的十进制范围就变成了0~255。这样你就可以用多个buf 组成16,32位等数据了。
    加粗样式
    最后 总结

    计算机底层发送数据是一个个数。接收来之后,要我们自己按照自己的方式转换。

    常见的转换的函数用 itoa strtoul strtol atoi atof。多个字节转化要使用移位,取反等操作。

    都要大四了还搞不清这个概念也真是丢脸。

    首先,底层的数据传输都是字节流,所以不管选择什么方式,都会被分解为一个一个的字节。

    1、选择Hex发送就代表你要发送的内容是纯数字,由程序完成String到Int再到Byte的转化。所以你应该保证每个你要发送的数都是两位的,如果是7就应该写07,因为程序会每两位每两位地读。如果你选择了Hex发送,而输入的又是字符,比如你写了ab,那么就会被程序读为16进制的AB。这就是不同的概念了,无论你选择什么方式显示都不能得到原来的ab了。

    2、选择ASCII发送就代表你要发送的是字符串,这时候程序就会一位一位地读,比如你写了1234,在字节流中传递的就是123对应的ASCII码,31,32,33,34(十六进制的)。比较而言,在Hex发送模式下,写了1234,会被发送的就是12,34,如果是01020304那就是01,02,03,04。这个时候,你写ab就会发送相应的ASCII码61,62,其他字符同理。

    到这里,数据已经发送出去了,接下来就是显示的问题。是显示模式,不是解析,不存在解析。

    3、选择Hex显示就是把字节转化为16进制整型,你收到的是12,34,就显示为12,34,你收到31,32,33,34,也显示为31,32,33,34,如果收到AB呢,那也是AB。

    4、选择ASCII显示呢,就会把你接收到的十六进制转化为对应的字符,比如你收到了31,就会显示为1。这种模式下可能会出现乱码,原因就是ASCII码只从0-7f。如果你在十六进制发送模式下发送了字符,比如发送了ab,那你就会收到AB,这个并没有ASCII码对应的字符。

    所以在Hex模式下如果输入字符,是无论如何接收不到正确的数据的,其他方式那就随意了。重要的是,方式的选择改变的不是数据本身,而是数据的表现形式。

    参考文章:
    https://blog.csdn.net/u010154491/article/details/58592831
    https://blog.csdn.net/weixin_30372371/article/details/95550949
    https://blog.csdn.net/wuan584974722/article/details/54460220

    展开全文
  • VB实现PC向PLC发送读_写指令 vb控件设置应用
  • 字符串和ascii是不一样的把,怎么可以让单片机和一个支持串口通信的设备通信,哪个设备只能接收ascii,我用单片机发送给他的时候,应该是什么格式呢,ascii码一位即可,命令是2,3...9就这样的,单个数字
  • 我用VB编的程序,非常的小巧实用。 字符串可以随便输入,ASCII码输入时最前面不能有空格,每两个码字之间要用一个空格隔开,如75 76 7A
  • Mailmerge 是一个可以定制群发邮件的命令行程序,它可以处理简单和复杂的邮件。来源:https://linux.cn/article-12452-1.html作者:Brian "bex" Exelbierd译者:...尤其是在按队列将邮件发送给收件人的自动...

    3bf0474732b631823cf90ac54e9e7f88.png
    Mailmerge 是一个可以定制群发邮件的命令行程序,它可以处理简单和复杂的邮件。
    • 来源:https://linux.cn/article-12452-1.html
    • 作者:Brian "bex" Exelbierd
    • 译者:SilentDawn

    (本文字数:7599,阅读时长大约:9 分钟)

    电子邮件还是生活的一部分,尽管有种种不足,它仍然是大多数人发送信息的最佳方式,尤其是在按队列将邮件发送给收件人的自动化方式中。

    作为 Fedora 社区行动和影响协调员,我的工作之一就是给人们发送资助旅行相关的好消息,我经常通过电子邮件做这些事。这里,我将给你展示如何使用 Mailmerge 向一群人发送定制邮件的,Mailmerge 是一个可以处理简单和复杂的邮件的命令行程序。

    安装 Mailmerge

    在 Fedora 中,Mailmerge 已经打包可用,你可以通过在命令行中运行 sudo dnf install python3-mailmerge 来安装它。你还可以使用 pip 命令从 PyPi 中安装,具体可以参阅该项目的 README。

    配置 Mailmerge

    三个配置文件控制着 Mailmerge 的工作模式。运行 mailmerge --sample,将生成配置文件模板。这些文件包括:

    • mailmerge_server.conf: 这里保存着 SMTP 服务端邮件发送相关详细配置,但你的密码 在这里保存。
    • mailmerge_database.csv: 这里保存每封邮件的定制数据,包括收件人的电子邮件地址。
    • mailmerge_template.txt: 这里保存电子邮件的文本,文本中包含占位符,这些占位符会使用 mailmerge_database.csv 中的数据替换。

    Server.conf

    配置模板文件 mailmerge_server.conf 包含几个大家应该很熟悉的例子。如果你曾经往手机上添加过电子邮件或者设置过桌面电子邮件客户端,那你就应该看到过这些数据。需要提醒的是要记得把你的用户名更新到这个文件中,尤其是在你使用模板所提供的配置时。

    Database.csv

    mailmerge_database.csv 这个配置文件稍微有点复杂。最起码要将邮件接收者的电子邮件地址保存在这里,其它在电子邮件中任何需要替换的定制信息也要保存在这里。推荐在创建本文件的占位符列表时,同步编辑 mailmerge_template.txt 文件。我发现一个有效的做法是,使用电子表格软件录入这些数据,完成后导出为 CSV 文件。使用下面的示例文件:

    email,name,number
    myself@mydomain.com,"Myself",17
    bob@bobdomain.com,"Bob",42

    可以你向这两个人发送电子邮件,使用他们的名字并告诉他们一个数字。这个示例文件虽然不是特别有趣,但应用了一个重要的原则,那就是:始终让自己处于邮件接收列表的首位。这样你可以在向列表全员发送邮件之前,先给自己发送一个测试邮件,以验证邮件的效果是否如你预期。

    任何包含半角逗号的值,都 必须 以半角双引号(")封闭。如果恰好在半角双引号封闭的区域需要有一个半角双引号,那就在同一行中连续使用两个半角双引号。引号的规则比较有趣,去 Python 3 中关于 CSV 的内容中 一探究竟吧。

    Template.txt

    我的工作之一,就是为我们 Fedora 贡献者会议 Flock 发送与旅行基金有关的信息。通过简单的邮件告诉有关的人,他被选中为旅行基金支持的幸运者,以及相应基金支持的详细信息。与接收者相关的具体信息之一就是我们可以为他的旅行提供多少资助。下面是一份我的节略后的模板文件(为了简洁,已经移除大量的文本):

    $ cat mailmerge_template.txt
    TO: {{Email}}
    SUBJECT: Flock 2019 Funding Offer
    FROM: Brian Exelbierd <bexelbie@redhat.com>
    
    
    Hi {{Name}},
    
    
    I am writing you on behalf of the Flock funding committee.  You requested funding for your attendance at Flock.  After careful consideration we are able to offer you the following funding:
    
    
    Travel Budget: {{Travel_Budget}}
    
    
    <<snip>>

    模板的起头定义了邮件的接收者、发送者和主题。在空行之后,是邮件的内容。该邮件需要从 database.csv 文件中获取接收者的 EmailNameTravel_Budget 。注意,上述这些占位符是由双大括弧( {{}} )封闭的。相应的 mailmerge_database.csv 如下:

    $ cat mailmerge_database.csv
    Name,Email,Travel_Budget
    Brian,bexelbie@redhat.com,1000
    PersonA,persona@fedoraproject.org,1500
    PèrsonB,personb@fedoraproject.org,500

    注意,我把自己的信息放在了首条,这是为了测试方便。除了我,还有另外两个人的信息在文档中。列表中的第二个人 PèrsonB,他的名字中有一个包含变音符号的字母,Mailmerge 会对这类字母自动编码。

    以上包含了模板的全部知识点:写上你自己的电子邮件信息,并编写好以双大括弧封闭的占位符。接下来创建用来提供前述占位符具体值的数据文件。现在测试一下电子邮件的效果。

    测试并发送简单邮件

    试运行

    测试从邮件的试运行开始,试运行就是讲邮件内容显示出来,所有的占位符都会被具体值取代。默认情况下,如果你运行不带参数的命令 mailmerge,它将对收件列表中的第一个人进行试运行:

    $ mailmerge
    >>> encoding ascii
    >>> message 0
    TO: bexelbie@redhat.com
    SUBJECT: Flock 2019 Funding Offer
    FROM: Brian Exelbierd <bexelbie@redhat.com>
    MIME-Version: 1.0
    Content-Type: text/plain; charset="us-ascii"
    Content-Transfer-Encoding: 7bit
    Date: Sat, 20 Jul 2019 18:17:15 -0000
    
    
    Hi Brian,
    
    
    I am writing you on behalf of the Flock funding committee.  You requested funding for your attendance at Flock.  After careful consideration we are able to offer you the following funding:
    
    
    Travel Budget: 1000
    
    
    <<snip>>
    
    
    >>> sent message 0 DRY RUN
    >>> No attachments were sent with the emails.
    >>> Limit was 1 messages.  To remove the limit, use the --no-limit option.
    >>> This was a dry run.  To send messages, use the --no-dry-run option.

    从试运行生成的邮件中(列表中的 message 0 ,和计算机中很多计数场景一样,计数从 0 开始),可以看到我的名字及旅行预算是正确的。如果你想检视所有的邮件,运行 mailmerge --no-limit,告诉 Mailmerge 不要仅仅处理第一个收件人的信息。下面是第三个收件人邮件的试运行结果,用来测试特殊字符的编码:

    >>> message 2
    TO: personb@fedoraproject.org
    SUBJECT: Flock 2019 Funding Offer
    FROM: Brian Exelbierd <bexelbie@redhat.com>
    MIME-Version: 1.0
    Content-Type: text/plain; charset="iso-8859-1"
    Content-Transfer-Encoding: quoted-printable
    Date: Sat, 20 Jul 2019 18:22:48 -0000
    
    
    Hi P=E8rsonB,

    没有问题,P=E8rsonBPèrsonB 的编码形式。

    发送测试信息

    现在,运行 mailmerge --no-dry-run,Mailmerge 将向收件人列表中的第一个人发送电子邮件:

    $ mailmerge --no-dry-run
    >>> encoding ascii
    >>> message 0
    TO: bexelbie@redhat.com
    SUBJECT: Flock 2019 Funding Offer
    FROM: Brian Exelbierd <bexelbie@redhat.com>
    MIME-Version: 1.0
    Content-Type: text/plain; charset="us-ascii"
    Content-Transfer-Encoding: 7bit
    Date: Sat, 20 Jul 2019 18:25:45 -0000
    
    
    Hi Brian,
    
    
    I am writing you on behalf of the Flock funding committee.  You requested funding for your attendance at Flock.  After careful consideration we are able to offer you the following funding:
    
    
    Travel Budget: 1000
    
    
    <<snip>>
    
    
    >>> Read SMTP server configuration from mailmerge_server.conf
    >>>   host = smtp.gmail.com
    >>>   port = 587
    >>>   username = bexelbie@redhat.com
    >>>   security = STARTTLS
    >>> password for bexelbie@redhat.com on smtp.gmail.com:
    >>> sent message 0
    >>> No attachments were sent with the emails.
    >>> Limit was 1 messages.  To remove the limit, use the --no-limit option.

    在倒数第 4 行,它将要求你输入你的密码。如果你使用的是双因素认证或者域控制登录,那就需要创建应用密码来绕过这些控制。如果你使用的是 Gmail 或者类似的系统,可以直接在界面上完成密码验证。如果不行的话,联系你的邮件系统管理员。上述这些操作不会影响邮件系统的安全性,但是仍然有必要采用复杂的安全性好的密码。

    我在我的邮件收件箱中,看到了这封格式美观的测试邮件。如果测试邮件看起来没有问题,那就可以运行 mailmerge --no-dry-run --no-limit 发送所有的邮件了。

    发送复杂邮件

    只有充分了解了 Jinja2 模板 ,你才可能充分领略 Mailmerge 真正的威力。在邮件模板中使用条件语句及附带附件,是很有用的。下面就是一个复杂邮件的模板及对应的数据文件:

    $ cat mailmerge_template.txt
    TO: {{Email}}
    SUBJECT: Flock 2019 Funding Offer
    FROM: Brian Exelbierd <bexelbie@redhat.com>
    ATTACHMENT: attachments/{{File}}
    
    
    Hi {{Name}},
    
    
    I am writing you on behalf of the Flock funding committee.  You requested funding for your attendance at Flock.  After careful consideration we are able to offer you the following funding:
    
    
    Travel Budget: {{Travel_Budget}}
    {% if Hotel == "Yes" -%}
    Lodging: Lodging in the hotel Wednesday-Sunday (4 nights)
    {%- endif %}
    
    
    <<snip>>
    
    
    $ cat mailmerge_database.csv
    Name,Email,Travel_Budget,Hotel,File
    Brian,bexelbie@redhat.com,1000,Yes,visa_bex.pdf
    PersonA,persona@fedoraproject.org,1500,No,visa_person_a.pdf
    PèrsonB,personb@fedoraproject.org,500,Yes,visa_person_b.pdf

    在这个邮件中有两项新内容。首先是附件,我需要向参加国际旅行的人发送签证邀请信,帮助他们来 Flock,文件头的 ATTACHMENT 部分说明了要包含什么文件;为了保持我的文档目录清晰,我将所有需要作为附件的文档保存于附件子目录下。其次是包含了关于宾馆的条件信息,因为有些人的旅行资金包含了住宿费用,我需要对涉及住宿的人员诉及相关信息,而这是通过 if 判断实现的:

    {% if Hotel == "Yes" -%}
    Lodging: Lodging in the hotel Wednesday-Sunday (4 nights)
    {%- endif %}

    这和大多数编程语言中的 if 判断是一样的。Jinja2 实力非凡,可以实现多级判断。通过包含数据元素控制邮件内容,能大大简化相关的日常工作。空格的正确使用对邮件的易读性很重要。ifendif 语句中的短线( - )是 Jinja2 控制 空白字符 的一部分。这里面选项很多,所以还是要通过试验找到最适合自己的方式。

    在上面的例子中,我在数据文件扩充了 HotelFile 两个字段,这些字段的值控制着宾馆信息和附件文件名。另外,在上例中,我和 PèrsonB 有住宿资助,但 PersonA 没有。

    对于简单邮件和复杂邮件而言,试运行及正式发送邮件的操作都是相同的。快去试试吧!

    你还可以尝试在邮件头中使用条件判断( ifendif ),比如你可以使发送给在数据库中的某人的邮件包含附件,或者改变对部分人改变发送人的信息。

    Mailmerge 的优点

    Mailmerge 是用来批量发送定制邮件的简洁而高效的工具。每个人只接受到他需要的信息,其它额外的操作和细节都是透明的。

    我还发现,即使是在发送简单的集团邮件时,相对于使用 CC 或者 BCC 向一组受众发送一封邮件,采用 Mailmerge 也是非常高效的。很多人使用了邮件过滤,那些不是直接发给他们的邮件,他们一律不会立刻处理。使用 Mailmerge 保证了每名接收者收到的就是自己的邮件。所有的信息会对接收者进行正确过滤,再也不会有人无意间回复到整个邮件组。


    展开全文
  • If (Handle = -1) Or (Len(StrConv(Data, vbUnicode)) = 0) Then Exit Function PurgeComm Handle, PURGE_RXABORT Or PURGE_RXCLEAR '清空输入缓冲区 WriteFile Handle, Data(0), UBound(Data) + 1, ComWriteByte...

    分三模块

    modSerialPort.bas 串口操作模块

    modTCPClient.bas TCP操作模块

    modModbusMaster.bas Modbus主站模块

    实现代码例举如下

    '打开
    
    hModbus=ModbusOpen("Com1",ModbusRTU) '或者
    
    hModbus=ModbusOpen("192.168.1.2:502",ModbusTCP)
    
    
    '读取
    if ModbusRead(hModbus,1,InputStatus,0,IntArr,ModbusRTU)=True then
    '读取成功
    else
    '读取失败
    end
    
    '写入
    if ModbusWrite(hModbus,1,HoldingRegister,0,IntArr,ModbusRTU)=True then
    '写入成功
    else
    '写入失败
    end
    
    
    '关闭
    ModbusClose(hModbus,ModbusRTU)
    补充示例下载 点击打开链接

     
    

    ===========================================================================

    modSerialPort.bas

    Option Explicit
    Private Const DEFAULT_QUEUE = 1024
    Private Const DEFAULT_WAIT_TIME = 50
    
    Private Const GENERIC_READ = &H80000000
    Private Const GENERIC_WRITE = &H40000000
    Private Const OPEN_EXISTING = 3              '
    Private Const PURGE_RXABORT = &H2
    Private Const PURGE_RXCLEAR = &H8
    
    'Utils
    Private Const SYNCHRONIZE = &H100000
    Private Const STANDARD_RIGHTS_READ = &H20000
    Private Const ERROR_SUCCESS = 0&
    Private Const HKEY_LOCAL_MACHINE = &H80000002
    Private Const KEY_ENUMERATE_SUB_KEYS = &H8
    Private Const KEY_NOTIFY = &H10
    Private Const KEY_QUERY_VALUE = &H1
    Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
    Private Const REG_DWORD = 4
    
    'COM
    Private Type COMMTIMEOUTS
            ReadIntervalTimeout As Long
            WriteTotalTimeoutConstant As Long
            ReadTotalTimeoutConstant As Long
            WriteTotalTimeoutMultiplier As Long
            ReadTotalTimeoutMultiplier As Long
    End Type
    
    Private Type COMSTAT
            fBitFields As Long
            cbInQue As Long
            cbOutQue As Long
    End Type
    
    Private Type DCB
        DCBlength As Long
        Baudrate As Long
        fBitFields As Long 'See Comments in Win32API.Txt
        wReserved As Integer
        XonLim As Integer
        XoffLim As Integer
        ByteSize As Byte
        Parity As Byte
        StopBits As Byte
        XOnChar As Byte
        XOffChar As Byte
        ErrorChar As Byte
        EofChar As Byte
        EvtChar As Byte
        wReserved1 As Integer 'Reserved; Do Not Use
    End Type
    
    Private Type OVERLAPPED
        ternal As Long
        hEvent As Long
        offset As Long
        OffsetHigh As Long
        ternalHigh As Long
    End Type
    
    Private Type SECURITY_ATTRIBUTES
            nLength As Long
            bInheritHandle As Long
            lpSecurityDescriptor As Long
    End Type
    
    'Common
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    'COM
    Private Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
    Private Declare Function ClearCommError Lib "kernel32" (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long
    Private Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long
    Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
    Private Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
    Private Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
    Private Declare Function SetupComm Lib "kernel32" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
    Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long
    'Utils
    Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
    Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As String, lpcbData As Long) As Long
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    
    'Utils
    Public Function EnumSerialPorts() As String  '枚举已存在的串口
        Dim hKey As Long, ID As Long, Result As String
        Dim Value As String, ValueLength As Long, Data As String, DataLength As Long
        Result = ""
        If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM", 0&, KEY_READ, hKey) = ERROR_SUCCESS Then
            Do
                ValueLength = 2000
                DataLength = 2000
                Value = String(ValueLength, Chr(32))  '注册项
                Data = String(DataLength, Chr(32)) '值 Com 名称
                If RegEnumValue(hKey, ID, ByVal Value, ValueLength, 0&, REG_DWORD, ByVal Data, DataLength) = ERROR_SUCCESS Then
                    Result = Result & IIf(Len(Result) = 0, "", ",") & Trim(Replace(Left(Data, DataLength), Chr(0), Chr(32)))
                Else
                    Exit Do
                End If
                ID = ID + 1
            Loop
            RegCloseKey hKey
        End If
        EnumSerialPorts = Result
    End Function
    
    'COM
    Public Sub ComClose(ByRef Handle As Long)
        If Handle = -1 Then Exit Sub
        CloseHandle Handle
        Handle = -1
    End Sub
    
    Public Function ComOpen(ByVal Port As String, Optional ByVal Settings As String = "9600,n,8,1", Optional ByVal dwInQueue As Long = DEFAULT_QUEUE, Optional ByVal dwOutQueue As Long = DEFAULT_QUEUE) As Long
        Dim Result As Long, lpDCB As DCB, lpCommTimeouts As COMMTIMEOUTS, lpSA As SECURITY_ATTRIBUTES
        ComOpen = -1
        If IsNumeric(Port) Then
            Port = "\\.\Com" & Port
        Else
            Port = "\\.\" & Port
        End If
        Result = CreateFile(Port, GENERIC_READ Or GENERIC_WRITE, 0&, lpSA, OPEN_EXISTING, 0, 0&)
        If Result = -1 Then Exit Function
        If GetCommState(Result, lpDCB) = 0 Then
            CloseHandle Result
            Exit Function
        End If
        BuildCommDCB Settings, lpDCB
        If SetCommState(Result, lpDCB) = 0 Then
            CloseHandle Result
            Exit Function
        End If
        SetupComm Result, dwInQueue, dwOutQueue  '分配串口缓冲区
        '设定通讯超时参数
        lpCommTimeouts.ReadIntervalTimeout = 2
        lpCommTimeouts.ReadTotalTimeoutConstant = 4
        lpCommTimeouts.ReadTotalTimeoutMultiplier = 3
        lpCommTimeouts.WriteTotalTimeoutConstant = 5000 '一次写入串口数据的固定超时。
        lpCommTimeouts.WriteTotalTimeoutMultiplier = 50 '写入每字符间的超时。
        SetCommTimeouts Result, lpCommTimeouts
        ComOpen = Result
    End Function
    
    Public Function ComReadByte(ByVal Handle As Long, ByRef Result() As Byte, Optional ByVal WaitTime As Long = DEFAULT_WAIT_TIME) As Long
        Dim lpOverlapped As OVERLAPPED, lpStat As COMSTAT, lpErrors As Long
        If Handle = -1 Then Exit Function
        ComReadByte = 0
        If WaitTime > 0 Then Sleep WaitTime
        ClearCommError Handle, lpErrors, lpStat
        If lpStat.cbInQue > 0 Then
            ReDim Result(DEFAULT_QUEUE - 1) '设置缓冲区大小1K
            ReadFile Handle, Result(0), lpStat.cbInQue, ComReadByte, lpOverlapped
            If ComReadByte > 0 Then
                ReDim Preserve Result(ComReadByte - 1)
            Else
                Erase Result
            End If
        End If
    End Function
    
    Public Function ComWriteByte(ByVal Handle As Long, ByRef Data() As Byte) As Long
        Dim lpOverlapped As OVERLAPPED, lpErrors As Long, lpStat As COMSTAT
        If (Handle = -1) Or (Len(StrConv(Data, vbUnicode)) = 0) Then Exit Function
        PurgeComm Handle, PURGE_RXABORT Or PURGE_RXCLEAR  '清空输入缓冲区
        WriteFile Handle, Data(0), UBound(Data) + 1, ComWriteByte, lpOverlapped
        Do
            ClearCommError Handle, lpErrors, lpStat
        Loop Until lpStat.cbOutQue = 0  '等待输出结束
    End Function

    ======================================================================

    modTCPClient.bas

    Option Explicit
    Private Const DEFAULT_QUEUE = 1024
    Private Const DEFAULT_WAIT_TIME = 50
    
    'TCP
    Private Const WSA_DescriptionLen = 256
    Private Const WSA_DescriptionSize = WSA_DescriptionLen + 1
    Private Const WSA_SYS_STATUS_LEN = 128
    Private Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
    Private Const AF_INET = 2
    Private Const SOCK_STREAM = 1
    Private Const IPPROTO_TCP = 6
    Private Const INADDR_NONE = &HFFFF
    Private Const SOCKET_ERROR = -1
    
    Private Type HostEnt
        hName As Long
        hAliases As Long
        hAddrType As Integer
        hLength As Integer
        hAddrList As Long
    End Type
    
    Private Type SockAddr
        Sin_Family As Integer
        Sin_Port As Integer
        Sin_Addr As Long
        Sin_Zero(7) As Byte
    End Type
    
    Private Type WSADataType
        wVersion As Integer
        wHighVersion As Integer
        szDescription As String * WSA_DescriptionSize
        szSystemStatus As String * WSA_SysStatusSize
        iMaxSockets As Integer
        iMaxUdpDg As Integer
        lpVendorInfo As Long
    End Type
    
    'Common
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    'TCP
    Private Declare Function CloseSocket Lib "ws2_32.dll" Alias "closesocket" (ByVal hSocket As Long) As Long
    Private Declare Function Connect Lib "ws2_32.dll" Alias "connect" (ByVal hSocket As Long, Addr As SockAddr, ByVal NameLen As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function GetHostByName Lib "ws2_32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
    Private Declare Function Htons Lib "ws2_32.dll" Alias "htons" (ByVal HostShort As Integer) As Integer
    Private Declare Function iNet_Addr Lib "wsock32.dll" Alias "inet_addr" (ByVal S As String) As Long
    Private Declare Function Recv Lib "ws2_32.dll" Alias "recv" (ByVal hSocket As Long, Buf As Any, ByVal BufLen As Long, ByVal Flags As Long) As Long
    Private Declare Function Send Lib "ws2_32.dll" Alias "send" (ByVal hSocket As Long, Buf As Any, ByVal BufLen As Long, ByVal Flags As Long) As Long
    Private Declare Function Socket Lib "ws2_32.dll" Alias "socket" (ByVal af As Long, ByVal sType As Long, ByVal Protocol As Long) As Long
    Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
    Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
    
    '=================================
    '名称   GetHostByNameAlias
    '参数   HostName  String 主机名
    '返回   Long
    '说明   将主机名转换成IP地址
    '日期   2015-04-08
    '=================================
    Public Function GetHostByNameAlias(ByVal HostName As String) As Long
        Dim Result As Long, hHost As HostEnt
        GetHostByNameAlias = iNet_Addr(HostName)
        If GetHostByNameAlias = INADDR_NONE Then
            Result = GetHostByName(HostName)
            If Result <> 0 Then
                CopyMemory hHost, ByVal Result, LenB(hHost)
                CopyMemory Result, ByVal hHost.hAddrList, LenB(Result)
                CopyMemory GetHostByNameAlias, ByVal Result, hHost.hLength
            End If
        End If
    End Function
    
    Public Sub TCPClose(ByRef Handle As Long)
        CloseSocket Handle
        WSACleanup
        Handle = -1
    End Sub
    
    Public Function TCPOpen(ByVal Host As String, Optional ByVal Port As Long = 502) As Long
        Dim WSAData As WSADataType, SA As SockAddr, Result As Long
        If WSAStartup(&H202, WSAData) <> 0 Then
            WSACleanup
        Else
            If (InStr(Host, ":") > 0) Then
                If IsNumeric(Right(Host, Len(Host) - InStr(Host, ":"))) = True Then
                    Port = CLng(Right(Host, Len(Host) - InStr(Host, ":")))
                End If
                Host = Left(Host, InStr(Host, ":") - 1)
            End If
            Result = Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
            SA.Sin_Family = AF_INET
            SA.Sin_Port = Htons(CInt("&H" & Hex(Port)))
            SA.Sin_Addr = GetHostByNameAlias(Host)
            If Connect(Result, SA, LenB(SA)) = SOCKET_ERROR Then
                WSACleanup
                Result = -1
            End If
        End If
        TCPOpen = Result
    End Function
    
    Public Function TCPReadByte(ByVal Handle As Long, ByRef Result() As Byte, Optional ByVal WaitTime As Long = DEFAULT_WAIT_TIME) As Long
        Dim T As Double, I As Integer
        If Handle = -1 Then Exit Function
        If WaitTime > 0 Then Sleep WaitTime
        ReDim Result(DEFAULT_QUEUE - 1)
        TCPReadByte = Recv(Handle, Result(0), UBound(Result) + 1, 0)
        If TCPReadByte > 0 Then
            ReDim Preserve Result(TCPReadByte - 1)
        Else
            Erase Result
        End If
    End Function
    
    Public Function TCPWriteByte(ByRef Handle As Long, ByRef Data() As Byte) As Boolean
        TCPWriteByte = -1
        If (Len(StrConv(Data, vbUnicode)) = 0) Or (Handle = -1) Then Exit Function '检查数据包大小
        TCPWriteByte = Send(Handle, Data(0), UBound(Data) + 1, 0)
        If TCPWriteByte = -1 Then  '通讯故障
            Select Case Err.LastDllError
                Case 10053
                    TCPClose Handle
                Case Else
                    'Debug.Print Err.LastDllError
            End Select
        Else
            TCPWriteByte = True
        End If
    End Function

    ==============================================================

    modModbusMaster.bas

    Option Explicit
    Private Const DEFAULT_QUEUE = 1024
    Private Const DEFAULT_WAIT_TIME = 50
    Private Const DEFAULT_RETRY_COUNT = 3
    Private Const DEFAULT_PROTOCOL = 0
    
    'Modbus
    Public Enum ModbusProtocolType
        ModbusRTU = 0
        ModbusASCII = 1
        ModbusTCP = 2
    End Enum
    
    Public Enum ModbusRegistersType
        CoilStatus = 1
        InputStatus = 2
        HoldingRegister = 3
        InputRegister = 4
    End Enum
    
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    
    'Modbus
    Private Function ArrToHex(ByRef Arr() As Byte) As String
        Dim I As Integer, Result As String
        For I = 0 To UBound(Arr)
            Result = Result & Hex(Arr(I), 2)
        Next
        ArrToHex = Result
    End Function
    
    Private Function Hex(ByVal Number As Variant, Optional ByVal Length As Integer = 0) As String
        Dim Result As String
        Result = VBA.Hex(Number)
        If Len(Result) < Length Then Result = String(Length - Len(Result), "0") & Result
        Hex = Result
    End Function
    
    Private Sub HexToArr(Str As String, ByRef Result() As Byte)
        Dim C As Integer, I As Integer, CH As String
        C = Len(Str) \ 2 - 1
        ReDim Result(C)
        For I = 0 To C
            CH = Mid(Str, I * 2 + 1, 2)
            Result(I) = CByte("&H" & CH)
        Next
    End Sub
    
    Private Sub GetCRC16(ByRef Data() As Byte, ByRef Result() As Byte, Optional ByVal offset As Integer = 0, Optional ByVal Length As Integer = 0)
        Dim CRC16Lo As Byte, CRC16Hi As Byte      'CRC寄存器
        Dim CL As Byte, CH As Byte                '多项式码&HA001
        Dim SaveHi As Byte, SaveLo As Byte
        Dim I As Integer
        Dim Flag As Integer
        
        CRC16Lo = &HFF
        CRC16Hi = &HFF
        CL = &H1
        CH = &HA0
        Length = IIf(Length < 1, UBound(Data) - offset, Length - 1)   'Update 2007-03-15
        For I = offset To offset + Length
            CRC16Lo = CRC16Lo Xor Data(I) '每一个数据与CRC寄存器进行异或
            For Flag = 0 To 7
                SaveHi = CRC16Hi
                SaveLo = CRC16Lo
                CRC16Hi = CRC16Hi \ 2            '高位右移一位
                CRC16Lo = CRC16Lo \ 2            '低位右移一位
                If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1
                    CRC16Lo = CRC16Lo Or &H80      '则低位字节右移后前面补1
                End If                           '否则自动补0
                If ((SaveLo And &H1) = &H1) Then '如果LSB为1,则与多项式码进行异或
                    CRC16Hi = CRC16Hi Xor CH
                    CRC16Lo = CRC16Lo Xor CL
                End If
            Next
        Next
        ReDim Result(1)
        Result(0) = CRC16Lo              'CRC低位
        Result(1) = CRC16Hi              'CRC高位
    End Sub
    
    '=================================
    '名称   GetLRC
    '参数   Data    Byte()  数据内容
    '       Offset  Integer 数组起始位置,默认值 0(从数组第一个元素开始)
    '       Length  Integer 计算长度,默认值 0(计算整个数组)
    '返回   Byte
    '说明   计算LRC值,Modbus ASCII中的校验码
    '日期   2014-10-05
    '=================================
    Private Function GetLRC(Data() As Byte, Optional ByVal offset As Integer = 0, Optional ByVal Length As Integer = 0) As Byte
        Dim I As Integer, Result As Byte
        If Length = 0 Then Length = UBound(Data) + 1
        Result = 0
        For I = offset To offset + Length - 1
            Result = (CInt(Result) + Data(I)) Mod 256
        Next
        If Result<>0 Then Result = ((Not Result) + 1)
        GetLRC = Result
    End Function
    
    Private Sub PacketFrom(ByRef Data() As Byte, ByRef Result() As Byte, ByVal Protocol As ModbusProtocolType, Optional ByVal TCPID As Long = 0)  '协议校验
        Dim I As Integer, C As Long, Str As String
        Dim CRC() As Byte, Arr() As Byte
        If Len(StrConv(Data, vbUnicode)) = 0 Then Exit Sub
        C = UBound(Data) + 1
        If C < 5 Then Exit Sub      '数据包长度过滤
        Select Case Protocol
            Case ModbusRTU    '0
                GetCRC16 Data, CRC, 0, C - 2
                If CRC(0) = Data(C - 2) And CRC(1) = Data(C - 1) Then 'CRC检查
                    ReDim Result(C - 3)
                    CopyMemory Result(0), Data(0), C - 2
                End If
            Case ModbusASCII  '1
                If (Data(0) = 58) And (Data(C - 1) = 10) And (Data(C - 2) = 13) Then '头尾标记检查
                    Str = StrConv(Data, vbUnicode)
                    HexToArr Mid(Str, 2, Len(Str) - 3), Arr
                    C = UBound(Arr)
                    If GetLRC(Arr, , C - 1) = Arr(C) Then 'LRC检查
                        ReDim Result(C - 1)
                        CopyMemory Result(0), Arr(0), C - 1
                    End If
                End If
            Case ModbusTCP    '2
                If Data(2) * 256 + Data(3) = 0 Then 'Modbus标记检查
                    C = Data(4) * 256 + Data(5)
                    If C = UBound(Data) - 5 Then '数据长度检查
                        ReDim Result(C - 1)
                        CopyMemory Result(0), Data(6), C
                    End If
                End If
            Case Else
                '
        End Select
        Erase Arr
        Erase CRC
    End Sub
    
    Private Sub PacketTo(ByRef Data() As Byte, ByRef Result() As Byte, ByVal Protocol As ModbusProtocolType, Optional ByVal TCPID As Long = 0) '协议封包
        Dim CRC() As Byte, L As Long, Str As String
        If Len(StrConv(Data, vbUnicode)) = 0 Then Exit Sub
        L = UBound(Data) + 1
        Select Case Protocol
            Case ModbusRTU   '0
                ReDim Result(L + 1)
                GetCRC16 Data, CRC
                CopyMemory Result(0), Data(0), L
                CopyMemory Result(L), CRC(0), 2
            Case ModbusASCII  '1
                ReDim CRC(L)
                CopyMemory CRC(0), Data(0), L
                CRC(L) = GetLRC(Data)
                Result = StrConv(":" & ArrToHex(CRC) & vbCrLf, vbFromUnicode)
            Case ModbusTCP    '2
                ReDim Result(L + 5)
                CopyMemory Result(6), Data(0), L
                Result(0) = TCPID \ 256
                Result(1) = TCPID Mod 256
                Result(2) = 0
                Result(3) = 0
                Result(4) = L \ 256
                Result(5) = L Mod 256
            Case Else
                '
        End Select
        Erase CRC
    End Sub
    
    
    Public Sub ModbusClose(ByRef Handle As Long, Optional ByVal Protocol As ModbusProtocolType = DEFAULT_PROTOCOL)
        Select Case Protocol
            Case ModbusASCII, ModbusRTU
                ComClose Handle
            Case ModbusTCP
                TCPClose Handle
        End Select
    End Sub
    
    Public Function ModbusOpen(ByVal ModbusPort As String, Optional ByVal Protocol As ModbusProtocolType = DEFAULT_PROTOCOL, Optional ByVal ModbusSettings As String = "9600,n,8,1") As Long
        Dim Result As Long
        Select Case Protocol
            Case ModbusASCII, ModbusRTU
                Result = ComOpen(ModbusPort, ModbusSettings)
            Case ModbusTCP
                If IsNumeric(ModbusSettings) = False Then ModbusSettings = "502"
                Result = TCPOpen(ModbusPort, CLng(ModbusSettings))
        End Select
        ModbusOpen = Result
    End Function
    
    Public Function ModbusRead(ByVal Handle As Long, ByVal ID As Byte, ByVal RegType As ModbusRegistersType, ByVal Address As Long, ByRef Registers As Variant, Optional ByVal Protocol As ModbusProtocolType = DEFAULT_PROTOCOL, Optional ByVal WaitTime As Integer = DEFAULT_WAIT_TIME, Optional ByVal ReTryCount As Byte = DEFAULT_RETRY_COUNT) As Boolean
        Dim Result As Boolean, I As Long, Count As Long, Data() As Byte, Arr() As Byte, ArrR() As Byte, TryCount As Integer
        If Handle = -1 Then Exit Function
        If IsArray(Registers) Then
            Count = UBound(Registers) + 1
        Else
            Count = 1
        End If
        If Count < 1 Then Exit Function
        
        ReDim Data(5)
        Data(0) = ID '设备地址
        Data(1) = RegType '功能码
        Data(2) = (Address And &HFF00&) \ 256 '寄存器地址高字节
        Data(3) = Address Mod 256 '寄存器地址低字节
        Data(4) = Count \ 256  '寄存器数量高字节
        Data(5) = Count Mod 256 '寄存器数量低字节
        TryCount = 1
        Do Until TryCount > ReTryCount
            PacketTo Data, Arr, Protocol
            Select Case Protocol
                Case ModbusASCII, ModbusRTU
                    ComWriteByte Handle, Arr
                Case ModbusTCP
                    TCPWriteByte Handle, Arr
            End Select
            Erase Arr
            If ID = 0 Then '特殊情况,群发了一条读指令
                Erase Data
                ModbusRead = True
                Exit Function
            Else
                Select Case Protocol
                    Case ModbusASCII, ModbusRTU
                        ComReadByte Handle, Arr, WaitTime
                        PacketFrom Arr, ArrR, Protocol
                    Case ModbusTCP
                        TCPReadByte Handle, Arr, WaitTime
                        PacketFrom Arr, ArrR, Protocol
                End Select
                Erase Arr
                If Len(StrConv(ArrR, vbUnicode)) > 0 Then Exit Do
            End If
            TryCount = TryCount + 1
        Loop
        Erase Data
        If Len(StrConv(ArrR, vbUnicode)) > 0 Then
            Select Case ArrR(1)
                Case &H1, &H2 '0x01[读写量] 0x02[只读量]
                    If IsArray(Registers) Then
                        If ArrR(2) <> IIf(Count Mod 8 = 0, Count \ 8, Count \ 8 + 1) Then
                            Erase ArrR
                            Exit Function
                        End If
                        For I = 0 To Count - 1
                            Registers(I) = CByte(IIf((ArrR(I \ 8 + 3) And 2 ^ (I Mod 8)) = 0, 0, 1))
                        Next
                    Else
                        If UBound(ArrR) < 3 Then
                            Erase ArrR
                            Exit Function
                        End If
                        Registers = CByte(ArrR(3))
                    End If
                    Result = True
                Case &H3, &H4 '0x03[读写寄存器] 0x04[只读寄存器]
                    If IsArray(Registers) Then
                        If ArrR(2) <> Count * 2 Then
                            Erase ArrR
                            Exit Function
                        End If
                        For I = 0 To Count - 1
                            Select Case VarType(Registers(I))
                                Case vbLong
                                    Registers(I) = CLng("&H" & Hex(ArrR(I * 2 + 3), 2) & Hex(ArrR(I * 2 + 4), 2))
                                Case vbInteger
                                    Registers(I) = CInt("&H" & Hex(ArrR(I * 2 + 3), 2) & Hex(ArrR(I * 2 + 4), 2))
                            End Select
                        Next
                    Else
                        If UBound(ArrR) < 4 Then
                            Erase ArrR
                            Exit Function
                        End If
                        Select Case VarType(Registers)
                            Case vbLong
                                Registers = CLng("&H" & Hex(ArrR(3), 2) & Hex(ArrR(4), 2))
                            Case vbInteger
                                Registers = CInt("&H" & Hex(ArrR(3), 2) & Hex(ArrR(4), 2))
                        End Select
                    End If
                    Result = True
                Case Else
                    '
            End Select
        End If
        Erase ArrR
        ModbusRead = Result
    End Function
    
    Public Function ModbusWrite(ByVal Handle As Long, ByVal ID As Byte, ByVal RegType As ModbusRegistersType, ByVal Address As Long, ByRef Registers As Variant, Optional ByVal SingleWrite As Boolean = False, Optional ByVal Protocol As ModbusProtocolType = DEFAULT_PROTOCOL, Optional ByVal WaitTime As Integer = DEFAULT_WAIT_TIME, Optional ByVal ReTryCount As Byte = DEFAULT_RETRY_COUNT) As Boolean
        Dim Result As Boolean, I As Long, FunCode As Byte, Count As Long, Data() As Byte, Arr() As Byte, ArrR() As Byte, TryCount As Integer, Value As Long
        If Handle = -1 Then Exit Function
        If IsArray(Registers) Then
            Count = UBound(Registers) + 1
        Else
            Count = 1
        End If
        Select Case RegType
            Case CoilStatus ' 1
                FunCode = IIf((Count = 1) And (SingleWrite = True), &H5, &HF)
            Case HoldingRegister ' 3
                FunCode = IIf((Count = 1) And (SingleWrite = True), &H6, &H10)
            Case Else
                FunCode = 0
        End Select
        If (Count < 1) Or (FunCode = 0) Then Exit Function
        Result = False
        Select Case FunCode
            Case &H5, &H6 '0x05[写单个点]  0x06[写单个寄存器]
                ReDim Data(5)
                Data(0) = ID
                Data(1) = FunCode
                Data(2) = (Address And &HFF00&) \ 256 '寄存器地址高字节
                Data(3) = Address Mod 256 '寄存器地址低字节
                If FunCode = &H5 Then
                    If IsArray(Registers) Then
                        Value = IIf(Registers(0) = 0, 0&, &HFF00&)
                    Else
                        Value = IIf(Registers = 0, 0&, &HFF00&)
                    End If
                Else
                    If IsArray(Registers) Then
                        Value = CLng("&H" & Hex(Registers(0)))
                    Else
                        Value = CLng("&H" & Hex(Registers))
                    End If
                End If
                Data(4) = Value \ 256  '写入值高字节
                Data(5) = Value Mod 256 '写入值低字节
            Case &HF '0x0F 写多个点
                ReDim Data(6 + IIf(Count Mod 8 = 0, Count \ 8, Count \ 8 + 1))
                Data(0) = ID
                Data(1) = FunCode
                Data(2) = (Address And &HFF00&) \ 256 '寄存器地址高字节
                Data(3) = Address Mod 256 '寄存器地址低字节
                Data(4) = Count \ 256  '寄存器数量高字节
                Data(5) = Count Mod 256 '寄存器数量低字节
                Data(6) = IIf(Count Mod 8 = 0, Count \ 8, Count \ 8 + 1) '字节数
                If IsArray(Registers) Then
                    For I = 0 To Count - 1
                        If Registers(I) <> 0 Then Data(7 + I \ 8) = Data(7 + I \ 8) Or 2 ^ (I Mod 8)
                    Next
                Else
                    Data(7) = IIf(Registers <> 0, 1, 0)
                End If
            Case &H10 '0x10 写多个寄存器
                If Count > &H78 Then Exit Function '写入数量过多
                ReDim Data(6 + Count * 2)
                Data(0) = ID
                Data(1) = FunCode
                Data(2) = (Address And &HFF00&) \ 256 '寄存器地址高字节
                Data(3) = Address Mod 256 '寄存器地址低字节
                Data(4) = Count \ 256 '寄存器数量高字节
                Data(5) = Count Mod 256 '寄存器数量低字节
                Data(6) = Count * 2 '字节数
                If IsArray(Registers) Then
                    For I = 0 To Count - 1
                        Value = CLng("&H" & Hex(Registers(I))) And &HFFFF&
                        Data(7 + I * 2) = Value \ 256 '高字节
                        Data(8 + I * 2) = Value Mod 256 '低字节
                    Next
                Else
                    Value = CLng("&H" & Hex(Registers)) And &HFFFF&
                    Data(7) = Value \ 256  '高字节
                    Data(8) = Value Mod 256  '低字节
                End If
            Case Else
                '
        End Select
        If Len(StrConv(Data, vbUnicode)) > 0 Then
            TryCount = 1
            Do Until TryCount > ReTryCount
                PacketTo Data, Arr, Protocol
                Select Case Protocol
                    Case ModbusASCII, ModbusRTU
                        ComWriteByte Handle, Arr
                    Case ModbusTCP
                        TCPWriteByte Handle, Arr
                End Select
                Erase Arr
                If ID = 0 Then '特殊情况,群发了一条读指令
                    ModbusWrite = True
                    Exit Function
                Else
                    Select Case Protocol
                        Case ModbusASCII, ModbusRTU
                            ComReadByte Handle, Arr, WaitTime
                            PacketFrom Arr, ArrR, Protocol
                        Case ModbusTCP
                            TCPReadByte Handle, Arr, WaitTime
                            PacketFrom Arr, ArrR, Protocol
                    End Select
                    Erase Arr
                    If Len(StrConv(ArrR, vbUnicode)) > 0 Then Exit Do
                End If
                TryCount = TryCount + 1
            Loop
            Erase Data
            If Len(StrConv(ArrR, vbUnicode)) > 0 Then
                Result = CBool(FunCode = ArrR(1))
            End If
        End If
        Erase ArrR
        ModbusWrite = Result
    End Function
    
    'Utils
    Public Function Readbit(ByVal Address As Long, ByRef Registers() As Byte) As Integer
        Readbit = IIf(Registers(Address \ 8) And CByte(2 ^ (Address Mod 8)), 1, 0)
    End Function
    
    Public Sub Writebit(ByVal Address As Long, ByVal Value As Long, ByRef Registers() As Byte)
        If Value = 0 Then
            Registers(Address \ 8) = Registers(Address \ 8) And (Not CByte(2 ^ (Address Mod 8)))
        Else
            Registers(Address \ 8) = Registers(Address \ 8) Or CByte(2 ^ (Address Mod 8))
        End If
    End Sub
    
    Public Function ReadWord(ByVal Address As Long, ByRef Registers() As Byte) As Integer
        CopyMemory ReadWord, Registers(Address * 2), 2
    End Function
    
    Public Sub WriteWord(ByVal Address As Long, ByVal Value As Integer, ByRef Registers() As Byte)
        CopyMemory Registers(Address * 2), Value, 2
    End Sub



    展开全文
  • VB实现向窗口发送按键消息 : 嵌入式模拟键盘 待解决问题 vb WM_KEYDOWN 参数设置???? id=“question_content”>Private Declare Function FindWindow Lib “user32” Alias “FindWindowA” (ByVal ...

    VB实现向窗口发送按键消息 : 嵌入式模拟键盘

    待解决问题 vb WM_KEYDOWN 参数设置????

    id=“question_content”>Private Declare Function FindWindow Lib “user32” Alias “FindWindowA” (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function PostMessage Lib “user32” Alias “PostMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim cqhwnd As Long
    Private Const VK_F1 = &H70
    Private Const WM_KEYDOWN = &H100
    Private Const WM_KEYUP = &H101
    Private Const WM_CLOSE = &H10

    Private Sub Command2_Click()
    PostMessage cqhwnd, WM_KEYDOWN, VK_A, 0&
    PostMessage cqhwnd, WM_KEYUP, VK_A, 0&
    End Sub

    模拟按下按键。

    Private Const VK_F1 = &H70
    Private Const WM_KEYDOWN = &H100
    Private Const WM_KEYUP = &H101
    Private Const WM_CLOSE = &H10
    这些什么意思?貌似赋值?
    如果我想模拟按Q键,应该赋值为什么?
    为什么有些会输出2次?

    提问者: 提问时间:09-06-17 14:39

    '函数申明
    Private Declare Sub keybd_event Lib “user32” (ByVal bVk As Byte, ByVal Scan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Const KEYEVENTF_KEYUP = &H2 '释放按键常数

    '回车键例子
    Private Sub Command1_Click()
    Text1.SetFocus
    Call keybd_event(13, 0, 0, 0) '按下
    Call keybd_event(13, 0, KEYEVENTF_KEYUP, 0) '释放
    End Sub

    键码
    常数 值 描述
    vbKeyLButton 1 鼠标左键
    vbKeyRButton 2 鼠标右键
    vbKeyCancel 3 CANCEL 键
    vbKeyMButton 4 鼠标中键
    vbKeyBack 8 BACKSPACE 键
    vbKeyTab 9 TAB 键
    vbKeyClear 12 CLEAR 键
    vbKeyReturn 13 ENTER 键
    vbKeyShift 16 SHIFT 键
    vbKeyControl 17 CTRL 键
    vbKeyMenu 18 菜单键
    vbKeyPause 19 PAUSE 键
    vbKeyCapital 20 CAPS LOCK 键
    vbKeyEscape 27 ESC 键
    vbKeySpace 32 SPACEBAR 键
    vbKeyPageUp 33 PAGEUP 键
    vbKeyPageDown 34 PAGEDOWN 键
    vbKeyEnd 35 END 键
    vbKeyHome 36 HOME 键
    vbKeyLeft 37 LEFT ARROW 键
    vbKeyUp 38 UP ARROW 键
    vbKeyRight 39 RIGHT ARROW 键
    vbKeyDown 40 DOWN ARROW 键
    vbKeySelect 41 SELECT 键
    vbKeyPrint 42 PRINT SCREEN 键
    vbKeyExecute 43 EXECUTE 键
    vbKeySnapshot 44 SNAP SHOT 键
    vbKeyInser 45 INS 键
    vbKeyDelete 46 DEL 键
    vbKeyHelp 47 HELP 键
    vbKeyNumlock 144 NUM LOCK 键

    vbKeyA 65 A 键
    vbKeyB 66 B 键
    vbKeyC 67 C 键
    vbKeyD 68 D 键
    vbKeyE 69 E 键
    vbKeyF 70 F 键
    vbKeyG 71 G 键
    vbKeyH 72 H 键
    vbKeyI 73 I 键
    vbKeyJ 74 J 键
    vbKeyK 75 K 键
    vbKeyL 76 L 键
    vbKeyM 77 M 键
    vbKeyN 78 N 键
    vbKeyO 79 O 键
    vbKeyP 80 P 键
    vbKeyQ 81 Q 键
    vbKeyR 82 R 键
    vbKeyS 83 S 键
    vbKeyT 84 T 键
    vbKeyU 85 U 键
    vbKeyV 86 V 键
    vbKeyW 87 W 键
    vbKeyX 88 X 键
    vbKeyY 89 Y 键
    vbKeyZ 90 Z 键
    vbKey0 48 0 键
    vbKey1 49 1 键
    vbKey2 50 2 键
    vbKey3 51 3 键
    vbKey4 52 4 键
    vbKey5 53 5 键
    vbKey6 54 6 键
    vbKey7 55 7 键
    vbKey8 56 8 键
    vbKey9 57 9 键
    vbKeyF1 112 F1 键
    vbKeyF2 113 F2 键
    vbKeyF3 114 F3 键
    vbKeyF4 115 F4 键
    vbKeyF5 116 F5 键
    vbKeyF6 117 F6 键
    vbKeyF7 118 F7 键
    vbKeyF8 119 F8 键
    vbKeyF9 120 F9 键
    vbKeyF10 121 F10 键
    vbKeyF11 122 F11 键
    vbKeyF12 123 F12 键
    vbKeyF13 124 F13 键
    vbKeyF14 125 F14 键
    vbKeyF15 126 F15 键
    vbKeyF16 127 F16 键

    这年头,在这个论坛里面已经没有什么技术贴了…呵呵发一篇惊天地,泣鬼神的帖子.当然这个只是模拟键盘的终极模拟.呵呵
    键盘是我们使用计算机的一个很重要的输入设备了,即使在鼠标大行其道的今天,很多程序依然离不开键盘来操作。但是有时候,一些重复性的,很繁琐的键盘操作 总会让人疲惫,于是就有了用程序来代替人们按键的方法,这样可以把很多重复性的键盘操作交给程序来模拟,省了很多精力,按键精灵就是这样的一个软件。那么 我们怎样才能用VB来写一个程序,达到与按键精灵类似的功能呢?那就让我们来先了解一下windows中响应键盘事件的机制。
    当用户按下 键盘上的一个键时,键盘内的芯片会检测到这个动作,并把这个信号传送到计算机。如何区别是哪一个键被按下了呢?键盘上的所有按键都有一个编码,称作键盘扫 描码。当你按下一个键时,这个键的扫描码就被传给系统。扫描码是跟具体的硬件相关的,同一个键,在不同键盘上的扫描码有可能不同。键盘控制器就是将这个扫 描码传给计算机,然后交给键盘驱动程序。键盘驱动程序会完成相关的工作,并把这个扫描码转换为键盘虚拟码。什么是虚拟码呢?因为扫描码与硬件相关,不具有 通用性,为了统一键盘上所有键的编码,于是就提出了虚拟码概念。无论什么键盘,同一个按键的虚拟码总是相同的,这样程序就可以识别了。简单点说,虚拟码就 是我们经常可以看到的像VK_A,VK_B这样的常数,比如键A的虚拟码是65,写成16进制就是&H41,注意,人们经常用16进制来表示虚拟 码。当键盘驱动程序把扫描码转换为虚拟码后,会把这个键盘操作的扫描码和虚拟码还有其它信息一起传递给操作系统。然后操作系统则会把这些信息封装在一个消 息中,并把这个键盘消息插入到消息列队。最后,要是不出意外的话,这个键盘消息最终会被送到当前的活动窗口那里,活动窗口所在的应用程序接收到这个消息 后,就知道键盘上哪个键被按下,也就可以决定该作出什么响应给用户了。这个过程可以简单的如下表示:
    用户按下按键-----键盘驱动程序将此事件传递给操作系统-----操作系统将键盘事件插入消息队列-----键盘消息被发送到当前活动窗口
    明白了这个过程,我们就可以编程实现在其中的某个环节来模拟键盘操作了。在VB中,有多种方法可以实现键盘模拟,我们就介绍几种比较典型的。
    1.局部级模拟

     从上面的流程可以看出,键盘事件是最终被送到活动窗口,然后才引起目标程序响应的。那么最直接的模拟方法就是:直接伪造一个键盘消息发给目标程序。哈哈, 这实在是很简单,windows提供了几个这样的API函数可以实现直接向目标程序发送消息的功能,常用的有SendMessage和 PostMessage,它们的区别是PostMessage函数直接把消息仍给目标程序就不管了,而SendMessage把消息发出去后,还要等待目 标程序返回些什么东西才好。这里要注意的是,模拟键盘消息一定要用PostMessage函数才好,用SendMessage是不正确的(因为模拟键盘消 息是不需要返回值的,不然目标程序会没反应),切记切记!PostMessage函数的VB声明如下:
    

    Declare Function PostMessage Lib “user32” Alias “PostMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    参数hwnd 是你要发送消息的目标程序上某个控件的句柄,参数wMsg 是消息的类型,表示你要发送什么样的消息,最后wParam 和lParam 这两个参数是随消息附加的数据,具体内容要由消息决定。
    再来看看wMsg 这个参数,要模拟按键就靠这个了。键盘消息常用的有如下几个:
    WM_KEYDOWN 表示一个普通键被按下
    WM_KEYUP 表示一个普通键被释放
    WM_SYSKEYDOWN 表示一个系统键被按下,比如Alt键
    WM_SYSKEYUP 表示一个系统键被释放,比如Alt键
    如 果你确定要发送以上几个键盘消息,那么再来看看如何确定键盘消息中的wParam 和lParam 这两个参数。在一个键盘消息中,wParam 参数的 含义较简单,它表示你要发送的键盘事件的按键虚拟码,比如你要对目标程序模拟按下A键,那么wParam 参数的值就设为VK_A ,至于lParam 这个参数就比较复杂了,因为它包含了多个信息,一般可以把它设为0,但是如果你想要你的模拟更真实一些,那么建议你还是设置一下这个参数。那么我们就详细 了解一下lParam 吧。lParam 是一个long类型的参数,它在内存中占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码。它的VB声明如 下:
    Declare Function MapVirtualKey Lib “user32” Alias “MapVirtualKeyA” (ByVal wCode As Long, ByVal wMapType As Long) As Long
    参 数wCode 表示待转换的码,参数wMapType 表示从什么转换为什么,如果是虚拟码转扫描码,则wMapType 设置为0,如果是虚拟扫描码转 虚拟码,则wMapType 设置为1,如果是虚拟码转ASCII码,则wMapType 设置为2.相信有了这些,我们就可以构造键盘事件的 lParam参数了。下面给出一个构造lParam参数的函数:

    1.Declare Function MapVirtualKey Lib “user32” Alias “MapVirtualKeyA” (ByVal wCode As Long, ByVal wMapType As Long) As Long
    2.
    3.Function MakeKeyLparam(ByVal VirtualKey As Long, ByVal flag As Long) As Long
    4.'参数VirtualKey表示按键虚拟码,flag表示是按下键还是释放键,用WM_KEYDOWN和WM_KEYUP这两个常数表示
    5. Dim s As String
    6. Dim Firstbyte As String 'lparam参数的24-31位
    7. If flag = WM_KEYDOWN Then '如果是按下键
    8. Firstbyte = “00”
    9. Else
    10. Firstbyte = “C0” '如果是释放键
    11. End If
    12. Dim Scancode As Long
    13. '获得键的扫描码
    14. Scancode = MapVirtualKey(VirtualKey, 0)
    15. Dim Secondbyte As String 'lparam参数的16-23位,即虚拟键扫描码
    16. Secondbyte = Right(“00” & Hex(Scancode), 2)
    17. s = Firstbyte & Secondbyte & “0001” '0001为lparam参数的0-15位,即发送次数和其它扩展信息
    18. MakeKeyLparam = Val("&H" & s)
    19.End Function

    这 个函数像这样调用,比如按下A键,那么lParam=MakeKeyLparam(VK_A,WM_KEYDOWN) ,很简单吧。值得注意的是,即使你 发送消息时设置了lParam参数的值,但是系统在传递消息时仍然可能会根据当时的情况重新设置该参数,那么目标程序收到的消息中lParam的值可能会 和你发送时的有所不同。所以,如果你很懒的话,还是直接把它设为0吧,对大多数程序不会有影响的,呵呵。
    好了,做完以上的事情,现在我们可以向目标程序发送键盘消息了。首先取得目标程序接受这个消息的控件的句柄,比如目标句柄是12345,那么我们来对目标模拟按下并释放A键,像这样:(为了简单起见,lParam这个参数就不构造了,直接传0)
    PostMessage 12345,WM_KEYDOWN,VK_A,0& '按下A键
    PostMessage 12345,WM_UP,VK_A,0& '释放A键
    好 了,一次按键就完成了。现在你可以迫不及待的打开记事本做实验,先用FindWindowEx这类API函数找到记事本程序的句柄,再向它发送键盘消息, 期望记事本里能诡异的自动出现字符。可是你马上就是失望了,咦,怎么一点反应也没有?你欺骗感情啊~~55555555555555 不是的哦,接着往下看啊。
    一般目标程序都会含有多个控件,并不是每个控件都会对键盘消息作出反应,只有把键盘消息发送给接受它的控件才会得到期望 的反应。那记事本来说,它的编辑框其实是个edit类,只有这个控件才对键盘事件有反应,如果只是把消息发给记事本的窗体,那是没有用的。现在你找出记事 本那个编辑框的句柄,比如是54321,那么写如下代码:
    PostMessage 54321,WM_KEYDOWN,VK_F1,0& '按下F1键
    PostMessage 54321,WM_UP,VK_F1,0& '释放F1键
    怎么样,是不是打开了记事本的“帮助”信息?这说明目标程序已经收到了你发的消息,还不错吧

    可以马上新问题就来了,你想模拟向记事本按下A这个键,好在记事本里自动输入字符,可是,没有任何反应!这是怎么一回事呢?
    原 来,如果要向目标程序发送字符,光靠WM_KEYDOWN和WM_UP这两个事件还不行,还需要一个事件:WM_CHAR,这个消息表示一个字符,程序需 靠它看来接受输入的字符。一般只有A,B,C等这样的按键才有WM_CHAR消息,别的键(比如方向键和功能键)是没有这个消息的,WM_CHAR消息一 般发生在WM_KEYDOWN消息之后。WM_CHAR消息的lParam参数的含义与其它键盘消息一样,而它的wParam则表示相应字符的ASCII 编码(可以输入中文的哦_),现在你可以写出一个完整的向记事本里自动写入字符的程序了,下面是一个例子,并附有这些消息常数的具体值:

    1.Declare Function PostMessage Lib “user32” Alias “PostMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    2.Declare Function MapVirtualKey Lib “user32” Alias “MapVirtualKeyA” (ByVal wCode As Long, ByVal wMapType As Long) As Long
    3.
    4.Public Const WM_KEYDOWN = &H100
    5.Public Const WM_KEYUP = &H101
    6.Public Const WM_CHAR = &H102
    7.Public Const VK_A = &H41
    8.
    9.Function MakeKeyLparam(ByVal VirtualKey As Long, ByVal flag As Long) As Long
    10. Dim s As String
    11. Dim Firstbyte As String 'lparam参数的24-31位
    12. If flag = WM_KEYDOWN Then '如果是按下键
    13. Firstbyte = “00”
    14. Else
    15. Firstbyte = “C0” '如果是释放键
    16. End If
    17. Dim Scancode As Long
    18. '获得键的扫描码
    19. Scancode = MapVirtualKey(VirtualKey, 0)
    20. Dim Secondbyte As String 'lparam参数的16-23位,即虚拟键扫描码
    21. Secondbyte = Right(“00” & Hex(Scancode), 2)
    22. s = Firstbyte & Secondbyte & “0001” '0001为lparam参数的0-15位,即发送次数和其它扩展信息
    23. MakeKeyLparam = Val("&H" & s)
    24.End Function
    25.
    26.Private Sub Form_Load()
    27. dim hwnd as long
    28. hwnd = XXXXXX 'XXXXX表示记事本编辑框的句柄
    29. PostMessage hwnd,WM_KEYDOWN,VK_A,MakeKeyLparam(VK_A,WM_KEYDOWN) '按下A键
    30. PostMessage hwnd,WM_CHAR,ASC(“A”),MakeKeyLparam(VK_A,WM_KEYDOWN) '输入字符A
    31. PostMessage hwnd,WM_UP,VK_A,MakeKeyLparam(VK_A,WM_UP) '释放A键
    32.End Sub

    这 就是通过局部键盘消息来模拟按键。这个方法有一个极大的好处,就是:它可以实现后台按键,也就是说他对你的前台操作不会有什么影响。比如,你可以用这个方 法做个程序在游戏中模拟按键来不断地执行某些重复的操作,而你则一边喝茶一边与QQ上的MM们聊得火热,它丝毫不会影响你的前台操作。无论目标程序是否获 得焦点都没有影响,这就是后台模拟按键的原理啦~~~~

    2.全局级模拟

     你会发现,用上面的方法模拟按键并不 是对所有程序都有效的,有的程序啊,你向它发了一大堆消息,可是它却一点反应也没有。这是怎么回事呢?这就要看具体的情况了,有些程序(特别是一些游戏) 出于某些原因,会禁止用户对它使用模拟按键程序,这个怎么实现呢?比如可以在程序中检查一下,如果发现自己不是活动窗口,就不接受键盘消息。或者仔细检查 一下收到的键盘消息,你会发现真实的按键和模拟的按键消息总是有一些小差别,从这些小差别上,目标程序就能判断出:这是假的!是伪造的!!因此,如果用 PostMessage发送局部消息模拟按键不成功的话,你可以试一试全局级的键盘消息,看看能不能骗过目标程序。
    

    模拟全局键盘消息常见的可以有以下一些方法:
    (1) 用API函数keybd_event,这个函数可以用来模拟一个键盘事件,它的VB声明为:
    Declare Sub keybd_event Lib “user32” (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    参数bVk表示要模拟的按键的虚拟码,bScan表示该按键的扫描码(一般可以传0),dwFlags表示是按下键还是释放键(按下键为0,释放键为2),dwExtraInfo是扩展标志,一般没有用。比如要模拟按下A键,可以这样:
    Const KEYEVENTF_KEYUP = &H2
    keybd_event VK_A, 0, 0, 0 '按下A键
    keybd_event VK_A, 0, KEYEVENTF_KEYUP, 0 '释放A键
    注意有时候按键的速度不要太快,否则会出问题,可以用API函数Sleep来进行延时,声明如下:
    Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
    参数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函数来模拟键盘事件。除了这个函数,SendInput函数也可以模拟全局键盘事件。SendInput可以直接把一条消息插入到消息队列中,算是比较底层的了。它的VB声明如下:
    Declare Function SendInput Lib “user32.dll” (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
    参数:
    nlnprts:定义plnputs指向的结构的数目。
    plnputs:指向INPUT结构数组的指针。每个结构代表插人到键盘或鼠标输入流中的一个事件。
    cbSize:定义INPUT结构的大小。若cbSize不是INPUT结构的大小,则函数调用失败。
    返回值:函数返回被成功地插人键盘或鼠标输入流中的事件的数目。若要获得更多的错误信息,可以调用GetlastError函数。
    备注:Sendlnput函数将INPUT结构中的事件顺序地插入键盘或鼠标的输入流中。这些事件与用户插入的(用鼠标或键盘)或调用keybd_event,mouse_event,或另外的Sendlnput插人的键盘或鼠标的输入流不兼容。
    嗯,这个函数用起来蛮复杂的,因为它的参数都是指针一类的东西。要用它来模拟键盘输入,先要构造一组数据结构,把你要模拟的键盘消息装进去,然后传给它。为了方便起见,把它做在一个过程里面,要用的时候直接调用好了,代码如下:

    1.Declare Function SendInput Lib “user32.dll” (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
    2.Declare Sub CopyMemory Lib “kernel32” Alias “RtlMoveMemory” (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
    3.Type GENERALINPUT
    4. dwType As Long
    5. xi(0 To 23) As Byte
    6.End Type
    7.
    8.Type KEYBDINPUT
    9. wVk As Integer
    10. wScan As Integer
    11. dwFlags As Long
    12. time As Long
    13. dwExtraInfo As Long
    14.End Type
    15.
    16.Const INPUT_KEYBOARD = 1
    17.
    18.Sub MySendKey(bkey As Long)
    19.'参数bkey传入要模拟按键的虚拟码即可模拟按下指定键
    20.Dim GInput(0 To 1) As GENERALINPUT
    21.Dim KInput As KEYBDINPUT
    22.KInput.wVk = bkey '你要模拟的按键
    23.KInput.dwFlags = 0 '按下键标志
    24.GInput(0).dwType = INPUT_KEYBOARD
    25.CopyMemory GInput(0).xi(0), KInput, Len(KInput) '这个函数用来把内存中KInput的数据复制到GInput
    26.KInput.wVk = bkey
    27.KInput.dwFlags = KEYEVENTF_KEYUP ’ 释放按键
    28.GInput(1).dwType = INPUT_KEYBOARD ’ 表示该消息为键盘消息
    29.CopyMemory GInput(1).xi(0), KInput, Len(KInput)
    30.'以上工作把按下键和释放键共2条键盘消息加入到GInput数据结构中
    31.SendInput 2, GInput(0), Len(GInput(0)) '把GInput中存放的消息插入到消息列队
    32.End Sub

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

    Declare Function SetWindowsHookEx Lib “user32” Alias “SetWindowsHookExA” (ByVal idHook As Long,ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    先 安装WH_JOURNALPLAYBACK这个钩子,然后你需要自己写一个钩子函数,在系统调用它时,把你要模拟的事件传递给钩子参数lParam所指向 的EVENTMSG区域,就可以达到模拟按键的效果。不过用这个钩子模拟键盘事件有一个副作用,就是它会锁定真实的鼠标键盘,不过如果你就是想在模拟的时 候不会受真实键盘操作的干扰,那么用用它倒是个不错的主意。
    3.驱动级模拟

     如果上面的方法你都试过了,可是你发现目标程序却仍然顽固的不接受你模拟的消息,寒~~~~~~~~~还好,我还剩下最后一招,这就是驱动级模拟:直接读写键盘的硬件端口!
     有一些使用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,得到断码,表示释放这个键
    好了,现在的问题就是在VB中如何向端口写入数据了。因为在windows中,普通应用程序是无权操作端口的,于是我们就需要一个驱动程序来帮助我们实 现。在这里我们可以使用一个组件WINIO来完成读写端口操作。什么是WINIO?WINIO是一个全免费的、无需注册的、含源程序的 WINDOWS2000端口操作驱动程序组件(可以到上 去下载)。它不仅可以操作端口,还可以操作内存;不仅能在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个文件拷贝到你的程序的文件夹下,然后在VB中新建一个工 程,添加一个模块,在模块中加入下面的winio函数声明:

    1.Declare Function MapPhysToLin Lib “WinIo.dll” (ByVal PhysAddr As Long, ByVal PhysSize As Long, ByRef PhysMemHandle) As Long
    2.Declare Function UnmapPhysicalMemory Lib “WinIo.dll” (ByVal PhysMemHandle, ByVal LinAddr) As Boolean
    3.Declare Function GetPhysLong Lib “WinIo.dll” (ByVal PhysAddr As Long, ByRef PhysVal As Long) As Boolean
    4.Declare Function SetPhysLong Lib “WinIo.dll” (ByVal PhysAddr As Long, ByVal PhysVal As Long) As Boolean
    5.Declare Function GetPortVal Lib “WinIo.dll” (ByVal PortAddr As Integer, ByRef PortVal As Long, ByVal bSize As Byte) As Boolean
    6.Declare Function SetPortVal Lib “WinIo.dll” (ByVal PortAddr As Integer, ByVal PortVal As Long, ByVal bSize As Byte) As Boolean
    7.Declare Function InitializeWinIo Lib “WinIo.dll” () As Boolean
    8.Declare Function ShutdownWinIo Lib “WinIo.dll” () As Boolean
    9.Declare Function InstallWinIoDriver Lib “WinIo.dll” (ByVal DriverPath As String, ByVal Mode As Integer) As Boolean
    10.Declare Function RemoveWinIoDriver Lib “WinIo.dll” () As Boolean
    11.
    12.’ ------------------------------------以上是WINIO函数声明-------------------------------------------
    13.
    14.Declare Function MapVirtualKey Lib “user32” Alias “MapVirtualKeyA” (ByVal wCode As Long, ByVal wMapType As Long) As Long
    15.
    16.’-----------------------------------以上是WIN32 API函数声明-----------------------------------------

    再添加下面这个过程:

    1.Sub KBCWait4IBE() '等待键盘缓冲区为空
    2.Dim dwVal As Long
    3. Do
    4. GetPortVal &H64, dwVal, 1
    5.'这句表示从&H64端口读取一个字节并把读出的数据放到变量dwVal中
    6.'GetPortVal函数的用法是GetPortVal 端口号,存放读出数据的变量,读入的长度
    7. Loop While (dwVal And &H2)
    8.End Sub

    上面的是一个根据KBC规范写的过程,它的作用是在向键盘端口写入数据前等待一段时间,后面将会用到。
    然后再添加如下过程,这2个过程用来模拟按键:

    1.Public Const KBC_KEY_CMD = &H64 '键盘命令端口
    2.Public Const KBC_KEY_DATA = &H60 '键盘数据端口
    3.
    4.Sub MyKeyDown(ByVal vKeyCoad As Long)
    5.'这个用来模拟按下键,参数vKeyCoad传入按键的虚拟码
    6.Dim btScancode As Long
    7.btScancode = MapVirtualKey(vKeyCoad, 0)
    8.
    9. KBCWait4IBE '发送数据前应该先等待键盘缓冲区为空
    10. SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
    11.'SetPortVal函数用于向端口写入数据,它的用法是SetPortVal 端口号,欲写入的数据,写入数据的长度
    12. KBCWait4IBE
    13. SetPortVal KBC_KEY_DATA, btScancode, 1 '写入按键信息,按下键
    14.
    15.End Sub
    16.
    17.Sub MyKeyUp(ByVal vKeyCoad As Long)
    18.'这个用来模拟释放键,参数vKeyCoad传入按键的虚拟码
    19.Dim btScancode As Long
    20.btScancode = MapVirtualKey(vKeyCoad, 0)
    21.
    22. KBCWait4IBE '等待键盘缓冲区为空
    23. SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
    24. KBCWait4IBE
    25. SetPortVal KBC_KEY_DATA, (btScancode Or &H80), 1 '写入按键信息,释放键
    26.
    27.End Sub

    定义了上面的过程后,就可以用它来模拟键盘输入了。在窗体模块中添加一个定时器控件,然后加入以下代码:

    1.Private Sub Form_Load()
    2.If InitializeWinIo = False Then
    3. '用InitializeWinIo函数加载驱动程序,如果成功会返回true,否则返回false
    4. MsgBox “驱动程序加载失败!”
    5. Unload Me
    6.End If
    7.Timer1.Interval=3000
    8.Timer1.Enabled=True
    9.End Sub
    10.
    11.Private Sub Form_Unload(Cancel As Integer)
    12.ShutdownWinIo '程序结束时记得用ShutdownWinIo函数卸载驱动程序
    13.End Sub
    14.
    15.Private Sub Timer1_Timer()
    16.Dim VK_A as Long = &H41
    17.MyKeyDown VK_A
    18.MyKeyUp VK_A '模拟按下并释放A键
    19.End Sub

    [/quote]
    运行上面的程序,就会每隔3秒钟模拟按下一次A键,试试看,怎么样,是不是对所有程序都有效果了?
    需要注意的问题:
    要在VB的调试模式下使用WINIO,需要把那3个文件拷贝到VB的安装目录中。
    键盘上有些键属于扩展键(比如键盘上的方向键就是扩展键),对于扩展键不应该用上面的MyKeyDown和MyKeyUp过程来模拟,可以使用下面的2个过程来准确模拟扩展键:
    [quote]

    1.Sub MyKeyDownEx(ByVal vKeyCoad As Long) '模拟扩展键按下,参数vKeyCoad是扩展键的虚拟码
    2.Dim btScancode As Long
    3.btScancode = MapVirtualKey(vKeyCoad, 0)
    4.
    5. KBCWait4IBE '等待键盘缓冲区为空
    6. SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
    7. KBCWait4IBE
    8. SetPortVal KBC_KEY_DATA, &HE0, 1 '写入扩展键标志信息
    9.
    10.
    11. KBCWait4IBE '等待键盘缓冲区为空
    12. SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
    13. KBCWait4IBE
    14. SetPortVal KBC_KEY_DATA, btScancode, 1 '写入按键信息,按下键
    15.
    16.
    17.End Sub
    18.
    19.
    20.Sub MyKeyUpEx(ByVal vKeyCoad As Long) '模拟扩展键弹起
    21.Dim btScancode As Long
    22.btScancode = MapVirtualKey(vKeyCoad, 0)
    23.
    24. KBCWait4IBE '等待键盘缓冲区为空
    25. SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
    26. KBCWait4IBE
    27. SetPortVal KBC_KEY_DATA, &HE0, 1 '写入扩展键标志信息
    28.
    29.
    30. KBCWait4IBE '等待键盘缓冲区为空
    31. SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
    32. KBCWait4IBE
    33. SetPortVal KBC_KEY_DATA, (btScancode Or &H80), 1 '写入按键信息,释放键
    34.
    35.End Sub

    [/quote]
    还 应该注意的是,如果要从扩展键转换到普通键,那么普通键的KeyDown事件应该发送两次。也就是说,如果我想模拟先按下一个扩展键,再按下一个普通键, 那么就应该向端口发送两次该普通键被按下的信息。比如,我想模拟先按下左方向键,再按下空格键这个事件,由于左方向键是扩展键,空格键是普通键,那么流程 就应该是这样的:
    [quote]

    1.MyKeyDownEx VK_LEFT '按下左方向键
    2.Sleep 200 '延时200毫秒
    3.MyKeyUpEx VK_LEFT '释放左方向键
    4.
    5.Sleep 500
    6.MyKeyDown VK_SPACE '按下空格键,注意要发送两次
    7.MyKeyDown VK_SPACE
    8.Sleep 200
    9.MyKeyUp VK_SPACE '释放空格键

    好了,相信到这里,你的模拟按键程序也就差不多了,测试一下,是不是很有效呢,嘿嘿~~~~
    WINIO组件的下载地址:
    4.骨灰级模拟
    方法3算是很底层的模拟了,我现在还没有发现有它模拟无效的程序。但是如果你用尽上面所有的方法,仍然无效的话,那么还有最后一个方法,绝对对任何程序都会有效,那就是:把键盘拿出来,老老实实地按下去吧。~~~~

    我用WINIO在VB下模拟鼠标左键点击,具体代码如下:

    1.Private Sub XR()
    2. Dim Result As Boolean
    3.
    4. Result = SetPortVal(Val("&H64"), Val("&HD3"), 1)
    5.
    6. If (Result = False) Then
    7. MsgBox “Whoops ! There is a problem with SetPortByte.”, vbOKOnly + vbCritical, “VBDumpPort32”
    8. Unload FrmVBDumpPort32
    9. End If
    10. Sleep 100
    11. Result = SetPortVal(Val("&H64"), Val("&Hf4"), 1)
    12.
    13. If (Result = False) Then
    14. MsgBox “Whoops ! There is a problem with SetPortByte.”, vbOKOnly + vbCritical, “VBDumpPort32”
    15. Unload FrmVBDumpPort32
    16. End If
    17.
    18. Result = SetPortVal(Val("&H60"), Val("&H09"), 1)
    19.
    20. If (Result = False) Then
    21. MsgBox “Whoops ! There is a problem with SetPortByte.”, vbOKOnly + vbCritical, “VBDumpPort32”
    22. Unload FrmVBDumpPort32
    23. End If
    24.
    25. Result = SetPortVal(Val("&H60"), Val("&H00"), 1)
    26.
    27. If (Result = False) Then
    28. MsgBox “Whoops ! There is a problem with SetPortByte.”, vbOKOnly + vbCritical, “VBDumpPort32”
    29. Unload FrmVBDumpPort32
    30. End If
    31.
    32. Result = SetPortVal(Val("&H60"), Val("&H00"), 1)
    33.
    34. If (Result = False) Then
    35. MsgBox “Whoops ! There is a problem with SetPortByte.”, vbOKOnly + vbCritical, “VBDumpPort32”
    36. Unload FrmVBDumpPort32
    37. End If
    38.
    39. Result = SetPortVal(Val("&H60"), Val("&H08"), 1)
    40.
    41. If (Result = False) Then
    42. MsgBox “Whoops ! There is a problem with SetPortByte.”, vbOKOnly + vbCritical, “VBDumpPort32”
    43. Unload FrmVBDumpPort32
    44. End If
    45.
    46. Result = SetPortVal(Val("&H60"), Val("&H00"), 1)
    47.
    48. If (Result = False) Then
    49. MsgBox “Whoops ! There is a problem with SetPortByte.”, vbOKOnly + vbCritical, “VBDumpPort32”
    50. Unload FrmVBDumpPort32
    51. End If
    52.
    53. Result = SetPortVal(Val("&H60"), Val("&H00"), 1)
    54.
    55. If (Result = False) Then
    56. MsgBox “Whoops ! There is a problem with SetPortByte.”, vbOKOnly + vbCritical, “VBDumpPort32”
    57. Unload FrmVBDumpPort32
    58. End If
    59.End Sub

    winio 模拟方向键:http://laomaspeak.blog.sohu.com/94919159.html

    1.‘模块
    2.
    3.Public Declare Function MapPhysToLin Lib “WinIo.dll” (ByVal PhysAddr As Long, ByVal PhysSize As Long, ByRef PhysMemHandle) As Long
    4.Public Declare Function UnmapPhysicalMemory Lib “WinIo.dll” (ByVal PhysMemHandle, ByVal LinAddr) As Boolean
    5.Public Declare Function GetPhysLong Lib “WinIo.dll” (ByVal PhysAddr As Long, ByRef PhysVal As Long) As Boolean
    6.Public Declare Function SetPhysLong Lib “WinIo.dll” (ByVal PhysAddr As Long, ByVal PhysVal As Long) As Boolean
    7.Public Declare Function GetPortVal Lib “WinIo.dll” (ByVal PortAddr As Integer, ByRef PortVal As Long, ByVal bSize As Byte) As Boolean
    8.Public Declare Function SetPortVal Lib “WinIo.dll” (ByVal PortAddr As Integer, ByVal PortVal As Long, ByVal bSize As Byte) As Boolean
    9.Public Declare Function InitializeWinIo Lib “WinIo.dll” () As Boolean
    10.Public Declare Function ShutdownWinIo Lib “WinIo.dll” () As Boolean
    11.Public Declare Function InstallWinIoDriver Lib “WinIo.dll” (ByVal DriverPath As String, ByVal Mode As Integer) As Boolean
    12.Public Declare Function RemoveWinIoDriver Lib “WinIo.dll” () As Boolean
    13.
    14.’ ------------------------------------以上是WINIO函数声明-------------------------------------------
    15.Public Const KBC_KEY_CMD = &H64 '键盘命令端口
    16.Public Const KBC_KEY_DATA = &H60 '键盘数据端口
    17.Public Declare Function MapVirtualKey Lib “user32” Alias “MapVirtualKeyA” (ByVal wCode As Long, ByVal wMapType As Long) As Long
    18.Public VK_A As Long
    19.
    20.
    21.Public Const VK_LBUTTON = &H1
    22.Public Const VK_RBUTTON = &H2
    23.Public Const VK_CANCEL = &H3
    24.Public Const VK_MBUTTON = &H4
    25.Public Const VK_BACK = &H8
    26.Public Const VK_TAB = &H9
    27.Public Const VK_CLEAR = &HC
    28.Public Const VK_RETURN = &HD
    29.Public Const VK_SHIFT = &H10
    30.Public Const VK_CONTROL = &H11
    31.Public Const VK_MENU = &H12
    32.Public Const VK_PAUSE = &H13
    33.Public Const VK_CAPITAL = &H14
    34.Public Const VK_ESCAPE = &H1B
    35.Public Const VK_SPACE = &H20
    36.Public Const VK_PRIOR = &H21
    37.Public Const VK_NEXT = &H22
    38.Public Const VK_END = &H23
    39.Public Const VK_HOME = &H24
    40.Public Const VK_LEFT = &H25
    41.Public Const VK_UP = &H26
    42.Public Const VK_RIGHT = &H27
    43.Public Const VK_DOWN = &H28
    44.Public Const VK_Select = &H29
    45.Public Const VK_PRINT = &H2A
    46.Public Const VK_EXECUTE = &H2B
    47.Public Const VK_SNAPSHOT = &H2C
    48.Public Const VK_Insert = &H2D
    49.Public Const VK_Delete = &H2E
    50.Public Const VK_HELP = &H2F
    51.Public Const VK_0 = &H30
    52.Public Const VK_1 = &H31
    53.Public Const VK_2 = &H32
    54.Public Const VK_3 = &H33
    55.Public Const VK_4 = &H34
    56.Public Const VK_5 = &H35
    57.Public Const VK_6 = &H36
    58.Public Const VK_7 = &H37
    59.Public Const VK_8 = &H38
    60.Public Const VK_9 = &H39
    61.Public Const VK_B = &H42
    62.Public Const VK_C = &H43
    63.Public Const VK_D = &H44
    64.Public Const VK_E = &H45
    65.Public Const VK_F = &H46
    66.Public Const VK_G = &H47
    67.Public Const VK_H = &H48
    68.Public Const VK_I = &H49
    69.Public Const VK_J = &H4A
    70.Public Const VK_K = &H4B
    71.Public Const VK_L = &H4C
    72.Public Const VK_M = &H4D
    73.Public Const VK_N = &H4E
    74.Public Const VK_O = &H4F
    75.Public Const VK_P = &H50
    76.Public Const VK_Q = &H51
    77.Public Const VK_R = &H52
    78.Public Const VK_S = &H53
    79.Public Const VK_T = &H54
    80.Public Const VK_U = &H55
    81.Public Const VK_V = &H56
    82.Public Const VK_W = &H57
    83.Public Const VK_X = &H58
    84.Public Const VK_Y = &H59
    85.Public Const VK_Z = &H5A
    86.Public Const VK_STARTKEY = &H5B
    87.Public Const VK_CONTEXTKEY = &H5D
    88.Public Const VK_NUMPAD0 = &H60
    89.Public Const VK_NUMPAD1 = &H61
    90.Public Const VK_NUMPAD2 = &H62
    91.Public Const VK_NUMPAD3 = &H63
    92.Public Const VK_NUMPAD4 = &H64
    93.Public Const VK_NUMPAD5 = &H65
    94.Public Const VK_NUMPAD6 = &H66
    95.Public Const VK_NUMPAD7 = &H67
    96.Public Const VK_NUMPAD8 = &H68
    97.Public Const VK_NUMPAD9 = &H69
    98.Public Const VK_MULTIPLY = &H6A
    99.Public Const VK_ADD = &H6B
    100.Public Const VK_SEPARATOR = &H6C
    101.Public Const VK_SUBTRACT = &H6D
    102.Public Const VK_DECIMAL = &H6E
    103.Public Const VK_DIVIDE = &H6F
    104.Public Const VK_F1 = &H70
    105.Public Const VK_F2 = &H71
    106.Public Const VK_F3 = &H72
    107.Public Const VK_F4 = &H73
    108.Public Const VK_F5 = &H74
    109.Public Const VK_F6 = &H75
    110.Public Const VK_F7 = &H76
    111.Public Const VK_F8 = &H77
    112.Public Const VK_F9 = &H78
    113.Public Const VK_F10 = &H79
    114.Public Const VK_F11 = &H7A
    115.Public Const VK_F12 = &H7B
    116.Public Const VK_F13 = &H7C
    117.Public Const VK_F14 = &H7D
    118.Public Const VK_F15 = &H7E
    119.Public Const VK_F16 = &H7F
    120.Public Const VK_F17 = &H80
    121.Public Const VK_F18 = &H81
    122.Public Const VK_F19 = &H82
    123.Public Const VK_F20 = &H83
    124.Public Const VK_F21 = &H84
    125.Public Const VK_F22 = &H85
    126.Public Const VK_F23 = &H86
    127.Public Const VK_F24 = &H87
    128.Public Const VK_NUMLOCK = &H90
    129.Public Const VK_OEM_SCROLL = &H91
    130.Public Const VK_OEM_1 = &HBA
    131.Public Const VK_OEM_PLUS = &HBB
    132.Public Const VK_OEM_COMMA = &HBC
    133.Public Const VK_OEM_MINUS = &HBD
    134.Public Const VK_OEM_PERIOD = &HBE
    135.Public Const VK_OEM_2 = &HBF
    136.Public Const VK_OEM_3 = &HC0
    137.Public Const VK_OEM_4 = &HDB
    138.Public Const VK_OEM_5 = &HDC
    139.Public Const VK_OEM_6 = &HDD
    140.Public Const VK_OEM_7 = &HDE
    141.Public Const VK_OEM_8 = &HDF
    142.Public Const VK_ICO_F17 = &HE0
    143.Public Const VK_ICO_F18 = &HE1
    144.Public Const VK_OEM102 = &HE2
    145.Public Const VK_ICO_HELP = &HE3
    146.Public Const VK_ICO_00 = &HE4
    147.Public Const VK_ICO_CLEAR = &HE6
    148.Public Const VK_OEM_RESET = &HE9
    149.Public Const VK_OEM_JUMP = &HEA
    150.Public Const VK_OEM_PA1 = &HEB
    151.Public Const VK_OEM_PA2 = &HEC
    152.Public Const VK_OEM_PA3 = &HED
    153.Public Const VK_OEM_WSCTRL = &HEE
    154.Public Const VK_OEM_CUSEL = &HEF
    155.Public Const VK_OEM_ATTN = &HF0
    156.Public Const VK_OEM_FINNISH = &HF1
    157.Public Const VK_OEM_COPY = &HF2
    158.Public Const VK_OEM_AUTO = &HF3
    159.Public Const VK_OEM_ENLW = &HF4
    160.Public Const VK_OEM_BACKTAB = &HF5
    161.Public Const VK_CRSEL = &HF7
    162.Public Const VK_EXSEL = &HF8
    163.Public Const VK_EREOF = &HF9
    164.Public Const VK_PLAY = &HFA
    165.Public Const VK_ZOOM = &HFB
    166.Public Const VK_NONAME = &HFC
    167.Public Const VK_PA1 = &HFD
    168.Public Const VK_OEM_CLEAR = &HFE
    169.‘Public Button As ComboBox
    170.
    171.’-----------------------------------以上是WIN32 API函数声明-----------------------------------------
    172.Sub KBCWait4IBE() '等待键盘缓冲区为空
    173.Dim dwVal As Long
    174. Do
    175. GetPortVal &H64, dwVal, 1
    176.'这句表示从&H64端口读取一个字节并把读出的数据放到变量dwVal中
    177.'GetPortVal函数的用法是GetPortVal 端口号,存放读出数据的变量,读入的长度
    178. Loop While (dwVal And &H2)
    179.End Sub
    180.
    181.
    182.'窗体
    183.
    184.Private Declare Sub keybd_event Lib “user32” (ByVal bVk As Byte, ByVal Scan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    185.
    186.Private Declare Function GetAsyncKeyState Lib “user32” (ByVal vKey As Long) As Integer
    187.
    188.Private Const strEnabled = “0123456789”
    189.
    190.
    191.Private Sub Command1_Click()
    192.Timer1.Interval = Val(Text2.Text) * 1000
    193.Timer1.Enabled = True
    194.Command2.Enabled = True
    195.Command1.Enabled = False
    196.Form1.WindowState = 1
    197.Text1.Locked = True
    198.End Sub
    199.
    200.Private Sub Command2_Click()
    201.Timer1.Interval = 0
    202.Command1.Enabled = True
    203.Command2.Enabled = False
    204.Form1.WindowState = 0
    205.Text1.Locked = False
    206.End Sub
    207.
    208.Private Sub Form_Load()
    209.Text1.Text = “这里输入你要说的话”
    210.Text2.Text = “1”
    211.Command1.Caption = “开始”
    212.Command2.Caption = “停止”
    213.Timer2.Interval = 10
    214.Timer2.Enabled = True
    215.Timer1.Enabled = Flash
    216.Command2.Enabled = False
    217.If InitializeWinIo = False Then
    218. '用InitializeWinIo函数加载驱动程序,如果成功会返回true,否则返回false
    219. MsgBox “驱动程序加载失败!”
    220. Unload Me
    221. End If
    222.End Sub
    223.Sub MyKeyDown(ByVal vKeyCoad As Long)
    224.'这个用来模拟按下键,参数vKeyCoad传入按键的虚拟码
    225.Dim btScancode As Long
    226.btScancode = MapVirtualKey(vKeyCoad, 0)
    227.
    228. KBCWait4IBE '发送数据前应该先等待键盘缓冲区为空
    229. SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
    230.'SetPortVal函数用于向端口写入数据,它的用法是SetPortVal 端口号,欲写入的数据,写入数据的长度
    231. KBCWait4IBE
    232. SetPortVal KBC_KEY_DATA, btScancode, 1 '写入按键信息,按下键
    233.
    234.End Sub
    235.
    236. Sub MyKeyUp(ByVal vKeyCoad As Long)
    237.'这个用来模拟释放键,参数vKeyCoad传入按键的虚拟码
    238.Dim btScancode As Long
    239.btScancode = MapVirtualKey(vKeyCoad, 0)
    240.
    241. KBCWait4IBE '等待键盘缓冲区为空
    242. SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
    243. KBCWait4IBE
    244. SetPortVal KBC_KEY_DATA, (btScancode Or &H80), 1 '写入按键信息,释放键
    245.
    246.End Sub
    247.
    248.Sub MyKeyDownEx(ByVal vKeyCoad As Long) '模拟扩展键按下,参数vKeyCoad是扩展键的虚拟码
    249.Dim btScancode As Long
    250.btScancode = MapVirtualKey(vKeyCoad, 0)
    251. KBCWait4IBE '等待键盘缓冲区为空
    252. SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
    253. KBCWait4IBE
    254. SetPortVal KBC_KEY_DATA, &HE0, 1 '写入扩展键标志信息
    255.
    256.
    257. KBCWait4IBE '等待键盘缓冲区为空
    258. SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
    259. KBCWait4IBE
    260. SetPortVal KBC_KEY_DATA, btScancode, 1 '写入按键信息,按下键
    261.
    262.
    263.End Sub
    264.
    265.Sub MyKeyUpEx(ByVal vKeyCoad As Long) '模拟扩展键弹起
    266.Dim btScancode As Long
    267.btScancode = MapVirtualKey(vKeyCoad, 0)
    268. KBCWait4IBE '等待键盘缓冲区为空
    269. SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
    270. KBCWait4IBE
    271. SetPortVal KBC_KEY_DATA, &HE0, 1 '写入扩展键标志信息
    272.
    273.
    274. KBCWait4IBE '等待键盘缓冲区为空
    275. SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
    276. KBCWait4IBE
    277. SetPortVal KBC_KEY_DATA, (btScancode Or &H80), 1 '写入按键信息,释放键
    278.
    279.End Sub
    280.
    281.
    282.Private Sub Form_Unload(Cancel As Integer)
    283. ShutdownWinIo '程序结束时记得用ShutdownWinIo函数卸载驱动程序
    284.End Sub
    285.Private Sub Timer1_Timer()
    286.MyKeyDown VK_A
    287.MyKeyUp VK_A
    288.Call keybd_event(13, 0, 0, 0) '回车
    289.'Call keybd_event(40, 0, 0, 0) '向下
    290.SendKeys Text1
    291.End Sub
    292.
    293.
    294.Private Sub Timer3_Timer()
    295.MyKeyDownEx VK_DOWN '按下向下方向键
    296.End Sub
    297.
    298.Private Sub Timer2_Timer()
    299.If GetAsyncKeyState(vbKeyF6) Then '按下F6开始说话
    300.Command1_Click
    301.End If
    302.If GetAsyncKeyState(vbKeyF8) Then '按下F8停止说话
    303.Command2_Click
    304.End If
    305.End Sub
    306.Private Sub Text2_KeyPress(KeyAscii As Integer)
    307.If InStr(1, strEnabled, Chr$(KeyAscii)) = 0 Then
    308. KeyAscii = 0
    309.End If
    310.End Sub

    VB:如何发送WM_KEYDOWN和WM_KEYUP消息

    29277723/blog/item/918bfe1b5fdec81d8718bf4a.html

    其实没什么说的,只是最近一段时间问的人比较多,所以写上几句
    简单的说,有两个需要注意的地方,一是要用postmessage发送消息,二是这两个消息lparam参数比较复杂,发送消息的时候要构造好lparam参数,下面给出示例代码:

    1.Option Explicit
    2.Private Declare Function MapVirtualKey Lib “user32” Alias “MapVirtualKeyA” (ByVal wCode As Long, ByVal wMapType As Long) As Long
    3.Private Declare Function SendMessage Lib “user32” Alias “SendMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    4.Private Declare Function FindWindow Lib “user32” Alias “FindWindowA” (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    5.Private Declare Function FindWindowEx Lib “user32” Alias “FindWindowExA” (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    6.Private Const WM_KEYDOWN = &H100
    7.Private Const WM_KEYUP = &H101
    8.Private Declare Function PostMessage Lib “user32” Alias “PostMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    9.
    10.Private Sub Command1_Click()
    11.Dim jsb As Long
    12.jsb = FindWindow(“notepad”, vbNullString)
    13.Dim mhwnd As Long
    14.mhwnd = FindWindowEx(jsb, 0, “edit”, vbNullString)
    15.Dim lParam As Long
    16.lParam = makelparam(vbKey5, False)
    17.PostMessage mhwnd, WM_KEYDOWN, vbKey5, lParam
    18.lParam = makelparam(vbKey5, True)
    19.PostMessage mhwnd, WM_KEYUP, vbKey5, lParam
    20.End Sub
    21.
    22.Private Function makelparam(ByVal VirtualKey As Long, ByVal flag As Boolean) As Long
    23.Dim s As String
    24.Dim Firstbyte As String 'lparam参数的24-31位
    25.If flag = False Then 'keydown
    26. Firstbyte = “00”
    27.Else
    28. Firstbyte = “C0” 'keyup
    29.End If
    30.Dim Scancode As Long
    31.'获得虚拟键扫描码
    32.Scancode = MapVirtualKey(VirtualKey, 0)
    33.Dim Secondbyte As String 'lparam参数的16-23位,即虚拟键扫描码
    34.Secondbyte = Right(“00” & Hex(Scancode), 2)
    35.s = Firstbyte & Secondbyte & “0001” '0001为lparam参数的0-15位,即发送次数
    36.makelparam = Val("&H" & s)
    37.End Function

    欢迎使用Markdown编辑器

    你好! 这是你第一次使用 Markdown编辑器 所展示的欢迎页。如果你想学习如何使用Markdown编辑器, 可以仔细阅读这篇文章,了解一下Markdown的基本语法知识。

    新的改变

    我们对Markdown编辑器进行了一些功能拓展与语法支持,除了标准的Markdown编辑器功能,我们增加了如下几点新功能,帮助你用它写博客:

    1. 全新的界面设计 ,将会带来全新的写作体验;
    2. 在创作中心设置你喜爱的代码高亮样式,Markdown 将代码片显示选择的高亮样式 进行展示;
    3. 增加了 图片拖拽 功能,你可以将本地的图片直接拖拽到编辑区域直接展示;
    4. 全新的 KaTeX数学公式 语法;
    5. 增加了支持甘特图的mermaid语法1 功能;
    6. 增加了 多屏幕编辑 Markdown文章功能;
    7. 增加了 焦点写作模式、预览模式、简洁写作模式、左右区域同步滚轮设置 等功能,功能按钮位于编辑区域与预览区域中间;
    8. 增加了 检查列表 功能。

    功能快捷键

    撤销:Ctrl/Command + Z
    重做:Ctrl/Command + Y
    加粗:Ctrl/Command + B
    斜体:Ctrl/Command + I
    标题:Ctrl/Command + Shift + H
    无序列表:Ctrl/Command + Shift + U
    有序列表:Ctrl/Command + Shift + O
    检查列表:Ctrl/Command + Shift + C
    插入代码:Ctrl/Command + Shift + K
    插入链接:Ctrl/Command + Shift + L
    插入图片:Ctrl/Command + Shift + G
    查找:Ctrl/Command + F
    替换:Ctrl/Command + G

    合理的创建标题,有助于目录的生成

    直接输入1次#,并按下space后,将生成1级标题。
    输入2次#,并按下space后,将生成2级标题。
    以此类推,我们支持6级标题。有助于使用TOC语法后生成一个完美的目录。

    如何改变文本的样式

    强调文本 强调文本

    加粗文本 加粗文本

    标记文本

    删除文本

    引用文本

    H2O is是液体。

    210 运算结果是 1024.

    插入链接与图片

    链接: link.

    图片: Alt

    带尺寸的图片: Alt

    居中的图片: Alt

    居中并且带尺寸的图片: Alt

    当然,我们为了让用户更加便捷,我们增加了图片拖拽功能。

    如何插入一段漂亮的代码片

    博客设置页面,选择一款你喜欢的代码片高亮样式,下面展示同样高亮的 代码片.

    // An highlighted block
    var foo = 'bar';
    

    生成一个适合你的列表

    • 项目
      • 项目
        • 项目
    1. 项目1
    2. 项目2
    3. 项目3
    • 计划任务
    • 完成任务

    创建一个表格

    一个简单的表格是这么创建的:

    项目Value
    电脑$1600
    手机$12
    导管$1

    设定内容居中、居左、居右

    使用:---------:居中
    使用:----------居左
    使用----------:居右

    第一列第二列第三列
    第一列文本居中第二列文本居右第三列文本居左

    SmartyPants

    SmartyPants将ASCII标点字符转换为“智能”印刷标点HTML实体。例如:

    TYPEASCIIHTML
    Single backticks'Isn't this fun?'‘Isn’t this fun?’
    Quotes"Isn't this fun?"“Isn’t this fun?”
    Dashes-- is en-dash, --- is em-dash– is en-dash, — is em-dash

    创建一个自定义列表

    Markdown
    Text-to- HTML conversion tool
    Authors
    John
    Luke

    如何创建一个注脚

    一个具有注脚的文本。2

    注释也是必不可少的

    Markdown将文本转换为 HTML

    KaTeX数学公式

    您可以使用渲染LaTeX数学表达式 KaTeX:

    Gamma公式展示 Γ ( n ) = ( n − 1 ) ! ∀ n ∈ N \Gamma(n) = (n-1)!\quad\forall n\in\mathbb N Γ(n)=(n1)!nN 是通过欧拉积分

    Γ ( z ) = ∫ 0 ∞ t z − 1 e − t d t   . \Gamma(z) = \int_0^\infty t^{z-1}e^{-t}dt\,. Γ(z)=0tz1etdt.

    你可以找到更多关于的信息 LaTeX 数学表达式here.

    新的甘特图功能,丰富你的文章

    Mon 06 Mon 13 Mon 20 已完成 进行中 计划一 计划二 现有任务 Adding GANTT diagram functionality to mermaid
    • 关于 甘特图 语法,参考 这儿,

    UML 图表

    可以使用UML图表进行渲染。 Mermaid. 例如下面产生的一个序列图:

    张三 李四 王五 你好!李四, 最近怎么样? 你最近怎么样,王五? 我很好,谢谢! 我很好,谢谢! 李四想了很长时间, 文字太长了 不适合放在一行. 打量着王五... 很好... 王五, 你怎么样? 张三 李四 王五

    这将产生一个流程图。:

    链接
    长方形
    圆角长方形
    菱形
    • 关于 Mermaid 语法,参考 这儿,

    FLowchart流程图

    我们依旧会支持flowchart的流程图:

    Created with Raphaël 2.3.0 开始 我的操作 确认? 结束 yes no
    • 关于 Flowchart流程图 语法,参考 这儿.

    导出与导入

    导出

    如果你想尝试使用此编辑器, 你可以在此篇文章任意编辑。当你完成了一篇文章的写作, 在上方工具栏找到 文章导出 ,生成一个.md文件或者.html文件进行本地保存。

    导入

    如果你想加载一篇你写过的.md文件,在上方工具栏可以选择导入功能进行对应扩展名的文件导入,
    继续你的创作。


    1. mermaid语法说明 ↩︎

    2. 注脚的解释 ↩︎

    展开全文
  • VB实现向指定窗口发送组合键

    千次阅读 2015-05-31 09:36:45
    模拟键盘http://hi.baidu.com/%B7%BF%B6%F7%BA%EA/blog/item/621c35c45b7a2fae8226ac2a.html   ...   待解决问题 ...vb WM_KEYDOWN 参数设置????  (离问题结束还有0天0小时) id
  • VB文本加密 特别设计到中文加密 让很多人费尽周折,经常会碰到解密中文出现乱码的情况下面这篇文章将对此做了说明计算机世界2000年第36期实现中文文本的加密方法武汉交通科技大学计算机科学与工程系 吴业福本文介绍了...
  • 如果数据使用简单的文本(标准 ASCII码),那么每个数据包使用7位数据。每个包是指一个字节,包括开始/停止位,数据位和奇偶校验位。由于实际数据位取决于通信协议的选取,术语“包”指任何通信的情况。
  • 例如文本框里输入253chr(13)255chr(13),要求输出结果书“&HFD” "&HFF",看了好多算法,但是还是没有...如输入255,显示的字符串&HFF,但是发送过去后不对,是把那个转换成了& H F F四个字符的ascii吗。。这是什么鬼。。
  • 用vc控件,读取串口数据,ascii和16进制2种方式
  • vb程序,显示利用控件,打开设置串口,发送和接收ascii码的上位机基本应用。适用和单片机通信。
  • 内容索引:VB源码,系统相关,串口 小巧的VB串口调试精灵软件源码,程序可以自动、手功向串口发送消息,并可实现接收,显示时候能够按照十六进制码、ASCII码、标准地址、4、8位地址显示,发送时候也可以选择这些编码,...
  • VB键盘事件shift参数,vb*mask

    千次阅读 2016-11-26 12:43:09
    VB 键盘按键事件的shift参数以及vbshiftmask,vbctrlmask,vbaltmask前瞻:1.shift参数值表 以及 vb*mask 值表2.ShiftDown=(Shift And vbShiftMask)>0如何理解正文:1.shift参数值表 以及 vb*mask 值表比如这两个函数...
  • 内容索引:VB源码,系统相关,串口 串口编程调试工具的VB源代码,支持手动和自动发送消息,设置参数,可以按十六进制,ASCII码、地址、4/8位地址接收消息,发送时也支持本选项。
  • 这是我3年前的一个例子,最近翻出来回忆一下。 串口是计算机上一种非常通用设备通信的协议。大多数计算机包含两个基于RS232的串口,现在配...串口通信的概念非常简单,串口按位(bit)发送和接收字节。尽管比按字节(...
  • VB.NET串口通信例子--我的回忆录

    万次阅读 多人点赞 2011-11-13 19:16:38
    这是我3年前的一个例子,最近翻出来回忆一下。 串口是计算机上一种非常通用设备通信的协议。大多数计算机包含两个基于RS232的串口,现在配...串口通信的概念非常简单,串口按位(bit)发送和接收字节。尽管比按字节
  • 代码附着大量注释,用大白话解释清楚代码意思,非常适用刚接触vb的小白。
  • VB6.0使用汇总一

    2019-04-04 20:19:50
    2)退出VB6.0时显示Visual Basic已经停止工作 二、软件的使用 1、VB输出可执行文件或安装包 2、ComboBox 控件的使用 3、MsComm串口控件 1)MsComm控件的添加 2)MsComm控件的事件及基本属性 4、添加引用无...
  • VB模拟键盘输入的N种方法

    千次阅读 2017-10-17 09:01:25
    VB模拟键盘事件的N种方法 键盘是我们使用计算机的一个很重要的输入设备了,即使在鼠标大行其道的今天,很多程序依然离不开键盘来操作。但是有时候,一些重复性的,很繁琐的键盘操作总会让人疲惫,于是就有了用...
  • (1) 开头字符(STX):ASCI I之开始字符STX,接收方以此判知传输数据之开头; (2) 从站号码:为两位数之16进制数值,在永宏PLC通讯系统中之网络架构采用主从系统在整个网络系统中只有一个主系统,但可以有254个从系统...
  • Public Sub SetBinaryMode(ByVal bMode As Boolean) If (bMode) Then '发送FTP命令,设置为二进制模式 '(TYPE是一种用作说明请求类型的FTP命令.) SendCommand("TYPE I") Else '发送FTP命令,设置ASCII模式。...
  • VB.Net 串口通信用法

    千次阅读 2012-06-17 09:39:42
    对于初次使用VB.Net 的 SerialPort 编写串口通信的朋友,这些是很必要的知识,也是编写串口通信程序前的知识准备。 1、使用 SerialPort 设置串口属性  进行串口通讯时,需要设置一些相关参数,可以通过设置...
  • vb sendmessage 详解

    千次阅读 2016-01-14 18:51:44
    EN_MAXTEXT(&H501=1281) 用户输人的文字数超出由EM_LIMITTEXT消息规定的界限,或超出由VB Maxlength属性规定的界限,就会发送这条消息 。此外,倘若不允许自动进行水平滚动,同时插入点要超出控件的宽度;或者不允许...
  • VB使用API的简明教程

    2021-03-29 15:23:30
    让我们想想,VB里的CommandButton控件让我们可以做什么?按下、弹起,还有呢?请看看图3,这样的情况在你的程序运行时出现过吗?  Windows是以消息来传递信息的。当出现某个操作,比如按钮被按下,就产生按钮被...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 3,525
精华内容 1,410
关键字:

vb发送ascii码