Option Explicit
 
 Const REG_SZ As Long = 1
 Const REG_DWORD As Long = 4
 Const KEY_ALL_ACCESS = &H3F
 Const HKEY_LOCAL_MACHINE = &H80000002
 
 Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
   String, 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 RegSetValueExLong Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
   ByVal cbData As Long) As Long
   
Private Declare Function RegCloseKey Lib "advapi32.dll" _
   (ByVal hKey As Long) As Long
   
Dim Flg As Integer

   
 Private Sub SetKeyValue(sKeyName As String, sValueName As String, _
   vValueSetting As Variant, lValueType As Long)
       Dim lRetVal As Long         ''result of the SetValueEx function
       Dim hKey As Long         ''handle of open key

       ''open the specified key
       lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, _
                              KEY_ALL_ACCESS, hKey)
       lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
       RegCloseKey (hKey)
End Sub

Private Sub Check1_Click()
    If Check1.Value = 1 Then
        Clipboard.Clear
        Text4.SetFocus
        Text4.SelStart = 1
        Text4.SelLength = Len(Text4)
        DoEvents
        Clipboard.SetText Screen.ActiveControl.SelText
        Text4.SelLength = 0
        Check1.Caption = "Clear c&lipboard"
        DoEvents
    Else
        Clipboard.Clear
        Check1.Caption = "Copy to c&lipboard"
    End If
End Sub

Private Sub Command1_Click()
    If InStr(1, Trim(Text1), " ") = 0 And InStr(1, Trim(Text2), " ") = 0 And InStr(1, Trim(Text3), " ") = 0 Then
        SetKeyValue "Software\Microsoft\MSSQLServer\Client\ConnectTo", Trim(Text1), "dbmssocn," & Trim(Text2) & "," & Trim(Text3), REG_SZ
        MsgBox "Advanced entry added", vbInformation, "Done"
    Else
        MsgBox "Please supply valid values", vbCritical, "Error"
    End If
End Sub
  Public Function SetValueEx(ByVal hKey As Long, sValueName As String, _
    lType As Long, vValue As Variant) As Long
        Dim lValue As Long
        Dim sValue As String
        Select Case lType
            Case REG_SZ
                sValue = vValue & Chr$(0)
                SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
                                               lType, sValue, Len(sValue))
            Case REG_DWORD
                lValue = vValue
                SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
   lType, lValue, 4)
        End Select
   End Function

Private Sub Command2_Click()
If Flg = 0 Then
    Height = 6825
    Flg = 1
    Command2.Caption = "&Hide VB code"
Else
    Height = 2190
    Flg = 0
    Command2.Caption = "S&how VB code"
End If
End Sub

Private Sub Command3_Click()
    Unload Me
End Sub

Private Sub Form_Activate()
Me.Caption = "Programmatically adding advanced entries -- Written by Anand Mahendra (anandbox@sify.com)"
    Text1.SetFocus
    If Trim(Text1) = "" Or Trim(Text2) = "" Or Trim(Text3) = "" Then
        Command1.Enabled = False
    Else
        Command1.Enabled = True
End If
End Sub

Private Sub Form_Load()
    Flg = 0
    DoEvents
End Sub

Private Sub Text1_Change()
    If Trim(Text1) = "" Or Trim(Text2) = "" Or Trim(Text3) = "" Then
        Command1.Enabled = False
    Else
        Command1.Enabled = True
    End If
End Sub

Private Sub Text2_Change()
    If Trim(Text1) = "" Or Trim(Text2) = "" Or Trim(Text3) = "" Then
        Command1.Enabled = False
    Else
        Command1.Enabled = True
    End If
End Sub

Private Sub Text3_Change()
    If Trim(Text1) = "" Or Trim(Text2) = "" Or Trim(Text3) = "" Then
        Command1.Enabled = False
    Else
        Command1.Enabled = True
    End If
End Sub