Purebasic DLL - Direkte Rückgabe eines String n. VB6/VB.NET

[mk-soft]

Bastel gerade eine DLL für mein Kollege der VB6 verwendet.
Die Funktionen sollen aber ein String zurück geben um mit VB einfacher damit arbeiten zu können.

Eine vorherige Umwandlung nach BSTR(Unicode) ist nicht erforderlich, da dieses von VB selber durchgeführt wird.

Beispielcode PB-DLL (vbTest.dll)

Code: Alles auswählen

; Comment     : DLL with vbString as Result
; Author      : mk-soft
; Version     : v1.1
; Date        : 2007.11.21

Structure vbString
  len.l
  text.s
EndStructure

; *************************************************************************************

; This procedure is called once, when the program loads the library
; for the first time. All init stuffs can be done here (but not DirectX init)
;
ProcedureDLL AttachProcess(Instance)
EndProcedure


; Called when the program release (free) the DLL
;
ProcedureDLL DetachProcess(Instance)
EndProcedure


; Both are called when a thread in a program call or release (free) the DLL
;
ProcedureDLL AttachThread(Instance)
EndProcedure

ProcedureDLL DetachThread(Instance)
EndProcedure

; *************************************************************************************


ProcedureDLL concat(text1.s, text2.s)

 Static vbResult.vbString
 
 With vbResult
  \text = text1 + text2
  \len = Len(\text)
 EndWith
 
 ProcedureReturn @vbResult\text
  
EndProcedure

VB.NET MainForm (Ein Button)

Code: Alles auswählen

Public Class MainForm

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim ret As String

        ret = concat("Hallo Welt", " ;)")
        ret = ret & concat(Chr(10), "Direkte Rückgabe eines Strings")
        MsgBox(ret)

    End Sub
End Class

VB.NET Modul1

Code: Alles auswählen

Module Module1

    Declare Ansi Function concat Lib "d:\daten\purebasic4\vbdll\vbTest.dll" (ByVal text1 As String, ByVal text2 As String) As String

End Module

Bei VB6 reicht

Code: Alles auswählen

Declare Function concat Lib "vbTest.dll" (ByVal text1 As String, ByVal text2 As String) As String

wenn die DLL im gleichen Verzeichnis liegt.

Viel freude beim programmieren

FF

[dysti]

@mk-soft,
toll, kann ich gerade gut gebrauchen.

[Kiffi]

auch ein großes Dankeschön von mir!


Grüße ... Kiffi

[NicTheQuick]

Mich wundert's, dass in der VB-Deklaration für 'concat' die Strings als ByVal
anstatt ByRef übergeben werden. Wie sieht das denn intern aus?

[mk-soft]

Bei "ByVal xyz As String" wird der Zeiger auf den String übergeben.
Stringvariablen sind immer Zeiger auf den String.

Bei "ByRef xyz As String" wird ein Zeiger auf den Zeiger von den String übergeben.
Also müsste man erste den Zeiger auslesen und dann den String auslesen.
Siehe concat2(...)

Code: Alles auswählen

ProcedureDLL concat(text1.s, text2.s)

 Static vbResult.vbString
 
 With vbResult
  \text = text1 + text2
  \len = Len(\text)
 EndWith
 
 ProcedureReturn @vbResult\text
 
EndProcedure

ProcedureDLL concat2(*text1, *text2)

 Static vbResult.vbString
 
 With vbResult
  \text = PeekS(PeekL(*text1)) + PeekS(PeekL(*text2))
  \len = Len(\text)
 EndWith
 
 ProcedureReturn @vbResult\text
 
EndProcedure

Nachtrag:
Mit ByRef kann man verschiedene Werte auch zurückgeben. Beispiel Kreisfunktion.
PB-Code

Code: Alles auswählen

; Comment     : DLL with vbString as Result
; Author      : mk-soft
; Version     : v1.1
; Date        : 2007.11.21

Structure vbString
  len.l
  text.s
EndStructure

; *************************************************************************************

; This procedure is called once, when the program loads the library
; for the first time. All init stuffs can be done here (but not DirectX init)
;
ProcedureDLL AttachProcess(Instance)
EndProcedure


; Called when the program release (free) the DLL
;
ProcedureDLL DetachProcess(Instance)
EndProcedure


; Both are called when a thread in a program call or release (free) the DLL
;
ProcedureDLL AttachThread(Instance)
EndProcedure

ProcedureDLL DetachThread(Instance)
EndProcedure

; *************************************************************************************

ProcedureDLL concat(text1.s, text2.s)

 Static vbResult.vbString
 
 With vbResult
  \text = text1 + text2
  \len = Len(\text)
 EndWith
 
 ProcedureReturn @vbResult\text
 
EndProcedure

; *************************************************************************************

ProcedureDLL concat2(*text1, *text2)

 Static vbResult.vbString
 
 With vbResult
  \text = PeekS(PeekL(*text1)) + PeekS(PeekL(*text2))
  \len = Len(\text)
 EndWith
 
 ProcedureReturn @vbResult\text
 
EndProcedure

; *************************************************************************************

ProcedureDLL Kreis(winkel.f, *sinus, *cosinus, *tangen)

  Protected rad.d, result.d
  
  rad = winkel / 180.0 * #PI
  
  If *sinus
    result = Sin(rad)
    PokeD(*sinus, result)
  EndIf
  
  If *cosinus
    result = Cos(rad)
    PokeD(*cosinus, result)
  EndIf
  
  If *tangen
    result = Tan(rad)
    PokeD(*tangen, result)
  EndIf
  
  ProcedureReturn 1

EndProcedure
; *************************************************************************************

Module1

Code: Alles auswählen

Module Module1

    Declare Ansi Function concat Lib "D:\Home\Michael\Eigene Dateien\Visual Studio 2005\Projects\WindowsApplication1\vbTest.dll" (ByVal text1 As String, ByVal text2 As String) As String
    Declare Ansi Function concat2 Lib "D:\Home\Michael\Eigene Dateien\Visual Studio 2005\Projects\WindowsApplication1\vbTest.dll" (ByRef text1 As String, ByRef text2 As String) As String
    Declare Ansi Function Kreis Lib "D:\Home\Michael\Eigene Dateien\Visual Studio 2005\Projects\WindowsApplication1\vbTest.dll" (ByVal winkel As Single, ByRef sinus As Double, ByRef cosinus As Double, ByRef tangen As Double) As Long

End Module

Class

Code: Alles auswählen

Public Class Form1

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim ret, ret1, ret2 As String

        ret1 = concat2("Hallo ", "Welt")
        ret2 = concat(Chr(10), "Ok!")
        ret = ret1 & ret2
        MsgBox(ret & "(" & Len(ret) & ")")

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        Dim winkel As Single
        Dim sinus, cosinus, tangen As Double
        Dim ausgabe As String

        winkel = 90.0
        Kreis(winkel, sinus, cosinus, tangen)

        ausgabe = "Winkel: " & winkel & Chr(10)
        ausgabe = ausgabe & "Sinus: " & Math.Round(sinus, 2) & Chr(10)
        ausgabe = ausgabe & "Cosinus: " & Math.Round(cosinus, 2) & Chr(10)
        ausgabe = ausgabe & "Tangen: " & Math.Round(tangen, 2) & Chr(10)

        MsgBox(ausgabe)

    End Sub
End Class

[ls9090]

Sali,

hab es nur so mit deinem obigen Beispiel zum Laufen gebracht:

Code in VB Modul:

Code: Alles auswählen

Declare Function concat Lib "d:\temp\vbTest.dll" (ByVal text1 As String, ByVal text2 As String) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpDest As Long, ByVal lpSource As Long, ByVal nBytes As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long

Public Function GetStringFromPointer(ByVal lpString As Long) As String

   Dim lngLength As Long, strBuffer As String

lngLength = lstrlen(lpString) 'get length of string (in chars)

strBuffer = Space$(lngLength) 'make a buffer to copy to
 CopyMemory StrPtr(strBuffer), lpString, lngLength * 2 'copy the string (note that this is a unicode string, so really there are 2 bytes per char

GetStringFromPointer = strBuffer 'return the copied string

End Function

Code in VB-Form:

Code: Alles auswählen

MsgBox StrConv(GetStringFromPointer(concat("Hallo ", " Welt")), vbUnicode)

Ohne das hab ich einen Absturz gehabt. Hoffe das hilft den anderen, die dasselbe Problem gehabt haben.

Gruss,

ls9090

[kwai chang caine]

Hello at all

Excuse me, for disturb you
I know you want speak deutch on the deutch forum
But i'm french, and don't speak deutch
I don't speak english very good too

And i not try the google translator, because it's worse for you to understand me...i have unfortunately try this option they are several month ago

But i have see this very interesting topic, for passing string VB in DLL.

I'm better programmer like i speak deutch...
So for create this code, i works nearly a month, with the help of kind members of english and french forum.
At the beginning, i want too pass dynamical array of string, can add lines, delete lines, modify lines and return the array modified...but for me it's very hard, to manage the array of pointers

But now, my code works....
It passing a VB and PB array dynamical string in DLL, modify the array (Replace five first "Sentence" word to "KCC"), add 2 lines, and return in the VB or PB exe
The second time, it reverse the function (Replace five first "KCC" word to "Sentence"), and always add 2 lines, and return in the VB or PB exe

I have several problems to create this code...but the last is to detect, if it's VB exe or PB exe who call the DLL ???
Because, if it's VB, i must use PeekS(UNICODE), other I must use Peeks(ASCII) in the DLL
I have try the API "IsTextUnicode" but that's don't works fine with me

So i have use a personal tips
In VB, TRUE = -1 and i multiply the value of arraysize with true, and test in the DLL, if the value it's negative it's VB call, if not it's PB call

If you have a beter way for detect if array is UNICODE or ASCII, i'm interesting
ATTENTION...i don't want compile the DLL in UNICODE mode, please

I use only VB6 and not use VB.NET

Please, if you have a little bit of time, can you try it, and correct it, if i have create error.
Your opinion is important for me..because i use this code several hundred of time, and it is the heart of my DLL.
So i want to be sure, that it's a good way for do that

In the ZIP, you have the caller of DLL PB, the caller of DLL VB, The exe VB caller of DLL, the EXCEL file caller of DLL, and obiously the code and the DLL

http://erdsjb.free.fr/PureStorage/DeutchForum.zip

Thanks a lot to your understanding
I wish you a good day