#define fbc -s console -dll
#include "windows.bi"

dim shared as integer iInit,iConstructor,iFreeConsole

sub InternalBegin() constructor
  iConstructor = 1
  iFreeConsole = AllocConsole()
  if iFreeConsole then
    color 10: print "I'm a constructor! (and i created a console)": color 7
  else
    color 10: print "I'm a constructor! (and you have a console :D)": color 7
  end if
    
end sub
sub InternalEnd() destructor
  if iConstructor = 0 then
    Messagebox(null,"DESTRUCTOR CALLED WITHOUT THE CONSTRUCTOR BEING CALLED FIRST","Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
  end if
  iConstructor=0  
  color 10: print "I'm a destructor.": color 7
  Messagebox(null,"DLL will unload now... Bye! o/","Test DLL",MB_ICONINFORMATION or MB_SYSTEMMODAL)
  if iFreeConsole then FreeConsole()
end sub

'-----------------------------
' void DoInit(void)
'-----------------------------
sub DoInit cdecl alias "DoInit" () export
  if iInit=0 then
    iInit = 1
    color 11: print "Initialization function called...": color 7
    if iConstructor=0 then
      Messagebox(null,"CONSTRUCTOR WAS NOT CALLED WHEN DLL WAS LOADED","Test DLL",MB_ICONWARNING or MB_SYSTEMMODAL)
    end if
  else
    Messagebox(null,"YOU INITIALIZED ME TWICE!","Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
  end if
end sub

'-----------------------------
' int SumIntInt(int A, int B) 
'-----------------------------
function SumIntInt cdecl alias "SumIntInt" (A as integer,B as integer) as integer export
  color 11: print "{SumIntInt} function called...": color 7
  if iInit=0 then
    Messagebox(null,"Function SumIntInt was called without initializing first...", _
    "Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
  end if    
  Messagebox(null,"SumIntInt: " & A & " + " & B & " = " & A+B,"Test DLL",MB_SYSTEMMODAL)
  return A+B
end function

'--------------------------------------------
' double SumDoubleDouble(double A, double B) 
'--------------------------------------------
function SumDoubleDouble cdecl alias "SumDoubleDouble" (A as double,B as double) as double export
  color 11: print "{SumDoubleDouble} function called...": color 7
  if iInit=0 then
    Messagebox(null,"Function SumDoubleDouble was called without initializing first...", _
    "Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
  end if    
  Messagebox(null,"SumDoubleDouble: " & A & " + " & B & " = " & A+B,"Test DLL",MB_SYSTEMMODAL)
  return A+B
end function

'--------------------------
' void MsgBox(char * zMsg) 
'--------------------------
sub MsgBox cdecl alias "MsgBox" (zMsg as zstring ptr) export
  color 11: print "{MsgBox} function called...": color 7
  if iInit=0 then
    Messagebox(null,"Function MsgBox was called without initializing first...", _
    "Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
  end if  
  Messagebox(null,"MsgBox '" & *zMsg & "'","Test DLL",MB_SYSTEMMODAL)
end sub

'-------------------------------------------------
' int TestCdecl_CallMeTwice(int Int33, int Int66) 
'-------------------------------------------------
function TestCdecl_CallMeTwice cdecl alias "TestCdecl_CallMeTwice" ( Int33 as integer , Int66 as integer ) as integer export
  static as any ptr OldStack,NewStack
  asm
    mov [NewStack],esp
  end asm
  color 11: print "{TestCdecl_CallMeTwice} function called...": color 7
  if ((Int33 <> 33) and (Int33 <> 66)) or ((Int66 <> 33) and (Int66 <> 66)) then
    Messagebox(null,!"Please Send Me integers 33 and 66 as parameters...\r\n" _
    "make sure you're using CDECL convention...\r\n" _
    "and don't forget to call this function twice in a row...","Test DLL",MB_ICONWARNING or MB_SYSTEMMODAL)
    return 0
  end if
  if OldStack=0 then
    OldStack = NewStack
    Messagebox(null,"Ok, CDECL first call... now call me again.","Test DLL",MB_SYSTEMMODAL)
    return 1
  else
    if Int33 = 33 and Int66 = 66 then 
      if OldStack <> NewStack then
        Messagebox(null,"Ok, CDECL second call... you used STDCALL convention :(","Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
        return 0
      else
        Messagebox(null,"Ok, CDECL second call... you used CDECL convention :D","Test DLL",MB_SYSTEMMODAL)
        return 2
      end if
    else
      if OldStack <> NewStack then
        Messagebox(null,"Ok, CDECL second call... you used PASCAL convention :(","Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
        return 0
      else
        Messagebox(null,"Ok, CDECL second call... you used UNKNOWN? convention :(","Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
        return 0
      end if
    end if
    OldStack=0
  end if
end function

'-------------------------------------------------------------
' STDCALL int TestStdCall_CallMeTwice@8(int Int33, int Int66) 
'-------------------------------------------------------------
function TestStdCall_CallMeTwice stdcall alias "TestStdCall_CallMeTwice" ( Int33 as integer , Int66 as integer ) as integer export
  static as any ptr OldStack,NewStack
  asm
    mov [NewStack],esp
  end asm
  color 11: print "{TestStdCall_CallMeTwice} function called...": color 7
  if ((Int33 <> 33) and (Int33 <> 66)) or ((Int66 <> 33) and (Int66 <> 66)) then
    Messagebox(null,!"Please Send Me integers 33 and 66 as parameters...\r\n" _
    "make sure you're using STDCALL convention...\r\n" _
    "and don't forget to call this function twice in a row...","Test DLL",MB_ICONWARNING or MB_SYSTEMMODAL)
    return 0
  end if
  if OldStack=0 then
    OldStack = NewStack
    Messagebox(null,"Ok, STDCALL first call... now call me again.","Test DLL",MB_SYSTEMMODAL)
    return 1
  else
    if Int33 = 33 and Int66 = 66 then 
      if OldStack <> NewStack then
        Messagebox(null,"Ok, STDCALL second call... you used CDECL convention :(","Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
        return 0
      else
        Messagebox(null,"Ok, STDCALL second call... you used STDCALL convention :D","Test DLL",MB_SYSTEMMODAL)
        return 2
      end if
    else
      if OldStack = NewStack then
        Messagebox(null,"Ok, STDCALL second call... you used PASCAL convention :(","Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
        return 0
      else
        Messagebox(null,"Ok, STDCALL second call... you used UNKNOWN? convention :(","Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
        return 0
      end if
    end if
    OldStack=0
  end if
end function

'---------------------------------------------------------
' PASCAL int TestPascal_CallMeTwice(int Int33, int Int66) 
'---------------------------------------------------------
function TestPascal_CallMeTwice pascal alias "TestPascal_CallMeTwice" ( Int33 as integer , Int66 as integer ) as integer export
  static as any ptr OldStack,NewStack
  asm
    mov [NewStack],esp
  end asm
  color 11: print "{TestPascal_CallMeTwice} function called...": color 7
  if ((Int33 <> 33) and (Int33 <> 66)) or ((Int66 <> 33) and (Int66 <> 66)) then
    Messagebox(null,!"Please Send Me integers 33 and 66 as parameters...\r\n" _
    "make sure you're using PASCAL convention...\r\n" _
    "and don't forget to call this function twice in a row...","Test DLL",MB_ICONWARNING or MB_SYSTEMMODAL)
    return 0
  end if
  if OldStack=0 then
    OldStack = NewStack
    Messagebox(null,"Ok, PASCAL first call... now call me again.","Test DLL",MB_SYSTEMMODAL)
    return 1
  else
    if Int33 = 33 and Int66 = 66 then 
      if OldStack <> NewStack then
        Messagebox(null,"Ok, PASCAL second call... you used UNKNOWN convention :(","Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
        return 0
      else
        Messagebox(null,"Ok, PASCAL second call... you used PASCAL convention :D","Test DLL",MB_SYSTEMMODAL)
        return 2
      end if
    else
      if OldStack = NewStack then
        Messagebox(null,"Ok, PASCAL second call... you used STDCALL convention :(","Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
        return 0
      else
        Messagebox(null,"Ok, PASCAL second call... you used CDECL convention :(","Test DLL",MB_ICONERROR or MB_SYSTEMMODAL)
        return 0
      end if
    end if
    OldStack=0
  end if
end function