精品主页 | 软件下载 | 系统下载 | 精品导航| 精彩图片 | 转帖工具 | 版主申请 | 影视下载
发新话题
打印

用 VB 实现“一点即填”

用 VB 实现“一点即填”

  


                  在申请Email信箱、主页空间时我们经常要填写表单,比如要填姓名、住址、身份证号、E-mail地址、个人简介等等⋯⋯每次都重复的填写,好烦哪!

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

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



一、设计界面

进入VB,选择“标准EXE”新建一工程,选择“工程”菜单下的“部件”,在弹出的对话框中选择“MicrosoftWindowsCommonControls6.0”,然后按照下表在窗体上添加控件,设置完成的界面如图1所示:

控件类型Name属性

标签label1Caption:名称标签label2Caption:内容文本框txtname

文本框txtcont

命令按钮command1Caption:添加命令按钮command2Caption:删除列表框listview1为它加入两个列,列标题分别为“名称”和“内容”,并

且把View属性修改成3-lvwReport,把GridLines改成True。



二、程序源代码

首先在工程中添加一个标准模块并输入如下代码,这些代码用于注册表操作:

’声明必要的API函数及常量

DeclareFunctionRegSaveKeyLib"advapi32.dll"Alias

"RegSaveKeyA"(ByValhKeyAsLong,ByVallpFileAsString,ByVallpSecurityAttributesAsLong)AsLong

DeclareFunctionRegSetValueLib"advapi32.dll"Alias

"RegSetValueA"(ByValhKeyAsLong,ByVallpSubKeyAsString,ByValdwTypeAsLong,ByVallpDataAsString,ByValcbDataAsLong)AsLong

DeclareFunctionRegCloseKeyLib"advapi32.dll"(ByValhKey

AsLong)AsLong

DeclareFunctionRegCreateKeyLib"advapi32.dll"Alias

"RegCreateKeyA"(ByValhKeyAsLong,ByVallpSubKeyAs

String,phkResultAsLong)AsLong

DeclareFunctionRegDeleteKeyLib"advapi32.dll"Alias

"RegDeleteKeyA"(ByValhKeyAsLong,ByVallpSubKeyAs

String)AsLong

DeclareFunctionRegDeleteValueLib"advapi32.dll"Alias

"RegDeleteValueA"(ByValhKeyAsLong,ByVallpValueName

AsString)AsLong

DeclareFunctionRegOpenKeyLib"advapi32.dll"Alias

"RegOpenKeyA"(ByValhKeyAsLong,ByVallpSubKeyAs

String,phkResultAsLong)AsLong

DeclareFunctionRegSetValueExLib"advapi32.dll"Alias

"RegSetValueExA"(ByValhKeyAsLong,ByVallpValueNameAsString,ByValReservedAsLong,ByValdwTypeAsLong,lpDataAsAny,ByValcbDataAsLong)AsLong

DeclareFunctionRegOpenKeyExLib"advapi32.dll"Alias

"RegOpenKeyExA"(ByValhKeyAsLong,ByVallpSubKeyAsString,ByValulOptionsAsLong,ByValsamDesiredAsLong,phkResultAsLong)AsLong

PublicConstHKEY_CLASSES_ROOT=&H80000000

PublicConstHKEY_CURRENT_USER=&H80000001

PublicConstHKEY_LOCAL_MACHINE=&H80000002

PublicConstHKEY_USERS=&H80000003

PublicConstERROR_NO_MORE_ITEMS=259&

PublicConstHKEY_CURRENT_CONFIG=&H80000005

EnumValueType

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

EndEnum

GlobalConstKEY_ALL_ACCESS=&H3FDimlngtypeAsLong

DimrtnAsLong,lBufferAsLong,sbufferAsString

DimlBufferSizeAsLong

’新建主键的过程


  


                  

PublicSubsavekey(hKeyAsLong,strPathAsString)

OnErrorGoToERR_savekey

Dimkeyhand&

r=RegCreateKey(hKey,strPath,keyhand&)

r=RegCloseKey(keyhand&)

ExitSub

ERR_savekey:

MsgBoxErr.Number&"-"&Err.Description

ResumeNext

EndSub

’保存字符型键值

PublicSubsavestring(hKeyAsLong,strPathAsString,strValue

AsString,strdataAsString)

OnErrorGoToERR_savestring

DimkeyhandAsLong

DimrAsLong

r=RegCreateKey(hKey,strPath,keyhand)

r=RegSetValueEx(keyhand,strValue,0,REG_SZ,ByValstrdata,Len(strdata))

r=RegCloseKey(keyhand)

ExitSub

ERR_savestring:

MsgBoxErr.Number&"-"&Err.Description

ResumeNext

EndSub

’保存DWORD型键值

FunctionSaveDword(ByValhKeyAsLong,ByValstrPathAs

String,ByValstrValueNameAsString,ByVallDataAsLong)

DimlResultAsLong

DimkeyhandAsLong

DimrAsLong

r=RegCreateKey(hKey,strPath,keyhand)

lResult=RegSetValueEx(keyhand,strValueName,0&,REG_DWORD,lData,4)

r=RegCloseKey(keyhand)EndFunction

’删除主键

PublicFunctionDeleteKey(ByValhKeyAsLong,ByValstrKey

AsString)

DimrAsLong

r=RegDeleteKey(hKey,strKey)EndFunction

’保存默认键值

FunctionSetDefaultValue(ByValhKeyAsLong,ByValSubkey

AsString,ByValValueAsString)AsBoolean

DimretAsLong,lenSAsLong,SAsString

ret=RegSetValue(hKey,Subkey,REG_SZ,Value,LenB

(StrConv(Value,vbFromUnicode)) 1)

SetDefaultValue=(ret=0)EndFunction

接着编写窗体部分的代码:

DimlcontAsInteger



PrivateSubCommand1_Click()

DimretAsBoolean

’在列表框中添加项目

lcont=ListView1.ListItems.Count 1

ListView1.ListItems.Addlcont,,txtname

ListView1.ListItems(lcont).SubItems(1)=txtcont

’生成以项目名称为文件名的HTML文件

OpenApp.Path&"\"&txtname&".htm"ForOutputAs

#1

Print#1,"<SCRIPTLANGUAGE="&""""&_

"JavaScript"&""""&"defer>"&vbCrLf_

&"varparentwin=external.menuArguments;"&_

vbCrLf&"vardoc=parentwin.document;"&_

vbCrLf&"varsel=doc.selection;"&vbCrLf&_

"varrng=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右键菜单上添加相应项目

savekeyHKEY_CURRENT_USER,

"software\microsoft\internetexplorer\menuext\"&txtname.Text

ret=SetDefaultValue(HKEY_CURRENT_USER,

"software\microsoft\internetexplorer\menuext"&"\"&txtname.Text,"file://"&App.Path&"\"&txtname&".htm")

SaveDwordHKEY_CURRENT_USER,

"software\microsoft\internetexplorer\menuext"&"\"&txtname,

"Contexts",4

savestringHKEY_CURRENT_USER,

"software\microsoft\internetexplorer\menuext"&"\"&txtname,

"iform",txtcont

EndSub



’删除


  


                  

PrivateSubCommand2_Click()

DeleteKeyHKEY_CURRENT_USER,

"software\microsoft\internetexplorer\menuext"&"\"&ListView1.SelectedItem

ListView1.ListItems.RemoveListView1.SelectedItem.Index

EndSub



PrivateSubForm_Load()

savekeyHKEY_CURRENT_USER,

"software\microsoft\internetexplorer\menuext"EndSub



三、程序运行

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

文中程序在WindowsME、VB6.0中文企业版下调试通过。

TOP

发新话题