How to load a freebasic DLL with o2

Started by Frank Brübach, June 22, 2024, 02:11:53 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Frank Brübach

Hello Charles..

Do you have any examples how to load an external freebasic DLL file with oxygen?

Freebasic


' file: batman32.bas
' compile as: fbc -dll batman32.bas
#include once "Batman32.bi"

function HelloBatman(ByVal s As string) as String Export
    return "HelloBatman "+s
End function

This compiling with freebasic produces a batman32.dll File and all OK Here

But how to load the dll to oxygen with using the function ?

Batman32.bi File
' batman32.bi
declare function HelloBatman Alias "HelloBatman"(ByVal s As String) as String

Last Not least Test File
Freebasic
' test-batman32.bas file to test Batman32.dll
'
#include "batman32.bi"
#inclib "batman32"

Dim s As String
s="World!"

print HelloBatman(s) ' result HelloBatman World

Print "ok"
sleep

Charles Pegge

#1
Hi Frank,

I have not used Freebasic since 2017 so I refer to my experiebce with eatlier O2 compilations.

First make sure your FreeBasic DLL declarations do not produce C-mangled names

Second, FreeBasic strings are not the same as OxygenBasic strings so you need to use a compatible type: zstring ptr / char ptr

' batman32.bi
  #ifdef OS_MS
    extern "Windows-MS"
  #else
    extern "C"
  #endif
' file: batman32.bas
' compile as: fbc -dll batman32.bas

'#include once "Batman32.bi"
declare function HelloBatman Alias "HelloBatman"(ByVal s As zString ptr) as zString ptr

function HelloBatman(ByVal s As zstring ptr) as zstring ptr Export
    return "HelloBatman "+s
End function

end extern

OxygenBasic client

extern lib "batman32.dll"
declare function HelloBatman (char*) as char*
end extern

char s[]="World!"

print HelloBatman(s) ' result HelloBatman World

Print "ok"

Frank Brübach

#2
Hello Charles..

Perhaps you can Check my Code example If you are seeing a mistake on my Side.. I know its long time ago you have worked with freebasic :-)  from my Side example must Work but I have Got an Error "Missing or unloadable Hello Batman"...
Thanks frank
'
uses console

' file: batman32.bas
' compile as: fbc -dll batman32.bas

' freebasic ------------------- >
'#include once "Batman32.bi"
'declare function HelloBatman Alias "HelloBatman"(ByVal s As zString ptr) as zString ptr

'function HelloBatman(ByVal s As zstring ptr) as zstring ptr Export
'    return "HelloBatman "+s
'End function

'end extern
'' ------------------- > freebasic ends
'
' oxygen

  #ifdef OS_MS
    extern "Windows-MS"
  #else
    extern "C"
  #endif

print "ok "

extern lib "batman32.dll"

declare function HelloBatman lib "batman32.dll" (s as zstring ptr) as zstring ptr

print " ok2 "
'declare function HelloBatman (s as zstring ptr) as zstring ptr
'declare function HelloBatman lib "batman32.dll" alias "HelloBatman" (byref s as zstring ptr) as zstring ptr
end extern


zstring s[]="World!"
'sys psz=strptr s
'print cast zstring HelloBatman *s ' result HelloBatman World

'--------------------- // problem
print HelloBatman s[] ' doesnt work error, missing or unloadable HelloBatman
'--------------------- // problem

'print s[] ' ok

Print " ok3 "

wait

Charles Pegge

#3
I think this should go at the start of the FB DLL, not o2

  #ifdef OS_MS
    extern "Windows-MS"
  #else
    extern "C"
  #endif


Frank Brübach

#4
No Chance doesn't Work at all dont know why from my Side all is doing correct Here

Tried also with zstring ptr, then extern stdcall  lib "batman32.dll."  and much more.. after two hours to find a solution I give Up this construct

Freebasic Side is OK so far tested all.. thx

Charles Pegge

#5
Looking through Oxygen.bas (inc\OXFBC\):

You could try adding this to your DLL:

'---------------------
sub ctor() constructor
'=====================
    'print "attach"
end sub


'--------------------
sub dtor() destructor
'====================
    'print "detach"
end sub

end extern

Frank Brübach

#6
Yes.. I have Got it :-)

The Problem lies in extern...  End extern in for example "mydll4.bas" file

And in this File you must Take the end extern below all other Code..

Need almost three hours to find this little Trick

Oxygen example Works Here fine now.. took another freebasic File AS a Test

Oxygen Test File

'
uses console


print "ok "

extern stdcall lib "mydll4.dll"

declare function AddNumbers lib "mydll4.dll"( byval a as integer, byval b as integer ) as integer

end extern

dim x as integer
dim y as integer

x=10
y=20

print AddNumbers (x,y) ' 30 -> yes!! work here

Print " ok2 "

wait


Freebasic Side: mydll4.bas File

'' freebasic mydll4.bas
' Compile AS: fbc -dll mydll4.bas
''
''#Include once "windows.bi"

'Extern "Windows-MS"
#Include Once "windows.bi"
  #Ifdef OS_MS
    extern "Windows-MS"
  #Else
    extern "C"
  #endif
 
'---------------------
Sub ctor() constructor
'=====================
    Print "attach"
End sub


'--------------------
Sub dtor() destructor
'====================
    print "detach"
end sub

'end extern ' must be at the end of code example ! :-)

#Include once "mydll4.bi"

'' simple exported function, the full prototype is in mydll.bi.
'' (the EXPORT clause must be used here)
function AddNumbers( byval a as integer, byval b as integer) as integer export
function = a + b
end function
End extern

Frank Brübach

Forgotten mydll4.bi File

'' mydll4.bi
''
declare function AddNumbers alias "AddNumbers"( byval a as integer, byval b as integer ) as integer

Charles Pegge

#8
I downloaded FB and looked at their DLL example:

extern "Windows-MS"
This prevents dll function names from being mangled in freebasic
"AddNumbers@8" becomes "AddNumbers"
This is required in general when using MS platforms and their DLLs

freebasuc mydll.bas
extern "Windows-MS"
#include once "mydll.bi"

'' simple exported function, the full prototype is in mydll.bi.
'' (the EXPORT clause must be used here)
function AddNumbers( byval a as integer, byval b as integer) as integer export
    function = a + b
end function
end extern

freebasic test.bas
xtern "Windows-MS"
#inclib "mydll"
#include "mydll.bi"
end extern


randomize( timer( ) )

dim as integer x = rnd( ) * 10
dim as integer y = rnd( ) * 10

print x; " +"; y; " ="; AddNumbers( x, y )


Oxygen test.bas
extern lib "mydll.dll"
include "myDLL.bi"
end extern

print AddNumbers( 2, 3 ) cr


Frank Brübach

#9
Hello Charles, Made another example for Testing with a Screen depth Test

Oxygen Test File:

' test: depth3dll.bas for oxygen basic
' 24-12-2024, frank bruebach
'
uses console

mbox "push return for next screen"

print "ok "

extern stdcall lib "depth3dll.dll"

declare function depth3 lib "depth3dll.dll"( byval a as integer, byval b as integer ) as integer

end extern


depth3(1,1) ' only a test, doesn't matter if I am using a function or a sub. it's working :-)

Print " ok2 "

print "push a key to exit"
wait



Depth3.bi File

'depth3.bi
Declare function depth3 Alias "depth3" (ByVal x AS Integer,ByVal y As Integer) AS INTEGER


Frank Brübach

Here the depth3dll.bas File (freebasic)

' test depth3dll.bas
'
#Include Once "windows.bi"
  #Ifdef OS_MS
    extern "Windows-MS"
  #Else
    extern "C"
  #endif
 
'---------------------
Sub ctor() constructor
'=====================
    Print "attach"
End sub

'--------------------
Sub dtor() destructor
'====================
    print "detach"
end sub

#Include once "depth3.bi"

Function depth3(ByVal x As integer, ByVal y As integer) As Integer export
DIM key AS STRING, driver AS STRING
DIM AS INTEGER i, j, w, h, d, rate
DIM depth(3) AS INTEGER

depth(0) = 8
depth(1) = 16
depth(2) = 32

For i = 0 to 2
SCREEN 16, depth(i) '14
SCREENINFO w, h, d,,,rate, driver
LINE(0,0)-(w-1,h-1),IIF(i = 0, 40, CINT(RGB(255, 0, 0))),B
LOCATE 2,2: PRINT "Mode: " + STR(w) + "x" + STR(h) + "x" + STR(d);
IF (rate > 0) THEN
PRINT " @ " + STR(rate) + " Hz";
END IF
PRINT " (" + driver + ")"
IF (i = 0) THEN
FOR j = 0 TO 255: LINE(32+j, 100)-(32+j, 139), j : NEXT
ELSE
FOR j = 0 TO 255
LINE(32+j, 40)-(32+j, 79), j SHL 16
LINE(32+j, 100)-(32+j, 139), j SHL 8
LINE(32+j, 160)-(32+j, 199), j
NEXT
END IF
key = INKEY
WHILE key = "": key = INKEY: WEND
IF key = CHR(255) + "k" THEN END
NEXT i
Function = 1
End Function
End Extern
' ends
'depth2(1,1)

Frank Brübach

#11
Good morning...

i have tested to load cWindow and afx headers from Jose Roca. Made a Test with freebasic AS a function and then build a DLL in freebasic. After that I load the fcWindmainDll.dll to oxygen.. IT Works :-)

oxygen test File


' test: cWind.bas for oxygen basic
' -> just a first test for cWindow Class (Afx) from jose roca
'
' 24+25-12-2024, frank bruebach
'
uses console

print "ok "

extern stdcall lib "fcWindowdll.dll"

declare function fWindMain lib "fcWindowdll.dll"(ByVal hInstance As sys, ByVal hPrevInstance AS sys,BYVAL szCmdLine AS ZSTRING Ptr,BYVAL nCmdShow AS Long ) As LONG
declare function fWndProc lib "fcWindowdll.dll"(BYVAL hWnd AS sys, BYVAL uMsg AS INT, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG 'LRESULT
end extern

sys command
fWindMain(1, 1, COMMAND, 1) 'calls only the fWindMain function

Print " ok2 "

print "push a key to exit"
wait


Frank Brübach

#12
Freebasic Side:

Creates a cWindow DLL File. I gave this File another Name fcWindowDll.bas for Testing purpose.

fcWindowDll.bas

' test fcWindowDll.bas / creates one .dll
' compile as: fbc -dll -> fcWindowDll.bas
' 24+25-12-2024, frank bruebach for translation to oxygenbasic
'
#Define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx

  #Include Once "windows.bi"
  #Ifdef OS_MS
    extern "Windows-MS"
  #Else
    extern "C"
  #endif
 
'---------------------
Sub ctor() constructor
'=====================
    Print "attach"
End sub

'--------------------
Sub dtor() destructor
'====================
    print "detach"
end sub

#Include once "cWind.bi"

'
Function fWindMain(ByVal hInstance As HINSTANCE, ByVal hPrevInstance AS HINSTANCE,BYVAL szCmdLine AS ZSTRING Ptr,BYVAL nCmdShow AS Long ) As LONG 'export

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   ' // Create the main window
   DIM pWindow AS CWindow
   'pWindow.Create(NULL, "CWindow Hello World with gradient", @fWndProc)   
   pWindow.Create(NULL, "CWindow Hello World with gradient", Cast(WndProc, @fWndProc) )
   
   pWindow.Brush = GetStockObject(WHITE_BRUSH)
   pWindow.SetClientSize(600, 420)
   pWindow.Center
   ' // Adds a button
   pWindow.AddControl("Button", , IDCANCEL, "&Close", 350, 250, 75, 23)


   ' // Display the window
   FUNCTION = pWindow.DoEvents(nCmdShow)
   
End Function

'
Sub DrawGradient (BYVAL hwnd AS HWND, BYVAL hDC AS HDC)

   DIM rc AS RECT, vertex(1) AS TRIVERTEX

   GetClientRect hwnd, @rc

   vertex(0).x      = 0
   vertex(0).y      = 0
   vertex(0).Red    = &hFF00
   vertex(0).Green  = &hFF00
   vertex(0).Blue   = &h0000
   vertex(0).Alpha  = &h0000

   vertex(1).x      = rc.Right - rc.Left
   vertex(1).y      = rc.Bottom - rc.Top
   vertex(1).Red    = &h8000
   vertex(1).Green  = &h0000
   vertex(1).Blue   = &h0000
   vertex(1).Alpha  = &h0000

   DIM gRect AS GRADIENT_RECT
   gRect.UpperLeft  = 0
   gRect.LowerRight = 1

   GradientFill hDc, @vertex(0), 2, @gRect, 1, GRADIENT_FILL_RECT_H

END SUB

'
FUNCTION fWndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT EXPORT

   STATIC hNewFont AS HFONT

   SELECT CASE uMsg

      CASE WM_CREATE
         ' // Get a pointer to the CWindow class from the CREATESTRUCT structure
         DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
         ' // Create a new font scaled according the DPI ratio
         IF pWindow->DPI <> 96 THEN hNewFont = pWindow->CreateFont("Tahoma", 9)
         EXIT FUNCTION

      CASE WM_COMMAND
         SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_PAINT
         ' // Draw the text
         DIM ps AS PAINTSTRUCT, hOldFont AS HFONT
         DIM hDC AS HDC = BeginPaint(hwnd, @ps)
         DrawGradient hwnd, hdc
         IF hNewFont THEN hOldFont = CAST(HFONT, SelectObject(hDC, CAST(HGDIOBJ, hNewFont)))
         DIM rc AS RECT
         GetClientRect hwnd, @rc
         SetBkMode hDC, TRANSPARENT
         SetTextColor hDC, &HFFFFFF
         DrawTextW hDC, "Hello, Freebasic and OxygenBasic World!", -1, @rc, DT_SINGLELINE OR DT_CENTER OR DT_VCENTER
         IF hNewFont THEN SelectObject(hDC, CAST(HGDIOBJ, CAST(HFONT, hOldFont)))
         EndPaint hwnd, @ps
         FUNCTION = CTRUE
         EXIT FUNCTION

      CASE WM_ERASEBKGND
         ' // Draw the gradient
         DIM hDC AS HDC = CAST(HDC, wParam)
         DrawGradient hwnd, hDC
         FUNCTION = CTRUE
         EXIT FUNCTION
      Case WM_SIZE
         ' // Optional resizing code
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Retrieve a pointer to the CWindow class
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            ' // Move the position of the button
            IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), _
               pWindow->ClientWidth - 120, pWindow->ClientHeight - 50, 75, 23, CTRUE
         END IF

    CASE WM_DESTROY
         ' // Destroy the new font
         IF hNewFont THEN DeleteObject(CAST(HGDIOBJ, hNewFont))
         ' // End the application by sending an WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================
End Extern

' important for display cWindow frame here
END fWindMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' ends

The cwind.bi File

'cWind.bi

Declare Function fWindMain Alias "fWindMain"(ByVal hInstance As HINSTANCE, ByVal hPrevInstance AS HINSTANCE,BYVAL szCmdLine AS ZSTRING Ptr,BYVAL nCmdShow AS Long ) As LONG
Declare Function fWndProc Alias "fWndProc"(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

Frank Brübach

#13
Freebasic Side:
To Control if the fcWindowDll.dll is working correct I Made this example with dylib

''
''
#Include Once "windows.bi"

dim library as any ptr
Dim hwnd As HWND

Dim fWindMain As Function (ByVal hInstance As hwnd, ByVal hPrevInstance AS hwnd,BYVAL szCmdLine AS ZSTRING Ptr,BYVAL nCmdShow AS Long ) As LONG 'export

library = dylibload( "fcwindowDll.dll" )
if( library = 0 ) then
print "Cannot load the fcwindowDll dynamic library"
sleep
end 1
end if

fWindMain = dylibsymbol( library, "fWindMain" )
if( fWindMain = 0 ) then
print "Could not get fWindMain()'s address from fWindMain library"
end 1
end if

Dim as HWND x
dim as HWND y
Dim As Long b
Dim w As ZString Ptr

fWindMain( x,y,w,b )
'Print "push a key to exit"

dylibfree library
Print "ends"
sleep

After this succesfully Test I load fcWindiw.dll to oxygen Basic. And thats working!  :-)