Page 1 of 1

Willing to Pay for help with COM Automation.

Posted: Thu May 05, 2011 2:36 pm
by swhite
Hi

A month or so ago I was trying to get PB to work with a multi-threaded Windows COM dll created in Visual FoxPro. I was not successful at the time and had other tasks to complete so I set it aside. However, I would like to make this work as I have a number of potential uses for it. I am willing to pay someone to solve this issue if anyone is interested. The COM dll I created supports a dual interface so it is possible to use the fast vtable method if someone knows how. I can supply more details if and when they are needed.

You can get some idea of what I was trying to do by looking at this discussion:

http://www.purebasic.fr/english/viewto ... 3&t=45497

Thanks,
Simon

Re: Willing to Pay for help with COM Automation.

Posted: Sun May 08, 2011 12:52 pm
by DarkPlayer
You got a PM. :)

Solved: Willing to Pay for help with COM Automation.

Posted: Fri May 13, 2011 2:40 pm
by swhite
Hi

Thanks to DarkPlayer for his help in getting my COM server to work with Purebasic. I have posted the code below in case others would be interested in how to make this function. There is only one issue that is not clear to my mind and it was the reason why my code failed in past. The method "PrepareResponse" is defined in the VFP COM server as Procedure.s(text,s). It expects one string parameter and returns a string. However you will notice that in order to get this to work with PB two parameters were used in the PB code when calling this method. The second parameter points to the return string. Can anyone explain this situation?

Secondly for those that are not familiar with COM the "bstr" are cached by Windows and not released so this makes it appear that you have a memory leak. However, there is a function called SetOaNoCache() that can be used to turn off this caching. I have yet to test it but I suspect it will solve the perceived memory leak.

Code: Select all

Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  Global Name.GUID
  
  Name\Data1    = l
  Name\Data2    = w1
  Name\Data3    = w2
  Name\Data4[0] = b1
  Name\Data4[1] = b2
  Name\Data4[2] = b3
  Name\Data4[3] = b4
  Name\Data4[4] = b5
  Name\Data4[5] = b6
  Name\Data4[6] = b7
  Name\Data4[7] = b8
EndMacro

#CLSCTX_INPROC_SERVER  = $01

DEFINE_GUID(CLSID_KardAuth, $8DC6BA5D, $6861, $4F0A, $A0, $80, $7D, $ED, $CC, $97, $C1, $0F)
DEFINE_GUID(IID_KardAuth,   $4C791FAF, $8649, $462D, $A9, $3A, $18, $5F, $95, $C2, $DC, $0E)

Interface KardAuth Extends IDispatch
  PrepareResponse(String.p-bstr, returnvalue.i)
EndInterface

Global *Inter.KardAuth

Procedure KardAuth_Load()

  If CoInitializeEx_(0, #COINIT_MULTITHREADED) = #S_OK
   
    If CoCreateInstance_(@CLSID_KardAuth, 0, #CLSCTX_INPROC_SERVER, @IID_KardAuth, @*Inter) = #S_OK
   
      ProcedureReturn #True
   
    EndIf  
    
    CoUninitialize_() 
    
  EndIf

  ProcedureReturn #False
EndProcedure


Procedure.s KardAuth_PrepareResponse(Text.s)
  
  Protected *ReturnPtr.i
  

  If *Inter\PrepareResponse(Text, @*ReturnPtr) = #S_OK
      
     Protected ReturnStr.s = PeekS(*ReturnPtr, -1, #PB_Unicode)
  
     SysFreeString_(*ReturnPtr)
   
     ProcedureReturn ReturnStr
    
  EndIf

  ProcedureReturn ""

EndProcedure

Procedure KardAuth_Unload()
  
  *Inter\Release()
  CoUninitialize_() 
  
EndProcedure


If KardAuth_Load()

  Debug KardAuth_PrepareResponse("This is a Test")    

  KardAuth_Unload()
  
EndIf