快Key：按一下机械鼠标【拨器】，帮你自动填写用户名密码，登录，可制作U盘空间庄园(中国开源手机免费-附安装盘和源代码)
* 代码以本文所附下载文件包为准，安装文件和源文件包均在本文尾部可下载。
* 快Key及本文所有内容仅供交流使用，使用者责任自负，由快Key对使用者及其相关人员或组织造成的任何损失均由使用者自负，与本人无关。开始使用即表示接受此约定。
跳至最新下载章节
最新版本：V2.5， 2020.10.10发布。本文代码可能不是最新版。最新版以下载附件为准。
主要更新：（1）增加U盘随身版功能；（2）升级加密算法；（3）自动搜索已安装浏览器；（4）更稳定。
目 录
前言
1 基本原理与思路
2 全部文件
3 安装文件及源代码下载
4 倡议与致谢
5 出现问题与解决办法
6 联络信息
前言
阿色快疯了。被一大堆密码整疯了。
每天要使用的系统太多，一个系统一个密码，实在记不住。
近年来，信息安全要求也越来越严格，密码已经成为了我们的沉重负担。
20年前，阿色就面临这个问题。那时，阿色和伙伴们指望着统一认证系统的建立来解决问题。
20年过去了，各种认证系统都建立了，问题还是没有解决。
这也是信息化的一个经验：不是一集中就什么事都搞定了！
看来，再不解决阿色就退休了，阿色急眼了，阿色自己干！
这段时间，利用中午、晚上、节假日等闲暇时间，阿色做了个小程序，自认为比较好地解决了密码管理与使用问题。
阿色发挥大系统观思维，调整解决问题的角度——从“强组织”的认证中心转到“自组织”的电脑端——用终端程序解决。
阿色就编了个小程序，你把你的登录系统地址、用户名、密码等存到这个小程序里。
使用的时候，你按【鼠标滚轮】呼出这个小程序，点击相应按钮，它就自动填写用户名、密码等，然后自动登录系统。
登录信息电脑本地加密存储，不联网，不上传，符合安全规定，不必担心安全问题。
阿色只能帮你这些了，再帮就过界了，信息安全规则就不允许了。
本来跟弟兄们吹牛说3天搞定，结果搞了3个星期，这段时间工作也忙，几度想放弃了。
系统程序太难编了，细节太多，OS版本太多，差异太大。特别是对新系统阿色也生疏了。
但不管咋样，吹的牛还算是兑现了。
我先抛出来个初级版本，咱们还是开源吧，有兴趣的朋友接着做吧。
OK！主角该出场了。她叫——
快Key，英文名叫 QuicKeys。
好了！她来了她来了！她迈着优美的步伐走来了！Serve！
记住：
按鼠标【滚轮】！
按鼠标【滚轮】！
按鼠标【滚轮】！
祝你使用愉快！
安装前设置统一密码，用来给你原来所有密钥加密
浏览器或各种EXE都可以启动、登录
设置你自己的信息和要求
1基本原理与思路
'×××××××××××××××××××××××××××××××××××××××××××××××× 快Key（QuicKeys） 源码 ×××××××××××××××××××××××××××××××××××××××××××××××××××××
'* *
'* 版本：2.5 释放日期：2020.10.10 作者：王权（阿色） QQ:583389416 微信公众号：大系统观开放论坛 开发环境：Visual Basic 6.0 企业版 *
'* 功能：自动启动浏览器或exe文件，自动填写用户名、密码。最多管理30个密钥。可利用自带控制板制作U盘随身版，能够运行在其他电脑上。 *
'* 运行环境：Windows XP、Windows 7-10。XP需要单独编译。需要COMDLG32.OCX。 *
'* 安装路径：C:\QuicKeys 数据存储路径：与安装路径相同。用于启停、卸载和制作U盘随身版的控制板快捷方式安装在电脑桌面。 *
'* 基本原理：安装Hook，截获鼠标中键（滚轮）消息，按滚轮呼出程序，通过此程序自动填写用户名、密码等登录信息，这些信息事先已经保存，并加密。 *
'* 为了给各个密钥加密，需要一个“统一密码”，由用户自行设定。用户只要记住此密码即可打开各个原有密钥，并自动填写登录。 *
'* 统一密码也需要加密，给它加密的密码由开发者和用户自动联合设定，即初始密码。这样可以保证包括开发者和用户在内的任何人都无法破解统一密码。 *
'* 但为安全起见，请开发者严格保守己方所设密码，注意在发布源代码时删除此密码。加解密采用业界通用技术，并使用了加盐和密文等长等策略。 *
'* 开发者密码的风险很小，因为它并不登录真正的信息系统，且快Key是离线运行的，开发者无法获取用户端的联合密码和其他任何密钥信息，也就无法解密。 *
'* 特别说明：安装、更新、版本替换文件与运行时文件均用本文件，但要使用不同的文件名，运行文件为QuicKeys.exe，安装文件要改名。具体如下： *
'* （1）编译成QuicKeys.exe。 *
'* （2）按本条模式改名，必须包含setup字样，用于安装（安装和平时运行其实是一个EXE）：快Key-登录助手-安装-QuicKeys_2-0_Setup_for_Win7-10_20200923.exe。 *
'* 这样的话，安装时会以管理员身份运行，平时后台启动以普通用户身份，避免安全软件询问。 *
'* （3）另有控制板 StartQuicKeys.exe,用于桌面控制快Key的启停，还可制作U盘随身版。 *
'* （4）需要COMDLG32.OCX，要一起zip。最后将所有相关文件压缩为ZIP发布。 *
'* （5）快Key为开源软件，鼓励积极共享。本代码可任意发布，责任与权益由发布者自负。 *
'* *
'×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××
为什么快Key更安全？
快Key算法公开，密钥与算法分离，符合安全技术规范。
破解方法只有暴力一招，这是所有加密技术都要面对的。
快Key模拟手动输入，本身不联网，不收集和上传任何信息。所以，它至少跟手工输入安全水平相同。
而实际上，快Key比手工更安全。因为:
(1)为了好记，用户会趋向于设置更简单的密码，甚至所有系统都设成同样的密码。一个系统泄露，所有系统都面临巨大风险。而快Key能帮你记录密码，所以用户可以更容易地使用不同的复杂密码。
(2)用户明文记录密码也很普遍，这样很危险。快Key采用通用算法加密你的密码，只有暴力破解才能破译。这让用户系统更安全。
(3)实际上很多浏览器等也提供密码保存功能，它是联网的，你不知道它是否上传了你的密码。而快Key不连网，传不了密码，而且快Key提供源码，用户可以检查源码，并自行编译。安不安全一目了然。
(4)与集中式的认证中心相比，快Key不需要在认证的过程中通过网络传输登录信息，降低了安全风险。
为什么用快Key?
有朋友问我：有跟快Key一样或者更强的软件，比如keepass、lastpass，你为啥不用？
我的回答是:一是它连网，我不放心；二是它太麻烦，我要傻瓜型的，我想让它召之即来挥之即去，我设计的是按鼠标滚轮就出来；三是它要钱，我穷。
2 全部文件
此为V2.5版源代码，最新代码以附件（本文尾）为准。
跳至最新下载章节
2.1 主体程序：QuicKeys.exe
2.1.1 工程文件
（1）QuicKeys.vbw
**********************************************************************************************************************************************
Module_Common = -40, 28, 1167, 802,
FM_Add_Key = 104, 104, 1311, 630, Z, 78, 78, 1285, 604, C
FM_Config_Key = 208, 208, 1389, 797, , 182, 182, 1363, 771, C
FM_Check_UniKey_Setup = 26, 180, 1249, 759, , 52, 122, 1275, 665, C
FM_Help_Key = 260, 260, 953, 803, , 260, 260, 1500, 803, C
FM_Send_Info = 182, 182, 1296, 725, , 0, 0, 1240, 543, C
FM_Start_Note = 208, 208, 1322, 751, , 26, 26, 1266, 569, C
FM_Check_UniKey = 208, 208, 1359, 751, , 52, 52, 1292, 595, C
FM_Main = 156, 156, 1396, 699, , 130, 130, 1370, 673, C
FM_Select_Browser = 182, 182, 1422, 725, , 78, 78, 1318, 621, C
************************************************************************************************************************************************
（2）QuicKeys.vbp
*************************************************************************************************************************************************
Type=Exe
Reference=*\G{56A868B0-0AD4-11CE-B03A-0020AF0BA770}#1.0#0#C:\Windows\System32\quartz.dll#ActiveMovie control type library
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX
Module=Module_Common; Module_Common.bas
Form=FM_Add_Key.frm
Form=FM_Config_Key.frm
Form=FM_Check_UniKey_Setup.frm
Form=FM_Help_Key.frm
Form=FM_Send_Info.frm
Form=FM_Start_Note.frm
Form=FM_Check_UniKey.frm
Form=FM_Main.frm
Form=FM_Select_Browser.frm
IconForm="FM_Main"
Startup="FM_Main"
HelpFile=""
Title="QuicKeys"
ExeName32="QuicKeys.exe"
Command32=""
Name="QuicKeys"
HelpContextID="0"
CompatibleMode="0"
MajorVer=2
MinorVer=5
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="大系统观开放论坛"
VersionLegalCopyright="开源软件 自由版权 作者：王权"
VersionLegalTrademarks="BSV 大系统观"
VersionProductName="快Key (QuicKeys)"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
***********************************************************************************************************************************************
2.1.2 各模块及Form代码
（1）公共模块：Module_Common.bas
*******************************************************************************************************************************************************************
Attribute VB_Name = "Module_Common"
'********************************************************** 快Key（QuicKeys） 源码 ***********************************************************************
'* *
'* 版本：2.5 释放日期：2020.10.10 作者：王权（阿色） QQ:583389416 微信公众号：大系统观开放论坛 开发环境：Visual Basic 6.0 企业版 *
'* *
'* 功能：自动启动浏览器或exe文件，自动填写用户名、密码。最多管理30个密钥。可利用自带控制板制作U盘随身版，能够运行在其他电脑上。 *
'* 运行环境：Windows XP、Windows 7-10。XP需要单独编译。需要COMDLG32.OCX。 *
'* 安装路径：C:\QuicKeys 数据存储路径：与安装路径相同。用于启停、卸载和制作U盘随身版的控制板快捷方式安装在电脑桌面。 *
'* 基本原理：安装Hook，截获鼠标中键（滚轮）消息，按滚轮呼出程序，通过此程序自动填写用户名、密码等登录信息，这些信息事先已经保存，并加密。 *
'* 为了给各个密钥加密，需要一个“统一密码”，由用户自行设定。用户只要记住此密码即可打开各个原有密钥，并自动填写登录。 *
'* 统一密码也需要加密，给它加密的密码由开发者和用户自动联合设定，即初始密码。这样可以保证包括开发者和用户在内的任何人都无法破解统一密码。 *
'* 但为安全起见，请开发者严格保守己方所设密码，注意在发布源代码时删除此密码。加解密采用业界通用技术，并使用了加盐和密文等长等策略。 *
'* 开发者密码的风险很小，因为它并不登录真正的信息系统，且快Key是离线运行的，开发者无法获取用户端的联合密码和其他任何密钥信息，也就无法解密。 *
'* 特别说明：安装、更新、版本替换文件与运行时文件均用本文件，但要使用不同的文件名，运行文件为QuicKeys.exe，安装文件要改名。具体如下： *
'* （1）编译成QuicKeys.exe。 *
'* （2）按本条模式改名，必须包含setup字样，用于安装（安装和平时运行其实是一个EXE）：快Key-登录助手-安装-QuicKeys_2-0_Setup_for_Win7-10_20200923.exe。 *
'* 这样的话，安装时会以管理员身份运行，平时后台启动以普通用户身份，避免安全软件询问。 *
'* （3）另有控制板 StartQuicKeys.exe,用于桌面控制快Key的启停，还可制作U盘随身版。 *
'* （4）需要COMDLG32.OCX，要一起zip。最后将所有相关文件压缩为ZIP发布。 *
'* （5）快Key为开源软件，鼓励积极共享。本代码可任意发布，责任与权益由发布者自负。 *
'* *
'*******************************************************************************************************************************************************************
'******************************************************************* QuicKeys.exe **********************************************************************************
'************************************************************************* 定义常量 ，常量为大写加下划线 *********************************************************
Option Explicit
Public Const VER_NUM = "V2.5 Win7+" 'Win7-10编译时使用
'Public Const VER_NUM = "V2.5 WinXP" 'WinXP编译时使用
Public Const QK_TITLE = "快Key"
Public Const MAX_KEYS_NUM = 30 '可管理密钥最大数
Public Const AWQK = "ArthurW|QuicKeys_20200925@DQ;-)/ BigSystemsView^I*Love=China!" '用于开发者和用户共同加密统一密码，避免开发者和用户破解。此为示意，非真实值
Public Const MAIN_FORM_MAX_HEIGHT = 6345 'QuicKeys整个窗口的最大高度
Public Const SALTLEN = 4 '盐的长度
Public Const PWMAXLEN = 128 '密码最大长度
Public Const WEB_BROWSERS_LIST = "IE |IEXPLORE,Edge |MICROSOFTEDGE,谷歌 |CHROME,火狐 |FIREFOX,360 |360SE,360极速 |360CHROME,搜狗 |SOGOUEXPLORER,欧朋 |OPERA,QQ |QQBROWSER"
'************************************************************************* 定义全局变量 ，全局变量以g 开头 ********************************************************
Public gOldVerNum As String '已安装的版本号
Public gInstalled As Boolean '是否已经安装
Public gKeyIndex, gMaxIndex, gRealNum, gFirstSpaceNum As Integer '密钥编号， 密钥最大编号，实际使用个数 ，第一个密钥空位
Public gSysName As String '系统名称,具体系统
Public gBrowser As String '浏览器或程序
Public gURL As String 'gURL或参数
Public gUserName As String '用户名，具体系统
Public gPassWord As String '密码，具体系统
Public gTabNum1, gTabNum2 As Integer '用户名跳到密码需要TAB次数，密码跳到回车需要TAB次数
Public gManConfirm As Integer '填完用户密码后是否手动确认提交，1表示手动，0表示程序自动提交
Public gMouseX, gMouseY, gMouseXPre, gMouseYPre, gMouseXPreT, gMouseYPreT As Integer '鼠标坐标,当前和上一次
Public gShowFunc As Boolean '右上角功能键是否显示
Public gDelOrNot As Boolean '删除键是反复的，再按一次退出删除状态，标记是否正处于操作状态
Public gTotalRealKeyNum, gTotalServeTimes As Integer '实际密钥总数，服务次数总计
Public gUniPassBase As String '用户输入的统一密码，它被分裂为程序实际使用的统一密码和给统一密码加密的gFirstEncryptKey
Public gUniPassword, gOldUniPassword As String '快Key的统一密码
Public gFirstEncryptKey As String '给统一密码加密
Public gCheckUniPWMode, gCheckUniPWCycle As String '检查统一密码的方式、周期
Public gUniPWChecked As Boolean '如果启动本程序后检查过统一密码，此值true
Public gInConfig As Boolean '正在设置中
Public gLockMouseMidButton, gLock_FM_Send_Info As Boolean '锁死鼠标中键，即不响应
Public gDelOrEdit As Integer '因为删除和编辑修改密钥使用了同一个按钮组BT_DEL_Single，所以需要区分。1表示删除，2表示编辑
Public gQuicKeysDataPath, gQuicKeysRunPath As String 'QuicKeys 运行在我的文档中
Public gUDiskMode As Boolean 'U盘随身模式
Public gSysTempPath, gSysDeskTopPath As String 'Windows系统临时目录,系统桌面路径
Public gMyTwipsPerPixelX, gMyTwipsPerPixelY As Integer '窗体坐标与屏幕分辨率比值，因为VB不能正确获得大分辨率屏幕的 Screen.TwipsPerPixelX，只能采取测试法
Public gIEInstead As Boolean '随身版用，当临时电脑没有启动成功浏览器或程序时，用IE替代
Public gWebBrowsers() As String '浏览器名称、EXE数组，将常用浏览器参数存入该数组
'*******************************************************************************************************************************************************************
'************************************************************** 声明及相关定义 *************************************************************************************
Public Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const SWP_NOMOVE = &H2 '不移动窗体
Public Const SWP_NOSIZE = &H1 '不改变bai窗体尺寸
Public Const Flag = SWP_NOMOVE Or SWP_NOSIZE
Public Const HWND_TOPMOST = -1 '窗体总在最du前面
Public Const HWND_NOTOPMOST = -2 '窗体不在最前面
Private Declare Function SetFocus Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function SetCursorPos Lib "User32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub mouse_event Lib "User32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SHIFT = &H10
Private Const VBKey8 = 56
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
'******************************************************************* 鼠标滚轮 ****************************************************************************************
Public 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
Public Declare Function UnhookWindowsHookEx Lib "User32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "User32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
Public Type MOUSEMSGS
x As Long 'x座标
y As Long 'y座标
a As Long
b As Long
time As Long 'Window运行时间
End Type
Public Const WH_MOUSE_LL = 14
'消息
Public Const HC_ACTION = 0
'鼠标消息
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_MOUSEFIRST = &H200
Public Const WM_MOUSELAST = &H209
Public Const WM_MOUSEWHEEL = &H20A
Public MouseMsg As MOUSEMSGS
Public lHook As Long '记录Hook的值，以便退出程序的时候销毁Hook
Public lClick As Long, mClick As Long, rClick As Long, tClick As Long '用来统计鼠标各个键的按下次数
'获得Win系统各个目录
Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hwndOwner As Long, ByVal nFolder As Integer, ppidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal szPath As String) As Long
Const MAX_LEN = 200 '字符串最大长度
Const DESKTOP = &H0& '桌面
Const PROGRAMS = &H2& '程序集
Const MYDOCUMENTS = &H5& '我的文档
Const MYFAVORITES = &H6& '收藏夹
Const STARTUP = &H7& '启动
Const RECENT = &H8& '最近打开的文件
Const SENDTO = &H9& '发送
Const STARTMENU = &HB& '开始菜单
Const NETHOOD = &H13& '网上邻居
Const FONTS = &H14& '字体
Const SHELLNEW = &H15& 'ShellNew
Const APPDATA = &H1A& 'Application Data
Const PRINTHOOD = &H1B& 'PrintHood
Const PAGETMP = &H20& '网页临时文件
Const COOKIES = &H21& 'Cookies目录
Const HISTORY = &H22& '历史
Public pMC As FilgraphManager '定义pMC为FilgraphManager对像
Public pVW As IVideoWindow '定义pVW为IVideoWindow对像
'MD5加解密声明
'***************************************************************************************************************************************************************************************
Private Declare Function CryptAcquireContext Lib "advapi32.dll" _
Alias "CryptAcquireContextA" ( _
ByRef phProv As Long, _
ByVal pszContainer As String, _
ByVal pszProvider As String, _
ByVal dwProvType As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _
ByVal hProv As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" ( _
ByVal hProv As Long, _
ByVal Algid As Long, _
ByVal hKey As Long, _
ByVal dwFlags As Long, _
ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" ( _
ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" ( _
ByVal hHash As Long, _
pbData As Any, _
ByVal dwDataLen As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function CryptDeriveKey Lib "advapi32.dll" ( _
ByVal hProv As Long, _
ByVal Algid As Long, _
ByVal hBaseData As Long, _
ByVal dwFlags As Long, _
ByRef phKey As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" ( _
ByVal hKey As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" ( _
ByVal hKey As Long, _
ByVal hHash As Long, _
ByVal Final As Long, _
ByVal dwFlags As Long, _
pbData As Any, _
ByRef pdwDataLen As Long, _
ByVal dwBufLen As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" ( _
ByVal hKey As Long, _
ByVal hHash As Long, _
ByVal Final As Long, _
ByVal dwFlags As Long, _
pbData As Any, _
ByRef pdwDataLen As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Dest As Any, _
Src As Any, _
ByVal Ln As Long)
Private Const PROV_RSA_FULL = 1
Private Const CRYPT_NEWKEYSET = &H8
Private Const ALG_CLASS_HASH = 32768
Private Const ALG_CLASS_DATA_ENCRYPT = 24576&
Private Const ALG_TYPE_ANY = 0
Private Const ALG_TYPE_BLOCK = 1536&
Private Const ALG_TYPE_STREAM = 2048&
Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4
Private Const ALG_SID_DES = 1
Private Const ALG_SID_3DES = 3
Private Const ALG_SID_RC2 = 2
Private Const ALG_SID_RC4 = 1
Enum HASHALGORITHM
MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
End Enum
Enum ENCALGORITHM
DES = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_DES
[3DES] = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_3DES
RC2 = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_RC2
RC4 = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM Or ALG_SID_RC4
End Enum
Dim HexMatrix(15, 15) As Byte
'************************************************************ 声明与定义结束 *************************************************************************************
'************************************************************* 公共函数、子程序 *********************************************************************************
Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '鼠标钩子
On Error Resume Next
If code = HC_ACTION Then
CopyMemory MouseMsg, lParam, LenB(MouseMsg)
gMouseX = MouseMsg.x
gMouseY = MouseMsg.y
If gLock_FM_Send_Info = False And FM_Send_Info.Visible = True Then
FM_Send_Info.Left = (gMouseX + 20) * gMyTwipsPerPixelX
If FM_Send_Info.Left + FM_Send_Info.Width > Screen.Width Then FM_Send_Info.Left = (gMouseX - 20) * gMyTwipsPerPixelX - FM_Send_Info.Width
FM_Send_Info.Top = (gMouseY + 20) * gMyTwipsPerPixelY
If FM_Send_Info.Top + FM_Send_Info.Height > Screen.Height Then FM_Send_Info.Top = (gMouseY - 20) * gMyTwipsPerPixelY - FM_Send_Info.Height
End If
Select Case wParam '根据不同鼠标动作进行处理，在这里只处理了鼠标按下的动作
Case WM_LBUTTONDOWN '左键按下
If FM_Send_Info.Visible = True Then
gMouseXPre = gMouseXPreT
gMouseXPreT = gMouseX
gMouseYPre = gMouseYPreT
gMouseYPreT = gMouseY
gLock_FM_Send_Info = True
End If
CallMouseHookProc = 0 '这里把返回值设定为0，保证鼠标动作正常完成
Case WM_RBUTTONDOWN '右键按下
CallMouseHookProc = 0
Case WM_MBUTTONDOWN '中键(滚轮)按下
If gUDiskMode = True Then
If Dir(gQuicKeysDataPath & "\qkconfig.stp") = "" Then QUIT_ALL 'U盘模式下，如果U盘拔出则退出。不要把两个If合并，因为这样可以避免每次都去检查U盘
End If
If gLockMouseMidButton = False And FM_Send_Info.Visible = False Then
'检查处理统一密码、时间戳、记录总次数
FM_Main.SERV_TOTAL.Caption = "已服务" & gTotalServeTimes & "次"
SetWindowPos FM_Main.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
gShowFunc = False
FM_Main.BT_ADD.Visible = gShowFunc
FM_Main.BT_DEL.Visible = gShowFunc
FM_Main.BT_EDIT.Visible = gShowFunc
FM_Main.BT_ORDER.Visible = gShowFunc
FM_Main.BT_CONFIG.Visible = gShowFunc
FM_Main.BT_UNINSTALL.Visible = gShowFunc
FM_Main.BT_EXIT.Visible = gShowFunc
FM_Main.BT_HELP.Visible = gShowFunc
FM_Main.BT_FOLD.Caption = "<?"
FM_Main.Draw_MainForm
FM_Main.Enabled = False
FM_Main.Left = (gMouseX + 30) * gMyTwipsPerPixelX
If FM_Main.Left + FM_Main.Width > Screen.Width Then FM_Main.Left = (gMouseX - 30) * gMyTwipsPerPixelX - FM_Main.Width
FM_Main.Top = (gMouseY + 30) * gMyTwipsPerPixelY
If FM_Main.Top + FM_Main.Height > Screen.Height Then FM_Main.Top = (gMouseY - 30) * gMyTwipsPerPixelY - FM_Main.Height
FM_Main.Visible = True
Check_Rec_UniPW '其结果是是否FM_Main enabled
End If
If FM_Send_Info.Visible = True Then
FM_Send_Info.Left = (gMouseX + 20) * gMyTwipsPerPixelX
If FM_Send_Info.Left + FM_Send_Info.Width > Screen.Width Then FM_Send_Info.Left = (gMouseX - 20) * gMyTwipsPerPixelX - FM_Send_Info.Width
FM_Send_Info.Top = (gMouseY + 20) * gMyTwipsPerPixelY
If FM_Send_Info.Top + FM_Send_Info.Height > Screen.Height Then FM_Send_Info.Top = (gMouseY - 20) * gMyTwipsPerPixelY - FM_Send_Info.Height
End If
CallMouseHookProc = 0
End Select
End If
If code <> 0 Then
CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam) '使用CallNextHookEx，来保证鼠标钩子能够被其它程序使用
End If
End Function
Public Sub AddHook() '安装鼠标钩子，有时系统不稳定，安装失败，尝试三次
Dim i As Integer
lHook = 0
For i = 1 To 3
lHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, App.hInstance, 0)
If lHook <> 0 Then Exit For
Next
If lHook = 0 Then
MsgBox "安装Hook失败，快Key未启动。", 0 + 64, " " & QK_TITLE
DelHook
End
End If
End Sub
Public Sub DelHook() '卸除鼠标钩子
UnhookWindowsHookEx lHook
End Sub
Public Sub QUIT_ALL() '完全退出，不能简单地End ，因为要解除hook
On Error Resume Next
DelHook
End
End Sub
Public Sub Check_Rec_UniPW() '检查处理统一密码，时间戳，记录总次数。返回true表示显示FM_Check_UniKey窗口
On Error Resume Next
Dim TempStr As String
Dim KeepMins As Integer '时间戳持续时间，分钟数
Dim LastTime As Date
Dim PWCycle As Integer
Dim QKFileName As String
If gUniPWChecked = False Then
ShowCheckPad '开机后首次呼出必须检查
Exit Sub
End If
'检查统一密码时间戳
QKFileName = gQuicKeysDataPath & "\qkconfig.stp"
Open QKFileName For Input As #1
Line Input #1, TempStr
Line Input #1, TempStr
Line Input #1, TempStr
Line Input #1, TempStr
gCheckUniPWMode = DecryptStr(TempStr, gFirstEncryptKey)
Line Input #1, TempStr
gCheckUniPWCycle = DecryptStr(TempStr, gFirstEncryptKey)
PWCycle = CInt(gCheckUniPWCycle)
Close #1
Select Case gCheckUniPWMode
Case "1"
'每次呼出都 call ShowCheckPad
ShowCheckPad
Case "2"
'本次开机首次呼出，实际上能执行到这里一定是在前面检查过了
PrintTimeStamp
FM_Main.Draw_MainForm
FM_Main.Enabled = True
Case "3"
'检查时间戳，超过设定期限 call ShowCheckPad
QKFileName = gQuicKeysDataPath & "\timestamp.ktm"
Open QKFileName For Input As #1
Line Input #1, TempStr '总次数，此处无用
Line Input #1, TempStr '时间戳
Close #1
TempStr = DecryptStr(TempStr, gFirstEncryptKey)
LastTime = CDate(TempStr)
KeepMins = Abs(DateDiff("n", Now, LastTime))
If KeepMins > PWCycle Then
ShowCheckPad
Else
PrintTimeStamp
FM_Main.Draw_MainForm
FM_Main.Enabled = True
End If
End Select
End Sub
Public Sub ShowCheckPad() '显示统一密码检查窗口
On Error Resume Next
FM_Check_UniKey.Show
FM_Check_UniKey.SetFocus
FM_Check_UniKey.TXT_UNI_PASSWORD.SetFocus
FM_Check_UniKey.Draw_FM_Check_UniKey
SetWindowPos FM_Check_UniKey.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
FM_Check_UniKey.Visible = True
SetCursorPos (FM_Check_UniKey.Left + 500) / gMyTwipsPerPixelX, (FM_Check_UniKey.Top + 950) / gMyTwipsPerPixelY
End Sub
Public Sub Create_UniPassword_FirstEncryptKey(UniPassBase As String) '将用户初始设定的统一密码分裂为gUniPassword 和 gFirstEncryptKey
Dim l As Integer
l = Len(UniPassBase)
gUniPassword = Your_Function(UniPassBase) 'Your_Function() 是由开发者自行设计的私有算法，此处删掉了阿色的私有算法，后继开发者请自行编码
gFirstEncryptKey = Your_Function(UniPassBase) '给统一密码加密的密码由用户和开发者联合设定，避免用户和开发者破解
End Sub
Public Function Check_UniKey_Pass() '检查统一密码，通过后返回True
On Error Resume Next
Dim SUCCESS As Boolean
Dim TempStr, UniPasswordSaved, UniPasswordInput As String
Dim QKFileName As String
Dim i, l, a, a1, a2 As Integer
SetWindowPos FM_Check_UniKey.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
FM_Check_UniKey.Visible = True
SUCCESS = False
QKFileName = gQuicKeysDataPath & "\qkconfig.stp"
Open QKFileName For Input As #1
Line Input #1, TempStr
Line Input #1, TempStr
Line Input #1, UniPasswordSaved
Close #1
UniPasswordInput = FM_Check_UniKey.TXT_UNI_PASSWORD.Text
TempStr = DecryptStr(UniPasswordSaved, gFirstEncryptKey)
If TempStr = UniPasswordInput Then SUCCESS = True
If SUCCESS = True Then
PrintTimeStamp
FM_Check_UniKey.Hide
Else
MsgBox "统一密码输入错误，请重新输入。", 16, " " & QK_TITLE
FM_Check_UniKey.TXT_UNI_PASSWORD.Text = ""
End If
Check_UniKey_Pass = SUCCESS
End Function
Public Sub PrintTimeStamp() '记录最近使用时间，时间戳，使用次数
On Error Resume Next
Dim QKFileName, TempStr As String
QKFileName = gQuicKeysDataPath & "\timestamp.ktm"
TempStr = CStr(Now())
gTotalServeTimes = gTotalServeTimes + 1
Open QKFileName For Output As #1
Print #1, CStr(gTotalServeTimes)
TempStr = EncryptStr(CStr(Now()), gFirstEncryptKey)
Print #1, TempStr
TempStr = DecryptStr(TempStr, gFirstEncryptKey)
Print #1, TempStr
Close #1
End Sub
Public Sub Get_QuicKeysPath() '获得Win系统有关路径。因Windows7、10等系统权限设定的差别，使用Windows系统的文件夹容易出问题。
'简单起见，设置在C:\Quickeys
On Error Resume Next
Dim sTmp As String * MAX_LEN '存放结果的固定长度的字符串
Dim pidl As Long '某特殊目录在特殊目录列表中的位置
gUDiskMode = False
gQuicKeysRunPath = "C:\QuicKeys"
gQuicKeysDataPath = gQuicKeysRunPath
'如果在U盘运行随身方式
If UCase(Left(App.Path, 1)) <> "C" And UCase(App.EXEName) = "快KEY随身版" Then
gUDiskMode = True
gQuicKeysRunPath = Left(App.Path, 2) & "\" '在根目录下有\，否则无，为统一去掉\，再加上\
gQuicKeysDataPath = gQuicKeysRunPath & "QuicKeys"
End If
'获得网页临时目录，用于存临时产生的文件
SHGetSpecialFolderLocation 0, PAGETMP, pidl
SHGetPathFromIDList pidl, sTmp
gSysTempPath = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'获得win系统桌面路径
SHGetSpecialFolderLocation 0, DESKTOP, pidl
SHGetPathFromIDList pidl, sTmp
gSysDeskTopPath = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Sub
Public Sub Open_Browser(BT_Index As Integer) '打开浏览器或程序
On Error Resume Next
Dim KeyFileName As String
Dim TempStr, BrowserName As String
Dim EN_KEY As String
Dim TmpNum As Integer
EN_KEY = gUniPassword
gSysName = ""
gBrowser = ""
gURL = ""
gUserName = ""
gPassWord = ""
gTabNum1 = 1
gTabNum2 = 1
gManConfirm = 0
FM_Main.Visible = False
gKeyIndex = BT_Index + 1
KeyFileName = gQuicKeysDataPath & "\key" & gKeyIndex & ".kir"
Open KeyFileName For Input As #1
If Not EOF(1) Then
Line Input #1, gSysName
Line Input #1, gBrowser
Line Input #1, gURL
If Trim(gURL) = "{-null-}" Then gURL = ""
Line Input #1, gUserName
If Trim(gUserName) = "{-null-}" Then gUserName = ""
Line Input #1, TempStr
gPassWord = DecryptStr(TempStr, EN_KEY)
If gPassWord = "{-null-}" Then gPassWord = ""
Line Input #1, TempStr
gTabNum1 = Val(TempStr)
Line Input #1, TempStr
gTabNum2 = Val(TempStr)
Line Input #1, TempStr
gManConfirm = Val(TempStr)
End If
Close #1
TempStr = UCase(Trim(gBrowser))
If TempStr = "" Then TempStr = "IE |iexplore.exe"
BrowserName = Trim(Left(TempStr, InStr(TempStr, "|") - 1))
TempStr = Mid(TempStr, InStr(TempStr, "|") + 1, Len(gBrowser))
TempStr = Replace(TempStr, """", "")
If UCase(TempStr) <> "IEXPLORE.EXE" And Dir(TempStr) = "" Then '如果路径不对，一般意味着在U盘随身模式运行，借用的电脑没装该浏览器，或者路径不一样
If gIEInstead = False Then
TmpNum = MsgBox("自动启动浏览器或程序失败。" & vbCrLf & "此电脑未安装您指定的" & BrowserName & "浏览器或相应程序，或者安装路径不正确。" & vbCrLf & vbCrLf & "您可以：" & vbCrLf _
& " （1）启动IE代替，且不再询问；" & vbCrLf _
& " （2）手动打开目标系统的登录页面，然后用快Key辅助登录；" & vbCrLf _
& " （3）按照此电脑修改启动路径，然后重新启动登录；" & vbCrLf _
& " （4）终止登录。" & vbCrLf & vbCrLf _
& "请选择：" & vbCrLf & " 按【是】启动IE（不再询问）" & vbCrLf & " 按【否】终止登录" & vbCrLf & " 按【取消】手动打开登录页面", 3 + 32 + 0, " " & QK_TITLE)
Select Case TmpNum
Case vbYes '启动IE
gIEInstead = True
TempStr = "IEXPLORE.EXE"
Case vbNo '终止本次登录
FM_Send_Info.Hide
Exit Sub
Case vbCancel
End Select
Else
TempStr = "IEXPLORE.EXE"
End If
End If
If InStr(TempStr, " ") <> 0 Then TempStr = """" & TempStr & """" '空格需要用""，需要处理一下
If UCase(TempStr) = "IEXPLORE.EXE" Then
TempStr = "cmd /c @start " & TempStr & " " & gURL
Else
TempStr = TempStr & " " & gURL
End If
Shell TempStr, 0 ' 使用cmd /c 就不用给iexplore.exe 的路径，其他浏览器不行
If gUserName <> "" Then
SetWindowPos FM_Send_Info.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
FM_Send_Info.Left = (gMouseX + 20) * gMyTwipsPerPixelX
If FM_Send_Info.Left + FM_Send_Info.Width > Screen.Width Then FM_Send_Info.Left = (gMouseX - 20) * gMyTwipsPerPixelX - FM_Send_Info.Width
FM_Send_Info.Top = (gMouseY + 20) * gMyTwipsPerPixelY
If FM_Send_Info.Top + FM_Send_Info.Height > Screen.Height Then FM_Send_Info.Top = (gMouseY - 20) * gMyTwipsPerPixelY - FM_Send_Info.Height
FM_Send_Info.Caption = "快Key: 登录【" & gSysName & "】"
FM_Send_Info.Show
End If
End Sub
Public Sub Submit_Key() '自动填写用户名和密码等。第几把钥匙，用户名，密码，间隔几次TAB，都是全局变量
On Error Resume Next
DelHook
SetCursorPos gMouseXPre, gMouseYPre
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 '模拟单击左键带来的，会与Hook混乱，必须解除hook，然后再加上hook
MySleep 100
AddHook
If gUserName <> "" Then
Send_String (gUserName) '填写用户名
Send_TAB (gTabNum1) '发送n个TAB键
If gPassWord <> "" Then
Send_String (gPassWord) '填写密码
Else
gManConfirm = 1
End If
Send_TAB (gTabNum2) '发送n个TAB键
Else
gManConfirm = 1
End If
If gManConfirm = 0 Then Send_Enter '发送回车，0表示自动发送，1表示填写完用户密码后人工按确认键
End Sub
Public Sub Send_String(UN_PW As String) '发送用户名或密码，通过剪贴板实现
On Error Resume Next
'为什么不用sendkeys? 因为sendkeys处理不了中文，会把英文输入为中文。在交通银行等页面所有自动输入都被禁止。
MySleep 100
Clipboard.Clear '清空剪贴板
Clipboard.SetText UN_PW '将剪贴板内容设置为
keybd_event 17, 0, 0, 0 '按下Ctrl A 全选输入框
keybd_event 65, 0, 0, 0
MySleep 100 '需要
keybd_event 65, 0, KEYEVENTF_KEYUP, 0
keybd_event 17, 0, KEYEVENTF_KEYUP, 0
MySleep 100
keybd_event 17, 0, 0, 0 '按下Ctrl V 粘贴
keybd_event 86, 0, 0, 0
MySleep 100
keybd_event 86, 0, KEYEVENTF_KEYUP, 0
keybd_event 17, 0, KEYEVENTF_KEYUP, 0
Clipboard.Clear '清空剪贴板
End Sub
Public Sub Send_TAB(N As Integer) '发送N个TAB键
On Error Resume Next
Dim i As Integer
If N >= 1 Then
For i = 1 To N
keybd_event 9, 0, 0, 0 '按下TAB
MySleep 100 '需要
keybd_event 9, 0, KEYEVENTF_KEYUP, 0
MySleep 100
Next
End If
End Sub
Public Sub Send_Enter() '发送N个回车
On Error Resume Next
keybd_event 13, 0, 0, 0 '按下回车
MySleep 100 '需要
keybd_event 13, 0, KEYEVENTF_KEYUP, 0
MySleep 100
End Sub
Public Sub Get_Mouse_Form_XY_Ratio() '因为VB的问题，各种获得屏幕分辨率的方法都有问题。注意：GetCursorPos() 不好用。
'当屏幕分辨率3000多时，获取值错误，使得鼠标坐标与窗体坐标换算出问题（一般是1:15，即15缇）,Screen.TwipsPerPixelX 失效。因此采取测试法，。
Dim x, y As Integer
'测试获得屏幕分辨率，即鼠标最大XY
SetCursorPos 1000000, 1000000
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
x = MouseMsg.x + 1 '防止除数为0
y = MouseMsg.y + 1
gMyTwipsPerPixelX = Int(Screen.Width / x + 0.5)
gMyTwipsPerPixelY = Int(Screen.Height / y + 0.5)
SetCursorPos x / 2, y / 2
End Sub
Public Sub MySleep(ms As Long) '原Sleep不交出控制权，改造一个。 ms:毫秒数
Dim BeginTime As Long
BeginTime = timeGetTime '记下开始时的时间
While timeGetTime < BeginTime + ms '循环等待
DoEvents '转让控制权，以便让操作系统处理其它的事件
Wend
End Sub
Public Function GetMainboardSerialNumber() As String '获得电脑主板号，参与给统一密码加密，可以进一步防止开发者解密
On Error Resume Next
Dim strComputer
Dim objWMIService
Dim objItem
Dim strOption
Dim colItems
GetMainboardSerialNumber = ""
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_BaseBoard")
For Each objItem In colItems
If objItem.SerialNumber <> "" Then
GetMainboardSerialNumber = objItem.SerialNumber
Exit Function
End If
Next
End Function
Public Function Check_Password_Rules(ByVal Password As String) '检查密码合法性，合格返回True
Dim i, l, a, s As Integer
s = 0
l = Len(Password)
'长度
If l >= 12 Then s = s + 1
'包含大写字母
For i = 1 To l
a = Asc(Mid(Password, i, 1))
If a >= 65 And a <= 90 Then
s = s + 1
Exit For
End If
Next
'包含小写字母
For i = 1 To l
a = Asc(Mid(Password, i, 1))
If a >= 97 And a <= 122 Then
s = s + 1
Exit For
End If
Next
'包含数字
For i = 1 To l
a = Asc(Mid(Password, i, 1))
If a >= 48 And a <= 57 Then
s = s + 1
Exit For
End If
Next
'包含特殊字符
For i = 1 To l
a = Asc(Mid(Password, i, 1))
If Not ((a >= 65 And a <= 90) Or (a >= 97 And a <= 122) Or (a >= 48 And a <= 57)) Then
s = s + 1
Exit For
End If
Next
If s >= 5 Then
Check_Password_Rules = True
Else
Check_Password_Rules = False
End If
End Function
Public Sub Search_Browsers() '不能为了加快安装速度而提前搜索，因为此时安装目录还不存在，而搜索结果需要保存在该目录
Dim BrowserExeName, SearchDoneFlagFile As String
Dim i, BrowsersNum, SearchBrowserDoneNum, LoopNum As Integer
Dim SearchDoneFlag() As Boolean
BrowsersNum = UBound(gWebBrowsers) + 1
ReDim SearchDoneFlag(BrowsersNum - 1) As Boolean
For i = 0 To BrowsersNum - 1
SearchDoneFlag(i) = False
Next
SearchBrowserDoneNum = 0
LoopNum = 0
For i = 1 To BrowsersNum - 1 '不搜IE
BrowserExeName = Mid(gWebBrowsers(i), InStr(gWebBrowsers(i), "|") + 1, 50) '不含.exe
Search_A_Browser (BrowserExeName)
MySleep 200
Show_Installing_Progress 15 + 20 * i / BrowsersNum
Next
Do While SearchBrowserDoneNum < BrowsersNum - 1 And LoopNum < 100
For i = 1 To BrowsersNum - 1
If SearchDoneFlag(i) = False Then
BrowserExeName = Mid(gWebBrowsers(i), InStr(gWebBrowsers(i), "|") + 1, 50)
SearchDoneFlagFile = gQuicKeysDataPath & "\browser" & BrowserExeName & ".lst"
If (Dir(SearchDoneFlagFile) <> "") Then SearchDoneFlag(i) = True
End If
Next
SearchBrowserDoneNum = 0
For i = 1 To BrowsersNum - 1
If SearchDoneFlag(i) = True Then SearchBrowserDoneNum = SearchBrowserDoneNum + 1
Next
MySleep 1000
LoopNum = LoopNum + 1
Show_Installing_Progress 35 + 40 * LoopNum / 100
Loop
End Sub
Public Sub Search_A_Browser(ByVal BrowserExeName As String)
Dim strFilename As String
strFilename = gQuicKeysDataPath & "\Search" & BrowserExeName & ".bat"
Open strFilename For Output As #1
Print #1, "C:"
Print #1, "cd " & gQuicKeysDataPath
Print #1, "del /q /f browser" & BrowserExeName & ".lst"
Print #1, "dir /s/b C:\" & BrowserExeName & ".exe>browser" & BrowserExeName & ".tmp"
Print #1, "rename browser" & BrowserExeName & ".tmp browser" & BrowserExeName & ".lst"
Print #1, "del /q /f Search" & BrowserExeName & ".bat"
Close #1
Shell strFilename, vbHide
End Sub
Public Sub Show_Installing()
FM_Check_UniKey_Setup.PIC_INSTALLING.Visible = True
Set pMC = New FilgraphManager
pMC.Stop
pMC.RenderFile App.Path & "\installing.gif"
Set pVW = pMC
pVW.WindowStyle = CLng(&H6000000)
pVW.Left = 0
pVW.Top = 0
pVW.Width = 75
pVW.Height = 56
pVW.Owner = FM_Check_UniKey_Setup.PIC_INSTALLING.hwnd
pVW.MessageDrain = FM_Check_UniKey_Setup.PIC_INSTALLING.hwnd
pMC.Run
End Sub
Public Sub Stop_Show_Installing()
Set pVW = Nothing
Set pMC = Nothing
FM_Check_UniKey_Setup.LB_STATUS0.Caption = "已经完成"
End Sub
Public Sub Show_Installing_Progress(Percents As Integer)
Dim EndX As Integer
EndX = FM_Check_UniKey_Setup.LN_PROGRESS_BACK.X1 + (FM_Check_UniKey_Setup.LN_PROGRESS_BACK.X2 - FM_Check_UniKey_Setup.LN_PROGRESS_BACK.X1) * Percents / 100
FM_Check_UniKey_Setup.LN_PROGRESS.X2 = EndX
FM_Check_UniKey_Setup.LN_PROGRESS.Visible = False
MySleep 100
FM_Check_UniKey_Setup.LN_PROGRESS.Visible = True
End Sub
'____________________________________________________________________________ 加解密 ___________________________________________________________________________________________________
'加密 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Public Function EncryptString(ByVal str As String, Password As String) As String
On Error Resume Next
Dim byt() As Byte
Dim HASHALGORITHM As HASHALGORITHM
Dim ENCALGORITHM As ENCALGORITHM
byt = str
HASHALGORITHM = MD5
ENCALGORITHM = RC4
EncryptString = BytesToHex(Encrypt(byt, Password, HASHALGORITHM, ENCALGORITHM))
End Function
Public Function EncryptByte(byt() As Byte, Password As String) As Byte()
On Error Resume Next
Dim HASHALGORITHM As HASHALGORITHM
Dim ENCALGORITHM As ENCALGORITHM
HASHALGORITHM = MD5
ENCALGORITHM = RC4
EncryptByte = Encrypt(byt, Password, HASHALGORITHM, ENCALGORITHM)
End Function
Private Function Encrypt(data() As Byte, ByVal Password As String, Optional ByVal HASHALGORITHM As HASHALGORITHM = MD5, Optional ByVal ENCALGORITHM As ENCALGORITHM = RC4) As Byte()
On Error Resume Next
Dim lRes As Long
Dim hProv As Long
Dim hHash As Long
Dim hKey As Long
Dim lBufLen As Long
Dim lDataLen As Long
Dim abData() As Byte
lRes = CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_FULL, 0)
If lRes = 0 And Err.LastDllError = &H80090016 Then lRes = CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET)
If lRes <> 0 Then
lRes = CryptCreateHash(hProv, HASHALGORITHM, 0, 0, hHash)
If lRes <> 0 Then
lRes = CryptHashData(hHash, ByVal Password, Len(Password), 0)
If lRes <> 0 Then
lRes = CryptDeriveKey(hProv, ENCALGORITHM, hHash, 0, hKey)
If lRes <> 0 Then
lBufLen = UBound(data) - LBound(data) + 1
lDataLen = lBufLen
lRes = CryptEncrypt(hKey, 0&, 1, 0, ByVal 0&, lBufLen, 0)
If lRes <> 0 Then
If lBufLen < lDataLen Then lBufLen = lDataLen
ReDim abData(0 To lBufLen - 1)
MoveMemory abData(0), data(LBound(data)), lDataLen
lRes = CryptEncrypt(hKey, 0&, 1, 0, abData(0), lBufLen, lDataLen)
If lRes <> 0 Then
If lDataLen <> lBufLen Then ReDim Preserve abData(0 To lBufLen - 1)
Encrypt = abData
End If
End If
End If
CryptDestroyKey hKey
End If
CryptDestroyHash hHash
End If
CryptReleaseContext hProv, 0
End If
If lRes = 0 Then Err.Raise Err.LastDllError
End Function
'解密 -------------------------------------------------------------------------------------------------------------------------------------------------
Public Function DecryptString(ByVal str As String, Password As String) As String
On Error Resume Next
Dim byt() As Byte
Dim HASHALGORITHM As HASHALGORITHM
Dim ENCALGORITHM As ENCALGORITHM
byt = HexToBytes(str)
HASHALGORITHM = MD5
ENCALGORITHM = RC4
DecryptString = Decrypt(byt, Password, HASHALGORITHM, ENCALGORITHM)
End Function
Public Function DecryptByte(byt() As Byte, Password As String) As Byte()
On Error Resume Next
Dim HASHALGORITHM As HASHALGORITHM
Dim ENCALGORITHM As ENCALGORITHM
HASHALGORITHM = MD5
ENCALGORITHM = RC4
DecryptByte = Decrypt(byt, Password, HASHALGORITHM, ENCALGORITHM)
End Function
Private Function Decrypt(data() As Byte, ByVal Password As String, Optional ByVal HASHALGORITHM As HASHALGORITHM = MD5, Optional ByVal ENCALGORITHM As ENCALGORITHM = RC4) As Byte()
On Error Resume Next
Dim lRes As Long
Dim hProv As Long
Dim hHash As Long
Dim hKey As Long
Dim lBufLen As Long
Dim abData() As Byte
lRes = CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_FULL, 0)
If lRes = 0 And Err.LastDllError = &H80090016 Then lRes = CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET)
If lRes <> 0 Then
lRes = CryptCreateHash(hProv, HASHALGORITHM, 0, 0, hHash)
If lRes <> 0 Then
lRes = CryptHashData(hHash, ByVal Password, Len(Password), 0)
If lRes <> 0 Then
lRes = CryptDeriveKey(hProv, ENCALGORITHM, hHash, 0, hKey)
If lRes <> 0 Then
lBufLen = UBound(data) - LBound(data) + 1
ReDim abData(0 To lBufLen - 1)
MoveMemory abData(0), data(LBound(data)), lBufLen
lRes = CryptDecrypt(hKey, 0&, 1, 0, abData(0), lBufLen)
If lRes <> 0 Then
ReDim Preserve abData(0 To lBufLen - 1)
Decrypt = abData
End If
End If
CryptDestroyKey hKey
End If
CryptDestroyHash hHash
End If
CryptReleaseContext hProv, 0
End If
If lRes = 0 Then Err.Raise Err.LastDllError
End Function
'字节与十六进制字符串的转换 ------------------------------------------------------------------------------------------------------------------------------
Public Function BytesToHex(bits() As Byte) As String
On Error Resume Next
Dim i As Long
Dim b
Dim s As String
For Each b In bits
If b < 16 Then
s = s & "0" & Hex(b)
Else
s = s & Hex(b)
End If
Next
BytesToHex = s
End Function
Public Function HexToBytes(sHex As String) As Byte()
On Error Resume Next
Dim b() As Byte
Dim rst() As Byte
Dim i As Long
Dim N As Long
Dim m1 As Byte
Dim m2 As Byte
If HexMatrix(15, 15) = 0 Then Call MatrixInitialize
b = StrConv(sHex, vbFromUnicode)
i = (UBound(b) + 1) / 2 - 1
ReDim rst(i)
For i = 0 To UBound(b) Step 2
If b(i) > 96 Then
m1 = b(i) - 87
ElseIf b(i) > 64 Then
m1 = b(i) - 55
ElseIf b(i) > 47 Then
m1 = b(i) - 48
End If
If b(i + 1) > 96 Then
m2 = b(i + 1) - 87
ElseIf b(i + 1) > 64 Then
m2 = b(i + 1) - 55
ElseIf b(i + 1) > 47 Then
m2 = b(i + 1) - 48
End If
rst(N) = HexMatrix(m1, m2)
N = N + 1
Next i
HexToBytes = rst
End Function
Private Sub MatrixInitialize()
On Error Resume Next
HexMatrix(0, 0) = &H0: HexMatrix(0, 1) = &H1: HexMatrix(0, 2) = &H2: HexMatrix(0, 3) = &H3: HexMatrix(0, 4) = &H4: HexMatrix(0, 5) = &H5: HexMatrix(0, 6) = &H6: HexMatrix(0, 7) = &H7
HexMatrix(0, 8) = &H8: HexMatrix(0, 9) = &H9: HexMatrix(0, 10) = &HA: HexMatrix(0, 11) = &HB: HexMatrix(0, 12) = &HC: HexMatrix(0, 13) = &HD: HexMatrix(0, 14) = &HE: HexMatrix(0, 15) = &HF
HexMatrix(1, 0) = &H10: HexMatrix(1, 1) = &H11: HexMatrix(1, 2) = &H12: HexMatrix(1, 3) = &H13: HexMatrix(1, 4) = &H14: HexMatrix(1, 5) = &H15: HexMatrix(1, 6) = &H16: HexMatrix(1, 7) = &H17
HexMatrix(1, 8) = &H18: HexMatrix(1, 9) = &H19: HexMatrix(1, 10) = &H1A: HexMatrix(1, 11) = &H1B: HexMatrix(1, 12) = &H1C: HexMatrix(1, 13) = &H1D: HexMatrix(1, 14) = &H1E: HexMatrix(1, 15) = &H1F
HexMatrix(2, 0) = &H20: HexMatrix(2, 1) = &H21: HexMatrix(2, 2) = &H22: HexMatrix(2, 3) = &H23: HexMatrix(2, 4) = &H24: HexMatrix(2, 5) = &H25: HexMatrix(2, 6) = &H26: HexMatrix(2, 7) = &H27
HexMatrix(2, 8) = &H28: HexMatrix(2, 9) = &H29: HexMatrix(2, 10) = &H2A: HexMatrix(2, 11) = &H2B: HexMatrix(2, 12) = &H2C: HexMatrix(2, 13) = &H2D: HexMatrix(2, 14) = &H2E: HexMatrix(2, 15) = &H2F
HexMatrix(3, 0) = &H30: HexMatrix(3, 1) = &H31: HexMatrix(3, 2) = &H32: HexMatrix(3, 3) = &H33: HexMatrix(3, 4) = &H34: HexMatrix(3, 5) = &H35: HexMatrix(3, 6) = &H36: HexMatrix(3, 7) = &H37
HexMatrix(3, 8) = &H38: HexMatrix(3, 9) = &H39: HexMatrix(3, 10) = &H3A: HexMatrix(3, 11) = &H3B: HexMatrix(3, 12) = &H3C: HexMatrix(3, 13) = &H3D: HexMatrix(3, 14) = &H3E: HexMatrix(3, 15) = &H3F
HexMatrix(4, 0) = &H40: HexMatrix(4, 1) = &H41: HexMatrix(4, 2) = &H42: HexMatrix(4, 3) = &H43: HexMatrix(4, 4) = &H44: HexMatrix(4, 5) = &H45: HexMatrix(4, 6) = &H46: HexMatrix(4, 7) = &H47
HexMatrix(4, 8) = &H48: HexMatrix(4, 9) = &H49: HexMatrix(4, 10) = &H4A: HexMatrix(4, 11) = &H4B: HexMatrix(4, 12) = &H4C: HexMatrix(4, 13) = &H4D: HexMatrix(4, 14) = &H4E: HexMatrix(4, 15) = &H4F
HexMatrix(5, 0) = &H50: HexMatrix(5, 1) = &H51: HexMatrix(5, 2) = &H52: HexMatrix(5, 3) = &H53: HexMatrix(5, 4) = &H54: HexMatrix(5, 5) = &H55: HexMatrix(5, 6) = &H56: HexMatrix(5, 7) = &H57
HexMatrix(5, 8) = &H58: HexMatrix(5, 9) = &H59: HexMatrix(5, 10) = &H5A: HexMatrix(5, 11) = &H5B: HexMatrix(5, 12) = &H5C: HexMatrix(5, 13) = &H5D: HexMatrix(5, 14) = &H5E: HexMatrix(5, 15) = &H5F
HexMatrix(6, 0) = &H60: HexMatrix(6, 1) = &H61: HexMatrix(6, 2) = &H62: HexMatrix(6, 3) = &H63: HexMatrix(6, 4) = &H64: HexMatrix(6, 5) = &H65: HexMatrix(6, 6) = &H66: HexMatrix(6, 7) = &H67
HexMatrix(6, 8) = &H68: HexMatrix(6, 9) = &H69: HexMatrix(6, 10) = &H6A: HexMatrix(6, 11) = &H6B: HexMatrix(6, 12) = &H6C: HexMatrix(6, 13) = &H6D: HexMatrix(6, 14) = &H6E: HexMatrix(6, 15) = &H6F
HexMatrix(7, 0) = &H70: HexMatrix(7, 1) = &H71: HexMatrix(7, 2) = &H72: HexMatrix(7, 3) = &H73: HexMatrix(7, 4) = &H74: HexMatrix(7, 5) = &H75: HexMatrix(7, 6) = &H76: HexMatrix(7, 7) = &H77
HexMatrix(7, 8) = &H78: HexMatrix(7, 9) = &H79: HexMatrix(7, 10) = &H7A: HexMatrix(7, 11) = &H7B: HexMatrix(7, 12) = &H7C: HexMatrix(7, 13) = &H7D: HexMatrix(7, 14) = &H7E: HexMatrix(7, 15) = &H7F
HexMatrix(8, 0) = &H80: HexMatrix(8, 1) = &H81: HexMatrix(8, 2) = &H82: HexMatrix(8, 3) = &H83: HexMatrix(8, 4) = &H84: HexMatrix(8, 5) = &H85: HexMatrix(8, 6) = &H86: HexMatrix(8, 7) = &H87
HexMatrix(8, 8) = &H88: HexMatrix(8, 9) = &H89: HexMatrix(8, 10) = &H8A: HexMatrix(8, 11) = &H8B: HexMatrix(8, 12) = &H8C: HexMatrix(8, 13) = &H8D: HexMatrix(8, 14) = &H8E: HexMatrix(8, 15) = &H8F
HexMatrix(9, 0) = &H90: HexMatrix(9, 1) = &H91: HexMatrix(9, 2) = &H92: HexMatrix(9, 3) = &H93: HexMatrix(9, 4) = &H94: HexMatrix(9, 5) = &H95: HexMatrix(9, 6) = &H96: HexMatrix(9, 7) = &H97
HexMatrix(9, 8) = &H98: HexMatrix(9, 9) = &H99: HexMatrix(9, 10) = &H9A: HexMatrix(9, 11) = &H9B: HexMatrix(9, 12) = &H9C: HexMatrix(9, 13) = &H9D: HexMatrix(9, 14) = &H9E: HexMatrix(9, 15) = &H9F
HexMatrix(10, 0) = &HA0: HexMatrix(10, 1) = &HA1: HexMatrix(10, 2) = &HA2: HexMatrix(10, 3) = &HA3: HexMatrix(10, 4) = &HA4: HexMatrix(10, 5) = &HA5: HexMatrix(10, 6) = &HA6: HexMatrix(10, 7) = &HA7
HexMatrix(10, 8) = &HA8: HexMatrix(10, 9) = &HA9: HexMatrix(10, 10) = &HAA: HexMatrix(10, 11) = &HAB: HexMatrix(10, 12) = &HAC: HexMatrix(10, 13) = &HAD: HexMatrix(10, 14) = &HAE: HexMatrix(10, 15) = &HAF
HexMatrix(11, 0) = &HB0: HexMatrix(11, 1) = &HB1: HexMatrix(11, 2) = &HB2: HexMatrix(11, 3) = &HB3: HexMatrix(11, 4) = &HB4: HexMatrix(11, 5) = &HB5: HexMatrix(11, 6) = &HB6: HexMatrix(11, 7) = &HB7
HexMatrix(11, 8) = &HB8: HexMatrix(11, 9) = &HB9: HexMatrix(11, 10) = &HBA: HexMatrix(11, 11) = &HBB: HexMatrix(11, 12) = &HBC: HexMatrix(11, 13) = &HBD: HexMatrix(11, 14) = &HBE: HexMatrix(11, 15) = &HBF
HexMatrix(12, 0) = &HC0: HexMatrix(12, 1) = &HC1: HexMatrix(12, 2) = &HC2: HexMatrix(12, 3) = &HC3: HexMatrix(12, 4) = &HC4: HexMatrix(12, 5) = &HC5: HexMatrix(12, 6) = &HC6: HexMatrix(12, 7) = &HC7
HexMatrix(12, 8) = &HC8: HexMatrix(12, 9) = &HC9: HexMatrix(12, 10) = &HCA: HexMatrix(12, 11) = &HCB: HexMatrix(12, 12) = &HCC: HexMatrix(12, 13) = &HCD: HexMatrix(12, 14) = &HCE: HexMatrix(12, 15) = &HCF
HexMatrix(13, 0) = &HD0: HexMatrix(13, 1) = &HD1: HexMatrix(13, 2) = &HD2: HexMatrix(13, 3) = &HD3: HexMatrix(13, 4) = &HD4: HexMatrix(13, 5) = &HD5: HexMatrix(13, 6) = &HD6: HexMatrix(13, 7) = &HD7
HexMatrix(13, 8) = &HD8: HexMatrix(13, 9) = &HD9: HexMatrix(13, 10) = &HDA: HexMatrix(13, 11) = &HDB: HexMatrix(13, 12) = &HDC: HexMatrix(13, 13) = &HDD: HexMatrix(13, 14) = &HDE: HexMatrix(13, 15) = &HDF
HexMatrix(14, 0) = &HE0: HexMatrix(14, 1) = &HE1: HexMatrix(14, 2) = &HE2: HexMatrix(14, 3) = &HE3: HexMatrix(14, 4) = &HE4: HexMatrix(14, 5) = &HE5: HexMatrix(14, 6) = &HE6: HexMatrix(14, 7) = &HE7
HexMatrix(14, 8) = &HE8: HexMatrix(14, 9) = &HE9: HexMatrix(14, 10) = &HEA: HexMatrix(14, 11) = &HEB: HexMatrix(14, 12) = &HEC: HexMatrix(14, 13) = &HED: HexMatrix(14, 14) = &HEE: HexMatrix(14, 15) = &HEF
HexMatrix(15, 0) = &HF0: HexMatrix(15, 1) = &HF1: HexMatrix(15, 2) = &HF2: HexMatrix(15, 3) = &HF3: HexMatrix(15, 4) = &HF4: HexMatrix(15, 5) = &HF5: HexMatrix(15, 6) = &HF6: HexMatrix(15, 7) = &HF7
HexMatrix(15, 8) = &HF8: HexMatrix(15, 9) = &HF9: HexMatrix(15, 10) = &HFA: HexMatrix(15, 11) = &HFB: HexMatrix(15, 12) = &HFC: HexMatrix(15, 13) = &HFD: HexMatrix(15, 14) = &HFE: HexMatrix(15, 15) = &HFF
End Sub
'加减盐、密文等长处理 ------------------------------------------------------------------------------------------------------------------------------------
Public Function EncryptStr(ByVal str As String, ByVal Password As String) As String '带盐、加尾等长加密。当SALTLEN=4时，密文长度为512
Dim s, salt, tail, t As String
Dim l As Integer
s = Left(str, PWMAXLEN)
l = Len(s)
t = Right(CStr(l + 100000), 4)
s = s & Get_Rnd_Chars(PWMAXLEN - l - SALTLEN - 4 - 1)
salt = Get_Rnd_Chars(SALTLEN)
s = salt & t & s
EncryptStr = salt & EncryptString(s, Password & salt)
End Function
Public Function DecryptStr(ByVal str As String, ByVal Password As String) As String '解密减盐
Dim s, ss, salt As String
Dim l As Integer
l = Len(str)
salt = Left(str, SALTLEN)
s = Right(str, l - SALTLEN)
ss = DecryptString(s, Password & salt)
l = Len(ss)
l = CInt(Mid(ss, SALTLEN + 1, 4))
DecryptStr = Mid(ss, SALTLEN + 1 + 4, l)
End Function
Public Function Get_Rnd_Chars(N As Integer) As String '从一个预置的字符串中随机返回N个字符。为什么不完全随机？NO！！！Add Arthur's smell
On Error Resume Next
Dim s, ss As String
Dim i, j, l As Integer
s = "0123456789ABCDEF0123456789ABCDEF"
l = Len(s) - 1
Get_Rnd_Chars = ""
Randomize
For j = 1 To N
i = Int(l * Rnd) + 1
ss = Mid(s, i, 1)
If ss = "" Then ss = "7"
Get_Rnd_Chars = Get_Rnd_Chars & ss
Next
End Function
'*************************************************************************** 公共模块Module_Common 代码结束 ****************************************************************************
（2）窗体：FM_Add_Key
FM_Add_Key.frm
************************************************************************************************************************************************************************************************
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FM_Add_Key
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "快Key: 添加密钥"
ClientHeight = 5280
ClientLeft = 45
ClientTop = 390
ClientWidth = 4350
ForeColor = &H00000000&
Icon = "FM_Add_Key.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5280
ScaleWidth = 4350
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox TXT_TARGET_NUM
Height = 270
Left = 3720
TabIndex = 2
Text = "1"
Top = 720
Width = 375
End
Begin VB.CommandButton BT_ELSE
Caption = "其他"
Height = 255
Left = 2780
TabIndex = 4
Top = 1080
Width = 520
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 3600
Top = 4680
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox TXT_URL
Height = 495
Left = 240
MultiLine = -1 'True
TabIndex = 7
Top = 2160
Width = 3855
End
Begin VB.CommandButton BT_BROWSE
Caption = "浏览"
Height = 255
Left = 3300
TabIndex = 5
Top = 1080
Width = 520
End
Begin VB.CommandButton BT_IE
Caption = "IE:缺省"
Height = 255
Left = 1890
TabIndex = 3
Top = 1080
Width = 885
End
Begin VB.TextBox TXT_BROWSER_PATH
Height = 495
Left = 240
MultiLine = -1 'True
TabIndex = 6
Text = "FM_Add_Key.frx":424A
Top = 1320
Width = 3060
End
Begin VB.CommandButton BT_SEE_PW
Height = 255
Left = 3840
Picture = "FM_Add_Key.frx":425C
Style = 1 'Graphical
TabIndex = 10
Top = 3120
Width = 255
End
Begin VB.CheckBox CB_MANUAL_CONFIRM
Caption = "Check1"
Height = 270
Left = 3960
TabIndex = 13
Top = 4200
Width = 255
End
Begin VB.CommandButton BT_SUBMIT_ADD
Caption = "提交"
Height = 375
Left = 240
TabIndex = 14
Top = 4800
Width = 3855
End
Begin VB.TextBox TXT_TAB2
Height = 270
Left = 3240
TabIndex = 12
Text = "1"
Top = 3840
Width = 855
End
Begin VB.TextBox TXT_TAB1
Height = 270
Left = 3240
TabIndex = 11
Text = "1"
Top = 3480
Width = 855
End
Begin VB.TextBox TXT_PW
ForeColor = &H00C0C0C0&
Height = 270
IMEMode = 3 'DISABLE
Left = 1080
TabIndex = 9
Text = "原系统密码，不填表示手动输入"
Top = 3120
Width = 2775
End
Begin VB.TextBox TXT_UN
ForeColor = &H00C0C0C0&
Height = 270
Left = 1260
TabIndex = 8
Text = "原系统用户名，不填表示手动输入"
Top = 2760
Width = 2835
End
Begin VB.TextBox TXT_SYSNM
ForeColor = &H00C0C0C0&
Height = 270
Left = 1080
TabIndex = 1
Text = "原系统简称，最多12字，必填"
Top = 720
Width = 1935
End
Begin VB.Label Label13
BackStyle = 0 'Transparent
Caption = "序号"
Height = 255
Left = 3250
TabIndex = 26
Top = 765
Width = 495
End
Begin VB.Label Label12
BackStyle = 0 'Transparent
Caption = "或"
Height = 255
Left = 3900
TabIndex = 25
Top = 1180
Width = 375
End
Begin VB.Label Label11
BackStyle = 0 'Transparent
Caption = "手工填写完整路径"
Height = 615
Left = 3360
TabIndex = 24
Top = 1400
Width = 855
End
Begin VB.Label Label10
BackStyle = 0 'Transparent
Caption = "网址与参数"
Height = 255
Left = 240
TabIndex = 23
Top = 1920
Width = 1095
End
Begin VB.Label Label9
BackStyle = 0 'Transparent
Caption = "启动浏览器或程序"
Height = 255
Left = 240
TabIndex = 22
Top = 1080
Width = 1575
End
Begin VB.Label Label8
Alignment = 2 'Center
BackColor = &H00C0C0FF&
Caption = "提示：请确认大小写、中英文、半全角无误"
Height = 230
Left = 240
TabIndex = 21
Top = 4560
Width = 3855
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "手动确认登录(填完登录信息不自动提交)"
Height = 255
Left = 240
TabIndex = 20
Top = 4210
Width = 3255
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = " 软件模拟用键盘手动登录。请先在欲登录的系统测试一下用键盘登录的过程，然后填写："
Height = 495
Left = 240
TabIndex = 19
Top = 120
Width = 3975
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "从密码框到确认键需要按几次TAB键"
Height = 375
Left = 240
TabIndex = 18
Top = 3850
Width = 3135
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "从用户名框到密码框要按几次TAB键"
Height = 255
Left = 240
TabIndex = 17
Top = 3490
Width = 3135
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "登录密码"
Height = 255
Left = 240
TabIndex = 16
Top = 3130
Width = 1005
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "登录用户名"
Height = 255
Left = 240
TabIndex = 15
Top = 2770
Width = 1095
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "系统名称"
Height = 255
Left = 240
TabIndex = 0
Top = 760
Width = 975
End
End
Attribute VB_Name = "FM_Add_Key"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************************************************************************************
'* *
'* 快Key 窗体 FM_Add_Key *
'* *
'*********************************************************************************************************************************************************************
'*************************************************************************** 函数、子程序 ****************************************************************************
'FM_Add_Key 窗口，增加和修改密钥都用这个窗口
Private Sub Form_Load()
End Sub
Public Sub Draw_FM_Add_Key()
On Error Resume Next
SetWindowPos FM_Add_Key.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
If FM_Main.Left > Screen.Width / 2 Then
FM_Add_Key.Left = FM_Main.Left - FM_Add_Key.Width - 20
Else
FM_Add_Key.Left = FM_Main.Left + FM_Main.Width + 20
End If
FM_Add_Key.Top = FM_Main.Top + 400
TXT_PW.PasswordChar = ""
If gDelOrEdit = 2 Then
If TXT_UN.Text = "原系统用户名，不填表示手动输入" Or TXT_UN.Text = "" Then
TXT_UN.Text = "原系统用户名，不填表示手动输入"
TXT_UN.ForeColor = &HC0C0C0
End If
TXT_PW.PasswordChar = "*"
If TXT_PW.Text = "原系统密码，不填表示手动输入" Then TXT_PW.PasswordChar = ""
End If
gLockMouseMidButton = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
FM_Main.Enabled = True
For i = 1 To 3
For j = 1 To 10
btIndex = (j - 1) * 3 + i - 1
FM_Main.BT_DEL_SINGLE(btIndex).Visible = False
Next
Next
gDelOrNot = Not gDelOrNot
FM_Main.BT_EDIT.BackColor = &H8000000F
FM_Main.BT_EDIT.Caption = "…"
FM_Main.BT_EDIT.FontSize = 6
FM_Main.BT_ADD.Enabled = Not gDelOrNot 'True
If gTotalRealKeyNum >= MAX_KEYS_NUM Then FM_Main.BT_ADD.Enabled = False
FM_Main.BT_DEL.Enabled = Not gDelOrNot 'True
FM_Main.BT_EDIT.Enabled = Not gDelOrNot 'True
FM_Main.BT_ORDER.Enabled = Not gDelOrNot 'True
FM_Main.BT_CONFIG.Enabled = Not gDelOrNot 'True
FM_Main.BT_UNINSTALL.Enabled = Not gDelOrNot 'True
FM_Main.BT_EXIT.Enabled = Not gDelOrNot 'True
FM_Main.BT_HELP.Enabled = Not gDelOrNot 'True
FM_Main.BT_FOLD.Enabled = Not gDelOrNot 'True
FM_Main.Draw_MainForm
gLockMouseMidButton = False
End Sub
Private Sub BT_SUBMIT_ADD_Click() '添加一个密钥，占用序号指定的位置，原位置顺延后退
On Error Resume Next
Dim strFilename As String
Dim ADD_SUCCESS As Boolean
Dim Loc_Index As Integer
If TXT_SYSNM.Text = "原系统简称，最多12字，必填" Or TXT_SYSNM.Text = "" Then
MsgBox "添加或修改密钥失败：系统名称不能空。", 16, " " & QK_TITLE
Else
ADD_SUCCESS = False
If gDelOrEdit <> 2 Then '增加密钥
Loc_Index = Save_and_Place_a_Key
ADD_SUCCESS = True
gTotalRealKeyNum = gTotalRealKeyNum + 1
Set_Default_FM_Add_Key
FM_Add_Key.Visible = False
If Loc_Index >= MAX_KEYS_NUM Then
FM_Main.BT_ADD.Enabled = False
FM_Add_Key.Visible = False
End If
FM_Main.BT_A_KEY(Loc_Index - 1).Enabled = True
For i = 1 To 3
For j = 1 To 10
btIndex = (j - 1) * 3 + i - 1
FM_Main.BT_DEL_SINGLE(btIndex).Visible = False
Next
Next
FM_Main.BT_ADD.Enabled = True
FM_Main.Draw_MainForm
If ADD_SUCCESS = False Then
MsgBox "添加密钥失败：最多可添加" & MAX_KEYS_NUM & "个密钥，未找到空位。请删除不必要的密钥。", 16, " " & QK_TITLE
End If
gDelOrNot = Not gDelOrNot
Else '修改密钥
strFilename = gQuicKeysDataPath & "\key" & gKeyIndex & ".kir"
If Dir(strFilename) <> "" Then Kill strFilename
FM_Main.BT_A_KEY(gKeyIndex - 1).Visible = False
FM_Main.BT_DEL_SINGLE(gKeyIndex - 1).Visible = False
Save_and_Place_a_Key
FM_Add_Key.Hide
FM_Main.BT_EDIT_Click_RUN
FM_Main.Draw_MainForm
End If
FM_Main.Enabled = True
End If
gLockMouseMidButton = False
End Sub
Private Function Save_and_Place_a_Key() '写密钥文件，并把密钥放到指定序号的位置，返回密钥位置序号
On Error Resume Next
Dim strFilename, BrowserName, BrowserExeName, OldName, NewName As String
Dim ADD_SUCCESS As Boolean
Dim Target_Num, Temp_i As Integer
Dim EN_KEY As String
EN_KEY = gUniPassword 'gUniPassword是全局变量，快Key的统一密码
Target_Num = CInt(TXT_TARGET_NUM.Text)
If Target_Num > MAX_KEYS_NUM Then Target_Num = MAX_KEYS_NUM
If Target_Num < 1 Then Target_Num = 1
For i = Target_Num To MAX_KEYS_NUM + Target_Num - 1 '循环找第一个可用的空位
Temp_i = i Mod MAX_KEYS_NUM
If Temp_i = 0 Then Temp_i = MAX_KEYS_NUM
strFilename = gQuicKeysDataPath & "\key" & Temp_i & ".kir"
If Dir(strFilename) = "" Then '如果文件不存在，就是第一个空位
gFirstSpaceNum = i
Exit For
End If
Next
If gFirstSpaceNum < Target_Num Then gFirstSpaceNum = gFirstSpaceNum + MAX_KEYS_NUM
strFilename = gQuicKeysDataPath & "\keytemp.kir"
Open strFilename For Output As #1
gSysName = TXT_SYSNM.Text
Print #1, gSysName
gBrowser = TXT_BROWSER_PATH.Text
gBrowser = Replace(gBrowser, Chr(10), "") '多行时去掉回车
gBrowser = Replace(gBrowser, Chr(13), "")
gBrowser = Replace(gBrowser, """", "")
'自动标注浏览器名称
If InStr(gBrowser, "|") = 0 Then
BrowserExeName = UCase(Dir(gBrowser))
If BrowserExeName = "" Then BrowserExeName = gBrowser
BrowserExeName = "|" & Replace(BrowserExeName, ".EXE", "") '加|避免chrome和360chrome混淆
BrowserName = "其他 |"
For i = 0 To UBound(gWebBrowsers)
If InStr(gWebBrowsers(i), BrowserExeName) > 0 Then
BrowserName = Left(gWebBrowsers(i), InStr(gWebBrowsers(i), "|"))
Exit For
End If
Next
gBrowser = BrowserName & gBrowser
End If
Print #1, gBrowser
gURL = TXT_URL.Text
If Trim(gURL) = "" Then gURL = "{-null-}"
Print #1, gURL
gUserName = Trim(TXT_UN.Text)
If gUserName = "原系统用户名，不填表示手动输入" Or gUserName = "" Then gUserName = "{-null-}"
Print #1, gUserName
gPassWord = TXT_PW.Text
If gPassWord = "原系统密码，不填表示手动输入" Or gPassWord = "" Then gPassWord = "{-null-}"
gPassWord = EncryptStr(gPassWord, EN_KEY)
Print #1, gPassWord
Print #1, TXT_TAB1.Text
Print #1, TXT_TAB2.Text
Print #1, CStr(CB_MANUAL_CONFIRM.Value) '0表示未选，1表示选上
Close #1
Do While gFirstSpaceNum > Target_Num
Temp_i = (gFirstSpaceNum - 1) Mod MAX_KEYS_NUM
If Temp_i = 0 Then Temp_i = MAX_KEYS_NUM
OldName = gQuicKeysDataPath & "\key" & Temp_i & ".kir"
Temp_i = Temp_i + 1
Temp_i = Temp_i Mod MAX_KEYS_NUM
If Temp_i = 0 Then Temp_i = MAX_KEYS_NUM
NewName = gQuicKeysDataPath & "\key" & Temp_i & ".kir"
Name OldName As NewName
gFirstSpaceNum = gFirstSpaceNum - 1
Loop
Name gQuicKeysDataPath & "\keytemp.kir" As gQuicKeysDataPath & "\key" & Target_Num & ".kir"
Save_and_Place_a_Key = Target_Num
End Function
Public Sub Set_Default_FM_Add_Key() '设置增加密钥操作窗口的缺省值
TXT_SYSNM.ForeColor = &HC0C0C0
TXT_SYSNM.Text = "原系统简称，最多12字，必填"
TXT_BROWSER_PATH.Text = "IE |iexplore.exe"
TXT_URL.Text = ""
TXT_UN.ForeColor = &HC0C0C0
TXT_UN.Text = "原系统用户名，不填表示手动输入"
TXT_PW.ForeColor = &HC0C0C0
TXT_PW.Text = "原系统密码，不填表示手动输入"
TXT_TAB1.Text = "1"
TXT_TAB2.Text = "1"
CB_MANUAL_CONFIRM.Value = 0
End Sub
Private Sub TXT_SYSNM_GotFocus() '文本框得到焦点
If TXT_SYSNM.Text = "原系统简称，最多12字，必填" Then
TXT_SYSNM.ForeColor = &H0&
TXT_SYSNM.Text = ""
End If
End Sub
Private Sub TXT_SYSNM_LostFocus() '文本框失去焦点
If TXT_SYSNM.Text = "" Then
TXT_SYSNM.ForeColor = &HC0C0C0
TXT_SYSNM.Text = "原系统简称，最多12字，必填"
End If
End Sub
Private Sub TXT_BROWSER_PATH_LostFocus()
If Trim(TXT_BROWSER_PATH.Text) = "" Then
TXT_BROWSER_PATH.Text = "IE |iexplore.exe"
End If
End Sub
Private Sub TXT_UN_GotFocus() '文本框得到焦点
If TXT_UN.Text = "原系统用户名，不填表示手动输入" Then
TXT_UN.ForeColor = &H0&
TXT_UN.Text = ""
End If
End Sub
Private Sub TXT_UN_LostFocus() '文本框失去焦点
If TXT_UN.Text = "" Then
TXT_UN.ForeColor = &HC0C0C0
TXT_UN.Text = "原系统用户名，不填表示手动输入"
End If
End Sub
Private Sub TXT_PW_GotFocus() '文本框得到焦点
If TXT_PW.Text = "原系统密码，不填表示手动输入" Then
TXT_PW.ForeColor = &H0&
TXT_PW.Text = ""
TXT_PW.PasswordChar = "*"
End If
End Sub
Private Sub TXT_PW_LostFocus() '文本框失去焦点
If TXT_PW.Text = "" Then
TXT_PW.ForeColor = &HC0C0C0
TXT_PW.Text = "原系统密码，不填表示手动输入"
TXT_PW.PasswordChar = ""
End If
End Sub
Private Sub BT_SEE_PW_Click() '是否明码显示密码
Select Case TXT_PW.PasswordChar
Case "*"
TXT_PW.PasswordChar = ""
Case ""
TXT_PW.PasswordChar = "*"
End Select
End Sub
Private Sub BT_IE_Click()
TXT_BROWSER_PATH.Text = "IE |iexplore.exe"
End Sub
Private Sub BT_ELSE_Click()
FM_Select_Browser.Draw_FM_Select_Browser
End Sub
Private Sub BT_BROWSE_Click()
On Error Resume Next
CommonDialog1.Filter = "EXE文件（*.exe）|*.exe"
Me.CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then TXT_BROWSER_PATH.Text = CommonDialog1.FileName
End Sub
'*************************************************************************** FM_Add_Key 窗体代码结束 ****************************************************************************
（3）窗体：FM_Check_UniKey
FM_Check_UniKey.frm
************************************************************************************************************************************************************************************
VERSION 5.00
Begin VB.Form FM_Check_UniKey
BorderStyle = 1 'Fixed Single
Caption = "快Key: 检查统一密码"
ClientHeight = 1215
ClientLeft = 45
ClientTop = 390
ClientWidth = 2550
Icon = "FM_Check_UniKey.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1215
ScaleWidth = 2550
Begin VB.CommandButton BT_SUBMIT_UNIPW
Caption = "确认"
Height = 375
Left = 240
TabIndex = 3
Top = 720
Width = 2055
End
Begin VB.CommandButton BT_SEE_PW
Height = 255
Left = 2040
Picture = "FM_Check_UniKey.frx":424A
Style = 1 'Graphical
TabIndex = 2
Top = 360
Width = 255
End
Begin VB.TextBox TXT_UNI_PASSWORD
ForeColor = &H00000000&
Height = 270
IMEMode = 3 'DISABLE
Left = 240
PasswordChar = "*"
TabIndex = 1
Top = 360
Width = 2055
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "请输入您的统一密码"
Height = 375
Left = 240
TabIndex = 0
Top = 120
Width = 3135
End
End
Attribute VB_Name = "FM_Check_UniKey"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************************************************************************************
'* *
'* 快Key 窗体FM_Check_UniKey *
'* *
'*********************************************************************************************************************************************************************
'*************************************************************************** 函数、子程序 ****************************************************************************
'FM_Check_UniKey 检查统一密码窗口
Private Sub Form_Load()
SetWindowPos FM_Check_UniKey.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
Draw_FM_Check_UniKey
End Sub
Private Sub BT_SUBMIT_UNIPW_Click()
On Error Resume Next
If Check_Password_Rules(TXT_UNI_PASSWORD.Text) = False Then
MsgBox "您已设置的密码不符合信息安全规范，请尽快重新设置。" & vbCrLf & "本次操作可继续进行。" & vbCrLf & vbCrLf & _
"要求：长度12个字符以上，同时包括大写字母、小写字母、数字和特殊字符。", 0 + 64, " " & QK_TITLE
End If
Create_UniPassword_FirstEncryptKey (TXT_UNI_PASSWORD.Text) '基于用户输入的统一密码，分裂出 gUniPassword 和 gFirstEncryptKey
If Check_UniKey_Pass = True Then
gUniPassBase = TXT_UNI_PASSWORD.Text
FM_Config_Key.TXT_UNI_PASSWORD.Text = gUniPassBase
gUniPWChecked = True
FM_Config_Key.Enabled = True
FM_Main.Draw_MainForm
If gInConfig = False Then
FM_Main.Enabled = True
gLockMouseMidButton = False
End If
End If
End Sub
Public Sub Draw_FM_Check_UniKey()
On Error Resume Next
If FM_Main.Left > Screen.Width / 2 Then
FM_Check_UniKey.Left = FM_Main.Left - FM_Check_UniKey.Width - 20 + 200
Else
FM_Check_UniKey.Left = FM_Main.Left + FM_Main.Width + 20 + 200
End If
FM_Check_UniKey.Top = FM_Main.Top
FM_Check_UniKey.Caption = QK_TITLE & ": 检查统一密码"
FM_Main.Enabled = False
TXT_UNI_PASSWORD.Text = ""
TXT_UNI_PASSWORD.PasswordChar = "*"
gLockMouseMidButton = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
FM_Main.Enabled = True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '点击窗口关闭X时，不退出，只隐藏
On Error Resume Next
If UnloadMode = 0 Then
Cancel = 1
Me.Hide
FM_Main.Hide
If gUniPWChecked = True Then FM_Config_Key.Hide
TXT_UNI_PASSWORD.Text = ""
gLockMouseMidButton = False
End If
End Sub
Private Sub BT_SEE_PW_Click()
Select Case TXT_UNI_PASSWORD.PasswordChar
Case "*"
TXT_UNI_PASSWORD.PasswordChar = ""
Case ""
TXT_UNI_PASSWORD.PasswordChar = "*"
End Select
End Sub
'*************************************************************************** FM_Check_UniKey 窗体代码结束 ****************************************************************************
（4）窗体：FM_Check_UniKey_Setup
FM_Check_UniKey_Setup.frm
***********************************************************************************************************************************************************************************************
VERSION 5.00
Begin VB.Form FM_Check_UniKey_Setup
BorderStyle = 1 'Fixed Single
Caption = "快Key: 安装/更新"
ClientHeight = 6210
ClientLeft = 45
ClientTop = 390
ClientWidth = 5295
Icon = "FM_Check_UniKey_Setup.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6210
ScaleWidth = 5295
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox PIC_INSTALLING
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 800
Left = 3670
ScaleHeight = 765
ScaleWidth = 1110
TabIndex = 16
Top = 3250
Width = 1140
Begin VB.Label LB_STATUS0
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "准备就绪"
ForeColor = &H0000C000&
Height = 495
Left = 130
TabIndex = 18
Top = 300
Width = 855
End
End
Begin VB.CommandButton BT_QUIT_SETUP
Caption = "退出安装"
Height = 375
Left = 3600
TabIndex = 14
Top = 5480
Width = 1215
End
Begin VB.CommandButton BT_SUBMIT_UNIPW_SETUP
Caption = "确认安装/更新"
Height = 375
Left = 480
TabIndex = 3
Top = 5480
Width = 3015
End
Begin VB.CommandButton BT_SEE_PW
Height = 255
Left = 4440
Picture = "FM_Check_UniKey_Setup.frx":424A
Style = 1 'Graphical
TabIndex = 2
Top = 5120
Width = 375
End
Begin VB.TextBox TXT_UNI_PASSWORD
ForeColor = &H00000000&
Height = 270
IMEMode = 3 'DISABLE
Left = 480
PasswordChar = "*"
TabIndex = 1
Top = 5120
Width = 3975
End
Begin VB.Line LN_PROGRESS
BorderColor = &H0000C000&
BorderStyle = 2 'Dash
BorderWidth = 3
DrawMode = 14 'Copy Pen
X1 = 370
X2 = 3000
Y1 = 4200
Y2 = 4200
End
Begin VB.Line LN_PROGRESS_BACK
BorderColor = &H00C0C0C0&
BorderWidth = 2
X1 = 360
X2 = 4920
Y1 = 4200
Y2 = 4200
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = " 请设置【统一密码】，否则无法使用快Key。"
Height = 375
Left = 405
TabIndex = 0
Top = 4320
Width = 4455
End
Begin VB.Label LB_STATUS
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "正在搜索浏览器"
BeginProperty Font
Name = "宋体"
Size = 7.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000C000&
Height = 255
Left = 1515
TabIndex = 17
Top = 3960
Visible = 0 'False
Width = 2055
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "* 开机启动需要修改注册表，请设置安全软件允许。"
ForeColor = &H000000FF&
Height = 255
Left = 405
TabIndex = 15
Top = 4875
Width = 4335
End
Begin VB.Label Label12
BackStyle = 0 'Transparent
Caption = "（3）开机自动在后台启动。"
Height = 375
Left = 690
TabIndex = 13
Top = 2250
Width = 3615
End
Begin VB.Label Label11
BackStyle = 0 'Transparent
Caption = "（4）本程序不联网，不上传任何信息。"
Height = 375
Left = 690
TabIndex = 12
Top = 2500
Width = 3615
End
Begin VB.Label Label10
BackStyle = 0 'Transparent
Caption = "【作者声明】"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 400
TabIndex = 11
Top = 2900
Width = 3615
End
Begin VB.Label Label9
BackStyle = 0 'Transparent
Caption = " 本程序为开源软件，免费自由使用，自由分享，作者不对使用者及因使用者引起的任何损失负责。开始使用即表示接受此约定。"
Height = 975
Left = 480
TabIndex = 10
Top = 3180
Width = 3135
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "【使用说明】"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 400
TabIndex = 9
Top = 1500
Width = 4695
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "*（1）按鼠标【滚轮】呼出。"
ForeColor = &H000000FF&
Height = 375
Left = 600
TabIndex = 8
Top = 1750
Width = 5175
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "*（2）使用前必须设置【统一密码】。"
Height = 375
Left = 600
TabIndex = 7
Top = 2000
Width = 4695
End
Begin VB.Label Label4
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "欢迎使用快Key！"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 1200
TabIndex = 6
Top = 360
Width = 3255
End
Begin VB.Image Image1
Height = 560
Left = 960
Picture = "FM_Check_UniKey_Setup.frx":7DDB
Stretch = -1 'True
Top = 240
Width = 600
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = " 快Key（QuicKeys），帮助您自动填写用户名/密码。"
Height = 375
Left = 400
TabIndex = 5
Top = 1100
Width = 4695
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = " 统一密码是打开快Key的密码，请牢记，不要泄露。"
Height = 375
Left = 405
TabIndex = 4
Top = 4600
Width = 4335
End
End
Attribute VB_Name = "FM_Check_UniKey_Setup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************************************************************************************
'* *
'* 快Key 窗体FM_Check_UniKey_Setup *
'* *
'*********************************************************************************************************************************************************************
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'*************************************************************************** 函数、子程序 ****************************************************************************
'FM_Check_UniKey_Setup 安装时填写统一密码窗口
Private Sub Form_Load()
Dim strFilename, Uname As String
SetWindowPos FM_Check_UniKey_Setup.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
Draw_FM_Check_UniKey_Setup
If gInstalled = True Then
strFilename = gQuicKeysDataPath & "\qkconfig.stp"
Open strFilename For Input As #1
Line Input #1, gOldVerNum
Line Input #1, Uname
Close #1
End If
If Left(Trim(gOldVerNum), 2) = "V2" Then
FM_Check_UniKey_Setup.TXT_UNI_PASSWORD.PasswordChar = ""
FM_Check_UniKey_Setup.TXT_UNI_PASSWORD.Text = "统一密码已设置，继续使用，此处不需输入"
FM_Check_UniKey_Setup.TXT_UNI_PASSWORD.Enabled = False
FM_Check_UniKey_Setup.BT_SEE_PW.Enabled = False
Else
If Left(Trim(gOldVerNum), 2) = "V1" Then
FM_Check_UniKey_Setup.TXT_UNI_PASSWORD.PasswordChar = ""
FM_Check_UniKey_Setup.TXT_UNI_PASSWORD.ForeColor = &HFF&
FM_Check_UniKey_Setup.TXT_UNI_PASSWORD.Text = "系统升级，请重新设置统一密码"
End If
End If
End Sub
Private Sub BT_SUBMIT_UNIPW_SETUP_Click()
'''''On Error Resume Next '因为安全软件会阻止修改注册表，为了提示用户安装时注意到这一点，要让错误信息显示出来
Dim strFilename As String
Dim Uname, Upassword As String
Dim TempStr As String
Dim EN_KEY As String
DelHook
FM_Main.Hide
If (Left(Trim(gOldVerNum), 2) = "V1" Or gInstalled = False) And Check_Password_Rules(TXT_UNI_PASSWORD.Text) = False Then
TXT_UNI_PASSWORD.Text = ""
FM_Check_UniKey_Setup.Show
MsgBox "您输入的密码不符合信息安全规范，请重新输入。" & vbCrLf & vbCrLf & "要求：长度12个字符以上，同时包括大写字母、小写字母、数字和特殊字符。", 0 + 64, " " & QK_TITLE
Else
If Left(Trim(gOldVerNum), 2) = "V1" Or gInstalled = False Then
gUniPassBase = TXT_UNI_PASSWORD.Text
Create_UniPassword_FirstEncryptKey (gUniPassBase) '以用户输入的统一密码为基础，生成全局变量 gUniPassword 和 gFirstEncryptKey
EN_KEY = gFirstEncryptKey
End If
If gInstalled = False Then '开始安装
BT_SUBMIT_UNIPW_SETUP.Enabled = False
BT_QUIT_SETUP.Enabled = False
If Dir(gQuicKeysRunPath, vbDirectory) = "" Then MkDir (gQuicKeysRunPath)
Show_Installing
LB_STATUS.Visible = True
LB_STATUS.Caption = "正在初始化"
Show_Installing_Progress 8
MySleep 1000
LB_STATUS.Caption = "正在搜索浏览器，约2分钟"
Show_Installing_Progress 15
Search_Browsers
LB_STATUS.Caption = "正在拷贝文件"
Show_Installing_Progress 75
Shell "taskkill /f /im QuicKeys.exe" '杀死老程序进程,进程不存在也不会出错，安装文件名不叫QuicKeys.exe
MySleep 500
'拷贝QuicKeys.exe到 QuicKeys目录
TempStr = IIf(Len(App.Path) > 3, App.Path & "\" & App.EXEName & ".exe", App.Path & App.EXEName & ".exe") '获得安装文件自身路径和名称。
'EXE在根目录下时，app.path带“\”，不在根目录下时没有。
strFilename = gQuicKeysRunPath & "\QuicKeys.exe"
If Dir(strFilename) <> "" Then Kill strFilename '删掉旧的QuicKeys.exe 文件，如果文件不存在，删除会出错
MySleep 500
FileCopy TempStr, strFilename '把新文件考过来
'拷贝StartQuicKeys.exe到 QuicKeys目录
TempStr = IIf(Len(App.Path) > 3, App.Path & "\StartQuicKeys.ex_", App.Path & "StartQuicKeys.ex_")
strFilename = gQuicKeysRunPath & "\StartQuicKeys.exe"
If Dir(strFilename) <> "" Then Kill strFilename
MySleep 500
FileCopy TempStr, strFilename '把新文件考过来
'拷贝COMDLG32.OCX到 C:\Windows\System32\ 和 C:\Windows\SysWOW64\
TempStr = IIf(Len(App.Path) > 3, App.Path & "\COMDLG32.OCX", App.Path & "COMDLG32.OCX")
strFilename = "C:\Windows\System32\COMDLG32.OCX"
If Dir(TempStr) <> "" And Dir(strFilename) = "" Then
FileCopy TempStr, strFilename
End If
'建立控制板的桌面快捷方式
TempStr = IIf(Len(App.Path) > 3, App.Path & "\快Key控制板.lnk", App.Path & "快Key控制板.lnk")
strFilename = gSysDeskTopPath & "\快Key控制板.lnk"
MySleep 500
FileCopy TempStr, strFilename '把新文件考过来，旧文件被直接覆盖，无询问
'写注册表，开机启动QuicKeys.exe
'改注册表必须编译成exe，安装时设定以管理员身份运行执行，平时不要。
'管理员身份设定：编译时“文件描述”中要含有“Setup”字样，系统就会自动以管理员身份运行，也可在执行文件名包含Setup、Install等字样
Set W = CreateObject("wscript.shell")
W.regwrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & "QuicKeys.exe", gQuicKeysRunPath & "\QuicKeys.exe"
LB_STATUS.Caption = "正在配置参数"
Show_Installing_Progress 90
MySleep 2000
'写配置文件
strFilename = gQuicKeysDataPath & "\qkconfig.stp"
Open strFilename For Output As #1
Print #1, VER_NUM '正在执行的版本号
Print #1, "未定名" 'Uname
Upassword = EncryptStr(gUniPassword, EN_KEY)
Print #1, Upassword
gCheckUniPWMode = "2"
gCheckUniPWCycle = "60"
gCheckUniPWMode = EncryptStr(gCheckUniPWMode, EN_KEY)
gCheckUniPWCycle = EncryptStr(gCheckUniPWCycle, EN_KEY)
Print #1, gCheckUniPWMode
Print #1, gCheckUniPWCycle
Close #1
PrintTimeStamp
LB_STATUS = "安装完成->启动"
Show_Installing_Progress 100
MySleep 2000
'启动QuicKeys.exe
strFilename = gQuicKeysRunPath & "\QuicKeys.exe"
Shell strFilename, 1 '启动
Stop_Show_Installing
End '直接结束即可，前面已经删除Hook
Else '已安装过
'************************ 升级更新，检查版本号，如果不同，询问是否替换。 ***********************************************************************************
strFilename = gQuicKeysDataPath & "\qkconfig.stp"
Open strFilename For Input As #1
Line Input #1, gOldVerNum
Line Input #1, Uname
Close #1
TempStr = "发现已经安装的快Key版本号为 【" & gOldVerNum & "】" & vbCrLf
TempStr = TempStr & "当前正在安装的快Key版本号为 【" & VER_NUM & "】" & vbCrLf & vbCrLf
If Left(Trim(gOldVerNum), 2) = "V1" Then
TempStr2 = "【注意】：需要重新填写各系统密码，系统路径等数据可继续沿用。"
Else
TempStr2 = "已存在的密钥等数据不会被覆盖。"
End If
TempStr = TempStr & "是否用 【" & VER_NUM & "】 版本替换 【" & gOldVerNum & "】 版本？" & vbCrLf & TempStr2 & vbCrLf & vbCrLf
TempStr = TempStr & "按【是】替换，按【否】取消并退出。"
TmpNum = MsgBox(TempStr, 4 + 32 + 256, " " & QK_TITLE & " " & VER_NUM)
If TmpNum = vbYes Then '如果确实替换
BT_SUBMIT_UNIPW_SETUP.Enabled = False
BT_QUIT_SETUP.Enabled = False
Show_Installing
LB_STATUS.Visible = True
LB_STATUS.Caption = "正在初始化"
Show_Installing_Progress 8
MySleep 1000
LB_STATUS.Caption = "正在搜索浏览器，约2分钟"
Show_Installing_Progress 15
Search_Browsers
LB_STATUS.Caption = "正在更新文件"
Show_Installing_Progress 75
Shell "taskkill /f /im QuicKeys.exe" '杀死老程序进程,进程不存在也不会出错
TempStr = IIf(Len(App.Path) > 3, App.Path & "\" & App.EXEName & ".exe", App.Path & App.EXEName & ".exe") '获得安装文件自身路径和名称。
'当EXE在根目录下，app.path 是带有“\”，不在时候没有。
MySleep 500
'拷贝QuicKeys.exe到 QuicKeys目录
strFilename = gQuicKeysRunPath & "\QuicKeys.exe"
If Dir(strFilename) <> "" Then Kill strFilename '删掉 QuicKeys.exe 文件，如果文件不存在，删除会出错
MySleep 500
FileCopy TempStr, strFilename '把新文件考过来
'拷贝StartQuicKeys.exe到 QuicKeys目录
TempStr = IIf(Len(App.Path) > 3, App.Path & "\StartQuicKeys.ex_", App.Path & "StartQuicKeys.ex_")
strFilename = gQuicKeysRunPath & "\StartQuicKeys.exe"
If Dir(strFilename) <> "" Then Kill strFilename
MySleep 500
FileCopy TempStr, strFilename '把新文件考过来
'建立控制板的桌面快捷方式
TempStr = IIf(Len(App.Path) > 3, App.Path & "\快Key控制板.lnk", App.Path & "快Key控制板.lnk")
strFilename = gSysDeskTopPath & "\快Key控制板.lnk"
MySleep 500
FileCopy TempStr, strFilename '把新文件考过来，旧文件被直接覆盖，无询问
LB_STATUS.Caption = "正在更新配置"
Show_Installing_Progress 95
'更新qkconfig.stp
strFilename = gQuicKeysDataPath & "\qkconfig.stp"
If Left(Trim(gOldVerNum), 2) = "V1" Then '由V1更换为V2的加密方式
EN_KEY = gFirstEncryptKey
Open strFilename For Output As #1
Print #1, VER_NUM '正在执行的版本号
Print #1, Uname '原用户名
Upassword = EncryptStr(gUniPassword, EN_KEY)
Print #1, Upassword
gCheckUniPWMode = "2"
gCheckUniPWCycle = "60"
gCheckUniPWMode = EncryptStr(gCheckUniPWMode, EN_KEY)
gCheckUniPWCycle = EncryptStr(gCheckUniPWCycle, EN_KEY)
Print #1, gCheckUniPWMode
Print #1, gCheckUniPWCycle
Close #1
PrintTimeStamp
Else '已经是V2，只更新一下版本号
Open strFilename For Input As #1
Line Input #1, gOldVerNum
Line Input #1, Uname
Line Input #1, Upassword
Line Input #1, gCheckUniPWMode
Line Input #1, gCheckUniPWCycle
Close #1
Open strFilename For Output As #1
Print #1, VER_NUM
Print #1, Uname
Print #1, Upassword
Print #1, gCheckUniPWMode
Print #1, gCheckUniPWCycle
Close #1
End If
LB_STATUS = "更新完成->启动"
Show_Installing_Progress 100
MySleep 2000
'重新启动 QuicKeys.exe
strFilename = gQuicKeysRunPath & "\QuicKeys.exe"
MySleep 100 '需要等一下，否则找不到QuicKeys.exe
Shell strFilename, 1 '重启新版本
Stop_Show_Installing
MsgBox "已替换到 【" & VER_NUM & "】 版本，并已重新启动。" & vbCrLf & "请按鼠标【滚轮】呼出。", 0 + 64, " " & QK_TITLE
End
Else
End
End If
End If
End If
End Sub
Private Sub BT_QUIT_SETUP_Click()
TmpNum = MsgBox("确定退出安装快Key吗？" & vbCrLf & "按【是】退出安装，按【否】继续安装。", 4 + 32 + 256, " " & QK_TITLE & " " & VER_NUM & ": 安装")
If TmpNum = vbYes Then End '如果不安装就完全退出
End Sub
Public Sub Draw_FM_Check_UniKey_Setup()
On Error Resume Next
If FM_Main.Left > Screen.Width / 2 Then
FM_Check_UniKey_Setup.Left = FM_Main.Left - FM_Check_UniKey_Setup.Width - 20 + 200
Else
FM_Check_UniKey_Setup.Left = FM_Main.Left + FM_Main.Width + 20 + 200
End If
FM_Check_UniKey_Setup.Top = FM_Main.Top
FM_Check_UniKey_Setup.Caption = "快Key " & VER_NUM & ": 安装/更新"
FM_Main.Enabled = False
TXT_UNI_PASSWORD.Text = ""
TXT_UNI_PASSWORD.PasswordChar = "*"
Show_Installing_Progress 5
gLockMouseMidButton = True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '点击窗口关闭X时，不退出，只隐藏
On Error Resume Next
Dim TmpNum As Integer
If UnloadMode = 0 Then
Cancel = 1
Me.Hide
End If
TmpNum = MsgBox("确定退出安装快Key吗？" & vbCrLf & "按【是】退出安装，按【否】继续安装。", 4 + 32 + 256, " " & QK_TITLE & " " & VER_NUM & ": 安装")
If TmpNum = vbYes Then '如果不安装就完全退出，下面的语句不执行
End
Else
FM_Check_UniKey_Setup.Show
End If
End Sub
Private Sub BT_SEE_PW_Click() '明文显示密码
Select Case TXT_UNI_PASSWORD.PasswordChar
Case "*"
TXT_UNI_PASSWORD.PasswordChar = ""
Case ""
TXT_UNI_PASSWORD.PasswordChar = "*"
End Select
End Sub
Private Sub TXT_UNI_PASSWORD_GotFocus() '文本框得到焦点
If TXT_UNI_PASSWORD.Text = "系统升级，请重新设置统一密码" Then
TXT_UNI_PASSWORD.ForeColor = &H0&
TXT_UNI_PASSWORD.Text = ""
TXT_UNI_PASSWORD.PasswordChar = "*"
End If
End Sub
Private Sub TXT_UNI_PASSWORD_LostFocus() '文本框失去焦点
If TXT_UNI_PASSWORD.Text = "" Then
TXT_UNI_PASSWORD.ForeColor = &HFF&
TXT_UNI_PASSWORD.Text = "系统升级，请重新设置统一密码"
TXT_UNI_PASSWORD.PasswordChar = "*"
End If
End Sub
'*********************************************************************** FM_Check_UniKey_Setup 窗体代码结束 ***********************************************************************
（5）窗体： FM_Config_Key
FM_Config_Key.frm
******************************************************************************************************************************************************************************************
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FM_Config_Key
BorderStyle = 1 'Fixed Single
Caption = "快Key: 用户设置"
ClientHeight = 3405
ClientLeft = 45
ClientTop = 390
ClientWidth = 3120
Icon = "FM_Config_Key.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3405
ScaleWidth = 3120
StartUpPosition = 3 '窗口缺省
Begin MSComDlg.CommonDialog CommonDialog1
Left = 0
Top = 2040
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton BT_See_PW
Height = 255
Left = 2640
Picture = "FM_Config_Key.frx":424A
Style = 1 'Graphical
TabIndex = 12
Top = 1320
Width = 255
End
Begin VB.TextBox TXT_MINS
Alignment = 1 'Right Justify
Height = 270
Left = 1300
TabIndex = 10
Text = "60"
Top = 2460
Width = 615
End
Begin VB.CommandButton BT_CONFIG_CONFIRM
Caption = "确认"
Height = 375
Left = 240
TabIndex = 9
Top = 2870
Width = 2655
End
Begin VB.OptionButton OPT_PW_3
Caption = "超过 分钟未使用"
Height = 250
Left = 600
TabIndex = 8
Top = 2460
Width = 2490
End
Begin VB.OptionButton OPT_PW_2
Caption = "开机后首次呼出时"
Height = 250
Left = 600
TabIndex = 7
Top = 2210
Value = -1 'True
Width = 2055
End
Begin VB.OptionButton OPT_PW_1
Caption = "每次呼出时"
Height = 250
Left = 600
TabIndex = 6
Top = 1960
Width = 1935
End
Begin VB.TextBox TXT_UNI_PASSWORD
ForeColor = &H00C0C0C0&
Height = 270
Left = 1080
TabIndex = 4
Text = "快Key密码，必填"
Top = 1320
Width = 1815
End
Begin VB.TextBox TXT_USER_NAME
ForeColor = &H00C0C0C0&
Height = 270
Left = 1080
TabIndex = 2
Text = "未定名"
Top = 960
Width = 1815
End
Begin VB.CommandButton BT_CHANGE_PHOTO
Caption = "更换头像"
Height = 250
Left = 960
TabIndex = 0
Top = 280
Width = 975
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "可随时更换"
Height = 255
Left = 1900
TabIndex = 13
Top = 300
Width = 975
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "50x50像素图片效果最佳"
Height = 255
Left = 820
TabIndex = 11
Top = 560
Width = 2055
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "何时要求验证统一密码？"
Height = 255
Left = 240
TabIndex = 5
Top = 1720
Width = 2655
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "统一密码"
Height = 375
Left = 240
TabIndex = 3
Top = 1360
Width = 735
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "用户姓名"
Height = 255
Left = 240
TabIndex = 1
Top = 1000
Width = 855
End
Begin VB.Image Photo
Height = 500
Left = 360
Picture = "FM_Config_Key.frx":7DDB
Stretch = -1 'True
Top = 240
Width = 500
End
End
Attribute VB_Name = "FM_Config_Key"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************************************************************************************
'* *
'* 快Key 窗体FM_Config_Key *
'* *
'*********************************************************************************************************************************************************************
'*************************************************************************** 函数、子程序 ****************************************************************************
'FM_Config_Key 窗口，填写修改用户消息
Private Sub Form_Load()
SetWindowPos FM_Config_Key.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
Draw_FM_Config_Key
FM_Main.Enabled = False
End Sub
Public Sub Draw_FM_Config_Key()
On Error Resume Next
Dim QKFileName, TempStr As String
If FM_Main.Left > Screen.Width / 2 Then
FM_Config_Key.Left = FM_Main.Left - FM_Config_Key.Width - 20
Else
FM_Config_Key.Left = FM_Main.Left + FM_Main.Width + 20
End If
FM_Config_Key.Top = FM_Main.Top + 400
gLockMouseMidButton = True
TXT_UNI_PASSWORD.PasswordChar = ""
QKFileName = gQuicKeysDataPath & "\uphoto.jpg"
If Dir(QKFileName) <> "" Then
Photo.Picture = LoadPicture(QKFileName)
End If
QKFileName = gQuicKeysDataPath & "\qkconfig.stp"
If Dir(QKFileName) <> "" Then
Open QKFileName For Input As #1
Line Input #1, gOldVerNum
Line Input #1, Uname
Line Input #1, Upassword
Line Input #1, gCheckUniPWMode
Line Input #1, gCheckUniPWCycle
Close #1
TXT_USER_NAME.Text = Uname
TXT_USER_NAME.ForeColor = &H0&
TXT_UNI_PASSWORD.Text = gUniPassBase
TXT_UNI_PASSWORD.ForeColor = &H0&
TXT_UNI_PASSWORD.PasswordChar = "*"
gCheckUniPWMode = DecryptStr(gCheckUniPWMode, gFirstEncryptKey)
Select Case gCheckUniPWMode
Case "1"
OPT_PW_1.Value = True
Case "2"
OPT_PW_2.Value = True
Case "3"
OPT_PW_3.Value = True
End Select
gCheckUniPWCycle = DecryptStr(gCheckUniPWCycle, gFirstEncryptKey)
TXT_MINS.Text = gCheckUniPWCycle
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
FM_Main.Enabled = True
gInConfig = False
gLockMouseMidButton = False
If Dir(gQuicKeysDataPath & "\qkconfig.stp") = "" Then End '安装时，如果不设置就退出安装
End Sub
Private Sub BT_CONFIG_CONFIRM_Click() '提交设置信息
On Error Resume Next
Dim strFilename As String
Dim Uname, Upassword As String
Dim TempStr As String
Dim EN_KEY As String
If Check_Password_Rules(TXT_UNI_PASSWORD.Text) = False Then
TXT_UNI_PASSWORD.Text = ""
FM_Config_Key.Show
MsgBox "您输入的密码不符合信息安全规范，请重新输入。" & vbCrLf & vbCrLf & "要求：长度12个字符以上，同时包括大写字母、小写字母、数字和特殊字符。", 0 + 64, " " & QK_TITLE
Else
gOldUniPassword = gUniPassword
Create_UniPassword_FirstEncryptKey (TXT_UNI_PASSWORD.Text) '基于用户输入的统一密码，分裂出 gUniPassword 和 gFirstEncryptKey
EN_KEY = gFirstEncryptKey 'gFirstEncryptKey ， 用它给统一密码加密，而各个系统的密码由统一密码加密
'写配置文件
strFilename = gQuicKeysDataPath & "\qkconfig.stp"
Open strFilename For Output As #1
Uname = TXT_USER_NAME.Text
Print #1, VER_NUM '正在执行的版本号
Print #1, Uname
Upassword = EncryptStr(gUniPassword, EN_KEY)
Print #1, Upassword
If OPT_PW_1.Value = True Then gCheckUniPWMode = "1": gCheckUniPWCycle = "60"
If OPT_PW_2.Value = True Then gCheckUniPWMode = "2": gCheckUniPWCycle = "60"
If OPT_PW_3.Value = True Then gCheckUniPWMode = "3": gCheckUniPWCycle = TXT_MINS.Text
gCheckUniPWMode = EncryptStr(gCheckUniPWMode, EN_KEY)
gCheckUniPWCycle = EncryptStr(gCheckUniPWCycle, EN_KEY)
Print #1, gCheckUniPWMode
Print #1, gCheckUniPWCycle
Close #1
'更新所有密钥文件
For i = 1 To MAX_KEYS_NUM
strFilename = gQuicKeysDataPath & "\key" & i & ".kir"
If Dir(strFilename) <> "" Then
'读旧的密钥文件
Open strFilename For Input As #1
Line Input #1, gSysName
Line Input #1, gBrowser
Line Input #1, gURL
Line Input #1, gUserName
Line Input #1, TempStr
gPassWord = DecryptStr(TempStr, gOldUniPassword)
Line Input #1, TempStr
gTabNum1 = Val(TempStr)
Line Input #1, TempStr
gTabNum2 = Val(TempStr)
Line Input #1, TempStr
gManConfirm = Val(TempStr)
Close #1
'重写密钥文件
Open strFilename For Output As #1
Print #1, gSysName
Print #1, gBrowser
Print #1, gURL
Print #1, gUserName
TempStr = EncryptStr(gPassWord, gUniPassword)
Print #1, TempStr
Print #1, gTabNum1 & "" '强制转换为字符串
Print #1, gTabNum2 & ""
Print #1, gManConfirm & ""
Close #1
End If
Next
Set_Default_FM_Config_Key
'FM_Config_Key.Visible = False
FM_Config_Key.Hide
FM_Main.LB_NAME.Caption = Uname
FM_Main.Draw_MainForm
FM_Main.Enabled = True
PrintTimeStamp
gInConfig = False
gLockMouseMidButton = False
End If
End Sub
Private Sub Set_Default_FM_Config_Key() '设置增加密钥操作窗口的缺省值
TXT_USER_NAME.ForeColor = &HC0C0C0
TXT_USER_NAME.Text = "未定名"
TXT_UNI_PASSWORD.ForeColor = &HC0C0C0
TXT_UNI_PASSWORD.Text = "快Key密码，必填"
End Sub
Private Sub TXT_USER_NAME_GotFocus() '文本框得到焦点
If TXT_USER_NAME.Text = "未定名" Then
TXT_USER_NAME.ForeColor = &H0&
TXT_USER_NAME.Text = ""
End If
End Sub
Private Sub TXT_USER_NAME_LostFocus() '文本框失去焦点
If TXT_USER_NAME.Text = "" Then
TXT_USER_NAME.ForeColor = &HC0C0C0
TXT_USER_NAME.Text = "未定名"
End If
End Sub
Private Sub TXT_UNI_PASSWORD_GotFocus() '文本框得到焦点
If TXT_UNI_PASSWORD.Text = "快Key密码，必填" Then
TXT_UNI_PASSWORD.ForeColor = &H0&
TXT_UNI_PASSWORD.Text = ""
TXT_UNI_PASSWORD.PasswordChar = "*"
End If
End Sub
Private Sub TXT_UNI_PASSWORD_LostFocus() '文本框失去焦点
If TXT_UNI_PASSWORD.Text = "" Then
TXT_UNI_PASSWORD.ForeColor = &HC0C0C0
TXT_UNI_PASSWORD.Text = "快Key密码，必填"
TXT_UNI_PASSWORD.PasswordChar = ""
End If
End Sub
Private Sub BT_SEE_PW_Click() '是否明码显示密码
Select Case TXT_UNI_PASSWORD.PasswordChar
Case "*"
TXT_UNI_PASSWORD.PasswordChar = ""
Case ""
TXT_UNI_PASSWORD.PasswordChar = "*"
End Select
End Sub
Private Sub BT_CHANGE_PHOTO_Click() '设置头像
On Error Resume Next
CommonDialog1.Filter = "文本文件（*.jpg）|*.jpg"
Me.CommonDialog1.ShowOpen
FileCopy Me.CommonDialog1.FileName, gQuicKeysDataPath & "\uphoto.jpg"
Draw_FM_Config_Key
FM_Main.Draw_MainForm
End Sub
'************************************************************** FM_Config_Key 窗体代码结束 *********************************************************************
（6）窗体：FM_Help_Key
FM_Help_Key.frm
********************************************************************************************************************************************************************
VERSION 5.00
Begin VB.Form FM_Help_Key
BorderStyle = 1 'Fixed Single
Caption = "快Key: 使用指南"
ClientHeight = 8760
ClientLeft = 45
ClientTop = 390
ClientWidth = 7095
Icon = "FM_Help_Key.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8760
ScaleWidth = 7095
StartUpPosition = 2 '屏幕中心
Visible = 0 'False
Begin VB.CommandButton BT_LINK
Caption = "手动联络"
Height = 495
Left = 4680
TabIndex = 17
Top = 8040
Width = 1695
End
Begin VB.CommandButton BT_HELP_CLOSE
Caption = "关闭"
Height = 495
Left = 600
TabIndex = 0
Top = 8040
Width = 3975
End
Begin VB.Label LB_VERNUM
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "V2.0(Win7+)"
Height = 255
Left = 5160
TabIndex = 19
Top = 960
Width = 1095
End
Begin VB.Label Label7
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "当前版本号："
Height = 255
Left = 5160
TabIndex = 18
Top = 720
Width = 1215
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "王 权 田雪松 仲 强 蒋 政"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 720
TabIndex = 16
Top = 7560
Width = 3855
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "【开发团队】"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 2
Left = 480
TabIndex = 15
Top = 7280
Width = 2055
End
Begin VB.Image Image2
Enabled = 0 'False
Height = 1935
Left = 4680
Picture = "FM_Help_Key.frx":424A
Stretch = -1 'True
Top = 6000
Width = 1800
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "【联系信息】"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 480
TabIndex = 14
Top = 6200
Width = 2055
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "【版权与免责声明】"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 480
TabIndex = 13
Top = 4680
Width = 2535
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = " 鼠标悬浮在功能键上即显示其功能。"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 9
Left = 600
TabIndex = 12
Top = 2800
Width = 5895
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = " 快Key采用业界标准对您原有的密码等信息进行加密，保证您的系统安全。"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Index = 8
Left = 600
TabIndex = 11
Top = 3840
Width = 5895
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = " 快Key不联网，在您电脑上脱网运行，不上传任何信息。"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 7
Left = 600
TabIndex = 10
Top = 4320
Width = 5895
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = " 任何时候，只要您按鼠标【滚轮】（或中键）即可调出快Key。"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 6
Left = 600
TabIndex = 9
Top = 2520
Width = 6000
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = " 使用快Key必须设定一个【统一密码】，请牢记此密码，并保证其安全。快Key通过统一密码管理所有系统密钥，最多可以管理30个密钥。"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Index = 5
Left = 600
TabIndex = 8
Top = 3120
Width = 5895
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = " 快Key为开源软件，自由拷贝，自由使用，自由分享，自由修改，自由发布。"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 4
Left = 600
TabIndex = 7
Top = 4920
Width = 5895
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = $"FM_Help_Key.frx":155D2
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 3
Left = 600
TabIndex = 6
Top = 5400
Width = 5895
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = " 本软件不自动更新，安装、更新、源文件、交流信息等可通过【大系统观开放论坛】微信公众号获得，或点击【手动联络】："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Index = 2
Left = 600
TabIndex = 5
Top = 6480
Width = 4095
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = " 快Key将您的各个系统的用户名、密码、系统地址等信息统一管理，在您需要时帮您快速调用启动系统，填写登录信息，并自动登录。"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Index = 0
Left = 600
TabIndex = 4
Top = 1800
Width = 5900
End
Begin VB.Label Label3
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "智能登录助手 2020.9"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2280
TabIndex = 3
Top = 960
Width = 2895
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "【功能简介】"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 480
TabIndex = 2
Top = 1560
Width = 1815
End
Begin VB.Image Image1
Enabled = 0 'False
Height = 795
Left = 1440
Picture = "FM_Help_Key.frx":15666
Stretch = -1 'True
Top = 480
Width = 900
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "欢迎使用快Key!"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 720
TabIndex = 1
Top = 600
Width = 6015
End
End
Attribute VB_Name = "FM_Help_Key"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************************************************************************************
'* *
'* 快Key 窗体FM_Help_Key *
'* *
'*********************************************************************************************************************************************************************
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpoperation As String, ByVal lpfile As String, ByVal lpparameters As String, _
ByVal lpdirectory As String, ByVal nshowcmd As Long) As Long
'*************************************************************************** 函数、子程序 ****************************************************************************
Private Sub BT_HELP_CLOSE_Click()
FM_Help_Key.Hide
End Sub
Private Sub BT_LINK_Click()
Dim lngReturn As Long
lngReturn = ShellExecute(Me.hwnd, "open", "https://www.cnblogs.com/BigSystemsView/p/13613306.html", "", "", 0)
FM_Help_Key.Hide
End Sub
Private Sub Form_Load()
SetWindowPos FM_Help_Key.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
LB_VERNUM.Caption = VER_NUM
End Sub
'************************************************************** FM_Help_Key 窗体代码结束 *****************************************************************************
(7)窗体：FM_Main
FM_Main.frm
**************************************************************************************************************************************************************************
VERSION 5.00
Begin VB.Form FM_Main
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Caption = "快Key"
ClientHeight = 5910
ClientLeft = 45
ClientTop = 390
ClientWidth = 3735
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "FM_Main.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5910
ScaleWidth = 3735
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 29
Left = 0
Style = 1 'Graphical
TabIndex = 72
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 28
Left = 0
Style = 1 'Graphical
TabIndex = 71
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 27
Left = 0
Style = 1 'Graphical
TabIndex = 70
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 26
Left = 0
Style = 1 'Graphical
TabIndex = 69
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 25
Left = 0
Style = 1 'Graphical
TabIndex = 68
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 24
Left = 0
Style = 1 'Graphical
TabIndex = 67
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 23
Left = 0
Style = 1 'Graphical
TabIndex = 66
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 22
Left = 0
Style = 1 'Graphical
TabIndex = 65
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 21
Left = 0
Style = 1 'Graphical
TabIndex = 64
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 20
Left = 0
Style = 1 'Graphical
TabIndex = 63
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 19
Left = 0
Style = 1 'Graphical
TabIndex = 62
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 18
Left = 0
Style = 1 'Graphical
TabIndex = 61
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 17
Left = 0
Style = 1 'Graphical
TabIndex = 60
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 16
Left = 0
Style = 1 'Graphical
TabIndex = 59
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 15
Left = 0
Style = 1 'Graphical
TabIndex = 58
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 14
Left = 0
Style = 1 'Graphical
TabIndex = 57
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 13
Left = 0
Style = 1 'Graphical
TabIndex = 56
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 12
Left = 0
Style = 1 'Graphical
TabIndex = 55
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 11
Left = 0
Style = 1 'Graphical
TabIndex = 54
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 10
Left = 0
Style = 1 'Graphical
TabIndex = 53
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 9
Left = 0
Style = 1 'Graphical
TabIndex = 52
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 8
Left = 0
Style = 1 'Graphical
TabIndex = 51
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 7
Left = 0
Style = 1 'Graphical
TabIndex = 50
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 6
Left = 0
Style = 1 'Graphical
TabIndex = 49
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 5
Left = 0
Style = 1 'Graphical
TabIndex = 48
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 4
Left = 0
Style = 1 'Graphical
TabIndex = 47
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 3
Left = 0
Style = 1 'Graphical
TabIndex = 46
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 2
Left = 0
Style = 1 'Graphical
TabIndex = 45
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 1
Left = 0
Style = 1 'Graphical
TabIndex = 44
Top = 0
Width = 250
End
Begin VB.CommandButton BT_DEL_SINGLE
BackColor = &H00C0C0FF&
Caption = "-"
Height = 250
Index = 0
Left = 0
Style = 1 'Graphical
TabIndex = 43
Top = 0
Width = 250
End
Begin VB.CommandButton BT_ADD
BackColor = &H00FFFFFF&
Caption = "+"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 250
Left = 2140
TabIndex = 8
TabStop = 0 'False
ToolTipText = "添加密钥"
Top = 60
Width = 300
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 29
Left = 2460
TabIndex = 40
Top = 5100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 28
Left = 1260
TabIndex = 39
Top = 5100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 27
Left = 60
TabIndex = 38
Top = 5100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 26
Left = 2460
TabIndex = 37
Top = 4600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 25
Left = 1260
TabIndex = 36
Top = 4600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 24
Left = 60
TabIndex = 35
Top = 4600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 23
Left = 2460
TabIndex = 34
Top = 4100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 22
Left = 1260
TabIndex = 33
Top = 4100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 21
Left = 60
TabIndex = 32
Top = 4100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 20
Left = 2460
TabIndex = 31
Top = 3600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 19
Left = 1260
TabIndex = 30
Top = 3600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 18
Left = 60
TabIndex = 29
Top = 3600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 17
Left = 2460
TabIndex = 28
Top = 3100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 16
Left = 1260
TabIndex = 27
Top = 3100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 15
Left = 60
TabIndex = 26
Top = 3100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 14
Left = 2460
TabIndex = 25
Top = 2600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 13
Left = 1260
TabIndex = 24
Top = 2600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 12
Left = 60
TabIndex = 23
Top = 2600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 11
Left = 2460
TabIndex = 22
Top = 2100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 10
Left = 1260
TabIndex = 21
Top = 2100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 9
Left = 60
TabIndex = 20
Top = 2100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 8
Left = 2460
TabIndex = 19
Top = 1600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 7
Left = 1260
TabIndex = 18
Top = 1600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 6
Left = 60
TabIndex = 17
Top = 1600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 5
Left = 2460
TabIndex = 16
Top = 1100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 4
Left = 1260
TabIndex = 15
Top = 1100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 3
Left = 60
TabIndex = 14
Top = 1100
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 2
Left = 2460
TabIndex = 13
Top = 600
Width = 1200
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 1
Left = 1260
TabIndex = 12
Top = 600
Width = 1200
End
Begin VB.CommandButton BT_FOLD
BackColor = &H00C0C0C0&
Caption = "<?"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 510
Left = 3360
Style = 1 'Graphical
TabIndex = 0
TabStop = 0 'False
ToolTipText = "展开/收敛功能菜单"
Top = 60
Width = 300
End
Begin VB.CommandButton BT_CONFIG
Caption = "设"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 250
Left = 2140
TabIndex = 4
TabStop = 0 'False
ToolTipText = "用户设置"
Top = 310
Width = 300
End
Begin VB.CommandButton BT_EXIT
Caption = "退"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 250
Left = 2740
TabIndex = 2
TabStop = 0 'False
ToolTipText = "退出软件"
Top = 310
Width = 300
End
Begin VB.CommandButton BT_ORDER
Caption = "∧"
BeginProperty Font
Name = "宋体"
Size = 6
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 250
Left = 3040
TabIndex = 5
TabStop = 0 'False
ToolTipText = "整理重排"
Top = 60
Width = 300
End
Begin VB.CommandButton BT_HELP
Caption = "?"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 250
Left = 3040
TabIndex = 1
TabStop = 0 'False
ToolTipText = "使用帮助"
Top = 310
Width = 300
End
Begin VB.CommandButton BT_UNINSTALL
Caption = "卸"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 250
Left = 2440
TabIndex = 3
TabStop = 0 'False
ToolTipText = "卸载软件"
Top = 310
Width = 300
End
Begin VB.CommandButton BT_EDIT
Caption = "…"
BeginProperty Font
Name = "宋体"
Size = 6
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 250
Left = 2740
Style = 1 'Graphical
TabIndex = 6
TabStop = 0 'False
ToolTipText = "修改密钥，再按退出修改"
Top = 60
Width = 300
End
Begin VB.CommandButton BT_DEL
Caption = "-"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 250
Left = 2440
MaskColor = &H80000000&
Style = 1 'Graphical
TabIndex = 7
TabStop = 0 'False
ToolTipText = "删除密钥，再按退出删除"
Top = 60
Width = 300
End
Begin VB.CommandButton BT_A_KEY
Caption = "系统名称"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Index = 0
Left = 60
TabIndex = 10
Top = 600
Width = 1200
End
Begin VB.Image Photo
Appearance = 0 'Flat
Enabled = 0 'False
Height = 500
Left = 80
Picture = "FM_Main.frx":424A
Stretch = -1 'True
Top = 60
Width = 500
End
Begin VB.Label SERV_TOTAL
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "欢迎使用！"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2000
TabIndex = 42
Top = 240
Width = 1335
End
Begin VB.Label Foot_Text
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "按滚轮呼出 脱网运行 不传密码 BSV/2020"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00008000&
Height = 255
Left = 0
TabIndex = 41
Top = 5640
Width = 3735
End
Begin VB.Line Line2
X1 = 120
X2 = 3600
Y1 = 600
Y2 = 600
End
Begin VB.Label KEY_TOTAL
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "密钥数:22"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1330
TabIndex = 11
Top = 240
Width = 1335
End
Begin VB.Line Line1
BorderColor = &H80000010&
X1 = 80
X2 = 3670
Y1 = 10
Y2 = 10
End
Begin VB.Label LB_NAME
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "未定名"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 630
TabIndex = 9
Top = 240
Width = 735
End
End
Attribute VB_Name = "FM_Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************************************************************************************
'* *
'* 快Key 主窗体 FM_Main *
'* *
'*********************************************************************************************************************************************************************
'*************************************************************************** 函数、子程序 ****************************************************************************
Private Sub Form_Load() '窗体载入的时候，安装鼠标钩子
On Error GoTo CommonErr
Init_Form
AddHook 'addhook要在draw_mainform前面
Get_Mouse_Form_XY_Ratio '要放在AddKook后。因为大分辨率屏幕时，缇数可能不等于15，所以要通过实验方法获得，否则窗口与鼠标不同步
Draw_MainForm
If gTotalRealKeyNum = 0 And gInstalled = True And gTotalServeTimes = 1 Then '刚安装完，尚无密钥
FM_Main.Visible = True
FM_Main.Left = (Screen.Width - FM_Main.Width) / 2
FM_Main.Top = (Screen.Height - FM_Main.Height) / 2
FM_Main.Enabled = True
SetWindowPos FM_Main.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
ShowCheckPad
End If
If gTotalRealKeyNum > 0 And InStr(UCase(App.EXEName), "SETUP") = 0 Then
SetWindowPos FM_Start_Note.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
FM_Start_Note.Show
FM_Start_Note.Refresh
MySleep 2000
FM_Start_Note.Hide
End If
SetWindowPos FM_Main.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
Exit Sub
CommonErr:
MsgBox "快Key需要防火墙、360等安全软件允许下列权限：" & vbCrLf & " （1）修改注册表：用于开机自动启动；" & vbCrLf & " （2）在U盘运行：用于随身版。" & vbCrLf & vbCrLf _
& "请打开安全防护软件，将相关项设置为允许，并将相关EXE文件加入信任列表。", 16, " " & QK_TITLE
End Sub
Private Sub BT_A_KEY_Click(Index As Integer) '30个密钥按键是个数组，0号元素对应第1个密钥
Open_Browser (Index)
End Sub
Private Sub BT_FOLD_Click() '折叠右上角功能键
gShowFunc = Not gShowFunc
BT_ADD.Visible = gShowFunc
BT_DEL.Visible = gShowFunc
BT_EDIT.Visible = gShowFunc
BT_ORDER.Visible = gShowFunc
BT_CONFIG.Visible = gShowFunc
BT_UNINSTALL.Visible = gShowFunc
BT_EXIT.Visible = gShowFunc
BT_HELP.Visible = gShowFunc
If gShowFunc = True Then
BT_FOLD.Caption = ">"
Else
BT_FOLD.Caption = "<?"
End If
End Sub
Private Sub BT_ADD_Click() '增加密钥
On Error Resume Next
Dim KeyFileName As String
Dim CAN_ADD As Boolean
CAN_ADD = False
For i = 1 To MAX_KEYS_NUM
KeyFileName = gQuicKeysDataPath & "\key" & i & ".kir"
If Dir(KeyFileName) = "" Then '如果文件不存在
CAN_ADD = True
gFirstSpaceNum = i
FM_Add_Key.TXT_TARGET_NUM = gFirstSpaceNum
Exit For
End If
Next
If CAN_ADD = False Then
MsgBox "添加密钥失败：最多可添加" & MAX_KEYS_NUM & "个密钥，未找到空位。请删除不必要的密钥。", 16, " " & QK_TITLE
Else
gDelOrEdit = 1
FM_Add_Key.Set_Default_FM_Add_Key
FM_Add_Key.Visible = True
FM_Add_Key.TXT_PW.PasswordChar = ""
FM_Add_Key.Caption = QK_TITLE & ": 添加密钥"
FM_Add_Key.Show
FM_Add_Key.Draw_FM_Add_Key
gDelOrNot = Not gDelOrNot
For i = 1 To 3
For j = 1 To 10
btIndex = (j - 1) * 3 + i - 1
tTop = 600 + (j - 1) * 500
BT_DEL_SINGLE(btIndex).Top = tTop
tLeft = 60 + (i - 1) * 1200 + 950
BT_DEL_SINGLE(btIndex).Left = tLeft
BT_DEL_SINGLE(btIndex).Width = 250
BT_DEL_SINGLE(btIndex).Caption = (j - 1) * 3 + i
BT_DEL_SINGLE(btIndex).FontSize = 7
KeyFileName = gQuicKeysDataPath & "\key" & (btIndex + 1) & ".kir"
BT_DEL_SINGLE(btIndex).Visible = True
Next
Next
FM_Main.Height = MAIN_FORM_MAX_HEIGHT
Foot_Text.Top = 5640
FM_Main.Enabled = False
End If
End Sub
Private Sub BT_DEL_Click() '删除密钥
On Error Resume Next
Dim tTop, tLeft, btIndex As Integer
Dim KeyFileName As String
Draw_MainForm
gDelOrEdit = 1 '1表示删除，2表示编辑，BT_DEL_SINGLE键组分别处理
gDelOrNot = Not gDelOrNot
If gDelOrNot = True Then
BT_DEL.BackColor = &HC0FFC0
BT_DEL.Caption = "←"
BT_DEL.FontSize = 10
gLockMouseMidButton = True
Else
BT_DEL.BackColor = &H8000000F
BT_DEL.Caption = "-"
BT_DEL.FontSize = 12
gLockMouseMidButton = False
End If
BT_ADD.Enabled = Not gDelOrNot
If gTotalRealKeyNum >= MAX_KEYS_NUM Then BT_ADD.Enabled = False
BT_EDIT.Enabled = Not gDelOrNot
BT_ORDER.Enabled = Not gDelOrNot
BT_FOLD.Enabled = Not gDelOrNot
BT_CONFIG.Enabled = Not gDelOrNot
BT_UNINSTALL.Enabled = Not gDelOrNot
BT_EXIT.Enabled = Not gDelOrNot
BT_HELP.Enabled = Not gDelOrNot
For i = 1 To 3
For j = 1 To 10
btIndex = (j - 1) * 3 + i - 1
tTop = 600 + (j - 1) * 500
BT_DEL_SINGLE(btIndex).Top = tTop
tLeft = 60 + (i - 1) * 1200 + 950
BT_DEL_SINGLE(btIndex).Left = tLeft
BT_DEL_SINGLE(btIndex).Width = 250
BT_DEL_SINGLE(btIndex).Caption = "-"
BT_DEL_SINGLE(btIndex).FontSize = 10
KeyFileName = gQuicKeysDataPath & "\key" & (btIndex + 1) & ".kir"
If Dir(KeyFileName) <> "" Then
BT_DEL_SINGLE(btIndex).Visible = gDelOrNot
BT_A_KEY(btIndex).Enabled = Not gDelOrNot
End If
Next
Next
End Sub
Private Sub BT_EDIT_Click() '编辑修改密钥
BT_EDIT_Click_RUN
End Sub
Public Sub BT_EDIT_Click_RUN()
On Error Resume Next
Dim tTop, tLeft, btIndex As Integer
Dim KeyFileName As String
gDelOrEdit = 2 '1表示删除，2表示编辑，BT_DEL_SINGLE键组分别处理
gDelOrNot = Not gDelOrNot
If gDelOrNot = True Then
BT_EDIT.BackColor = &HC0FFC0
BT_EDIT.Caption = "←"
BT_EDIT.FontSize = 10
gLockMouseMidButton = True
Else
BT_EDIT.BackColor = &H8000000F
BT_EDIT.Caption = "…"
BT_EDIT.FontSize = 6
gLockMouseMidButton = False
End If
BT_ADD.Enabled = Not gDelOrNot
If gTotalRealKeyNum >= MAX_KEYS_NUM Then BT_ADD.Enabled = False
BT_DEL.Enabled = Not gDelOrNot
BT_ORDER.Enabled = Not gDelOrNot
BT_FOLD.Enabled = Not gDelOrNot
BT_CONFIG.Enabled = Not gDelOrNot
BT_UNINSTALL.Enabled = Not gDelOrNot
BT_EXIT.Enabled = Not gDelOrNot
BT_HELP.Enabled = Not gDelOrNot
For i = 1 To 3
For j = 1 To 10
btIndex = (j - 1) * 3 + i - 1
tTop = 600 + (j - 1) * 500
BT_DEL_SINGLE(btIndex).Top = tTop
tLeft = 60 + (i - 1) * 1200 + 950 - 200
BT_DEL_SINGLE(btIndex).Left = tLeft
BT_DEL_SINGLE(btIndex).Width = 450
BT_DEL_SINGLE(btIndex).Caption = (j - 1) * 3 + i & "…"
BT_DEL_SINGLE(btIndex).FontSize = 7
KeyFileName = gQuicKeysDataPath & "\key" & (btIndex + 1) & ".kir"
If Dir(KeyFileName) <> "" Then
BT_DEL_SINGLE(btIndex).Visible = gDelOrNot
BT_A_KEY(btIndex).Enabled = Not gDelOrNot
End If
Next
Next
End Sub
Private Sub BT_DEL_SINGLE_Click(Index As Integer) '删除密钥，修改密钥也用这个，根据全局变量gDelOrEdit 决定
On Error Resume Next
Dim KeyFileName, TmpSysNM, TempStr, TempStr2 As String
Dim YN, t As Integer
KeyFileName = gQuicKeysDataPath & "\key" & (Index + 1) & ".kir"
Select Case gDelOrEdit
Case 1 '删除
Open KeyFileName For Input As #1
If Not EOF(1) Then
Line Input #1, TmpSysNM
End If
Close #1
t = MsgBox("删除密钥：【" & TmpSysNM & "】 吗？", 36, " " & QK_TITLE)
If t = vbYes Then
Kill KeyFileName
BT_A_KEY(Index).Visible = False
BT_DEL_SINGLE(Index).Visible = False
gTotalRealKeyNum = gTotalRealKeyNum - 1
KEY_TOTAL.Caption = "密钥数:" & gTotalRealKeyNum
End If
Case 2 '编辑修改
FM_Add_Key.TXT_TARGET_NUM = Index + 1
Open KeyFileName For Input As #1
If Not EOF(1) Then
Line Input #1, TempStr
FM_Add_Key.TXT_SYSNM = TempStr
Line Input #1, TempStr
FM_Add_Key.TXT_BROWSER_PATH = TempStr
Line Input #1, TempStr
If Trim(TempStr) = "{-null-}" Then TempStr = ""
FM_Add_Key.TXT_URL = TempStr
Line Input #1, TempStr
If Trim(TempStr) = "{-null-}" Then TempStr = ""
FM_Add_Key.TXT_UN = TempStr
Line Input #1, TempStr
TempStr2 = DecryptStr(TempStr, gUniPassword)
If TempStr2 = "{-null-}" Or TempStr2 = "" Then
FM_Add_Key.TXT_PW.ForeColor = &HC0C0C0
FM_Add_Key.TXT_PW.Text = "原系统密码，不填表示手动输入"
Else
FM_Add_Key.TXT_PW = TempStr2
End If
Line Input #1, TempStr
FM_Add_Key.TXT_TAB1 = TempStr
Line Input #1, TempStr
FM_Add_Key.TXT_TAB2 = TempStr
Line Input #1, TempStr
FM_Add_Key.CB_MANUAL_CONFIRM.Value = Int(TempStr)
End If
Close #1
FM_Add_Key.Visible = True
FM_Add_Key.TXT_PW.PasswordChar = ""
FM_Add_Key.Caption = QK_TITLE & ": 修改密钥"
FM_Add_Key.TXT_SYSNM.ForeColor = &H0&
FM_Add_Key.TXT_UN.ForeColor = &H0&
If FM_Add_Key.TXT_PW.Text <> "" And FM_Add_Key.TXT_PW.Text <> "原系统密码，不填表示手动输入" Then FM_Add_Key.TXT_PW.ForeColor = &H0&
FM_Add_Key.TXT_PW.PasswordChar = "*"
FM_Add_Key.Show
FM_Add_Key.Draw_FM_Add_Key
gKeyIndex = Index + 1
FM_Main.Enabled = False
End Select
End Sub
Private Sub BT_EXIT_Click() '彻底退出程序
Dim TempStr As String
Dim TmpNum As Integer
TempStr = "要退出快Key吗？" & vbCrLf & "退出后，快Key将不能被呼出。需要重新启动电脑才能再次启动快Key。" & vbCrLf & "建议点击窗口右上角 【X】 隐藏快Key。" & vbCrLf & vbCrLf & "按【是】退出，按【否】取消。"
TmpNum = MsgBox(TempStr, 4 + 32 + 256, " " & QK_TITLE)
If TmpNum = vbYes Then '如果确实退出
QUIT_ALL
End If
End Sub
Private Sub BT_UNINSTALL_Click() '卸载快Key
On Error Resume Next
Dim TempStr, b As String
Dim TmpNum As Integer
Dim strFilename As String
If UCase(App.EXEName) <> "快KEY随身版" Then '卸载电脑端
TempStr = "确定卸载本机上的快Key吗？" & vbCrLf & "卸载将彻底删除本机上的快Key及其管理的所有密钥的信息。" & vbCrLf & "如果制作了U盘随身版，可继续独立使用。" _
& vbCrLf & "卸载U盘随身版，需要在U盘随身版上进行。" & vbCrLf & vbCrLf
TempStr = TempStr & "按【是】卸载，按【否】取消。"
TmpNum = MsgBox(TempStr, 4 + 32 + 256, " " & QK_TITLE & " " & VER_NUM)
If TmpNum = vbYes Then '如果确实卸载
DelHook
MsgBox "本机上的快Key将完全卸载。" & vbCrLf & "谢谢使用！再见！", 0 + 64, " " & QK_TITLE '先在前面，否则后面杀进程就不执行了
strFilename = gSysDeskTopPath & "\快Key控制板.lnk" '删掉桌面控制板快捷方式
If Dir(strFilename) <> "" Then Kill strFilename
Open gQuicKeysDataPath & "\tempkillqk.bat" For Output As #1 '因为无法删除自己，所以用BAT文件通过Shell实现。
Print #1, "@echo off"
Print #1, "taskkill /f /im QuicKeys.exe"
Print #1, "taskkill /f /im " & App.EXEName '有时安装状态需要,当运行时名字不是QuicKeys.exe时
Print #1, "rmdir /s/q " & """" & gQuicKeysRunPath & """"
Print #1, "rmdir /s/q " & """" & gQuicKeysDataPath & """"
Print #1, "rd " & """" & QuicKeysRunPath & """"
Print #1, "rd " & """" & QuicKeysDataPath & """"
Close #1
MySleep 1000
Shell gQuicKeysDataPath & "\tempkillqk.bat >nul"
End
End If
Else '卸载U盘随身版
TempStr = "确定卸载U盘上的快Key随身版吗？" & vbCrLf & "卸载将彻底删除U盘上的快Key随身版及其管理的所有密钥的信息。" & vbCrLf & "电脑上的快Key将保留，可继续使用。" _
& vbCrLf & "卸载电脑上的快Key，请使用桌面快捷方式【快Key控制板】。" & vbCrLf & vbCrLf
TempStr = TempStr & "按【是】卸载，按【否】取消。"
TmpNum = MsgBox(TempStr, 4 + 32 + 256, " " & QK_TITLE & " " & VER_NUM)
If TmpNum = vbYes Then '如果确实卸载
DelHook
MsgBox "U盘上的快Key随身版将完全卸载。" & vbCrLf & "谢谢使用！再见！", 0 + 64, " " & QK_TITLE '先在前面，否则后面杀进程就不执行了
Open gQuicKeysDataPath & "\tempkillqk.bat" For Output As #1 '因为无法删除自己，所以用BAT文件通过Shell实现。
Print #1, "@echo off"
Print #1, "taskkill /f /im 快Key随身版.exe"
Print #1, "taskkill /f /im " & App.EXEName & ".exe" '有时安装状态需要,当运行时名字不是QuicKeys.exe时
Print #1, "cd \"
Print #1, "del /f /q 快Key随身版.exe"
Print #1, "rmdir /s/q " & """" & gQuicKeysDataPath & """"
Print #1, "rd " & """" & gQuicKeysRunPath & """"
Print #1, "rd " & """" & gQuicKeysDataPath & """"
Close #1
MySleep 1000
Shell gQuicKeysDataPath & "\tempkillqk.bat >nul"
End
End If
End If
End Sub
Public Sub Init_Form() '初始化FM_Main
On Error Resume Next
Dim strFilename, Uname As String
Dim TmpNum As Integer
gWebBrowsers() = Split(WEB_BROWSERS_LIST, ",") '预置各流行浏览器信息
FM_Main.Visible = False
gInstalled = False
gUniPassword = ""
gFirstEncryptKey = ""
gUniPWChecked = False '是否检查过统一密码
gInConfig = False '是否正在设置过程中，false表示不是正在设置
gLockMouseMidButton = False
gIEInstead = False '随身版用
Get_QuicKeysPath '获得QuicKeys路径，放在全局变量 gQuicKeysDataPath、gQuicKeysRunPath等
strFilename = gQuicKeysDataPath & "\uphoto.jpg"
If Dir(strFilename) <> "" Then
Photo.Picture = LoadPicture(strFilename)
End If
FM_Main.Caption = QK_TITLE & " - 智能登录助手 " & VER_NUM '在主窗口上显示标题
If gUDiskMode = True Then
FM_Main.BackColor = &H80FF& '窗体背景变色，提示为随身版
FM_Main.Caption = QK_TITLE & " - 智能登录助手 " & "（随身版）" '在主窗口标题上显示随身版
End If
gShowFunc = False 'True
BT_ADD.Visible = gShowFunc
BT_DEL.Visible = gShowFunc
BT_EDIT.Visible = gShowFunc
BT_ORDER.Visible = gShowFunc
BT_CONFIG.Visible = gShowFunc
BT_UNINSTALL.Visible = gShowFunc
BT_EXIT.Visible = gShowFunc
BT_HELP.Visible = gShowFunc
BT_FOLD.Caption = "<?"
gDelOrNot = False '设为非正在删除状态
For i = 0 To 29
BT_DEL_SINGLE(i).Visible = False
Next
strFilename = gQuicKeysDataPath & "\qkconfig.stp"
If Dir(strFilename) <> "" Then
gInstalled = True
Open strFilename For Input As #1
Line Input #1, gOldVerNum '已安装的版本号，用于与执行中的对比，决定是否替换
Line Input #1, Uname
Close #1
LB_NAME.Caption = Uname
End If
If InStr(UCase(App.EXEName), "SETUP") > 0 Then '文件名包含setup表示是安装文件
FM_Check_UniKey_Setup.Show
End If
'*********************************************************
'FM_Check_UniKey_Setup.Show '调试安装时使用，平时注释掉
End Sub
Public Sub Draw_MainForm() '绘制窗体，按照密钥个数
On Error Resume Next
Dim QKFileName As String
Dim TempStr As String
Dim TmpNum As Integer
Dim ColN As Single '计算用
Dim ColNum As Integer '显示几行按键
Dim h1, h2 As Integer
Dim gRealNum As Integer
QKFileName = gQuicKeysDataPath & "\uphoto.jpg"
If Dir(QKFileName) <> "" Then
Photo.Picture = LoadPicture(QKFileName)
End If
For i = 0 To 29
BT_A_KEY(i).Visible = False
Next
gMaxIndex = 0
gRealNum = 0
For i = 1 To MAX_KEYS_NUM
QKFileName = gQuicKeysDataPath & "\key" & i & ".kir"
If Dir(QKFileName) <> "" Then
gRealNum = gRealNum + 1
gMaxIndex = i
Open QKFileName For Input As #1
Line Input #1, gSysName
Close #1
BT_A_KEY(i - 1).Visible = True
BT_A_KEY(i - 1).Caption = gSysName
BT_A_KEY(i - 1).Enabled = True
End If
Next
gTotalRealKeyNum = gRealNum '全局变量
ColN = gMaxIndex / 3
ColNum = Int(ColN)
If (ColN - ColNum) > 0 Then ColNum = ColNum + 1
KEY_TOTAL.Caption = "密钥" & gRealNum & "个"
h1 = MAIN_FORM_MAX_HEIGHT
h2 = (10 - ColNum) * 500
FM_Main.Height = h1 - h2
h1 = 5640
Foot_Text.Top = h1 - h2
'如果密钥数为0，自动加大显示添加键
If gRealNum = 0 Then
BT_ADD.Visible = True
BT_ADD.Caption = "+添加密钥"
BT_ADD.Height = 510
BT_ADD.Width = 1200
BT_ADD.FontSize = 10
gShowFunc = True
BT_ADD.Visible = gShowFunc
BT_DEL.Visible = gShowFunc
BT_EDIT.Visible = gShowFunc
BT_ORDER.Visible = gShowFunc
BT_CONFIG.Visible = gShowFunc
BT_UNINSTALL.Visible = gShowFunc
BT_EXIT.Visible = gShowFunc
BT_HELP.Visible = gShowFunc
BT_FOLD.Caption = ">"
Else
BT_ADD.Caption = "+"
BT_ADD.Height = 250
BT_ADD.Width = 300
BT_ADD.FontSize = 12
End If
If gRealNum >= MAX_KEYS_NUM Then
BT_ADD.Enabled = False
FM_Add_Key.Visible = False
End If
QKFileName = gQuicKeysDataPath & "\timestamp" & ".ktm"
If Dir(QKFileName) <> "" Then
Open QKFileName For Input As #1
Line Input #1, TempStr
Close #1
gTotalServeTimes = Val(TempStr)
End If
SERV_TOTAL.Caption = "已服务" & gTotalServeTimes & "次"
End Sub
Private Sub BT_ORDER_Click() '整理密钥按键，重新排序，去掉空位，以文件keyN.kir存在为依据
On Error Resume Next
Dim TempStr, OldName, NewName As String
gRealNum = 0
For i = 1 To MAX_KEYS_NUM
OldName = gQuicKeysDataPath & "\key" & i & ".kir"
If Dir(OldName) <> "" Then
gRealNum = gRealNum + 1
NewName = gQuicKeysDataPath & "\key" & gRealNum & ".kir"
If i > gRealNum Then
Name OldName As NewName
End If
End If
Next
Draw_MainForm
End Sub
Private Sub BT_CONFIG_Click()
On Error Resume Next
gInConfig = True
FM_Config_Key.Show
FM_Config_Key.Draw_FM_Config_Key
FM_Main.Enabled = False
FM_Config_Key.Enabled = False
ShowCheckPad
End Sub
Private Sub BT_HELP_Click()
FM_Help_Key.Show
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '点击窗口关闭X时，不退出，只隐藏
If UnloadMode = 0 Then
Cancel = 1
Me.Hide
gLockMouseMidButton = False
gDelOrNot = False
BT_DEL.BackColor = &H8000000F
BT_DEL.Caption = "-"
BT_DEL.FontSize = 12
BT_EDIT.BackColor = &H8000000F
BT_EDIT.Caption = "…"
BT_EDIT.FontSize = 6
BT_ADD.Enabled = True
If gTotalRealKeyNum >= MAX_KEYS_NUM Then BT_ADD.Enabled = False
BT_DEL.Enabled = True
BT_EDIT.Enabled = True
BT_ORDER.Enabled = True
BT_FOLD.Enabled = True
BT_CONFIG.Enabled = True
BT_UNINSTALL.Enabled = True
BT_EXIT.Enabled = True
BT_HELP.Enabled = True
For i = 1 To 3
For j = 1 To 10
btIndex = (j - 1) * 3 + i - 1
BT_DEL_SINGLE(btIndex).Visible = False
BT_A_KEY(btIndex).Enabled = True
Next
Next
End If
End Sub
'*************************************************************************** FM_Main窗体代码结束 ****************************************************************************
（8）窗体：FM_Select_Browser
FM_Select_Browser.frm
*********************************************************************************************************************************************************************************
VERSION 5.00
Begin VB.Form FM_Select_Browser
BorderStyle = 1 'Fixed Single
Caption = "快Key: 选择浏览器或程序"
ClientHeight = 2355
ClientLeft = 45
ClientTop = 390
ClientWidth = 5205
Icon = "FM_Select_Browser.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2355
ScaleWidth = 5205
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton BT_SELECT
Caption = "选择"
Height = 375
Left = 240
TabIndex = 2
Top = 1800
Width = 4695
End
Begin VB.ListBox LST_BROWSERS
Height = 1320
Left = 240
TabIndex = 1
Top = 360
Width = 4695
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "下面是已安装和使用过的浏览器或程序，请选择："
Height = 255
Left = 240
TabIndex = 0
Top = 120
Width = 3855
End
End
Attribute VB_Name = "FM_Select_Browser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************************************************************************************
'* *
'* 快Key 窗体FM_Select_Browser *
'* *
'*********************************************************************************************************************************************************************
'*************************************************************************** 函数、子程序 ****************************************************************************
'FM_Select_Browser 窗口，选择用户已经使用过的浏览器或程序
Private Sub Form_Load()
Draw_FM_Select_Browser
End Sub
Public Sub Draw_FM_Select_Browser()
On Error Resume Next
Dim QKFileName, TempStr As String
LST_BROWSERS.Clear
For i = 1 To MAX_KEYS_NUM
QKFileName = gQuicKeysDataPath & "\key" & i & ".kir"
If Dir(QKFileName) <> "" Then
Open QKFileName For Input As #1
Line Input #1, gSysName
Line Input #1, gBrowser
Close #1
If Len(gBrowser) > 30 Then
TempStr = Left(gBrowser, 10) & "..." & Right(gBrowser, 17)
Else
TempStr = gBrowser
End If
LST_BROWSERS.AddItem i & " " & TempStr & "(" & gSysName & ")"
End If
Next
For i = 1 To UBound(gWebBrowsers)
BrowserExeName = Mid(gWebBrowsers(i), InStr(gWebBrowsers(i), "|") + 1, 50) '不含.exe
QKFileName = gQuicKeysDataPath & "\browser" & BrowserExeName & ".lst"
If (Dir(QKFileName) <> "") Then
TempStr = ""
Open QKFileName For Input As #1
If Not EOF(1) Then Line Input #1, TempStr
Close #1
If Trim(TempStr) <> "" And InStr(UCase(TempStr), UCase(BrowserExeName & ".exe")) > 0 Then
gBrowser = Left(gWebBrowsers(i), InStr(gWebBrowsers(i), "|")) & TempStr
If Len(gBrowser) > 30 Then
TempStr = Left(gBrowser, 10) & "..." & Right(gBrowser, 17)
Else
TempStr = gBrowser
End If
LST_BROWSERS.AddItem "* " & TempStr & "(自动搜索)"
End If
End If
Next
FM_Add_Key.Enabled = False
FM_Select_Browser.Show
SetWindowPos FM_Select_Browser.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
If FM_Add_Key.Left > Screen.Width / 2 Then
FM_Select_Browser.Left = FM_Add_Key.Left - FM_Select_Browser.Width - 20
Else
FM_Select_Browser.Left = FM_Add_Key.Left + FM_Add_Key.Width + 20
End If
FM_Select_Browser.Top = FM_Add_Key.Top + 400
FM_Select_Browser.LST_BROWSERS.Selected(0) = True
End Sub
Private Sub BT_SELECT_Click()
On Error Resume Next
Dim QKFileName, TempStr, BN1, BN2 As String
FM_Add_Key.Enabled = True
FM_Select_Browser.Hide
FM_Add_Key.TXT_BROWSER_PATH.Text = ""
TempStr = LST_BROWSERS.Text
TempStr = Left(TempStr, InStr(TempStr, " ") - 1)
If TempStr <> "*" Then
QKFileName = gQuicKeysDataPath & "\key" & TempStr & ".kir"
If Dir(QKFileName) <> "" Then
Open QKFileName For Input As #1
Line Input #1, gSysName
Line Input #1, gBrowser
Close #1
End If
Else
BN = Mid(LST_BROWSERS.Text, 3, InStr(LST_BROWSERS.Text, "|") - 3)
For i = 0 To UBound(gWebBrowsers)
If InStr(gWebBrowsers(i), BN & "|") > 0 Then Exit For '包括"|"，否则会混淆，比如“360”和“360极速”
Next
BN2 = Mid(gWebBrowsers(i), InStr(gWebBrowsers(i), "|") + 1, 50) 'EXE文件名，不含.exe
QKFileName = gQuicKeysDataPath & "\browser" & BN2 & ".lst"
If (Dir(QKFileName) <> "") Then
gBrowser = ""
Open QKFileName For Input As #1
If Not EOF(1) Then Line Input #1, gBrowser
Close #1
End If
gBrowser = BN & "|" & gBrowser
End If
FM_Add_Key.TXT_BROWSER_PATH.Text = Trim(gBrowser)
End Sub
Private Sub Form_Unload(Cancel As Integer)
FM_Add_Key.Enabled = True
End Sub
'*************************************************************************** FM_Select_Browser 窗体代码结束 ************************************************************************
（9）窗体：FM_Send_Info
FM_Send_Info.frm
****************************************************************************************************************************************************************************************
VERSION 5.00
Begin VB.Form FM_Send_Info
BorderStyle = 1 'Fixed Single
Caption = "快Key: 自动登录"
ClientHeight = 780
ClientLeft = 45
ClientTop = 390
ClientWidth = 3345
Icon = "FM_Send_Info.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 780
ScaleWidth = 3345
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton BT_SEND_KEY
BackColor = &H00FFFFFF&
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 700
Left = 30
MaskColor = &H00FF0000&
Picture = "FM_Send_Info.frx":424A
Style = 1 'Graphical
TabIndex = 0
Top = 30
Width = 900
End
Begin VB.Label LB_NOTE
BackStyle = 0 'Transparent
Caption = "进入登录页面后，鼠标左键点击【用户名】输入框，再按此【快Key图标】。 Go！"
Height = 735
Left = 1080
TabIndex = 1
Top = 115
Width = 2295
End
End
Attribute VB_Name = "FM_Send_Info"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************************************************************************************
'* *
'* 快Key 窗体FM_Send_Info *
'* *
'*********************************************************************************************************************************************************************
'*************************************************************************** 函数、子程序 ****************************************************************************
Private Sub Form_Unload(Cancel As Integer)
gLock_FM_Send_Info = False
End Sub
Private Sub BT_SEND_KEY_Click()
FM_Send_Info.Visible = False
gLock_FM_Send_Info = False
Submit_Key
End Sub
'********************************************************************* FM_Send_Info 窗体代码结束 *********************************************************************
（10）窗体： FM_Start_Note
FM_Start_Note.frm
**************************************************************************************************************************************************************************
VERSION 5.00
Begin VB.Form FM_Start_Note
BorderStyle = 0 'None
Caption = "快Key: 提示"
ClientHeight = 765
ClientLeft = 0
ClientTop = 0
ClientWidth = 2655
Enabled = 0 'False
Icon = "FM_Start_Note.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 765
ScaleWidth = 2655
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command1
BackColor = &H00FFFFFF&
Height = 700
Left = 30
Picture = "FM_Start_Note.frx":10CA
Style = 1 'Graphical
TabIndex = 0
Top = 24
Width = 800
End
Begin VB.Line Line4
BorderColor = &H00C0C0C0&
X1 = 2600
X2 = 2600
Y1 = 60
Y2 = 690
End
Begin VB.Line Line3
BorderColor = &H00C0C0C0&
X1 = 860
X2 = 860
Y1 = 60
Y2 = 690
End
Begin VB.Line Line2
BorderColor = &H00C0C0C0&
X1 = 860
X2 = 2600
Y1 = 690
Y2 = 690
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "按鼠标【滚轮】呼出"
Enabled = 0 'False
Height = 255
Left = 900
TabIndex = 2
Top = 440
Width = 1935
End
Begin VB.Line Line1
BorderColor = &H00C0C0C0&
X1 = 860
X2 = 2600
Y1 = 60
Y2 = 60
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "快Key已启动"
Enabled = 0 'False
Height = 255
Left = 900
TabIndex = 1
Top = 120
Width = 2295
End
End
Attribute VB_Name = "FM_Start_Note"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************************************************************************************
'* *
'* 快Key 窗体FM_Start_Note *
'* *
'*********************************************************************************************************************************************************************
'*************************************************************************** 函数、子程序 ****************************************************************************
'本窗体无代码
'******************************************************************** FM_Start_Note 窗体代码结束 *********************************************************************
2.2 控制板：StartQuicKeys.exe
2.2.1 工程文件
（1）StartQuicKeys.vbw
*************************************************************************************************************************************************************************
FM_StartStop = 52, 52, 1196, 595, Z, 26, 26, 1170, 569, C
FM_Make_UDisk = 0, 0, 1139, 543, , 0, 0, 1028, 543, C
（2）StartQuicKeys.vbp
*************************************************************************************************************************************************************************
Type=Exe
Form=FM_StartStop.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation
Form=FM_Make_UDisk.frm
IconForm="FM_StartStop"
Startup="FM_StartStop"
HelpFile=""
Title="StartQuicKeys"
ExeName32="StartQuicKeys.exe"
Command32=""
Name="StartQuicKeys"
HelpContextID="0"
CompatibleMode="0"
MajorVer=2
MinorVer=5
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="大系统观开放论坛"
VersionLegalCopyright="开源软件 自由版权 作者：王权"
VersionLegalTrademarks="BSV 大系统观"
VersionProductName="快Key (QuicKeys)"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
2.2.2 各模块及Form代码
（1）窗体：FM_StartStop
FM_StartStop.frm
*******************************************************************************************************************************************************************
VERSION 5.00
Begin VB.Form FM_StartStop
BorderStyle = 1 'Fixed Single
Caption = "快Key: 控制板"
ClientHeight = 405
ClientLeft = 45
ClientTop = 390
ClientWidth = 2910
Icon = "FM_StartStop.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 405
ScaleWidth = 2910
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton BT_UDisk
Caption = "制U盘"
Height = 375
Left = 2180
TabIndex = 3
ToolTipText = "制作U盘随身版，可在其他电脑上临时使用"
Top = 20
Width = 720
End
Begin VB.CommandButton BT_Uninstall
Caption = "卸载"
Height = 375
Left = 1460
TabIndex = 2
ToolTipText = "完全卸载，删除全部数据"
Top = 20
Width = 720
End
Begin VB.CommandButton BT_Stop
Caption = "停止"
Height = 375
Left = 740
TabIndex = 1
ToolTipText = "退出，下次开机仍将自动启动"
Top = 20
Width = 720
End
Begin VB.CommandButton BT_Start
Caption = "启动"
Height = 375
Left = 20
TabIndex = 0
ToolTipText = "启动或重新启动"
Top = 20
Width = 720
End
End
Attribute VB_Name = "FM_StartStop"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'********************************************************** 快Key（QuicKeys） 源码 ***********************************************************************
'* *
'* 版本：2.0 释放日期：2020.9.25 作者：王权（阿色） QQ:583389416 微信公众号：大系统观开放论坛 开发环境：Visual Basic 6.0 企业版 *
'* *
'* 功能：自动启动浏览器或exe文件，自动填写用户名、密码。最多管理30个密钥。可利用自带控制板制作U盘随身版，能够运行在其他电脑上。 *
'* 运行环境：Windows XP、Windows 7-10。XP需要单独编译。需要COMDLG32.OCX。 *
'* 安装路径：C:\QuicKeys 数据存储路径：与安装路径相同。用于启停、卸载和制作U盘随身版的控制板快捷方式安装在电脑桌面。 *
'* 基本原理：安装Hook，截获鼠标中键（滚轮）消息，按滚轮呼出程序，通过此程序自动填写用户名、密码等登录信息，这些信息事先已经保存，并加密。 *
'* 为了给各个密钥加密，需要一个“统一密码”，由用户自行设定。用户只要记住此密码即可打开各个原有密钥，并自动填写登录。 *
'* 统一密码也需要加密，给它加密的密码由开发者和用户自动联合设定，即初始密码。这样可以保证包括开发者和用户在内的任何人都无法破解统一密码。 *
'* 但为安全起见，请开发者严格保守己方所设密码，注意在发布源代码时删除此密码。加解密采用业界通用技术，并使用了加盐和密文等长等策略。 *
'* 开发者密码的风险很小，因为它并不登录真正的信息系统，且快Key是离线运行的，开发者无法获取用户端的联合密码和其他任何密钥信息，也就无法解密。 *
'* 特别说明：安装、更新、版本替换文件与运行时文件均用本文件，但要使用不同的文件名，运行文件为QuicKeys.exe，安装文件要改名。具体如下： *
'* （1）编译成QuicKeys.exe。 *
'* （2）按本条模式改名，必须包含setup字样，用于安装（安装和平时运行其实是一个EXE）：快Key-登录助手-安装-QuicKeys_2-0_Setup_for_Win7-10_20200923.exe。 *
'* 这样的话，安装时会以管理员身份运行，平时后台启动以普通用户身份，避免安全软件询问。 *
'* （3）另有控制板 StartQuicKeys.exe,用于桌面控制快Key的启停，还可制作U盘随身版。 *
'* （4）需要COMDLG32.OCX，要一起zip。最后将所有相关文件压缩为ZIP发布。 *
'* （5）快Key为开源软件，鼓励积极共享。本代码可任意发布，责任与权益由发布者自负。 *
'* *
'*******************************************************************************************************************************************************************
'******************************************************************* StartQuicKeys.exe *****************************************************************************
'*******************************************************************************************************************************************************************
'* *
'* 快Key 窗体 FM_StartStop *
'* *
'*******************************************************************************************************************************************************************
'************************************************************************* 定义常量 ，常量为大写加下划线 *********************************************************
Const QK_TITLE = "快Key"
'************************************************************** 声明及相关定义 *************************************************************************************
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOMOVE = &H2 '不移动窗体
Private Const SWP_NOSIZE = &H1 '不改变bai窗体尺寸
Private Const Flag = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1 '窗体总在最du前面
Private Const HWND_NOTOPMOST = -2 '窗体不在最前面
'获得Win系统各个目录
Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hwndOwner As Long, ByVal nFolder As Integer, ppidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal szPath As String) As Long
Const MAX_LEN = 200 '字符串最大长度
Const DESKTOP = &H0& '桌面
Const PROGRAMS = &H2& '程序集
Const MYDOCUMENTS = &H5& '我的文档
Const MYFAVORITES = &H6& '收藏夹
Const STARTUP = &H7& '启动
Const RECENT = &H8& '最近打开的文件
Const SENDTO = &H9& '发送
Const STARTMENU = &HB& '开始菜单
Const NETHOOD = &H13& '网上邻居
Const FONTS = &H14& '字体
Const SHELLNEW = &H15& 'ShellNew
Const APPDATA = &H1A& 'Application Data
Const PRINTHOOD = &H1B& 'PrintHood
Const PAGETMP = &H20& '网页临时文件
Const COOKIES = &H21& 'Cookies目录
Const HISTORY = &H22& '历史
'************************************************************ 声明与定义结束 *************************************************************************************
'************************************************************* 公共函数、子程序 *********************************************************************************
Private Sub Form_Load()
SetWindowPos FM_StartStop.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
End Sub
Private Sub BT_Start_Click()
Shell "taskkill /f /im QuicKeys.exe" '杀死老程序进程,进程不存在也不会出错
MySleep 1000
Shell "C:\QuicKeys\QuicKeys.exe", 1 '重启
End
End Sub
Private Sub BT_Stop_Click()
Dim TempStr As String
Dim TmpNum As Integer
TempStr = "要退出快Key吗？" & vbCrLf & "退出后，快Key将不能被呼出。需要重新启动电脑才能再次启动快Key。" & vbCrLf _
& "建议点击窗口右上角 【X】 隐藏快Key。" & vbCrLf & vbCrLf & "按【是】退出，按【否】取消。"
TmpNum = MsgBox(TempStr, 4 + 32 + 256, " " & QK_TITLE)
If TmpNum = vbYes Then '如果确实退出
Shell "taskkill /f /im QuicKeys.exe" '杀进程
End
End If
End Sub
Private Sub BT_Uninstall_Click()
On Error Resume Next
Dim TempStr, b As String
Dim TmpNum As Integer
Dim strFileName, SysTempPath, QuicKeysRunPath, QuicKeysDataPath As String
Dim sTmp As String * MAX_LEN '存放结果的固定长度的字符串
Dim pidl As Long '某特殊目录在特殊目录列表中的位置
TempStr = "确定卸载本机上的快Key吗？" & vbCrLf & "卸载将彻底删除本机上的快Key及其管理的所有密钥的信息。" & vbCrLf & "如果制作了U盘随身版，可继续独立使用。" _
& vbCrLf & "卸载U盘随身版，需要在U盘随身版上进行。" & vbCrLf & vbCrLf
TempStr = TempStr & "按【是】卸载，按【否】取消。"
TmpNum = MsgBox(TempStr, 4 + 32 + 256, " " & QK_TITLE & " " & VER_NUM)
If TmpNum = vbYes Then '如果确实卸载
MsgBox "快Key将完全卸载。" & vbCrLf & "谢谢使用！再见！", 0 + 64, " " & QK_TITLE '先在前面，否则后面杀进程就不执行了
QuicKeysRunPath = "C:\QuicKeys"
QuicKeysDataPath = QuicKeysRunPath
'获得网页临时目录，用于存临时产生的文件
SHGetSpecialFolderLocation 0, PAGETMP, pidl
SHGetPathFromIDList pidl, sTmp
SysTempPath = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'获得win系统桌面路径
SHGetSpecialFolderLocation 0, DESKTOP, pidl
SHGetPathFromIDList pidl, sTmp
gSysDeskTopPath = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
strFileName = gSysDeskTopPath & "\快Key控制板.lnk" '删掉桌面启停快捷方式
If Dir(strFileName) <> "" Then Kill strFileName
Open QuicKeysDataPath & "\tempkillqk.bat" For Output As #1
Print #1, "@echo off"
Print #1, "taskkill /f /im QuicKeys.exe"
Print #1, "taskkill /f /im " & App.EXEName & ".exe" '杀自己进程，这里是本启停程序
Print #1, "del /f /q " & """" & QuicKeysRunPath & "\StartQuicKeys.exe" & """"
Print #1, "del /f /q " & """" & QuicKeysRunPath & "\QuicKeys.exe" & """"
Print #1, "rmdir /s/q " & """" & QuicKeysRunPath & """"
Print #1, "rmdir /s/q " & """" & QuicKeysDataPath & """"
Print #1, "rd " & """" & QuicKeysRunPath & """"
Print #1, "rd " & """" & QuicKeysDataPath & """"
Close #1
MySleep 1000
Shell QuicKeysDataPath & "\tempkillqk.bat >nul"
End
End If
End Sub
Private Sub BT_UDisk_Click()
FM_Make_UDisk.Left = FM_StartStop.Left
FM_Make_UDisk.Top = FM_StartStop.Top
FM_StartStop.Hide
FM_Make_UDisk.Show
End Sub
Private Sub MySleep(ms As Long) '原Sleep不交出控制权，改造一个。 ms:毫秒数
Dim BeginTime As Long
BeginTime = timeGetTime '记下开始时的时间
While timeGetTime < BeginTime + ms '循环等待
DoEvents '转让控制权，以便让操作系统处理其它的事件
Wend
End Sub
'*************************************************************************** 窗体 FM_StartStop 代码结束 ****************************************************************************
（2）窗体：FM_Make_UDisk
FM_Make_UDisk.frm
*******************************************************************************************************************************************************************
VERSION 5.00
Begin VB.Form FM_Make_UDisk
BorderStyle = 1 'Fixed Single
Caption = "快Key: 制作U盘随身版"
ClientHeight = 1935
ClientLeft = 45
ClientTop = 390
ClientWidth = 2700
Icon = "FM_Make_UDisk.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1935
ScaleWidth = 2700
StartUpPosition = 3 '窗口缺省
Begin VB.DriveListBox Drive1
Height = 300
Left = 1575
TabIndex = 6
Top = 800
Width = 975
End
Begin VB.CommandButton BT_CANCEL
Caption = "取消"
Height = 375
Left = 1340
TabIndex = 5
Top = 1440
Width = 1215
End
Begin VB.CommandButton BT_MAKE
Caption = "开始制作"
Height = 375
Left = 120
TabIndex = 3
Top = 1440
Width = 1215
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "* U盘原有快Key数据将被清除。"
ForeColor = &H000000FF&
Height = 255
Left = 120
TabIndex = 4
Top = 1200
Width = 2535
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = " 请输入U盘盘符"
Height = 255
Left = 120
TabIndex = 2
Top = 840
Width = 2535
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = " 请注意安全保管U盘和密码。"
Height = 255
Left = 120
TabIndex = 1
Top = 540
Width = 2535
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = " 您可以将快Key及密钥复制到U盘，方便在其他电脑上使用。"
Height = 495
Left = 120
TabIndex = 0
Top = 120
Width = 2535
End
End
Attribute VB_Name = "FM_Make_UDisk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************************************************************************************************************************
'* *
'* 快Key 窗体 FM_Make_UDisk *
'* *
'*******************************************************************************************************************************************************************
'************************************************************************* 定义常量 ，常量为大写加下划线 *********************************************************
Const QK_TITLE = "快Key"
Private Sub BT_MAKE_Click()
On Error GoTo ReSelect
Dim UDisk_Sym, UD_Path, s As String
Dim PASS As Boolean
Dim FSO As Object
Dim TmpNum As Integer
Begin:
PASS = False
TempStr = "将覆盖U盘原有【快Key随身版】数据。" & vbCrLf & "是否继续？" & vbCrLf & vbCrLf & "按【是】继续，按【否】取消。"
TmpNum = MsgBox(TempStr, 4 + 32 + 256, " " & QK_TITLE)
If TmpNum = vbNo Then End '如果取消
UDisk_Sym = Trim(Drive1.Drive)
UDisk_Sym = Left(UDisk_Sym, 1) & ":"
UD_Path = UDisk_Sym & "\QuicKeys"
'拷贝文件到U盘，并调整设置
Set FSO = CreateObject("Scripting.FileSystemObject")
If Dir(UD_Path, vbDirectory) <> "" Then FSO.DeleteFolder UD_Path '不必先清空文件夹
FSO.CopyFolder "C:\QuicKeys", UD_Path
FileCopy "C:\QuicKeys\QuicKeys.exe", UDisk_Sym & "\快Key随身版.exe" '直接覆盖，无询问
s = UD_Path & "\QuicKeys.exe"
If Dir(s) <> "" Then Kill s
s = UD_Path & "\StartQuicKeys.exe"
If Dir(s) <> "" Then Kill s
MsgBox "制作完成。在U盘根目录下执行【快Key随身版】即可启动随身版。", 64, " " & QK_TITLE
PASS = True
ReSelect:
If PASS = True Then
End
Else
MsgBox "制作失败。请正确插入并选择U盘。", 16, " " & QK_TITLE
FM_Make_UDisk.Show
End If
End Sub
Private Sub BT_CANCEL_Click()
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
End '整个程序结束
End Sub
'*************************************************************************** 窗体 FM_Make_UDisk 代码结束 ************************************************************************
3 安装文件及源代码下载
快Key (QuicKeys) V2.5安装文件包（For Windows 7-10）：
快Key-登录助手-安装-QuicKeys_2-5_Setup_for_Win7-10_20201010.zip （https://files.cnblogs.com/files/BigSystemsView/%E5%BF%ABKey-%E7%99%BB%E5%BD%95%E5%8A%A9%E6%89%8B-%E5%AE%89%E8%A3%85-QuicKeys_2-5_Setup_for_Win7-10_20201010.zip）
快Key (QuicKeys) V2.5安装文件包（For Windows XP）：
快Key-登录助手-安装-QuicKeys_2-5_Setup_for_WinXP_20200927.zip （https://files.cnblogs.com/files/BigSystemsView/%E5%BF%ABKey-%E7%99%BB%E5%BD%95%E5%8A%A9%E6%89%8B-%E5%AE%89%E8%A3%85-QuicKeys_2-5_Setup_for_WinXP_20201010.zip）
快Key (QuicKeys) V2.5源代码文件包：
快KeyV2-5源代码-20201010.zip （https://files.cnblogs.com/files/BigSystemsView/%E5%BF%ABKeyV2-5%E6%BA%90%E4%BB%A3%E7%A0%81-20201010.zip）
因开发环境与本文编辑器的差别，为了保持文章整齐，上述文中源代码已做排版整理，可能存在错误，在VB 6.0开发环境更适合。
同时更新代码也可能不及时，源代码以本文件包为准。
4 倡议与致谢
由于本人能力所限，使用了较老的编程工具VB。但编写系统程序也无法使用当今较流行语言，后续开发者可以使用更好语言和开发工具，编写出更好系统程序。
本人还有一些想法没有实现，但近期没时间做了，继续做的可以联系我沟通，本人愿意提供任何力所能及的帮助。
本人也秉承开源精神，所有代码全部公开。上述源码即为当前版本的全部。
阿色是个老程序猿，功夫基本丧失，全靠百度边查边写，水平有限，恳请大家批评指正。
编写快Key过程中，阿色查阅借用了大量别人的思路和代码，在此深表谢意！
5 出现问题与解决办法
（1）安装时出现下面问题：“运行时错误 '75' ; 路径/文件访问错误”，或其他文件访问错误。
那是因为你的系统安全软件（比如360）阻止快Key安装。
可以再次尝试安装一下。
解决办法：
第1种情况：如果你的系统安全软件询问是否允许修改注册表，请选择允许即可。
第2种情况：如果你的系统软件没有询问，那是它直接禁止了。这时需要你打开安全软件，找到注册表相关设置，然后设置为允许修改注册表。安装完成后再恢复原状。
（2）忘记了统一密码。
那没人能帮你，阿色也不能。只能删掉重装，所有密钥数据都要重新填写了。
解决办法：
启动桌面快捷方式【快Key控制板】卸载。
如果自动卸载不成功，可手动卸载删除：
1）按Ctrl_Alt_Del，打开任务管理器，结束QuicKeys进程。
2）删掉C:\QuicKeys文件夹及所有文件。
3）重装快Key。
（3）安装不上，不能运行。
解决办法：
换个安装文件试试，XP版的兼容性更好些，它可在Windows 7等高版本操作系统上运行。
6 联络信息
博客园用户可在本文评论区留言。
或者，通过微信公众号【大系统观开放论坛】联络：
微公号：BigSystemsView
二维码：
以上是 快Key：按一下机械鼠标【拨器】，帮你自动填写用户名密码，登录，可制作U盘空间庄园(中国开源手机免费-附安装盘和源代码) 的全部内容， 来源链接： utcz.com/a/60349.html
