自己理解不了,请各路大侠指教,不明白这是怎么样一个过程?谢谢
Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias _
    "GetVolumeInformationA" (ByVal lpRootPathName As String, _
    ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, _
    lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
    lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
    ByVal nFileSystemNameSize As Long) As Long
    '创建注册表项
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias _
   "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   phkResult As Long) As Long
   '设置注册表项中的值
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, _
   ByVal cbData As Long) As Long
   '打开注册表中的项
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
   "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
   '获取子项
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Const REG_SZ = 1
Const REG_DWORD = 4
Const HKEY_CURRENT_USER = &H80000001
Dim fso, txtfile
Dim mySerial As Long
Dim mylong As Long
'提取计算机名和用户名
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
  '提取系统目录
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  Dim hKey As Long
  Dim strLong As String * 256
  Dim s As String * 100
  Dim Length As Long
  Dim WinPath As String
  Dim SysPath As String'附加数据库定义
Private con As New ADODB.Connection
Private rs As New ADODB.Recordset
Private rsDropDB As New ADODB.Recordset
Private rsSql As New ADODB.Recordset
Private str As String, Source As String, SourceM As String, SourceL As String'设置窗口可移动
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
Sub Step()
'配置数据源*********************************************
  '提取SQL驱动
  Length = GetSystemDirectory(s, Len(s))
  SysPath = Left(s, Length)
  Dim Lab As String
  Lab = SysPath + "\sqlsrv32.dll"    '提取计算机名称和用户名
    Dim txtUserName As String
    GetUserName strLong, 255
    txtUserName = strLong
    strLong = Trim(strLong)    '向创建ODBC数据源
    RegOpenKeyEx HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI", 0, 0, hKey
    RegCreateKey HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\db_Client", hKey
    RegSetValueEx hKey, "Database", 0, REG_SZ, ByVal "db_Client", Len("db_Client")
    RegSetValueEx hKey, "Driver", 0, REG_SZ, ByVal Lab, Len(Lab)
    RegSetValueEx hKey, "LastUser", 0, REG_SZ, ByVal txtUserName, Len(txtUserName)
    RegSetValueEx hKey, "Server", 0, REG_SZ, ByVal "(local)", 7
    RegSetValueEx hKey, "Trusted_Connection", 0, REG_SZ, ByVal "Yes", 3
    '驱动Server ODBC数据源
    RegOpenKeyEx HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\ODBC Data Sources", 0, 0, hKey
    RegCreateKey HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\ODBC Data Sources", hKey
    RegSetValueEx hKey, "db_Client", 0, REG_SZ, ByVal "SQL Server", 10
    For i = 1 To 3
        Call AddData
    Next i
End Sub
Sub AddData()
   SourceM = MyPath(App.Path, "窗体")
   SourceM = SourceM & "Database\db_Client_Data.MDF"
   SourceL = MyPath(App.Path, "窗体")
   SourceL = SourceL & "Database\db_Client_Log.LDF"
   '附加数据库********************************************
      Set con = New ADODB.Connection
      con.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa"
   On Error Resume Next
     Set rs = New ADODB.Recordset
         str = "EXEC sp_attach_db @dbname = N'db_Client', @filename1 = N'" + SourceM + "', @filename2 = N'" + SourceL + "'"
        Set rs = con.Execute(str)   Dim cn As New ADODB.Connection
   cn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=db_Client"
   If Err.Number = -2147217900 Then              '捕捉错误号
      Frm_mm.Show
      Unload Me
   Else
      '如果数据库出现质疑 问题 将其移除
      rsDropDB.Open "DROP DATABASE db_Client", con, adOpenDynamic, adLockOptimistic
      rsDropDB.Close
   End If
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
  X = ReleaseCapture
  returnva = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End SubPrivate Sub Timer1_Timer()
  Call Step
End Sub

解决方案 »

  1.   

    Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
      X = ReleaseCapture
      returnva = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    End If
    End SubPrivate Sub Timer1_Timer()
      Call Step
    End Sub
    这段请指教,还有前面那些定义的注册表的代码,就是定义吗,为什么要定义注册表?
      

  2.   

    returnva = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    是要让鼠标点窗口任何位置都可以拖窗口
    前面“定义的注册表”是函数声明,如果程序中用到这些函数,那么就不可以删除这些声明。
      

  3.   

    returnva = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    是要让鼠标点窗口任何位置都可以拖窗口
    前面“定义的注册表”是函数声明,如果程序中用到这些函数,那么就不可以删除这些声明。