Funktionsaufruf in Classic Visual Basic

 

 

'************************************************************************

'*    Beispiel eines GeoDLL-Funktionsaufrufs in Classic Visual Basic    *

'*  zum Ermitteln eines zurückgegebenen Strings anhand dessen Pointer.  *

'*                                                                      *

'* Achtung: Bei VB.net weichen die Deklarationen von diesem Beispiel ab!*

'*                      Siehe Beispiel VB.net                          *'

 *                                                                      *

'* Einige Funktionen der 32 Bit Dynamic Link Library GeoDLL geben einen *

'* String als Referenz auf dessen Pointer (Zeiger auf den String im     *

'* Speicherbereich) zurück. Mit der VB-Funktion GetStringFromPointer()  *

'* läßt sich der String anhand des Pointers aus dem Speicherbereich     *

'* ermitteln. Das Beispiel kann direkt in den VB-Quellcode eingebaut    *

'* werden.                                                              *

'*                                                                      *

'* Die hier vorgestellte Funktion funktioniert nur mit 32Bit-           *

'* Architektur. Bei 64Bit-Architektur müssen die API-Funktionen         *

'* angepaßt werden.                                                     *

'*                                                                      *

'* Autoren:                                                             *

'* Dipl.-Ing. Fred Killet, Killet GeoSoftware Ing.-GbR                  *

'* Dipl.-Ing. Klaus-Jochen Sympher, Dr.-Ing. Pecher und Partner GmbH    *

'* Dieter Otter, Tools & Components, www.vbarchiv.net                   *

'*                                                                      *

'* Für das Beispiel müssen im Aufrufverzeichnis der GeoDLL die Dateien  *

'* geodll32.dll und geodllbn.bin vorhanden sein.                        *

'*                                                                      *

'* Es sind zahlreiche Änderungen durchgeführt worden. Leider hatten wir *

'* nicht die Möglichkeit zu compilieren. Bei eventuell noch enthaltenen *

'* Syntaxfehlern bittet Herr Killet um Mitteilung!                      *

'************************************************************************

 

 

'Benötigte API-Funktionen für Classic Visual Basic deklarieren

Private Declare Function lstrcopy Lib "kernel32" _

  Alias "lstrcpyA" ( _

  ByVal lpString1 As String, _

  ByVal lpString2 As Long) As Long

 

'Hinweis: Diese abweichende Deklaration für VB.net:

'Private Declare Function lstrcopy Lib "kernel32" _

'  Alias "lstrcpyA" ( _

'  ByVal lpString1 As String, _

'  ByVal lpString2 As Integer) As Integer

 

Private Declare Function lstrlen Lib "kernel32" _

  Alias "lstrlenA" ( _

  ByVal lpString As Long) As Long

 

 

'String anhand String-Pointer aus dem Speicher auslesen und zurückgeben.

Public Function GetStringFromPointer _

  (ByVal lpStrPointer As Long) As String

 

  Dim nLen As Long

  Dim sBuffer As String

 

  'Länge des Strings

  nLen = lstrlen(lpStrPointer)

 

  'Buffer mit der benötigten Größe

  sBuffer = Space$(nLen)

 

  'String aus Speicheradresse auslesen

  lstrcopy sBuffer, lpStrPointer

  If InStr(sBuffer, vbNullChar) > 0 Then

    sBuffer = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)

  End If

 

  'String zurückgeben

  GetStringFromPointer = sBuffer

End Function

 

 

'GeoDLL-Funktion deklarieren

Public Declare Function getdllversion Lib "GeoDLL32( _

  ByRef lngVersion as Long) as Integer

 

 

'Hier wird beispielhaft der aus GeoDLL zurückgegebene String mit

'der Versionsnummer der GeoDLL ermittelt

Sub meineAnwendungMitGeoDLL32()

 

Dim lngVersion as Long     'der Pointer des Strings

Dim strVersion as String   'der String selbst

 

 

'GeoDLL schreibt seine Versionsnummer als String in den Speicher

'und gibt die Stringposition als Pointer zurück

rc = getdllversion(lngVersion)

 

'String mit Hilfe des Pointers ermitteln

'Das ergibt z.B. "12.03 C++"

strVersion = getStringFromPointer(lngVersion)

 

 

End sub