[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖
回复 26# tkaven
CAPI的语法挺简单的,结构体的处理的话,开一片内存往里面写数据就好了
第三方命令行工具编程
Http://Hi.Baidu.Com/Console_App

TOP

VERSION 5.00
Begin VB.Form TipBall
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   BorderStyle     =   0  'None
   Caption         =   "气泡"
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Enabled         =   0   'False
   FillColor       =   &H80000005&
   FillStyle       =   0  'Solid
   FontTransparent =   0   'False
   ForeColor       =   &H80000005&
   HasDC           =   0   'False
   Icon            =   "气泡主体.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   NegotiateMenus  =   0   'False
   ScaleHeight     =   3600
   ScaleMode       =   0  'User
   ScaleWidth      =   4800
   ShowInTaskbar   =   0   'False
   Visible         =   0   'False
End
Attribute VB_Name = "TipBall"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

'托盘API 模块
Private M_IconData As NOTIFYICONDATA
Private Type NOTIFYICONDATA
   cbSize As Long
   hwnd As Long
   uID As Long
   uFlags As Long
   uCallbackMessage As Long
   hIcon As Long
   szTip As String * 128
   dwState As Long
   dwStateMask As Long
   szInfo As String * 256
   uTimeout As Long
   szInfoTitle As String * 64
   dwInfoFlags As Long
End Type
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

'使用高分辨率图标所用的API
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long

Private Declare Function timeGetTime Lib "winmm.dll" () As Long '延迟API
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '避免延迟时CPU使用率过高 Sleep API

Dim CountStrC As Integer
  '统计参数个数
  
Dim Strcmd '参数拆分后的数组

Dim Info, TitleAndKind, Title, TipKinds, Start_Pro As String
   '内容 标题与提示种类  标题  提示种类 点击运行
   
Dim Hide_Start As Boolean '是否隐藏启动点击运行

Dim TrayIcon '用于存高分辨率图标

Dim SleepT '延迟时间
Dim Begintime As Double '记录当前时间



Private Sub Form_Load()
    Me.Hide '无窗口
    On Error GoTo EndPor '防止拖拽(如果参数类型不对则结束程序)

    If InStr(Command, ";;") <> "0" Then '如果参数不为空 则

        Strcmd = Split(Command, ";;") '拆分所有参数

        CountStrC = UBound(Strcmd) - LBound(Strcmd) + 1 '获取参数 数目

            Dim Tmp As String, i '自定义延迟 时 获取延迟时间
            For i = 1 To Len(Strcmd(0)) '只获取数字
                Tmp = Mid(Strcmd(0), i, 1)
                If Asc(Tmp) <= Asc("9") And Asc(Tmp) >= Asc("0") Then SleepT = SleepT & Tmp
            Next

                If CountStrC >= "2" Then  '如果有标题 则

                    If Strcmd(1) <> "" Then '如果标题不为空 则
                        If InStr(Strcmd(1), "#@") <> "0" Then '如果指定了标题类型 则
                            TitleAndKind = Split(Strcmd(1), "#@") '拆分标题 与 标题类型 参数 并存入 数组
                            Title = TitleAndKind(0) '获取标题
                           
                            '设定提示类型
                            If TitleAndKind(1) = "0" Then
                                TipKinds = &H0 '无标题图标
                            Else
                                If TitleAndKind(1) = "1" Then
                                    TipKinds = &H7 '询问标题图标
                                Else
                                    If TitleAndKind(1) = "2" Then
                                        TipKinds = &H2 '感叹标题图标
                                    Else
                                        If TitleAndKind(1) = "3" Then
                                            TipKinds = &H3 '错误标题图标
                                        Else
                                            If TitleAndKind(1) = "4" And CountStrC >= "5" Then If Trim(Strcmd(4)) <> "" Then TipKinds = &H4 '当设定了 托盘图标与4时,设定标题图标 同 托盘图标
                                        End If
                                    End If
                                End If
                            End If

                        Else
                            Title = Strcmd(1) '没指定类型时 直接 获取标题
                        End If
                    Else '如果标题为空 则
                        TipKinds = &H0 '无提示类型
                    End If


                    If CountStrC >= "3" Then

                        Info = Replace((Strcmd(2)), "\n", vbCrLf)  '获取内容 并 转义"\n"回车符

                        If CountStrC >= "4" Then '如果有点击后 运行的命令
                            If InStr(Strcmd(3), "##") <> "0" Or InStr(Strcmd(3), "##") <> "0" Then '如果指定为隐藏运行 获取命令路径 并 删除 ##
                                Start_Pro = Replace(Strcmd(3), "##", "")
                                Hide_Start = True
                            Else
                                Start_Pro = Trim(Strcmd(3)) '否则直接 获取点击后 运行的命令
                            End If

                            If CountStrC >= "5" Then
                                TrayIcon = LoadImage(App.hInstance, Trim(Strcmd(4)), 1, 16, 16, &H10 Or &H1000)   '先检测图标文件是否存在 如存在自定义托盘图标
                                If Trim(Strcmd(4)) <> "" Then If TrayIcon = "0" Then GoTo TrayIcoHelp '如果托盘ICO 文件类型不对 则提示错误
                            End If
                           
                        End If

                    End If

                    If Info = "" Then '如果内容为空 则 提示错误
                        Info = "提示内容应不为空"
                        Show_Error '调用错误 处理
                    End If

                End If

    Else '如果参数里不含分号 则
        If Command = "" Then '如果参数为空 则 显示参数格式
            Title = "气泡 调用参数 "
            Info = "[时间];;[标题[#@标题图标]];;内容;;" & vbCrLf & "[点击后执行的命令[##]];;[托盘图标路径]" & vbCrLf & vbCrLf & "正键 点击我 查看参数详细说明"
            SleepT = 20000
        Else '如果有参数 但参数没包含分号
            Info = "请键入 参数分隔符" & vbCrLf & "参数分隔符为两个西文半角的 分号"
            Show_Error '调用错误 处理
        End If
    End If


    Begintime = timeGetTime '记下开始时的时间
    While timeGetTime < Begintime + 2600  '循环等待原托盘 退出
        Por_Num = 0 '初始化 进程 数值
        Call EnumWindows(AddressOf EnumWindowsProc, 0)   ' 检测是否有新的 调用
        If Por_Num < 2 Then Tip_Show '调用气泡
        Sleep 3 '避免延迟时CPU使用率过高
        DoEvents '转让控制权,以便让操作系统处理其它的事件。
    Wend
   
'################## 以下为错误 处理 #####################

EndPor: End '防止拖拽 (注意这行不可改变位置与删除,须接在循环等待后面)

TrayIcoHelp:    Info = "自定义托盘图标参数错误" & vbCrLf & "所指定的不是 .Ico文件"
                Show_Error '调用错误 处理

'################## 以上为错误 处理 #####################

End Sub


Private Sub Show_Error() '错误处理
        '初始化错误参数
        Title = "参数错误!"
        TipKinds = &H3
        SleepT = 0
        Start_Pro = ""
        Tip_Show '调用气泡 显示错误信息
End Sub


Private Sub Tip_Show()
    With M_IconData
        .cbSize = Len(M_IconData)
        .hwnd = Me.hwnd
        .uID = vbNull
        .uFlags = &H2 Or &H10 Or &H1 Or &H4 '设定托盘图标、提示图标、信息栏
        .uCallbackMessage = &H200
        .hIcon = TrayIcon '托盘图标
        .szTip = "气泡提示" & vbNullChar
        .dwState = 0
        .dwStateMask = 0
        If SleepT = 0 Then SleepT = 7000 '有参数时的 默认延迟
        .uTimeout = SleepT
        .szInfo = Info + Chr(0)  '内容
        .szInfoTitle = Title + Chr(0) '标题
        If TipKinds = "" Then TipKinds = &H1 '当标题图标为空时 设定 标题图标为 普通标题图标
        .dwInfoFlags = TipKinds '提示类型
    End With
    Shell_NotifyIcon &H0, M_IconData '创建托盘图标

    '调用延迟
    Begintime = timeGetTime '记下开始时的时间
        While timeGetTime < Begintime + SleepT '循环等待
            Por_Num = 0 '初始化 进程 数值
            Call EnumWindows(AddressOf EnumWindowsProc, 0)   ' 检测是否有新的 调用
            If Por_Num >= 2 Then Tip_Exit '调用退出
            Sleep 2 '避免延迟时CPU使用率过高
            DoEvents '转让控制权,以便让操作系统处理其它的事件。
        Wend
    Tip_Exit '调用退出
End Sub

Private Sub Tip_Exit()
    Shell_NotifyIcon &H2, M_IconData '删除托盘图标
    End '退出程序
End Sub




'鼠标事件
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim cEvent As Single
    cEvent = x / Screen.TwipsPerPixelX
    Select Case cEvent
        Case 512
            'Debug.Print "MouseMove"
        Case 1026
            'Debug.Print "气泡显示"
        Case 1028 '右键点击或关闭气泡
            Tip_Exit '调用退出
        Case 1029 '左键或中键点击气泡
            If Title = "气泡 调用参数 " Then
                Dim TxtHelp As String
                TxtHelp = vbCrLf & vbCrLf
                TxtHelp = TxtHelp & "参数格式:" & vbCrLf & "[ShowsTime];;[Title[#@TitleIcoType]];;Text;;[ClickRun_FilePath[##]];;[TrayIco_FilePath]" & vbCrLf & vbCrLf
                TxtHelp = TxtHelp & "ShowsTime         气泡显示时间 单位Ms" & vbCrLf
                TxtHelp = TxtHelp & "Text              内容(支持 \n 回车转义符)" & vbCrLf
                TxtHelp = TxtHelp & "Title             标题" & vbCrLf
                TxtHelp = TxtHelp & "TitleIcoType      标题图标类型 0:无图标、1:询问图标、2:感叹图标、3:错误图标、4:同托盘图标" & vbCrLf
                TxtHelp = TxtHelp & "ClickRun_FilePath 鼠标正键点击气泡后 运行的外部程序" & vbCrLf
                TxtHelp = TxtHelp & "##                无窗口运行点击气泡后的外部程序" & vbCrLf
                TxtHelp = TxtHelp & "TrayIco_FilePath  自定义托盘图标文件路径 (支持XP样式的 .Ico图标!)" & vbCrLf & vbCrLf
                TxtHelp = TxtHelp & "注:   ""[ ]""       中为可选参数、参数分隔符为两个西文半角的分号" & vbCrLf & vbCrLf & vbCrLf
                TxtHelp = TxtHelp & "各项参数的缺省值: 标题图标为提示图标、显示7000ms、无托盘图标、无点击气泡后执行的命令" & vbCrLf & vbCrLf & vbCrLf
                TxtHelp = TxtHelp & "调用举例:" & vbCrLf
                TxtHelp = TxtHelp & """程序路径""  9000;;凌枫工作组#@2;;By T_kaven\nQQ群:35962310\n\n点击我 打开记事本;;%Windir%\Notepad.exe"
                MsgBox TxtHelp, 65536, "参数详细说明 (点击确定后 本帮助会自动复制到剪切板)"
                Clipboard.Clear '清除剪贴板
                Clipboard.SetText TxtHelp '将帮助文本传送到剪贴板
                Info = "By T_kaven" & vbCrLf & "QQ群:35962310" & vbCrLf & vbCrLf & "点击我 打开记事本"
                Title = "凌枫工作组"
                SleepT = 9000
                TipKinds = &H2 '感叹提示
                Start_Pro = Environ$("windir") & "\Notepad.exe"
                Shell_NotifyIcon &H2, M_IconData '删除托盘图标
                Tip_Show '调用气泡
            Else
                If Start_Pro <> "" Then '如果有点击后的命令则
                    On Error Resume Next '如果找不到 文件 则忽略(不检测文件是否存在 用于支持带参数运行)
                    If Hide_Start = True Then
                        Shell (Start_Pro), vbHide '如果 Hide_Start = True 隐藏运行
                    Else
                        Shell (Start_Pro), vbNormalFocus '否则 正常运行
                    End If
                End If
            End If
            Tip_Exit '调用退出
    End Select
End Sub

TOP

能否 把 下面这个 VB 源码 翻译成 cmd 脚本版的呢?  期待  话说 好久没来这论坛 逛了呢,哈哈~

TOP

还有 我对 win32 API 的有些 API 的 语法不太熟悉 有空请教你。。。。。 话说能否用这个做个托盘体跑提示呢? 哈哈 应该没问题的吧 估计不需要 多少行代码,有空的话 帮我留意一下  我只知道基本的要用到 "shell32" "LoadImageA" 这两个API

TOP

支持下,表示 玩到 21 层 打不过 改 SaveData.txt 过了 = =  囧

TOP

继续强力支持一下~
SYBN QQ:354324773

TOP

哇哦,老牛逼了

TOP

11/24/12
修正了穿墙的BUG
修正了一些音效遗漏
第三方命令行工具编程
Http://Hi.Baidu.Com/Console_App

TOP

表示神秘源码看不懂。

TOP

回复 16# tmplinshi
我擦…测试时候开挂发布忘记修回去了…
第三方命令行工具编程
Http://Hi.Baidu.Com/Console_App

TOP

膜拜一下。

TOP

本帖最后由 tmplinshi 于 2012-11-21 14:07 编辑
11/20/12:更新1.1
增加重新开始菜单项和快捷键R
增加CAPI运行检测
移除窗口默认菜单项
移除多余文件
修正游戏逻辑错误
修正对话框反应过快
修正音效在动作完成前播放 ...
defanive 发表于 2012-11-18 10:57


可以穿墙

TOP

BUG 当金币和经验超过100时,红钥匙的 字会只有一半,且数量看不到。
当就是图 _ui 会把靠窗口右边的文字挡住。

如 5 楼、8 楼图
如无特别说明,代码测试环境均为 XP SP3

TOP

设为信任还是会
彻底关掉杀软也不行

看来我的系统(XP)是有大问题了。
如无特别说明,代码测试环境均为 XP SP3

TOP

回复 12# cutebe
注入失败了
试一下关掉杀软,或者把capi.exe和dll设为信任
第三方命令行工具编程
Http://Hi.Baidu.Com/Console_App

TOP

返回列表