如何通过已知句柄,取得VB中正在运行的窗体的实体对象

nmd002 2008-05-27 04:23:02
谁能用VB代码实现以下内容:
把正在VB中运行的其他程序(外部程序)的某窗体,通过取到的句柄,取得这个窗体的实例化对象,并对其进行对象操作(主要是取得控件容器对象)。对象可以转化成VB.FORM类型的,或者是VBIDE.VBFORM类型的都行。

即set form1 = <根据已取得句柄的窗体转化成的实例对象>。然后使用form1.属性(或方法)进行各种操作。
...全文
1454 28 打赏 收藏 转发到动态 举报
写回复
用AI写文章
28 条回复
切换为时间正序
请发表友善的回复…
发表回复
wujianghua830726 2011-12-07
  • 打赏
  • 举报
回复
呵呵,我ue学习下
zack_0_ren 2011-11-23
  • 打赏
  • 举报
回复
遇到了类似的问题:已经获取了其他程序某窗口的句柄,想要把它截图保存,但图片长宽不一定.想法是根据该窗口句柄获取其对象,再获取长宽属性.看帖子估计获取对象是不行了.目前也就是预设长宽值这个笨办法了.
tanzhiyong2010 2011-05-12
  • 打赏
  • 举报
回复
findcontrol
nmd002 2008-06-18
  • 打赏
  • 举报
回复
如果还是没有新的途径,恐怕我只能结帖了.
我觉得现在无法完成这个开发,打算放弃了.

综合大家的意见,如果想要实现我的想法,只能人工制作一个转换用的FORM类,其结构必须跟VB6中已定义的类完全一致,达到细微处分毫不差的程度才行.然后才能按照9楼"严重睡眠不足啊^_^"所给出的例子,获得对一个窗体实例对象的控制.理论上再利用SetClassLong函数,应该就可以达到转化为真正VB6的FORM窗体实例对象的效果了.但是在参数及实现上,还是有很多未知环节.本人也只能奋斗到此,无法再进一步了.

而其中最重要的一环,是要求人工制作的这个FORM类,要使用C中的规定类和对象,其中还要包括VB6的其他类对象,以用于转换后在VB6中的更加方便的被调用.基本上不是写VB6的那帮人,干不了这个工作.--因为只有他们才知道如何用C写VB6的窗体类定义.

现将已知内容总结于此,希望将来能有高人,再研究同一实现时,可以借助我的研究和各位高人的意见,向这个问题再做挑战,并彻底解决它.
我很不甘心.我希望那些没有去过微软的中国程序员,有一天可以在同样不了解VB6内部资料和规定的情况下,只凭我们自己手上的各种工具和聪明才智,弄懂微软的产品结构,并把这个东西做出来.相信那时候中国程序员的软件水平就不只翻一番了.
nmd002 2008-06-04
  • 打赏
  • 举报
回复
谢谢"严重睡眠不足啊^_^"的指导,SetClassLong这个函数我还真没仔细看过它的用法和用途,有空真应该好好研究一下相关的知道.
Sandrer 2008-06-04
  • 打赏
  • 举报
回复
用SetClassLong函数可以对某个类进行子类化
至于你问的,如何获得窗体中包含的其它控件,可以用EnumChildWindow函数
但是属性嘛....有点难搞~~~~~~~~~

算了,我还是继续呆着学习吧,看来我的方法并不能满足到你.....
lsftest 2008-06-02
  • 打赏
  • 举报
回复
[Quote=引用 19 楼 Sandrer 的回复:]
其实你的主要目的,是想控制其它窗体中用VB编写的窗口类?
如果是这样的话,用全局子类化,更改一下VB窗口类的消息处理函数
在消息处理过程中,判断hWnd是属于哪个窗体,再进行写代码~
[/Quote]
楼主在上一个帖子里要求的不仅仅是各控件的各种属性值,还有程序中使用的全部变量值都想得到..
之前那个帖子我还以为楼主是在调试别人的源代码,但看现在这帖子的意思,基本上跟crack别人的exe没什么区别了..
看来楼主想要的,是类似于softice/trw/od那一类的debuger..
偏偏vb在底层方面真是太弱了...还是想想有没有其它方法吧...
吾...我记得以前有个软件能静态逆向vb的exe,把一些控件属性什么的列出来..楼主不如去找找那些工具吧..

Sandrer 2008-06-02
  • 打赏
  • 举报
回复
其实你的主要目的,是想控制其它窗体中用VB编写的窗口类?
如果是这样的话,用全局子类化,更改一下VB窗口类的消息处理函数
在消息处理过程中,判断hWnd是属于哪个窗体,再进行写代码~
nmd002 2008-06-02
  • 打赏
  • 举报
回复
回复17楼嗷嗷叫的老马:http://www.m5home.com/blog2/blogview.asp?logID=197&cateID=2里面写的内容我拜读过了.确实很长见识,但是我可能用不上.

原因解释如下:首先,看VC代码像是使用过MFC的架构,并不是你的VC学得不好,而是因为VC的内容你并未接触过MFC编程的部分,所以你要是尝试用纯粹的基础窗口编程来实现MFC的内容,几乎是不可能的.因为MFC内定了相当多的内部对象,不经常使用或者全面阅读过MFC的相关帮助,是很难理解其意义及用法的.
其次,如果我不能了解IHTMLDocument接口的定义(详细到内部变量类型及其所占字节的长度),就不能在VB6中使用该对象.还有其相关的其他辅助类型也是必须全都了解才行,因为MFC大部分的类都是相互关联和相互支持的.如果就是要用此类方法开发,只怕我要用VB6自己先定义一个MFC的类库(接口,结构,类).
再次,IHTMLDocument接口好歹还是有据可查的定义过的接口,尚且有出处.而VB6中的窗体只怕没那么好解决,至少我在MSDN里没办法查到.只有运行和非运行时类名的解释,但是用于开发的类定义的详细内容就没有了.

眼下看,我好像除了直接从内存里取值,再想办法把内存里的值转换成可用的数据这种方法,基本上很难实现取值的愿望了.但是,要这么做,必须了解VB运作的机制,了解整个数据向本地窗口取值操作的全部详细过程.除非对VB6的各个环节都了如指掌,不可能达到这种程度.我看想实现我的愿望,除非微软开发VB6本地窗体的人来帮忙了.要是再没有新的建议,我只能再次结帖了.
lsftest 2008-06-02
  • 打赏
  • 举报
回复
你用反编译vb,逆向vb之类的关键字搜索一下吧,,,
nmd002 2008-06-02
  • 打赏
  • 举报
回复
回复19楼"严重睡眠不足啊^_^":
请教一下,"用全局子类化"是指什么样的实现方法?
另外,"更改一下VB窗口类的消息处理函数.在消息处理过程中,判断hWnd是属于哪个窗体,再进行写代码~",这样做好像只能监听到指定窗体的各消息,并不能使我有效地取得其对象实体.而HWND这个问题早就解决了,是一开始就可以取得到的.问题只在于知道句柄之后,我应该怎么做才能控制窗体,或者取得其全部可用属性及内含控件.

回复20楼(lsftest):
先不考虑程序中使用的全部变量,只要能把窗体的各属性和内含的各控件取到手,我就很满足了.其他的可以在实现了这一前提的基础上再研究.如果窗体对象可得到,那么再想取得其内含的其他变量应该不会太难.
还想请教,"我记得以前有个软件能静态逆向vb的exe,把一些控件属性什么的列出来..",这个软件还记得叫什么名字吗?记不清楚也不要紧,记得多少告诉我多少,我好去查一下.
如果真的能找到,我还真应该试试,说不定可以找到一些相关的代码,这样也许我的问题还能解决.
嗷嗷叫的老马 2008-05-30
  • 打赏
  • 举报
回复
有些糊涂.

现在还没有想明白.

IE里面,可以实现根据句柄获取对象~~

看这个显示网页密码的代码:

http://www.m5home.com/blog2/blogview.asp?logID=197&cateID=2

这个代码就是根据句柄,取到了一个访问这个对象的接口,而对象本身其实还是在IE里面.

但是,估计这是IE本身的功能之一,它提供了接口.

而你想完成的功能,是要访问并不支持这种方法的东东....

不知道有没有办法"加工"出一个接口来..

就像电路一样~~
lsftest 2008-05-30
  • 打赏
  • 举报
回复
这个可能性真的不大。。。
楼主想想,如果真有这技术,那么那帮cracker还需要那么大费周章的去反汇编吗?
现在还是人类 2008-05-30
  • 打赏
  • 举报
回复
我认为不可能,对于部分东西应该可以,但是对其他的东西那就难说了。
nmd002 2008-05-29
  • 打赏
  • 举报
回复
我搞得这么麻烦,最终目的也只是为了取得像VB6“本地窗体”中的那些数据。如果自已进行封装类的话,只怕很难将本地窗体中的各数据取得出来了。
nmd002 2008-05-29
  • 打赏
  • 举报
回复
那请问我该怎么才能取到别的进程的数据呢?尤其是在某个窗体中的数据(不只是控件的显示文字,还有VB控件的其他属性)。就像VB6“本地窗口”里显示的各控件的各属性。
chenhui530 2008-05-29
  • 打赏
  • 举报
回复
你要获取别的进程的数据是可以要拿别的进程的对象在本进程中使用几乎是不可能
CathySun118 2008-05-28
  • 打赏
  • 举报
回复
这个有什么意义阿?
lyserver 2008-05-28
  • 打赏
  • 举报
回复
虽然直接使用消息API很容易实现跨进程窗体的消息传递和外观控制,还可以把相关代码封装到自己的类里,但实现不了LZ所说的SET FORM1=XX之类的语句,因为VB不支持接口继承(IMPLEMENT其实没有多大用处),不可能用VB实现VB.FORM的COM子类。建议LZ转变思路,用一个普通的类进行封装,然后使用类变量进行操作就行了。
nmd002 2008-05-28
  • 打赏
  • 举报
回复
看了9楼"严重睡眠不足啊^_^"的回复,终于明白您在1楼里提到的那段话是什么意思了.原来您是想采用自封装具备基础属性的FORM类,然后通过子类型化的方法,使对象转化为更加具体的操作对象.
但是这样有一个环节有问题.就算构建了一个非常严谨的VB下的CWND类,也不能使用MFC里那个通过句柄取到VC窗体对象的方法.所以还是不具备任何实用意义.也就是说如果您没有办法像引用API一样,把MFC里通过句柄取窗体的那个函数声明到VB里,一切都是徙劳的.

而我主要想做的是取得窗体后,再通过这个对象取得其全部容器中的控件集合,然后再取其属性.这样一封装之后,取到的窗体对象只怕要想成功地子类型化成VB可用的窗体也是不可能,自定义的CWND和VB.FORM之间根本没有继承关系,执行成功的可能性将非常之低.请问"严重睡眠不足啊^_^",您用所帖出的代码,成功地转化过本地工程中的窗体对象吗?

个人认为这是思路很清晰的代码,我只是想关注一下上面这段代码是否经过实际运行检验过.
加载更多回复(8)
‘文本朗读.vbpType=ExeReference=*G{00020430-0000-0000-C000-000000000046}#2.0#0#C:WINDOWSSystem32stdole2.tlb#OLE AutomationReference=*G{C866CA3A-32F7-11D2-9602-00C04F8EE628}#5.0#0#C:Program FilesCommon FilesMicrosoft SharedSpeechsapi.dll#Microsoft Speech Object LibraryReference=*G{00020905-0000-0000-C000-000000000046}#8.3#0#C:Program FilesMicrosoft OfficeOFFICE11MSWORD.OLB#Microsoft Word 11.0 Object LibraryObject={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; richtx32.ocxObject={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCXForm=文本朗读.frmForm=frmAbout.frmModule=mDeclares; MoudlesmDeclares.basModule=MSubclass; Moudlessubclass.basModule=MTimer; Moudles imer.basClass=cMemDC; ClassMoudlescMemDC.clsClass=cMenuBar; ClassMoudlescMenuBar.clsClass=cNCCalcSize; ClassMoudlescNCCalcSize.clsClass=cNeoCaption; ClassMoudlescNeoCaption.clsClass=cToolbarMenu; ClassMoudlescToolbarMenu.clsClass=INCAreaModifier; ClassMoudlesINCAreaModifier.clsClass=ISubclass; ClassMoudlesisubclass.clsClass=GSubclass; ClassMoudlessubclass.clsClass=CTimer; ClassMoudles imer.clsModule=Module1; Module1.basObject={6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0; COMCTL32.OCXIconForm="Form1"Startup="Form1"HelpFile=""Title="文本朗读"ExeName32="文本朗读.exe"Command32=""Name="工程1"HelpContextID="0"CompatibleMode="0"MajorVer=1MinorVer=1RevisionVer=22AutoIncrementVer=1ServerSupportFiles=0VersionCompanyName="安阳市监狱"CompilationType=0OptimizationType=0FavorPentiumPro(tm)=0CodeViewDebugInfo=0NoAliasing=0BoundsCheck=0OverflowCheck=0FlPointCheck=0FDIVCheck=0UnroundedFP=0StartMode=0Unattended=0Retained=0ThreadPerObject=0MaxNumberOfThreads=1DebugStartupOption=0[MS Transaction Server]AutoRefresh=1‘文本朗读.frmVERSION 5.00Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "richtx32.ocx"Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"Begin VB.Form Form1 AutoRedraw = -1 ‘True Caption = "文本播放器 1.1版" ClientHeight = 6255 ClientLeft = 165 ClientTop = 555 ClientWidth = 9855 Icon = "文本朗读.frx":0000 LinkTopic = "Form1" ScaleHeight = 6255 ScaleWidth = 9855 StartUpPosition = 2 ‘屏幕心 Begin VB.HScrollBar HScroll2 Height = 255 Left = 1080 Max = 100 TabIndex = 14 Top = 5880 Value = 50 Width = 1815 End Begin VB.PictureBox PicCaption Height = 495 Left = 240 Picture = "文本朗读.frx":08CA ScaleHeight = 435 ScaleWidth = 8715 TabIndex = 11 Top = 3960 Visible = 0 ‘False Width = 8775 Begin VB.PictureBox PicBorder Height = 135 Left = 960 Picture = "文本朗读.frx":1710C ScaleHeight = 75 ScaleWidth = 915 TabIndex = 12 Top = 240 Visible = 0 ‘False Width = 975 End End Begin VB.CommandButton Command6 Caption = "继续朗读" Height = 390 Left = 150 TabIndex = 10 Top = 3480 Width = 2760 End Begin VB.CommandButton Command5 Caption = "暂停朗读" Height = 390 Left = 150 TabIndex = 9 Top = 3000 Width = 2760 End Begin VB.HScrollBar HScroll1 Height = 255 Left = 1080 Max = 100 TabIndex = 8 Top = 5400 Value = 100 Width = 1815 End Begin MSComDlg.CommonDialog CDg1 Left = 6840 Top = 4560 _ExtentX = 847 _ExtentY = 847 _Version = 393216 Filter = "文本文件(*.txt)|*.txt|所有文件|*.*" FilterIndex = 2 End Begin VB.OptionButton Option2 Caption = "朗读选定" Height = 315 Left = 1800 TabIndex = 6 Top = 4920 Width = 1230 End Begin VB.OptionButton Option1 Caption = "朗读全文" Height = 315 Left = 120 TabIndex = 5 Top = 4920 Width = 1230 End Begin VB.CommandButton Command4 Caption = "退出程序" Height = 390 Left = 150 TabIndex = 4 Top = 4440 Width = 2760 End Begin VB.CommandButton Command3 Caption = "结束朗读" Height = 390 Left = 150 TabIndex = 3 Top = 3960 Width = 2760 End Begin VB.CommandButton Command2 Caption = "开始朗读" Height = 390 Left = 150 TabIndex = 2 Top = 2520 Width = 2760 End Begin VB.CommandButton Command1 Caption = "打开文件" Height = 390 Left = 150 TabIndex = 1 Top = 2040 Width = 2760 End Begin RichTextLib.RichTextBox RTf1 Height = 6105 Left = 3120 TabIndex = 0 Top = 30 Width = 6615 _ExtentX = 11668 _ExtentY = 10769 _Version = 393217 BackColor = 15138775 HideSelection = 0 ‘False ScrollBars = 2 AutoVerbMenu = -1 ‘True TextRTF = $"文本朗读.frx":17996 End Begin VB.Label Label1 AutoSize = -1 ‘True Caption = "语速调节:" Height = 180 Index = 1 Left = 120 TabIndex = 13 Top = 5880 Width = 900 End Begin VB.Label Label1 AutoSize = -1 ‘True Caption = "音量调节:" Height = 180 Index = 0 Left = 120 TabIndex = 7 Top = 5400 Width = 900 End Begin VB.Image Image1 Height = 1935 Left = -15 Picture = "文本朗读.frx":17A33 Stretch = -1 ‘True Top = 30 Width = 3075 End Begin VB.Menu FILEMNU Caption = "文件(&F)" Begin VB.Menu OPENMNU Caption = "打开(&O)" End Begin VB.Menu LDMNU Caption = "朗读(&L)" End Begin VB.Menu FG Caption = "-" End Begin VB.Menu EXTMNU Caption = "退出(&X)" End End Begin VB.Menu HILMNU Caption = "帮助(&H)" Begin VB.Menu aboutmnu Caption = "关于…" End EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseDim ld As New SpeechLib.SpVoiceDim qorx As BooleanDim wb As StringPrivate m_cN As cNeoCaption‘这是我又一次对文本播放器进行修订,‘增加了打开word、rtf文本、音量调节功能‘但是如何保存文声音文件还没做到,对TTS的安装等还没搞清楚,‘今后还需进一步努力加以改进。yxf 2004年5月30日‘------------------------------------------------------------------‘增加语速控制功能 2004年6月28日Private Sub aboutmnu_Click()frmAbout.Show 1End SubPrivate Sub Command1_Click()On Error Resume NextRTf1.Text = ""Dim str As StringDim lstr$CDg1.ShowOpenIf CDg1.FileName <> "" ThenIf LCase(right(CDg1.FileName, 3)) = "rtf" ThenRTf1.LoadFile CDg1.FileName, 0ElseIf LCase(right(CDg1.FileName, 3)) = "doc" ThenForm1.Caption = "文本播放器1.1版--正在打开文件……"Dim myword As New Word.Applicationmyword.Documents.Open FileName:=CDg1.FileName myword.Selection.WholeStoryRTf1.Text = myword.Selectionmyword.Quit Set myword = NothingElseIf LCase(right(CDg1.FileName, 3)) = "txt" ThenForm1.Caption = "文本播放器1.1版--正在打开文件……"RTf1.LoadFile CDg1.FileName, rtfText‘opentxt CDg1.FileName, str, lstr‘RTf1 = lstrElse If MsgBox("文件无法识别,按文本格式打开?", vbYesNo, "提示") = 6 ThenForm1.Caption = "文本播放器1.1版--正在打开文件……"opentxt CDg1.FileName, str, lstrRTf1 = lstr Else Exit Sub End IfEnd IfEnd IfMe.Caption = "文本播放器1.1版--" + CDg1.FileNameEnd SubPrivate Sub Command2_Click()On Error Resume NextIf qorx Thenwb = RTf1.TextElsewb = RTf1.SelTextEnd IfSet ld = New SpeechLib.SpVoiceld.Volume = HScroll1ld.Rate = HScroll2 / 10ld.Speak wb, 1End SubPrivate Sub Command3_Click()ld.Speak "", 2Set ld = NothingEnd SubPrivate Sub Command4_Click()ld.Speak "", 2Set ld = NothingEndEnd SubPrivate Sub Command5_Click()On Error Resume Nextld.PauseEnd SubPrivate Sub Command6_Click()On Error Resume Nextld.ResumeEnd SubPrivate Sub EXTMNU_Click()Command4_ClickEnd SubPrivate Sub Form_Resize()If Form1.Width > 3300 And Me.Height > 5000 ThenForm1.RTf1.Width = Me.Width - 3300RTf1.Height = Me.Height - 1000ElseRTf1.Width = 5895End IfEnd SubPrivate Sub Skin(f As Form, cN As cNeoCaption) cN.ActiveCaptionColor = &HFFFFFF cN.InActiveCaptionColor = &HC0C0C0 cN.ActiveMenuColor = &H0& cN.ActiveMenuColorOver = &H0 cN.InActiveMenuColor = &H0& cN.MenuBackgroundColor = RGB(207, 203, 207) cN.CaptionFont.Name = "宋体" cN.CaptionFont.Size = 9 cN.MenuFont.Name = "宋体" cN.MenuFont.Size = 9 cN.Attach f, f.PicCaption.Picture, f.PicBorder.Picture, 19, 20, 90, 140, 240, 400 f.BackColor = RGB(207, 203, 207)End SubPrivate Sub Form_Load()‘Dim X0 As Long‘Dim Y0 As Long‘让窗体‘X0 = Screen.Width‘Y0 = Screen.Height‘X0 = (X0 - Me.Width) / 2‘Y0 = (Y0 - Me.Height) / 2‘Me.Move X0, Y0‘ Set m_cN = New cNeoCaption ‘ Skin Me, m_cNqorx = TrueRTf1.Text = " 文本播放器1.1版" + vbCrLf + " 河南省安阳市育才路" + vbCrLf + " 2004年5月8日"Option1.Value = TrueEnd SubPrivate Sub Form_Unload(Cancel As Integer)Command4.Value = TrueEnd SubPrivate Sub HScroll1_Change()On Error Resume Nextld.Volume = HScroll1End SubPrivate Sub HScroll2_Change()On Error Resume Nextld.Rate = HScroll2 / 10End SubPrivate Sub LDMNU_Click()Command2_ClickEnd SubPrivate Sub OPENMNU_Click()Command1_ClickEnd SubPrivate Sub Option2_Click()qorx = FalseEnd SubPrivate Sub Option1_Click()qorx = TrueEnd SubVERSION 5.00Begin VB.Form frmAbout BorderStyle = 3 ‘Fixed Dialog Caption = "关于 文本朗读器" ClientHeight = 3555 ClientLeft = 2340 ClientTop = 1935 ClientWidth = 5730 ClipControls = 0 ‘False Icon = "frmAbout.frx":0000 LinkTopic = "Form2" MaxButton = 0 ‘False MinButton = 0 ‘False ScaleHeight = 2453.724 ScaleMode = 0 ‘User ScaleWidth = 5380.766 ShowInTaskbar = 0 ‘False Begin VB.CommandButton cmdOK Cancel = -1 ‘True Caption = "确定" Default = -1 ‘True Height = 345 Left = 4125 TabIndex = 0 Top = 2625 Width = 1500 End Begin VB.CommandButton cmdSysInfo Caption = "系统信息(&S)..." Height = 345 Left = 4140 TabIndex = 1 Top = 3075 Width = 1485 End Begin VB.Label Label1 Caption = "作者:河南省安阳市监狱 yxf" Height = 255 Left = 240 TabIndex = 6 Top = 3240 Width = 3735 End Begin VB.Image Image1 BorderStyle = 1 ‘Fixed Single Height = 675 Left = 120 Picture = "frmAbout.frx":08CA Stretch = -1 ‘True Top = 240 Width = 720 End Begin VB.Line Line1 BorderColor = &H00808080& BorderStyle = 6 ‘Inside Solid Index = 1 X1 = 84.515 X2 = 5309.398 Y1 = 1687.583 Y2 = 1687.583 End Begin VB.Label lblDescription Caption = $"frmAbout.frx":175602 ForeColor = &H00000000& Height = 1170 Left = 1080 TabIndex = 2 Top = 1125 Width = 3765 End Begin VB.Label lblTitle Caption = "文本朗读器" BeginProperty Font Name = "隶书" Size = 21.75 Charset = 134 Weight = 400 Underline = -1 ‘True Italic = -1 ‘True Strikethrough = 0 ‘False EndProperty ForeColor = &H000000FF& Height = 600 Left = 1080 TabIndex = 4 Top = 120 Width = 3885 End Begin VB.Line Line1 BorderColor = &H00FFFFFF& BorderWidth = 2 Index = 0 X1 = 98.6 X2 = 5309.398 Y1 = 1697.936 Y2 = 1697.936 End Begin VB.Label lblVersion Caption = "版本:1.1" Height = 225 Left = 1050 TabIndex = 5 Top = 780 Width = 3885 End Begin VB.Label lblDisclaimer Caption = "警告:本软件可以自由使用,但因对其使用而 带来的任何不良后果概不负责!" ForeColor = &H00000000& Height = 420 Left = 255 TabIndex = 3 Top = 2625 Width = 3630 EndEndAttribute VB_Name = "frmAbout"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption Explicit‘ 注册表关键字安全选项...Const READ_CONTROL = &H20000Const KEY_QUERY_VALUE = &H1Const KEY_SET_VALUE = &H2Const KEY_CREATE_SUB_KEY = &H4Const KEY_ENUMERATE_SUB_KEYS = &H8Const KEY_NOTIFY = &H10Const KEY_CREATE_LINK = &H20Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _ KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _ KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL ‘ 注册表关键字 ROOT 类型...Const HKEY_LOCAL_MACHINE = &H80000002Const ERROR_SUCCESS = 0Const REG_SZ = 1 ‘ 独立的空的终结字符串Const REG_DWORD = 4 ‘ 32位数字Const gREGKEYSYSINFOLOC = "SOFTWAREMicrosoftShared Tools Location"Const gREGVALSYSINFOLOC = "MSINFO"Const gREGKEYSYSINFO = "SOFTWAREMicrosoftShared ToolsMSINFO"Const gREGVALSYSINFO = "PATH"Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As LongPrivate Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As LongPrivate Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As LongPrivate Sub cmdSysInfo_Click() Call StartSysInfoEnd SubPrivate Sub cmdOK_Click() Unload MeEnd SubPrivate Sub Form_Load()Dim X0 As LongDim Y0 As Long‘让窗体X0 = Screen.WidthY0 = Screen.HeightX0 = (X0 - Me.Width) / 2Y0 = (Y0 - Me.Height) / 2Me.Move X0, Y0End SubPublic Sub StartSysInfo() On Error GoTo SysInfoErr Dim rc As Long Dim SysInfoPath As String ‘ 试图从注册表获得系统信息程序的路径及名称... If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then ‘ 试图仅从注册表获得系统信息程序的路径... ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then ‘ 已知32位文件版本的有效位置 If (Dir(SysInfoPath & "MSINFO32.EXE") <> "") Then SysInfoPath = SysInfoPath & "MSINFO32.EXE" ‘ 错误 - 文件不能被找到... Else GoTo SysInfoErr End If ‘ 错误 - 注册表相应条目不能被找到... Else GoTo SysInfoErr End If Call Shell(SysInfoPath, vbNormalFocus) Exit SubSysInfoErr: MsgBox "此时系统信息不可用", vbOKOnlyEnd SubPublic Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean Dim i As Long ‘ 循环计数器 Dim rc As Long ‘ 返回代码 Dim hKey As Long ‘ 打开的注册表关键字句柄 Dim hDepth As Long ‘ Dim KeyValType As Long ‘ 注册表关键字数据类型 Dim tmpVal As String ‘ 注册表关键字值的临时存储器 Dim KeyValSize As Long ‘ 注册表关键自变量的尺寸 ‘------------------------------------------------------------ ‘ 打开 {HKEY_LOCAL_MACHINE...} 下的 RegKey ‘------------------------------------------------------------ rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ‘ 打开注册表关键字 If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ‘ 处理错误... tmpVal = String$(1024, 0) ‘ 分配变量空间 KeyValSize = 1024 ‘ 标记变量尺寸 ‘------------------------------------------------------------ ‘ 检索注册表关键字的值... ‘------------------------------------------------------------ rc = RegQueryValueEx(hKey, SubKeyRef, 0, _ KeyValType, tmpVal, KeyValSize) ‘ 获得/创建关键字值 If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ‘ 处理错误 If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ‘ Win95 外接程序空终结字符串... tmpVal = Left(tmpVal, KeyValSize - 1) ‘ Null 被找到,从字符串分离出来 Else ‘ WinNT 没有空终结字符串... tmpVal = Left(tmpVal, KeyValSize) ‘ Null 没有被找到, 分离字符串 End If ‘------------------------------------------------------------ ‘ 决定转换的关键字的值类型... ‘------------------------------------------------------------ Select Case KeyValType ‘ 搜索数据类型... Case REG_SZ ‘ 字符串注册关键字数据类型 KeyVal = tmpVal ‘ 复制字符串的值 Case REG_DWORD ‘ 四字节的注册表关键字数据类型 For i = Len(tmpVal) To 1 Step -1 ‘ 将每位进行转换 KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ‘ 生成值字符。 By Char。 Next KeyVal = Format$("&h" + KeyVal) ‘ 转换四字节的字符为字符串 End Select GetKeyValue = True ‘ 返回成功 rc = RegCloseKey(hKey) ‘ 关闭注册表关键字 Exit Function ‘ 退出 GetKeyError: ‘ 错误发生后将其清除... KeyVal = "" ‘ 设置返回值到空字符串 GetKeyValue = False ‘ 返回失败 rc = RegCloseKey(hKey) ‘ 关闭注册表关键字End Function

1,486

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧