189 8069 5689
'---------------------以下放在模块中-----------------------
创新互联公司是一家集网站建设,吴忠企业网站建设,吴忠品牌网站建设,网站定制,吴忠网站建设报价,网络营销,网络优化,吴忠网站推广为一体的创新建站企业，帮助传统企业提升企业形象加强企业竞争力。可充分满足这一群体相比中小企业更为丰富、高端、多元的互联网需求。同时我们时刻保持专业、时尚、前沿，时刻以成就客户成长自我，坚持不断学习、思考、沉淀、净化自己，让我们为更多的企业打造出实用型网站。
Private Const NO_ERROR = 0
Private Const INTERNET_OPTION_END_BROWSER_SESSION = 42
Private Const CSIDL_COOKIES = H21
Private Structure SHITEMID
Dim cb As Long
Dim abID As Byte
End Structure
Private Structure ITEMIDLIST
Dim mkid As SHITEMID
End Structure
Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal dwOption As Long, ByRef lpBuffer As Long, ByVal dwBufferLength As Long) As Long
Private Function GetSpecialfolder(ByVal CSIDL As Long) As String
Dim r As Long
Dim IDL As ITEMIDLIST
'Get the special folder
Dim path As String
r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If r = NO_ERROR Then
'Create a buffer
path = Space$(512)
'Get the path from the IDList
r = SHGetPathFromIDList(IDL.mkid.cb, path$)
'Remove the unnecessary chr$(0)'s
GetSpecialfolder = Left$(path, InStr(path, Chr(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function
Public Sub ISetOption()
Dim CookiesPath As String
CookiesPath = GetSpecialfolder(CSIDL_COOKIES)
InternetSetOption(0, INTERNET_OPTION_END_BROWSER_SESSION, 0, 0)
End Sub
'--------------------------模块结束---------------------
'这样调用
ISetOption()
可以使用，因为两个子程序的数据都是互通的，而且可以相互的补充，你用了另外一个子程序的数据也不影响你原本的子程序，这都是相互的
Option Explicit Const MAX_TOOLTIP As Integer = 64 Const NIF_ICON = H2 '删除图标 Const NIF_MESSAGE = H1 Const NIF_TIP = H4 Const NIM_ADD = H0 '添加图标到任务栏提示区 Const NIM_DELETE = H2 Const WM_MOUSEMOVE = H200 Const WM_LBUTTONDOWN = H201 Const WM_LBUTTONUP = H202 Const WM_LBUTTONDBLCLK = H203 Const WM_RBUTTONDOWN = H204 Const WM_RBUTTONUP = H205 Const WM_RBUTTONDBLCLK = H206 Const SW_RESTORE = 9 Const SW_HIDE = 0 Private 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 就是了
VB6：
你可以在工程里多建一个窗体，操作的菜单写在这里，不显示9 OK了
当你要的窗体关闭后 再+载托盘
VB.NET里直接9有Closing和Closed事件
以下9是托盘：
Dim OldWindowProc As Long
Dim TheForm As Form
Dim TheMenu As Menu
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
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
Private TheData As NOTIFYICONDATA
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = (H400 + 1001) Then
If lParam = H205 Then
FormM.SetFocus
TheForm.PopupMenu TheMenu
Exit Function
End If
End If
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End Function
Public Sub AddToTray(frm As Form, mnu As Menu)
Set TheForm = frm
Set TheMenu = mnu
OldWindowProc = SetWindowLong(frm.hwnd, (-4), AddressOf NewWindowProc)
With TheData
.Uid = 0
.hwnd = frm.hwnd
.cbSize = Len(TheData)
.HIcon = frm.Icon.Handle
.UFlags = 2
.UCallbackMessage = (H400 + 1001)
.UFlags = .UFlags Or 1
.cbSize = Len(TheData)
End With
Shell_NotifyIcon 0, TheData
End Sub
Public Sub RemoveFromTray()
With TheData
.UFlags = 0
End With
Shell_NotifyIcon 2, TheData
SetWindowLong TheForm.hwnd, (-4), OldWindowProc
End Sub
Public Sub SetTrayTip(tip As String)
With TheData
.SzTip = tip vbNullChar
.UFlags = 4
End With
Shell_NotifyIcon 1, TheData
End Sub
要解决这个问题，首先要确保存储过程已经在数据库中创建。如果存储过程已经存在，请检查您的Vb.Net代码，确保您正确指定了存储过程的名称。此外，请确保您的Vb.Net代码正确指定了数据库的名称，以及连接字符串中的用户名和密码是正确的。