'starting browser with URL
'on a Module
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey as
Long) as
Long
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
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
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const ERROR_SUCCESS = 0&
Const REG_OPTION_NON_VOLATILE = &O0
Const KEY_ALL_CLASSES as
long
= &HF0063
Const KEY_ALL_ACCESS = &H3F
Const REG_SZ as
long
= 1
Public Function RegGetString$(hInKey as
Long, ByVal subkey$, ByVal valname$)
dim
RetVal$, hSubKey as
Long, dwType as
Long, SZ as
Long, v$, r as
Long
RetVal$ = ""
r = RegOpenKeyEx(hInKey, subkey$, 0, KEY_ALL_CLASSES, hSubKey)
If r <> ERROR_SUCCESS Then GoTo Quit_Now
SZ = 256: v$ = String$(SZ, 0)
r = RegQueryValueEx(hSubKey, valname$, 0, dwType, ByVal v$, SZ)
If r = ERROR_SUCCESS And dwType = REG_SZ Then
RetVal$ = Left(v$, SZ - 1)
Else
RetVal$ = ""
end
If
If hInKey = 0 Then r = RegCloseKey(hSubKey)
Quit_Now:
RegGetString$ = RetVal$
End Function
Public sub
ConnectW3(url$)
On Error GoTo fout_connectw3
dim
strProgram$, strDDETopic$, strDDEItem$
dim
intLoaded%
'make on
Form1 a invisible textbox named DDEText
strProgram = RegGetString(HKEY_CLASSES_ROOT, "http\shell\open\command", "")
strDDETopic = UCase(RegGetString(HKEY_CLASSES_ROOT, "http\shell\open\ddeexec\Application", "")) & "|" & RegGetString(HKEY_CLASSES_ROOT, "http\shell\open\ddeexec\Topic", "")
strDDEItem = url$
With Form1.DDEText
.LinkTopic = strDDETopic
.LinkItem = strDDEItem & ",," & -1
.LinkMode = 2
.LinkRequest
end
With
exit
Sub
fout_connectw3:
If Err.Number = 282 Then
If intLoaded = 0 Then
Shell strProgram, vbNormalFocus
intLoaded = 1
ElseIf intLoaded <= 5 Then
intLoaded = intLoaded + 1
Else
Err.Number = vbObjectError + 1
GoTo fout_connectw3
end
If
Resume
ElseIf Err.Number <> 0 Then
MsgBox "Fatal error while communicating to browser"
exit
Sub
end
If
End Sub
'use as
Call ConnectW3("http://www.kather.net/VisualBasicSource/")
Return