189 8069 5689
你可以直接打开 VB6 的程序，VB.net 会自动启动升级向导将你的 VB6 代码升级为 VB.net。
公司主营业务：成都做网站、网站设计、外贸营销网站建设、移动网站开发等业务。帮助企业客户真正实现互联网宣传，提高企业的竞争能力。创新互联公司是一支青春激扬、勤奋敬业、活力青春激扬、勤奋敬业、活力澎湃、和谐高效的团队。公司秉承以“开放、自由、严谨、自律”为核心的企业文化，感谢他们对我们的高要求，感谢他们从不同领域给我们带来的挑战，让我们激情的团队有机会用头脑与智慧不断的给客户带来惊喜。创新互联公司推出龙湖免费做网站回馈大家。
引用 Microsoft DAO 3.6 Object Library
Public Function DaoOpenDB(ByVal pDbType As String, ByVal pDbName As String, ByVal pMdbCnct As String) As Integer
On Error GoTo Err_Handler
Dim m_DbDataBase As DAO.Database
Dim gwsMainworkSpace As DAO.Workspace
Dim DAODBEngine As New DAO.DBEngine()
Dim m_DbWkSpace = DAODBEngine.CreateWorkspace("", " Admin ", "")
If pDbType = "c_ACCESS" Then
'Access
m_DbDataBase = m_DbWkSpace.OpenDatabase(pDbName)
Else
'Oracle
m_DbDataBase = m_DbWkSpace.OpenDatabase(pDbName, True, False, pMdbCnct)
End If
DaoOpenDB = c_OK '你在全局中已定义
Exit Function
Err_Handler:
DaoOpenDB = c_NG '你在全局中已定义
MsgBox(Err.Description, MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "Err")
End Function
打开VS2005及以上版本，新建一个VB.NET语言的项目，然后点工具-升级VB6代码，把代码粘贴进去即可
'---------------------以下放在模块中-----------------------
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()