用VB实现“一点即填”

来源:计算机等级考试    发布时间:2012-08-29    计算机等级考试视频    评论

  面对这种情况,大家可能首先想到的是上网上找一款 填表软件。但现有的软件不是用剪贴板传递就是采用拖放技 术,而且使用时必须运行填表软件,使用起来并不是很方便。 因此我们决定自己编写一个软件,将它集成到IE的右键菜单 里,使用时只要在要输入的输入项上单击鼠标右键,然后选 择相应的项即会自动输入,从而实现“一点即填”。

  本程序首先要在IE的右键菜单上添加项目,这可通过操作注册表来实现,然后利用一个JavaScript程序判断所选 的是不是可输入框,如果是,将我们事先保存的数据填上。 下面介绍具体的实现过程。

  一、设计界面
  进入 VB,选择“标准  EXE”新建一工程,选择“工 程”菜单下的“部件”,在弹出的对话框中选择“Microsoft Windows  Common Controls 6.0”,然后按照下表在窗体 上添加控件,设置完成的界面如图 1 所示: 控件类型    Name    属性 标签    label1    Caption:名称 标签    label2    Caption:内容 文本框    txtname 文本框    txtcont 命令按钮    command1    Caption:添加 命令按钮    command2    Caption:删除 列表框    listview1 为它加入两个列,列标题分别为“名称”和“内容”,并 且把 View 属性修改成 3-lvwReport,把 GridLines 改成 True。

  二、程序源代码

  首先在工程中添加一个标准模块并输入如下代码,这 些代码用于注册表操作:
’声明必要的API函数及常量
  Declare Function RegSaveKey Lib "advapi32.dll" Alias
  "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal lpSecurityAttributes   As Long) As Long
  Declare Function RegSetValue Lib "advapi32.dll" Alias
  "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long,   ByVal lpData As String, ByVal cbData As Long) As Long
  Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey
  As Long) As Long
  Declare Function RegCreateKey Lib "advapi32.dll" Alias
  "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As
  String, phkResult As Long) As Long
  Declare Function RegDeleteKey Lib "advapi32.dll" Alias
  "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As
  String) As Long
  Declare Function RegDeleteValue Lib "advapi32.dll" Alias
  "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName
  As String) As Long
  Declare Function RegOpenKey Lib "advapi32.dll" Alias
  "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As
  String, phkResult As Long) As Long
  Declare Function RegSetValueEx Lib "advapi32.dll" Alias
  "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As   Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
  Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias
  "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As   Long, ByVal samDesired As Long, phkResult As Long) As Long
  Public Const HKEY_CLASSES_ROOT = &H80000000
  Public Const HKEY_CURRENT_USER = &H80000001
  Public Const HKEY_LOCAL_MACHINE = &H80000002
  Public Const HKEY_USERS = &H80000003
  Public Const ERROR_NO_MORE_ITEMS = 259&
  Public Const HKEY_CURRENT_CONFIG = &H80000005
  Enum ValueType
  REG_NONE = 0
  REG_SZ = 1
  REG_EXPAND_SZ = 2
  REG_BINARY = 3
  REG_DWORD = 4
  REG_DWORD_BIG_ENDIAN = 5
  REG_MULTI_SZ = 7
  End Enum
  Global Const KEY_ALL_ACCESS = &H3F Dim lngtype As Long
  Dim rtn As Long, lBuffer As Long, sbuffer As String
  Dim lBufferSize As Long
  ’新建主键的过程进入讨论组讨论。
    Public Sub savekey(hKey As Long, strPath As String)
  On Error GoTo ERR_savekey
      Dim keyhand&   
      r = RegCreateKey(hKey, strPath, keyhand&)
      r = RegCloseKey(keyhand&)
      Exit Sub
  ERR_savekey:
      MsgBox Err.Number & "- " & Err.Description
      Resume Next
  End Sub
  ’保存字符型键值
  Public Sub savestring(hKey As Long, strPath As String, strValue
  As String, strdata As String)
      On Error GoTo ERR_savestring
      Dim keyhand As Long
      Dim r As Long
      r = RegCreateKey(hKey, strPath, keyhand)
      r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
      r = RegCloseKey(keyhand)
      Exit Sub
  ERR_savestring:
        MsgBox Err.Number & "- " & Err.Description
        Resume Next
  End Sub
  ’保存DWORD型键值
  Function SaveDword(ByVal hKey As Long, ByVal strPath As
  String, ByVal strValueName As String, ByVal lData As Long)
      Dim lResult As Long
      Dim keyhand As Long
      Dim r As Long
      r = RegCreateKey(hKey, strPath, keyhand)
      lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
      r = RegCloseKey(keyhand) End Function
  ’删除主键
  Public Function DeleteKey(ByVal hKey As Long, ByVal strKey
  As String)
      Dim r As Long
      r = RegDeleteKey(hKey, strKey) End Function
  ’保存默认键值
  Function SetDefaultValue(ByVal hKey As Long, ByVal Subkey
  As String, ByVal Value As String) As Boolean
      Dim ret As Long, lenS As Long, S As String
      ret = RegSetValue(hKey, Subkey, REG_SZ, Value, LenB
  (StrConv(Value, vbFromUnicode)) + 1)
      SetDefaultValue = (ret = 0) End Function
  接着编写窗体部分的代码:
  Dim lcont As Integer

  Private Sub Command1_Click()
      Dim ret As Boolean
      ’在列表框中添加项目
      lcont = ListView1.ListItems.Count + 1
      ListView1.ListItems.Add lcont, , txtname
      ListView1.ListItems(lcont).SubItems(1) = txtcont
      ’生成以项目名称为文件名的HTML文件
  Open App.Path & "/" & txtname & ".htm" For Output As
  #1
      Print #1, "<SCRIPT LANGUAGE=" & """" & _
      "JavaScript" & """" & " defer > " & vbCrLf _
      & "var parentwin=external.menuArguments;" & _
      vbCrLf & "var doc=parentwin.document;" & _
      vbCrLf & "var sel=doc.selection;" & vbCrLf & _
      "var rng=sel.createRange();" & vbCrLf & _
      "if (doc.activeElement.type==" & """" & _
      "text" & """" & "||doc.activeElement.type==" & _
      """" & "textarea" & """" & _
      "||doc.activeElement.type==" & """" & _
      "password" & """" & ")" & vbCrLf & _
      "rng.text =" & """" & txtcont.Text & _
      """" & ";" & vbCrLf & "</SCRIPT>"
      Close #1
      ’在IE右键菜单上添加相应项目
          savekey  HKEY_CURRENT_USER, 
  "software/microsoft/internet explorer/menuext/" & txtname.Text
      ret = SetDefaultValue(HKEY_CURRENT_USER,
  "software/microsoft/internet explorer/menuext" & "/" & txtname. Text, "file://" &   App.Path & "/" & txtname & ".htm")
          SaveDword  HKEY_CURRENT_USER, 
  "software/microsoft/internet explorer/menuext" & "/" & txtname,
  "Contexts", 4
          savestring  HKEY_CURRENT_USER, 
  "software/microsoft/internet explorer/menuext" & "/" & txtname,
  "iform", txtcont
  End Sub

  ’删除Private Sub Command2_Click()
          DeleteKey  HKEY_CURRENT_USER, 
  "software/microsoft/internet explorer/menuext" & "/" & ListView1. SelectedItem
      ListView1.ListItems.Remove ListView1.SelectedItem.Index
  End Sub

  Private Sub Form_Load()
          savekey  HKEY_CURRENT_USER, 
  "software/microsoft/internet explorer/menuext" End Sub

  三、程序运行

  输入完成代码后按 F5 运行,添入必要的信息后就 可使用了,图2 便是演示结 果。赶快打开你的IE试一试 吧! 

视频学习

我考网版权与免责声明

① 凡本网注明稿件来源为"原创"的所有文字、图片和音视频稿件,版权均属本网所有。任何媒体、网站或个人转载、链接转贴或以其他方式复制发表时必须注明"稿件来源:我考网",违者本网将依法追究责任;

② 本网部分稿件来源于网络,任何单位或个人认为我考网发布的内容可能涉嫌侵犯其合法权益,应该及时向我考网书面反馈,并提供身份证明、权属证明及详细侵权情况证明,我考网在收到上述法律文件后,将会尽快移除被控侵权内容。

最近更新

社区交流

考试问答