在申请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中文企业版下调试通过。