OpenEuphoria

2. Re: EuCOM and VARIANT arrays of BSTR

• Posted by raseu Oct 16, 2008
• 1029 views

the following will work for array of strings to a standard 'C' shared library, i expect the principles would be similar for OLE/Variant string arrays.

without warning  
 
include dll.e 
include machine.e 
include misc.e 
    
constant true  = 1 
constant false = (not true) 
 
atom libhandle 
    
--// external dll/so 
libhandle = open_dll("test_c_lib.so.dll") 
 
constant test_c_lib = define_c_proc( libhandle, "test_c_lib", { C_POINTER, C_INT }) 
    
--// poke/peek routines 
global function peek_buffer(atom memblk) 
   --// return the string of bytes at the address 
   integer  i 
   sequence s 
   s = {} 
   if memblk then 
      i = peek(memblk) 
      while i do 
         s      = append(s, i) 
         memblk = memblk + 1 
         i      = peek(memblk) 
      end while 
   end if 
   return s 
end function 
    
--// poke array of strings 
 
constant ARRAYPTR  = 1 
constant ARRAYBLK  = 2 
 
global function poke_string_array(object data) 
    
   --// ref : http://www.openeuphoria.org/cgi-bin/esearch.exu?thread=1&fromMonth=1&fromYear=D&toMonth=4&toYear=D&postedBy=&keywords=%22Passing+an+array+to+a+C+function%3F%22 
 
   atom     baseptr 
   sequence memblk 
   integer  len 
    
   len    = length(data) 
 
   if (not len) then 
      return -1 
   end if 
    
   --// array of pointers 
   baseptr = allocate(4 * len) 
 
   --// pointers to strings 
   memblk = {} 
   for i = 1 to len do 
      if (sequence(data[i])) then 
         memblk &= allocate_string(data[i]) 
      end if 
   end for 
 
   --// store pointers to strings 
   poke4(baseptr, memblk) 
 
   return { baseptr, memblk } 
 
end function 
 
--// peek array of strings 
global function peek_string_array(sequence memblk) 
   integer  len 
   sequence array 
   len = length(memblk) 
   if (not len) then 
      return {} 
   end if 
   array = repeat({},len) 
   for i = 1 to len do 
      array[i] = peek_buffer(memblk[i]) 
   end for 
   return array 
end function 
 
--// cleanup 
global function free_memblk(object memblk) 
   integer len 
   if (atom(memblk) and memblk) then 
      free(memblk) 
      memblk = 0 
   else 
      len = length(memblk) 
      for i = 1 to len do 
         if (sequence(memblk[i])) then 
            memblk[i] = free_memblk(memblk[i]) 
         elsif (memblk[i]) then 
            free(memblk[i]) 
            memblk[i] = 0 
         end if 
      end for 
   end if 
   return memblk 
end function 
 
--// TESTS 
 
procedure test_string_in_memory(integer n) 
   sequence TEST_STRING_ARRAY 
   sequence strblk 
   sequence result 
 
   puts(1, "-- create string array\n") 
   TEST_STRING_ARRAY = {} 
   for i = 1 to n do 
      TEST_STRING_ARRAY &= { sprintf("string[%d]", { i }) } 
   end for 
 
   puts(1, "-- poking string array into memory\n") 
   strblk = poke_string_array(TEST_STRING_ARRAY) 
   ? strblk 
 
   puts(1, "-- read string array from memory\n") 
   result = peek_string_array(strblk[ARRAYBLK]) 
   for i = 1 to length(result) do 
      puts(1, result[i] & "\n") 
   end for 
 
   --// free string array 
   strblk = free_memblk(strblk) 
   ? strblk 
 
end procedure 
 
procedure test_c_call(integer n) 
   sequence TEST_STRING_ARRAY 
   sequence strblk 
   sequence result 
 
   puts(1, "-- create string array\n") 
   TEST_STRING_ARRAY = {} 
   for i = 1 to n do 
      TEST_STRING_ARRAY &= { sprintf("string[%d]", { i }) } 
   end for 
 
   puts(1, "-- poking string array into memory\n") 
   strblk = poke_string_array(TEST_STRING_ARRAY) 
   ? strblk 
 
   puts(1, "-- calling 'C' function with string array\n") 
   c_proc(test_c_lib, { strblk[ARRAYPTR], n }) 
 
   --// free string array 
   strblk = free_memblk(strblk) 
   ? strblk 
 
end procedure 
 
   --// do tests 
   test_string_in_memory(5) 
   test_c_call(5) 
 

where the external 'C' function/procedure has the following signature/definition

 
/* dllinit.h */ 
 
#ifdef WIN32 
   #define TEST_EXPORT __declspec (dllexport) __stdcall 
   #include <windows.h> 
#else 
   #define TEST_EXPORT 
#endif 
 
#ifndef NULL 
   #define NULL  0 
#endif 
 
#ifndef TRUE 
   #define TRUE  1 
#endif 
 
#ifndef FALSE 
   #define FALSE 0 
#endif 
 
/* dllinit.c */ 
 
#include "dllinit.h" 
 
int TEST_EXPORT DllMain(int hDLL, int Reason, void *Reserved) 
{ 
    if (Reason == 1) 
      ; 
 
    return 1; 
} 
 
/* test_c_call.c */ 
 
#include <stdio.h> 
#include "dllinit.h" 
 
void TEST_EXPORT test_c_lib(char **args, int len) 
{ 
   int i; 
   for (i = 0; i < len; i++) 
      printf("string[%d] = %s\n", i + 1, args[i]); 
} 
 

HTH

4. Re: EuCOM and VARIANT arrays of BSTR

• Posted by axtens Oct 16, 2008
• 1019 views

Right, after a bit of instrumenting the code, I discovered that it's the

  make_variant( var, VT_ARRAY + VT_BSTR, psa )  

line that's failing. Hmm ... perhaps shall have to have a look at unpacking Matt's make_variant procedure.

Bruce.