form1.frm
来自「通过程序向另一软件发送信息或截取另一软件界面上的信息vb源码」· FRM 代码 · 共 125 行
FRM
125 行
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3090
ClientLeft = 60
ClientTop = 450
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3090
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 525
Left = 1410
TabIndex = 0
Top = 900
Width = 1485
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim lpClassName As String
Dim lpCaption As String
Dim Handle1 As Long
Dim Handle2 As Long
Dim Handle3 As Long
Dim Handle4 As Long
Dim Handle5 As Long
Dim SubHwnd As Long
Dim AK As Integer
Dim Wndtext As String
Dim sTx(11) As String
Dim S As String
Dim IES As IHTMLDocument2
Dim HtmlForms As IHTMLElementCollection
Dim HtmlForm As IHTMLFormElement
Dim kName, Index
Dim InputElement As IHTMLInputElement
Dim I, J, k As Integer
Private Sub Command1_Click()
' sTx(0) = Text1(0).Text
' sTx(1) = Text1(3).Text
' sTx(2) = Text1(1).Text
' sTx(3) = Text1(2).Text
' sTx(4) = Text1(1).Text
' sTx(5) = Text1(4).Text
' sTx(6) = Text1(5).Text
'
' sTx(7) = Text1(6).Text
' sTx(8) = Text1(7).Text
' sTx(9) = Text1(5).Text
' sTx(10) = Text1(1).Text
' sTx(11) = Text1(4).Text
'
' If sTx(0) = "" Then Exit Sub
' If sTx(1) = "" Then Exit Sub
' If sTx(2) = "" Then Exit Sub
' If sTx(3) = "" Then Exit Sub
' If sTx(4) = "" Then Exit Sub
' If sTx(5) = "" Then Exit Sub
' If sTx(6) = "" Then Exit Sub
' If sTx(7) = "" Then Exit Sub
' If sTx(8) = "" Then Exit Sub
' If sTx(9) = "" Then Exit Sub
' If sTx(10) = "" Then Exit Sub
' If sTx(11) = "" Then Exit Sub
Handle1 = FindWindow("WindowsForms10.Window.8.app.0.33c0d9d", "行政审批业务软件通用系统") ' 获得窗口句柄
Handle2 = FindWindowEx(Handle1, 0&, "WindowsForms10.Window.8.app.0.33c0d9d", "") ' 获得窗口句柄
Handle3 = FindWindowEx(Handle2, 0&, "Shell Embedding", "") ' 获得窗口句柄
Handle4 = FindWindowEx(Handle3, 0&, "Shell DocObject View", "") ' 获得窗口句柄
Handle5 = FindWindowEx(Handle4, 0&, "Internet Explorer_Server", vbNullString) ' 获得窗口句柄
Set IES = IEDOMFromhWnd(Handle5)
Set HtmlForms = IES.Forms
If HtmlForms.length = 0 Then Exit Sub
On Error Resume Next
'For k = 0 To HtmlForms.length - 1
' Set HtmlForm = HtmlForms.Item(k, k)
' J = HtmlForm.length - 1
' For I = 0 To J - 1
' kName = HtmlForm.Item(I, 0).Name
'Debug.Print kName
' If kName = "" Then GoTo Lm
HtmlForm.Item("organName").Value = "" & kName & "" + "DFDF"
HtmlForm.Item("juridicalPerson").Value = "" & kName & "" + "DFDF"
HtmlForm.Item("organPostAddress").Value = "" & kName & "" + "DFDF"
HtmlForm.Item("organCode").Value = "" & kName & "" + "DFDF"
HtmlForm.Item("organPostcode").Value = "" & kName & "" + "DFDF"
HtmlForm.Item("organTel").Value = "" & kName & "" + "DFDF"
HtmlForm.Item("organName").Value = "" & kName & "" + "DFDF"
HtmlForm.Item("organName").Value = "" & kName & "" + "DFDF"
HtmlForm.Item("organName").Value = "" & kName & "" + "DFDF"
HtmlForm.Item("organName").Value = "" & kName & "" + "DFDF"
HtmlForm.Item("organName").Value = "" & kName & "" + "DFDF"
HtmlForm.Item("organName").Value = "" & kName & "" + "DFDF"
'Lm:
' Next
'Next
DoEvents
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?