VB 5/6-Tipp 0563: Eigenes Protokoll definieren
von KaZaK
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: | Verwendete API-Aufrufe: RegCloseKey, RegCreateKeyExA (RegCreateKeyEx), RegFlushKey, RegOpenKeyExA (RegOpenKeyEx), RegSetValueExA (RegSetValueEx), RegSetValueExA (RegSetValueEx_Str) | Download: |
'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-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
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