Deklaration: Declare Function DdeInitialize Lib "user32" _ Alias "DdeInitializeA" ( _ pidInst As Long, _ ByVal pfnCallback As Long, _ ByVal afCmd As Long, _ ByVal ulRes As Long) As Integer Beschreibung: Parameter:
Rückgabewert: Rückgabekonstanten: Const DMLERR_NO_ERROR = 0 ' Funktion war erfolgreich Const DMLERR_DLL_USAGE = &H4004 ' Funktion war nicht erfolgreich, die DDE wurde als APPCLASS_MONITOR ' eingerichtet, will aber DDE Nachrichten senden / empfangen Const DMLERR_INVALIDPARAMETER = &H4006 ' Funktion war nicht erfolgreich, ungültige Parameter wurden übergeben Const DMLERR_SYS_ERROR = &H400F ' Beispiel: ' Schreiben Sie diesen Code in ein öffentliches Modul Private Declare Function DdeQueryString Lib "user32" _ Alias "DdeQueryStringA" ( _ ByVal idInst As Long, _ ByVal hsz As Long, _ ByVal psz As String, _ ByVal cchMax As Long, _ ByVal iCodePage As Long) As Long ' DdeQueryString iCodePage-Konstanten Private Const CP_WINANSI = 1004 ' (Standard) ANSI Zeichensatz Private Const CP_WINUNICODE = 1200 ' Unicode Zeichensatz ' Callback uType-Konstanten Private Const XTYP_CONNECT = (&H60 Or XCLASS_BOOL Or XTYPF_NOBLOCK) ' Ein Client will sich verbinden Public hInst As Long, hService As Long, hTopic As Long, hConv As Long Public Function DDECallback(ByVal wType As Long, ByVal wFmt As Long, ByVal _ h_Conv As Long, ByVal h_Topic As Long, ByVal h_Service As Long, ByVal hData _ As Long, ByVal lData1 As Long, ByVal lData2 As Long) As Long Dim hInstCount As Long, TmpBuffer As String, BuffeLength As Long, _ Retval As Long, hWnd2ndInstance As Long Select Case wType Case XTYP_CONNECT ' Eine Anwendung unseres Typs verbindet sich mit der DDE ' Ermitteln des Servicenamens des anfragenden Clients BuffeLength = DdeQueryString(hInst, h_Service, TmpBuffer, 0&, CP_WINANSI) TmpBuffer = Space(BuffeLength + 1) Retval = DdeQueryString(hInst, h_Service, TmpBuffer, _ Len(TmpBuffer), CP_WINANSI) TmpBuffer = Left$(TmpBuffer, BuffeLength) ' Falls es ein Client unseres Typs ist, dann unser wieder Fenster anzeigen If TmpBuffer = "VB Api Helpline" Then MsgBox "Es wurde der Start einer weiteren Instanz _ ermittelt.", , "Instanz ID: " & hInst Form1.Show DDECallback = 1 ' Anfrage bestätigen, dass ein DDE-Server vorhanden ist End If End Select End Function ' Schreiben Sie den nachfolgenden Code in eine Form Private Declare Function DdeInitialize Lib "user32" _ Alias "DdeInitializeA" ( _ pidInst As Long, _ ByVal pfnCallback As Long, _ ByVal afCmd As Long, _ ByVal ulRes As Long) As Integer Private Declare Function DdeUninitialize Lib "user32" ( _ ByVal idInst As Long) As Long Private Declare Function DdeNameService Lib "user32" ( _ ByVal idInst As Long, _ ByVal hsz1 As Long, _ ByVal hsz2 As Long, _ ByVal afCmd As Long) As Long Private Declare Function DdeCreateStringHandle Lib "user32" _ Alias "DdeCreateStringHandleA" ( _ ByVal idInst As Long, _ ByVal psz As String, _ ByVal iCodePage As Long) As Long Private Declare Function DdeConnect Lib "user32" ( _ ByVal idInst As Long, _ ByVal hszService As Long, _ ByVal hszTopic As Long, _ pCC As Any) As Long Private Declare Function DdeFreeStringHandle Lib "user32" ( _ ByVal idInst As Long, _ ByVal hsz As Long) As Long ' DdeCreateStringHandle iCodePage-Konstanten Private Const CP_WINANSI = 1004 ' (Standard) ANSI Zeichensatz Private Const CP_WINUNICODE = 1200 ' Unicode Zeichensatz ' DdeNameService afCmd-Konstanten Private Const DNS_REGISTER = &H1 ' Registriert einen Fehlercode Private Const DNS_UNREGISTER = &H2 ' Deregistriert einen DDE-Server ' DdeInitialize afCmd-Konstanten Private Const APPCLASS_STANDARD = &H0& ' Richtet das Programm als Standard-DDE-Anwendung ein ' DDE-Server starten Private Sub Form_Load() Dim Retval As Long ' DDE initialisieren, nur die CBF_CONNECTIONS soll empfangen werden Retval = DdeInitialize(hInst, AddressOf DDECallback, _ APPCLASS_STANDARD, 0&) If Retval << 0 Then Exit Sub End If ' 2 eindeutige Strings erstellen die unsere Anwendung beschreiben hService = DdeCreateStringHandle(hInst, "VB Api Helpline", CP_WINANSI) hTopic = DdeCreateStringHandle(hInst, "www.vbapihelpline.de", CP_WINANSI) ' Verbinden mit der DDE, und auf Vorhandensein eines Servers testen hConv = DdeConnect(hInst, hService, hTopic, ByVal 0&) If hConv << 0 Then MsgBox "Es besteht bereits eine Instanz, Porgramm wird beendet", _ , "Instanz ID: " & hInst Unload Me Else ' Server starten falls noch keiner existiert Retval = DdeNameService(hInst, hService, 0&, DNS_REGISTER) End If End Sub ' DDE-Sitzung beenden Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ' Beenden des Nachrichtenempfangs Call DdeNameService(hInst, hService, 0&, DNS_UNREGISTER) ' Strings auflösen Call DdeFreeStringHandle(hInst, hService) Call DdeFreeStringHandle(hInst, hTopic) ' Beenden der DDE-Sitzung Call DdeUninitialize(hInst) End Sub ' Fenster zum Testen der 2ten Instanz verstecken lassen Private Sub Command1_Click() Me.Hide End Sub Diese Seite wurde bereits 7.806 mal aufgerufen. |
Neu! sevPopUp 2.0 Dynamische Kontextmenüs! Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... Buchempfehlung Tipp des Monats Mai 2024 Hermann Röttger Wochentage eines Datumsbereichs ermitteln Wochentage eines Datumsbereichs ermitteln, optional mit Feiertagsberechnung Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |