Launch Application from browser and play stream.

[JamieWarren09]

Hi guys I recently found a script which allows users who have installed my application to go into the browser and type in like appname:// and then it would launch the application from the browser.

I am wondering if anyone can help me change the following code so that users could do like this


Appname://mms://blahblah.com:8080

and then what it would do is open the application and then play the added URL at the end of it (mms://blahblah.com:8080) play that in the windows media control player on the form?


Here is the current code im using!

Thanks

- CODE - Form File -

Const ProgramURL = "tvr" 'Change this to what you want the protocol that launches the program to be
Const Description = "Online TVR " 'Change this to the description of your program or protocol as long as its not blank or my functions wont be able to check if it exists.


Private Sub Command1_Click()
If MsgBox("Are you sure?", vbYesNo) = vbYes Then 'Confirm
'Remove registry keys
If GetString(HKEY_CLASSES_ROOT, ProgramURL, "") = "" Then 'Lets make sure the registry keys already exist so we dont remove something already gone
DeleteKey HKEY_CLASSES_ROOT, ProgramURL & "\shell\open\command" 'Delete the command key first
DeleteKey HKEY_CLASSES_ROOT, ProgramURL & "\shell\open" 'Delete the open key next
DeleteKey HKEY_CLASSES_ROOT, ProgramURL & "\shell" 'Delete the shell key now
DeleteKey HKEY_CLASSES_ROOT, ProgramURL 'Delete the program key last
End If: End If
End Sub

Private Sub Form_Load()
'Save registry keys
If GetString(HKEY_CLASSES_ROOT, ProgramURL, "") = "" Then 'Check if the registry key already exists (this is why the description cannot be blank)
SaveString HKEY_CLASSES_ROOT, ProgramURL, "", Description 'Here is where the description you wrote above is saved.
SaveString HKEY_CLASSES_ROOT, ProgramURL, "URL Protocol", "" 'This informs windows that we have a new protocol such as what aim did of aim://
SaveString HKEY_CLASSES_ROOT, ProgramURL & "\shell", "", "" 'Dont add anything here
SaveString HKEY_CLASSES_ROOT, ProgramURL & "\shell\open", "", "" 'Dont add anything here either
SaveString HKEY_CLASSES_ROOT, ProgramURL & "\shell\open\command", "", App.Path & "\" & App.EXEName & ".exe %1" 'You can change this if you like as long as it points to a valid exe and as long as you keep %1 here otherwise the Command$ string wont have what was written after the url
End If 'I would hope you know what this does :D
If Command$ <> "%1" And Command$ <> "" Then 'Check if this program was launched from a url
ProcessCommand (TheCommand) 'Goto command process
End If 'Same as above :o
frmMainproto.Hide

End Sub

Public Sub ProcessCommand(TheCommand As String) 'This simply processes whats after YourChoice://We Process This
TheCommand = LCase(TheCommand) 'Make it all lower case so its easier to process
TheCommand = Replace(TheCommand, LCase(ProgramURL & ":\\"), "") 'Lets remove the protocol part so we just have the sent data
Select Case TheCommand 'Select case is alot nicer then using if... then ... elseif ... then and so on
Case "hi" 'If TheCommand = "hi" then
MsgBox "Hello" 'do this
Case "hey" 'If TheCommand = "hello" then
MsgBox "Hi, How are you?" 'do this
Case Else 'Same thing as putting else in the if then areas
MsgBox "Unknown command - " & TheCommand
End Select 'end select just tells visual basics we are done with the select case
End Sub

- CODE - MODULE FILE -

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&
Public Const REG_SZ = 1
Public Const REG_DWORD = 4

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long

Declare Function RegCreateKey Lib "advapi32.dll" Alias _
        "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, _
        phkResult As Long) As Long

Declare Function RegDeleteKey Lib "advapi32.dll" Alias _
        "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long

Declare Function RegDeleteValue Lib "advapi32.dll" Alias _
        "RegDeleteValueA" (ByVal Hkey As Long, _
        ByVal lpValueName As String) As Long

Declare Function RegOpenKey Lib "advapi32.dll" Alias _
        "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, _
        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

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

Public Sub SaveKey(Hkey As Long, strPath As String)
    Dim keyhand&
    R = RegCreateKey(Hkey, strPath, keyhand&)
    R = RegCloseKey(keyhand&)
End Sub

Public Function GetString(Hkey As Long, strPath As String, strValue As String)
    Dim keyhand As Long
    Dim datatype As Long
    Dim lResult As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    Dim intZeroPos As Integer
    R = RegOpenKey(Hkey, strPath, keyhand)
    lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
    If lValueType = REG_SZ Then
        strBuf = String(lDataBufSize, " ")
        lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
        If lResult = ERROR_SUCCESS Then
            intZeroPos = InStr(strBuf, Chr$(0))
            If intZeroPos > 0 Then
                GetString = Left$(strBuf, intZeroPos - 1)
            Else
                GetString = strBuf
            End If
        End If
    End If
End Function

Public Sub SaveString(Hkey As Long, strPath As String, strValue As String, strdata As String)
    Dim keyhand As Long
    Dim R As Long
    R = RegCreateKey(Hkey, strPath, keyhand)
    R = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
    R = RegCloseKey(keyhand)
End Sub

Function GetDWord(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
    Dim lResult As Long
    Dim lValueType As Long
    Dim lBuf As Long
    Dim lDataBufSize As Long
    Dim R As Long
    Dim keyhand As Long
    R = RegOpenKey(Hkey, strPath, keyhand)
    lDataBufSize = 4
    lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)
    If lResult = ERROR_SUCCESS Then
        If lValueType = REG_DWORD Then
            GetDWord = lBuf
        End If
    End If
    R = RegCloseKey(keyhand)
End Function

Function SaveDWord(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
    Dim lResult As Long
    Dim keyhand As Long
    Dim R As Long
    R = RegCreateKey(Hkey, strPath, keyhand)
    lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
    R = RegCloseKey(keyhand)
End Function

Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)
    Dim R As Long
    R = RegDeleteKey(Hkey, strKey)
End Function

Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String)
    Dim keyhand As Long
    R = RegOpenKey(Hkey, strPath, keyhand)
    R = RegDeleteValue(keyhand, strValue)
    R = RegCloseKey(keyhand)
End Function