Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0563: Eigenes Protokoll definieren

 von 

Beschreibung 

Dieser Tipp soll zeigen, wie man Links aus dem Webbrowser abfängt, die mit einem bestimmten Protokoll anfangen (So wie es z.B. eDonkey oder eMule machen). In diesem Beispiel wurde "pcat" genommen.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

RegCloseKey, RegCreateKeyExA (RegCreateKeyEx), RegFlushKey, RegOpenKeyExA (RegOpenKeyEx), RegSetValueExA (RegSetValueEx), RegSetValueExA (RegSetValueEx_Str)

Download:

Download des Beispielprojektes [4,31 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'--------------- Anfang Projektdatei pcat.vbp ---------------
' Die Komponente ' (MSWINSCK.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Windows Socket "Winsock1"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label5"
' Steuerelement: Beschriftungsfeld "Label4"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"
'
' Autor: KaZaK <kazak@gmx.net> unter Mithilfe von Kill][Switch und Sebastian

'P(rotocol) CAT(cher)
'Dieser Tip soll zeigen, wie man Links aus dem Webbrowser
'abfängt, die mit einem bestimmten Protokoll anfangen.
'(So wie es z.B. eDonkey oder eMule machen)
'In diesem Beispiel wurde "pcat" genommen.

'ACHTUNG: Damit das Programm funktionsfähig ist,
'muss es vorher kompiliert werden, und die Registry-
'einträge müssen erstellt werden.
'Fragen oder Anregungen bitte an kazak@gmx.net

Option Explicit

Private Sub Command1_Click()
'Sub, um die zugehörigen Registry-Einträge zu erstellen
Dim pfad As String
Dim regpfad As String
Dim system As String
Dim result

pfad = App.Path
pfad = Replace(pfad, "\\", "\")
pfad = pfad & "\" & App.EXEName & ".exe"

Const HKEY_CLASSES_ROOT = &H80000000

result = RegKeyCreate(HKEY_CLASSES_ROOT, "pcat\")
result = RegValueSet(HKEY_CLASSES_ROOT, "pcat\", "", "URL: pcat Protocol")
result = RegValueSet(HKEY_CLASSES_ROOT, "pcat\", "URL Protocol", "")
result = RegKeyCreate(HKEY_CLASSES_ROOT, "pcat\shell\open\command")
result = RegValueSet(HKEY_CLASSES_ROOT, "pcat\shell\open\command", "", pfad & " %1")
result = RegKeyCreate(HKEY_CLASSES_ROOT, "pcat\DefaultIcon")
result = RegValueSet(HKEY_CLASSES_ROOT, "pcat\DefaultIcon", "", pfad)

End Sub

Private Sub Form_Load()
'Sub zum initialisieren
Winsock1.Protocol = sckUDPProtocol
Winsock1.RemoteHost = "localhost"
Winsock1.RemotePort = 28958
Winsock1.LocalPort = 28958

'Error tritt bei schon belegtem Port auf, d.h. das
'Programm läuft schon einmal
On Error Goto bindfehler
Winsock1.Bind
'schreibe übergebene Parameter in die Textbox
Text1.Text = Command$
Exit Sub

bindfehler:
'wenn Fehler aufgetritt, schickt es den übergebenen
'String an das schon laufende Programm und beendet
'sich selbst
  Winsock1.Close
  Winsock1.LocalPort = Winsock1.RemotePort + 1
  Winsock1.SendData Command$
  Unload Me

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'Sub wenn Datem am Winsock ankommen
Dim daten As String
'schreibe die angekommenen Daten in die Texbox
Winsock1.GetData daten
Text1.Text = daten
End Sub
 
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

 
'
'Autor: ActiveVB.de

' Dem Tipp angepasstes Registry Modul

' Ausschlielich Registry Funktionen!

Option Explicit
 
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 RegCloseKey Lib "advapi32.dll" _
        (ByVal hKey As Long) As Long

        
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _
        Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal _
        lpSubKey As String, ByVal Reserved As Long, ByVal _
        lpClass As String, ByVal dwOptions As Long, ByVal _
        samDesired As Long, ByVal lpSecurityAttributes As Any, _
        phkResult As Long, lpdwDisposition As Long) As Long
        
Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal _
        hKey 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 Long, ByVal cbData As Long) _
        As Long
        
Private Declare Function RegSetValueEx_Str Lib "advapi32.dll" _
        Alias "RegSetValueExA" (ByVal hKey As Long, ByVal _
        lpValueName As String, ByVal Reserved As Long, ByVal _
        dwType As Long, ByVal lpData As String, ByVal cbData As _
        Long) As Long
 
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = KEY_QUERY_VALUE Or _
                 KEY_ENUMERATE_SUB_KEYS _
                 Or KEY_NOTIFY
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE Or _
                       KEY_SET_VALUE Or _
                       KEY_CREATE_SUB_KEY Or _
                       KEY_ENUMERATE_SUB_KEYS Or _
                       KEY_NOTIFY Or _
                       KEY_CREATE_LINK
Const ERROR_SUCCESS = 0&
 
Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
 
Const REG_OPTION_NON_VOLATILE = &H0
 
Private RegRoot&

Function RegKeyCreate(Root&, Newkey$) As Long
  Dim result&, hKey&, Back&
    'Neuen Schlüssel erstellen
    result = RegCreateKeyEx(Root, Newkey, 0, vbNullString, _
                            REG_OPTION_NON_VOLATILE, _
                            KEY_ALL_ACCESS, 0&, hKey, Back)
    If result = ERROR_SUCCESS Then
      result = RegFlushKey(hKey)
      If result = ERROR_SUCCESS Then Call RegCloseKey(hKey)
        RegKeyCreate = Back
    End If
End Function
 
 
Function RegValueSet(Root&, Key$, Field$, Value As Variant) As Long
  Dim result&, hKey&, s$, l&
    'Wert in ein Feld der Registry schreiben
    result = RegOpenKeyEx(Root, Key, 0, KEY_ALL_ACCESS, hKey)
    If result = ERROR_SUCCESS Then
      Select Case VarType(Value)
        Case vbInteger, vbLong
          l = CLng(Value)
          result = RegSetValueEx(hKey, Field, 0, REG_DWORD, l, 4)
        Case vbString
          s = CStr(Value)
          result = RegSetValueEx_Str(hKey, Field, 0, REG_SZ, s, _
                                        Len(s) + 1)
      End Select
      result = RegCloseKey(hKey)
    End If
    
    RegValueSet = result
End Function
 



'---------- Ende Modul "Module1" alias Module1.bas ----------
'---------------- Ende Projektdatei pcat.vbp ----------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 8 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von am 09.06.2009 um 09:22

Funktioniert toll, auch mit Vista :-)

Für Vista ist aber der Ersatz des Winsock-OCX durch die hier
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=54681&lngWId=1

beschreibene Lösung notwendig.

Ich bin begeistert.

Kommentar von Rock am 15.12.2008 um 12:06

Funktioniert super:)

Allerdings hab ich noch ne Frage:

Wenn man das Protokoll aufruft, wird im Brwoser gefragt mit welchem Programm man das Starten will.
Jetzt Steht als Makiert das selbst geschriebene Programm zur auswahl.

Allerdings steht dort der komplette Pfad + app

Wie kann man es nun so umfunktionieren das Statt dem kompletten Pfad nur der gewünschte da steht.
Alst statt "C:\Programm\MeinProgramm.exe" nur "MeinProgramm" oder nur "MeinProgramm.exe"?

wär super toll wenn mir da jemand von euch helfen könnte:)

Kommentar von am 13.01.2006 um 20:58

@Brainiac
Wenn du auf einen Link mit eigenem Protkoll klickst, dann passiert nix anderes als dass dein Browser das festgelegte Programm mit dem Link als Parameter startet. Daten an den Browser können nicht zurück gegeben werden.
mfg

Kommentar von Brainiac am 13.01.2006 um 20:04

Sehr schönes Snippet,

funktioniert einwandfrei!

Natürlich möchte ich auch, dass mein prog reagiert; also eine Webseite zurücksendet oder den besucher direkt weiterverlinkt auf eine site.

Wie würde ich soetwas umsetzen?

Peace

Kommentar von Apraxas am 15.11.2005 um 10:17

Jo hab hierbei ein kleines problem ich möchte mir das ssh:\\ als protokoll definieren, und dann mit putty die ip öffenen sieht im browser dann ssh:\\serverip aus, leider wird mit dem %1 die komplette zeile übertragen also auch das ssh:\\ und damit fang ich ja nix an, weis jemand wie ich also nur die Serverip weitergeben kann ?

Kommentar von Narfik am 31.08.2005 um 02:25

Funktioniert wunderbar.Wie kann man es so erweitern, dass man die url erweitern kann das ein Programm damit umgehen kann. Einfaches Beispiel: url: test://test/erweiterung
das programm soll dann starten und zB die funktion "erweiterung" aufrufen oder den text "erweiterung" in eine textbox darstellen.

Kommentar von Lonesome Walker am 24.07.2005 um 17:11

Tja, das Beispiel funktioniert ein wenig angepaßt auch wunderbar unter w2k / XP; Registrierung einwandfrei möglich.

Nur, wenn man dann was über das Protokoll aufruft, hagelt es Fehlermeldungen...

z.B. Datei existiert nicht, oder Hilfedatei nicht gefunden...


Sehr schade...!

Kommentar von Kill][Switch am 10.01.2003 um 23:39

Hey cool... da steh ja mein nick drin : )
ein kleiner Vorschlag noch von meiner Seite:
In "Winsock1_DataArrival" noch vor Winsock1.GetData das hier einfügen

If Winsock1.RemoteHostIP <> "127.0.0.1" Then Exit Sub

man weis ja nie was man sich alles mit nem offenen Port so einfangen kann : )

oder man macht den Datenaustausch gleich so wie im Tipp 0337!!!

Gruß, Kill][Switch