Network communication is important today for integration.
But sometimes a simple call is what is needed.
That can create some challenges when the calling language is different than the called language.
This article will cover native (C, Pascal, Fortran etc.) to native (C etc.).
Other articles:
All the following examples will call this simple C Code.
demolib.h:
#ifndef DEMOLIB_H
#define DEMOLIB_H
/* workaround conflict with *nix dup function */
#if defined(NIX) || defined(VMS)
#define dup mydup
#endif
struct Data1
{
int iv;
char sv[50];
};
struct Data2
{
int iv1;
char sv1[50];
int iv2;
char sv2[50];
};
/* int in arg + int retval */
int add(int a, int b);
/* int array in arg + int retval */
int sum(int n, int *a);
/* string in arg + string retval */
/* caller must call free on retval */
char *dup(char *s);
/* int out arg + string out arg */
/* caller must call free on second arg */
void get_out(int *iv, char **sv);
/* caller must call free on retval */
/* struct retval */
struct Data1 *get_ret();
/* inout struct arg */
void chg(struct Data2 *d);
#endif
demolib.c:
#include <string.h>
#include <stdlib.h>
#include "demolib.h"
/* some very simple functions */
int add(int a, int b)
{
return a + b;
}
int sum(int n, int *a)
{
int i, sum;
sum = 0;
for(i = 0; i < n; i++)
{
sum += a[i];
}
return sum;
}
char *dup(char *s)
{
char *s2;
s2 = malloc(2 * strlen(s) + 1);
strcpy(s2, s);
strcat(s2, s);
return s2;
}
/* functions simulating real work */
static int IV = 123;
static char *SV = "ABC";
void get_out(int *iv, char **sv)
{
*iv = IV;
*sv = malloc(strlen(SV) + 1);
strcpy(*sv, SV);
}
struct Data1 *get_ret()
{
struct Data1 *d;
d = malloc(sizeof(struct Data1));
d->iv = IV;
strcpy(d->sv, SV);
return d;
}
void chg(struct Data2 *d)
{
d->iv2 = d->iv1 + 1;
strcpy(d->sv2, d->sv1);
strcat(d->sv2, "X");
}
The example does not cover all aspects of calling from managed to native, but it does cover some of the more common.
C is a foundational language on most platform so often it is possible to call from one language to another simply by using C converntions.
Example with GCC compiler suite.
Obviously no problem calling C from C.
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include "demolib.h"
int main()
{
int a, b, c, allsix, iv;
char *s, *s2, *sv;
int six[] = { 1, 2, 3, 4, 5, 6 };
struct Data1 *d1;
struct Data2 d2;
/* */
a = 123;
b = 456;
c = add(a, b);
printf("%d\n", c);
/* */
allsix = sum(6, six);
printf("%d\n", allsix);
/* */
s = "ABC";
s2 = dup(s);
printf("%s\n", s2);
free(s2);
/* */
get_out(&iv, &sv);
printf("%d %s\n", iv, sv);
free(sv);
/* */
d1 = get_ret();
printf("%d %s\n", d1->iv, d1->sv);
/* */
d2.iv1 = 123;
strcpy(d2.sv1, "ABC");
chg(&d2);
printf("%d %s\n", d2.iv2, d2.sv2);
/* */
return 0;
}
Build:
gcc -Wall testc.c demolib.c -o testc.exe
Output:
579 21 ABCABC 123 ABC 123 ABC 124 ABCX
To get from Fortran convention to C convention a small wrapper is practical:
#include <string.h>
#include <stdlib.h>
#include "demolib.h"
// scope: gfortran and gcc only
// strategy: using fortran 77 and VAX extensions only - no modern fortran C interop features used
// add trailing underscore to function names
// always pass by reference never by value
// convert array return types to extra array argument
// assume character string contain trailing nul
int add_(int *a, int *b)
{
return add(*a, *b);
}
int sum_(int *n, int *a)
{
return sum(*n, a);
}
void dup_(char *s, char *s2)
{
char *p;
p = dup(s);
strcpy(s2, p);
free(p);
}
void get_out_(int *iv, char *sv)
{
char *p;
get_out(iv, &p);
strcpy(sv, p);
free(p);
}
struct Data1 get_ret_()
{
struct Data1 d;
memcpy(&d, get_ret(), sizeof(struct Data1));
return d;
}
void chg_(struct Data2 *d)
{
chg(d);
}
And now it is simple:
program testfor
structure /data1/
integer*4 iv
character*50 sv
end structure
structure /data2/
integer*4 iv1
character*50 sv1
integer*4 iv2
character*50 sv2
end structure
integer*4 a,b,c,six(6),allsix,iv
character*50 s,s2,sv
record /data1/d1
record /data2/d2
integer*4 add,sum
record /data1/get_ret
external add,sum,dup,get_out,get_ret,chg
data six/1,2,3,4,5,6/
c
a = 123
b = 456
c = add(a, b)
write(*,*) c
c
allsix = sum(6, six)
write(*,*) allsix
c
s(1:4) = 'ABC' // char(0)
call dup(s(1:3), s2)
write(*,*) s2(1:6)
c
call get_out(iv, sv)
write(*,*) iv,sv(1:3)
c
d1 = get_ret()
write(*,*) d1.iv,d1.sv(1:3)
c
d2.iv1 = 123
d2.sv1(1:4) = 'ABC' // char(0)
call chg(d2)
write(*,*) d2.iv2,d2.sv2(1:4)
c
end
Build:
gcc -c -Wall demolib.c -o demolib.obj
gcc -c -Wall fordemolib.c -o fordemolib.obj
gfortran -Wall -fdec-structure testfor.for fordemolib.obj demolib.obj -o testfor.exe
Output:
579 21 ABCABC 123 ABC 123 ABC 124 ABCX
Delphi/Lazarus support many C constructs making it relative easy to call C.
program testpas2;
{$MODE objfpc}
{$H+}
{$LINK demolib.obj}
{$LINKLIB C:\DivNative\64bit\gcc\x86_64-w64-mingw32\lib\libmsvcrt.a}
type
Data1 = record
iv : integer;
sv : packed array[0..49] of char;
end;
Data2 = record
iv1 : integer;
sv1 : packed array[0..49] of char;
iv2 : integer;
sv2 : packed array[0..49] of char;
end;
PData1 = ^Data1;
function add(a, b : integer) : integer; cdecl; external name 'add';
function sum(n : integer; a : array of integer) : integer; cdecl; external name 'sum';
function dup(s : PChar) : PChar; cdecl; external name 'dup';
procedure get_out(var iv : integer; var sv : PChar); cdecl; external name 'get_out';
function get_ret : PData1; cdecl; external name 'get_ret';
procedure chg(var d : Data2); cdecl; external name 'chg';
var
a, b, c, allsix, iv : integer;
six : array [0..5] of integer = (1, 2, 3, 4, 5, 6);
s, s2, sv : string;
tempsv : pchar;
d1 : PData1;
d2 : Data2;
begin
(* *)
a := 123;
b := 456;
c := add(a, b);
writeln(c:1);
(* *)
allsix := sum(Length(six), six);
writeln(allsix:1);
(* *)
s := 'ABC';
s2 := dup(PChar(s));
writeln(s2);
(* *)
iv := 0;
tempsv := '';
get_out(iv, tempsv);
sv := tempsv;
writeln(iv:1,' ', sv);
(* *)
d1 := get_ret();
writeln(d1^.iv:1, ' ', d1^.sv);
(* *)
d2.iv1 := 123;
d2.sv1 := 'ABC';
chg(d2);
writeln(d2.iv2:1, ' ', d2.sv2);
end.
Build:
gcc -c demolib.c -o demolib.obj
fpc testpas2.pas
Output:
579 21 ABCABC 123 ABC 123 ABC 124 ABCX
Sometimes one have a DLL/so instead of a libray.
To demo how to handle that we will create the following wrapper.
stddemolib.c:
#include <stdlib.h>
#include "demolib.h"
#ifdef WIN
#define EXTERNAL(t) __declspec(dllexport) t __stdcall
#else
#ifdef NIX
#define EXTERNAL(t) t
#else
#ifdef VMS
#define EXTERNAL(t) t
#else
#error "Platform not supported or not specified"
#endif
#endif
#endif
EXTERNAL(int) std_add(int a, int b)
{
return add(a, b);
}
EXTERNAL(int) std_sum(int n, int *a)
{
return sum(n, a);
}
EXTERNAL(char *) std_dup(char *s)
{
return dup(s);
}
EXTERNAL(void) std_get_out(int *iv, char **sv)
{
get_out(iv, sv);
}
EXTERNAL(struct Data1 *) std_get_ret()
{
return get_ret();
}
EXTERNAL(void) std_chg(struct Data2 *d)
{
chg(d);
}
EXTERNAL(void) std_free(char *s)
{
free(s);
}
Build on Windows with GCC:
gcc -Wall -DWIN -shared -Wl,--kill-at stddemolib.c demolib.c -o stddemolib.dll
Build on Linux with GCC:
gcc -Wall -DNIX -shared -fPIC stddemolib.c demolib.c -o stddemolib.so
Build on VMS:
$ cc demolib
$ cc/def="VMS" stddemolib
$ link/share stddemolib+demolib+sys$input/option
SYMBOL_VECTOR=(std_add=PROCEDURE,-
std_sum=PROCEDURE,-
std_dup=PROCEDURE,-
std_get_out=PROCEDURE,-
std_get_ret=PROCEDURE,-
std_chg=PROCEDURE)
$
$ define/nolog/super stddemolib sys$disk:[]stddemolib
The API can be recreated in C and the necessary library and function pointers be loaded manually in C.
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <windows.h>
struct Data1
{
int iv;
char sv[50];
};
struct Data2
{
int iv1;
char sv1[50];
int iv2;
char sv2[50];
};
typedef int (*F_add)(int a, int b);
typedef int (*F_sum)(int n, int *a);
typedef char *(*F_dup)(char *s);
typedef void (*F_get_out)(int *iv, char **sv);
typedef struct Data1 *(*F_get_ret)();
typedef void (*F_chg)(struct Data2 *d);
int main()
{
HINSTANCE dll;
F_add add;
F_sum sum;
F_dup dup;
F_get_out get_out;
F_get_ret get_ret;
F_chg chg;
int a, b, c, allsix, iv;
char *s, *s2, *sv;
int six[] = { 1, 2, 3, 4, 5, 6 };
struct Data1 *d1;
struct Data2 d2;
/* */
dll = LoadLibrary("stddemolib.dll");
add = (F_add)GetProcAddress(dll, "std_add");
sum = (F_sum)GetProcAddress(dll, "std_sum");
dup = (F_dup)GetProcAddress(dll, "std_dup");
get_out = (F_get_out)GetProcAddress(dll, "std_get_out");
get_ret = (F_get_ret)GetProcAddress(dll, "std_get_ret");
chg = (F_chg)GetProcAddress(dll, "std_chg");
/* */
a = 123;
b = 456;
c = add(a, b);
printf("%d\n", c);
/* */
allsix = sum(6, six);
printf("%d\n", allsix);
/* */
s = "ABC";
s2 = dup(s);
printf("%s\n", s2);
free(s2);
/* */
get_out(&iv, &sv);
printf("%d %s\n", iv, sv);
free(sv);
/* */
d1 = get_ret();
printf("%d %s\n", d1->iv, d1->sv);
/* */
d2.iv1 = 123;
strcpy(d2.sv1, "ABC");
chg(&d2);
printf("%d %s\n", d2.iv2, d2.sv2);
/* */
return 0;
}
Build with GCC:
gcc -Wall -DWIN testcstd.c -o testcstd.exe
Output:
579 21 ABCABC 123 ABC 123 ABC 124 ABCX
The API can be recreated in C and the necessary library and function pointers be loaded manually in C.
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <dlfcn.h>
struct Data1
{
int iv;
char sv[50];
};
struct Data2
{
int iv1;
char sv1[50];
int iv2;
char sv2[50];
};
typedef int (*F_add)(int a, int b);
typedef int (*F_sum)(int n, int *a);
typedef char *(*F_dup)(char *s);
typedef void (*F_get_out)(int *iv, char **sv);
typedef struct Data1 *(*F_get_ret)();
typedef void (*F_chg)(struct Data2 *d);
int main()
{
void *so;
F_add add;
F_sum sum;
F_dup dup;
F_get_out get_out;
F_get_ret get_ret;
F_chg chg;
int a, b, c, allsix, iv;
char *s, *s2, *sv;
int six[] = { 1, 2, 3, 4, 5, 6 };
struct Data1 *d1;
struct Data2 d2;
/* */
so = dlopen("./stddemolib.so", RTLD_NOW);
add = (F_add)dlsym(so, "std_add");
sum = (F_sum)dlsym(so, "std_sum");
dup = (F_dup)dlsym(so, "std_dup");
get_out = (F_get_out)dlsym(so, "std_get_out");
get_ret = (F_get_ret)dlsym(so, "std_get_ret");
chg = (F_chg)dlsym(so, "std_chg");
/* */
a = 123;
b = 456;
c = add(a, b);
printf("%d\n", c);
/* */
allsix = sum(6, six);
printf("%d\n", allsix);
/* */
s = "ABC";
s2 = dup(s);
printf("%s\n", s2);
free(s2);
/* */
get_out(&iv, &sv);
printf("%d %s\n", iv, sv);
free(sv);
/* */
d1 = get_ret();
printf("%d %s\n", d1->iv, d1->sv);
/* */
d2.iv1 = 123;
strcpy(d2.sv1, "ABC");
chg(&d2);
printf("%d %s\n", d2.iv2, d2.sv2);
/* */
return 0;
}
Build with GCC:
gcc -Wall -DNIX -ldl testcstd.c -o testcstd
Output:
579 21 ABCABC 123 ABC 123 ABC 124 ABCX
The API can be recreated in C and the necessary library and function pointers be loaded manually in C.
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <descrip.h>
#include <lib$routines.h>
struct Data1
{
int iv;
char sv[50];
};
struct Data2
{
int iv1;
char sv1[50];
int iv2;
char sv2[50];
};
typedef int (*F_add)(int a, int b);
typedef int (*F_sum)(int n, int *a);
typedef char *(*F_dup)(char *s);
typedef void (*F_get_out)(int *iv, char **sv);
typedef struct Data1 *(*F_get_ret)();
typedef void (*F_chg)(struct Data2 *d);
int main()
{
F_add add;
F_sum sum;
F_dup dup;
F_get_out get_out;
F_get_ret get_ret;
F_chg chg;
int a, b, c, allsix, iv;
char *s, *s2, *sv;
int six[] = { 1, 2, 3, 4, 5, 6 };
struct Data1 *d1;
struct Data2 d2;
/* */
$DESCRIPTOR(shrexe, "stddemolib");
$DESCRIPTOR(S_add, "std_add");
$DESCRIPTOR(S_sum, "std_sum");
$DESCRIPTOR(S_dup, "std_dup");
$DESCRIPTOR(S_get_out, "std_get_out");
$DESCRIPTOR(S_get_ret, "std_get_ret");
$DESCRIPTOR(S_chg, "std_chg");
int res = lib$find_image_symbol(&shrexe, &S_add, &add);
lib$find_image_symbol(&shrexe, &S_sum, &sum);
lib$find_image_symbol(&shrexe, &S_dup, &dup);
lib$find_image_symbol(&shrexe, &S_get_out, &get_out);
lib$find_image_symbol(&shrexe, &S_get_ret, &get_ret);
lib$find_image_symbol(&shrexe, &S_chg, &chg);
/* */
a = 123;
b = 456;
c = add(a, b);
printf("%d\n", c);
/* */
allsix = sum(6, six);
printf("%d\n", allsix);
/* */
s = "ABC";
s2 = dup(s);
printf("%s\n", s2);
free(s2);
/* */
get_out(&iv, &sv);
printf("%d %s\n", iv, sv);
free(sv);
/* */
d1 = get_ret();
printf("%d %s\n", d1->iv, d1->sv);
/* */
d2.iv1 = 123;
strcpy(d2.sv1, "ABC");
chg(&d2);
printf("%d %s\n", d2.iv2, d2.sv2);
/* */
return 0;
}
Build:
$ cc/def="VMS" testcstd
$ link testcstd+sys$input/option
stddemolib/share
$
Output:
579 21 ABCABC 123 ABC 123 ABC 124 ABCX
Delphi/Lazarus has builtin support for referencing C functions in DLL's.
program TestPas;
type
Data1 = record
iv : integer;
sv : array[0..49] of char;
end;
Data2 = record
iv1 : integer;
sv1 : array[0..49] of char;
iv2 : integer;
sv2 : array[0..49] of char;
end;
PData1 = ^Data1;
function std_add(a, b : integer) : integer; stdcall; external 'stddemolib.dll';
function std_sum(n : integer; a : array of integer) : integer; stdcall; external 'stddemolib.dll';
function std_dup(s : PChar) : PChar; stdcall; external 'stddemolib.dll';
procedure std_get_out(var iv : integer; var sv : PChar); stdcall; external 'stddemolib.dll';
function std_get_ret : PData1; stdcall; external 'stddemolib.dll';
procedure std_chg(var d : Data2); stdcall; external 'stddemolib.dll';
var
a, b, c, allsix, iv : integer;
six : array [0..5] of integer = (1, 2, 3, 4, 5, 6);
s, s2, sv : string;
tempsv : pchar;
d1 : PData1;
d2 : Data2;
begin
(* *)
a := 123;
b := 456;
c := std_add(a, b);
writeln(c:1);
(* *)
allsix := std_sum(Length(six), six);
writeln(allsix:1);
(* *)
s := 'ABC';
s2 := std_dup(PChar(s));
writeln(s2);
(* *)
iv := 0;
tempsv := '';
std_get_out(iv, tempsv);
sv := tempsv;
writeln(iv:1,' ', sv);
(* *)
d1 := std_get_ret();
writeln(d1^.iv:1,' ', d1^.sv);
(* *)
d2.iv1 := 123;
d2.sv1 := 'ABC';
std_chg(d2);
writeln(d2.iv2:1,' ', d2.sv2);
end.
It works pretty smooth.
Output:
579 21 ABCABC 123 ABC 123 ABC 124 ABCX
Note that C++ provides an extra problem in this context..
C++ use decoration or name mangling to handle overload and limitations on length of names.
This can make it somewhat difficult to fine names in a DLL/so unless extern "C" is used.
A simple demo.
C++ source for Windows DLL:
extern "C"
{
__declspec(dllexport) int __stdcall add_c(int a, int b);
}
__declspec(dllexport) int __stdcall add_cpp(int a, int b);
int add_c(int a, int b)
{
return a + b;
}
int add_cpp(int a, int b)
{
return a + b;
}
Usage from Delphi/Lazarus:
program DemoPas;
function add_c_msvc(a, b : integer) : integer; stdcall; external 'demomsvc.dll' name 'add_c';
function add_cpp_msvc(a, b : integer) : integer; stdcall; external 'demomsvc.dll' name '?add_cpp@@YAHHH@Z';
function add_c_gcc(a, b : integer) : integer; stdcall; external 'demogcc.dll' name 'add_c';
function add_cpp_gcc(a, b : integer) : integer; stdcall; external 'demogcc.dll' name '_Z7add_cppii';
begin
writeln(add_c_msvc(123, 456));
writeln(add_cpp_msvc(123, 456));
writeln(add_c_gcc(123, 456));
writeln(add_cpp_gcc(123, 456));
end.
Build on Windows with MSVC++ and GCC:
cl /LD demo.cpp /Fedemomsvc.dll
gcc -Wall -shared -Wl,--kill-at demo.cpp -o demogcc.dll
And even though the names of the *_cpp_* entries can both be found in DLL using dumpbin and calculated using the compiler specific algorithm, then it is obviously not optimal.
Always use extern "C" for exported names (unless caller is known to be C++).
COM/DCOM/COM+/ActiveX is a core Windows technology.
It covers a lot of different functionality:
Here we will focus on the two first aspects.
At the very lowest level a COM class is just a class implementing the interface IUnknown and following some conventions.
COM classes that need to support dynamic API explorartion must also implement the interface IDispatch. This is needed to support script languages without strong type system.
But this article will not focus on the lower levels - instead it will focus on how it practically can be used for cross language calls.
For more details on COM see the COM article.
Writing a COM component in C++ is not that simple.
Basically there are two approaches:
Since this article is about using COM not understanding the internals, then it will take the second approach as it is significant less code to write - and live with the fact that it is far from standard C++.
Here comes an example.
First we define th einterface in IDL (Interface Definition Language).
SNat.idl:
import "oaidl.idl";
// IS
[object, uuid(CBF5E889-BFBA-41FC-83DF-98156E999C21), oleautomation, dual, pointer_default(unique)]
interface IS : IDispatch
{
[id(1)] HRESULT Add([in] long a, [in] long b, [out,retval] long *c);
[id(2)] HRESULT Dup([in] BSTR s, [out,retval]BSTR *s2);
[id(3),propget] HRESULT Iv([out, retval] long *iv);
[id(3),propput] HRESULT Iv([in] long iv);
[id(4),propget] HRESULT Sv([out, retval] BSTR *sv);
[id(4),propput] HRESULT Sv([in] BSTR sv);
[id(5)] HRESULT M();
}
// S library
[uuid(170E2745-A02D-416D-A3FA-4160ACE70F41), version(1.0)]
library SLibrary
{
importlib("stdole32.tlb");
[uuid(DB83A5B9-D6CC-4807-9755-BBD02755DD67)]
coclass CoS
{
[default] interface IS;
};
};
We compile that with the MIDL compiler:
midl SNat.idl
and we get a bunch of files including SNat.h with a C++ interface IS and a SNat.tlb type library, that will be used by languages with strong type system.
We define a class that use stuff from the generated files and the builtin support for COM.
SNatEx.h:
#ifndef SNAT_H
#define SNAT_H
#include <windows.h>
#include <tchar.h>
#include <atlbase.h>
#include <atlcom.h>
#include "SNat_i.c"
#include "SNat.h"
class ATL_NO_VTABLE CCoS : public CComObjectRootEx<CComSingleThreadModel>, public CComCoClass<CCoS, &CLSID_CoS>, public IDispatchImpl<IS, &IID_IS, &LIBID_SLibrary>
{
private:
long m_iv;
BSTR m_sv;
public:
CCoS();
virtual ~CCoS();
BEGIN_COM_MAP(CCoS)
COM_INTERFACE_ENTRY(IS)
COM_INTERFACE_ENTRY2(IDispatch, IS)
END_COM_MAP()
// IS
STDMETHODIMP Add(long a, long b, long *c);
STDMETHODIMP Dup(BSTR s, BSTR *s2);
STDMETHODIMP get_Iv(long *iv);
STDMETHODIMP put_Iv(long iv);
STDMETHODIMP get_Sv(BSTR *sv);
STDMETHODIMP put_Sv(BSTR sv);
STDMETHODIMP M();
static HRESULT WINAPI UpdateRegistry(BOOL b)
{
return _Module.UpdateRegistryClass(CLSID_CoS, _T("COM.SNat.1"), _T("COM.SNat"), 0U, THREADFLAGS_APARTMENT, b);
}
};
#endif
We provide the implementation for that class and some registration functions.
SNat.cpp:
#include <windows.h>
#include <oleauto.h>
#include <initguid.h>
#include <atlbase.h>
extern CComModule _Module;
#include <atlcom.h>
#include "SNatEx.h"
CComModule _Module;
BEGIN_OBJECT_MAP(ObjectMap)
OBJECT_ENTRY(CLSID_CoS, CCoS)
END_OBJECT_MAP()
CCoS::CCoS()
{
m_iv = 0;
m_sv = SysAllocString(L"");
}
CCoS::~CCoS()
{
SysFreeString(m_sv);
}
STDMETHODIMP CCoS::Add(long a, long b, long *c)
{
*c = a + b;
return S_OK;
}
STDMETHODIMP CCoS::Dup(BSTR s, BSTR *s2)
{
OLECHAR *buf = new OLECHAR[2 * SysStringLen(s) + 1];
wcscpy(buf, s);
wcscat(buf, s);
*s2 = SysAllocString(buf);
delete[] buf;
return S_OK;
}
STDMETHODIMP CCoS::get_Iv(long *iv)
{
*iv = m_iv;
return S_OK;
}
STDMETHODIMP CCoS::put_Iv(long iv)
{
m_iv = iv;
return S_OK;
}
STDMETHODIMP CCoS::get_Sv(BSTR *sv)
{
*sv = SysAllocString(m_sv);
return S_OK;
}
STDMETHODIMP CCoS::put_Sv(BSTR sv)
{
SysReAllocString(&m_sv, sv);
return S_OK;
}
STDMETHODIMP CCoS::M()
{
m_iv = m_iv + 1;
OLECHAR *buf = new OLECHAR[SysStringLen(m_sv) + 1 + 1];
wcscpy(buf, m_sv);
wcscat(buf, L"X");
SysFreeString(m_sv);
m_sv = SysAllocString(buf);
delete[] buf;
return S_OK;
}
BOOL WINAPI DllMain(HINSTANCE hInstance, DWORD dwReason, LPVOID lpReserved)
{
if(dwReason == DLL_PROCESS_ATTACH)
{
_Module.Init(ObjectMap, hInstance, &LIBID_SLibrary);
}
else if(dwReason == DLL_PROCESS_DETACH)
{
_Module.Term();
}
return TRUE;
}
STDMETHODIMP DllGetClassObject(REFCLSID rclsid, REFIID riid, void **ppv)
{
return _Module.GetClassObject(rclsid, riid, ppv);
}
STDMETHODIMP DllCanUnloadNow()
{
return (_Module.GetLockCount() == 0) ? S_OK : S_FALSE;
}
STDMETHODIMP DllRegisterServer()
{
return _Module.RegisterServer(TRUE);
}
STDMETHODIMP DllUnregisterServer()
{
return _Module.UnregisterServer(TRUE);
}
Build:
cl /LD SNat.cpp SNat.def oleaut32.lib
Registration:
regsvr32 SNat.dll
Be sure to register it correctly as either a 64 bit or 32 bit COM component.
We will see how to call the above COM component from C++ and Delphi/Lazarus.
// C++
#include <iostream>
using namespace std;
// Windows
#include <windows.h>
#include <initguid.h>
#include <tchar.h>
// our stuff
#import "SNat.tlb" no_namespace named_guids
void ReturnCheck(LPTSTR func, HRESULT res)
{
if(res != S_OK)
{
TCHAR buffer[1000];
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, res, 0, buffer, sizeof(buffer), 0);
_tprintf("%s: %s\n", func, buffer);
exit(1);
}
}
int main()
{
HRESULT res;
CoInitialize(NULL);
try
{
ISPtr spS;
res = spS.CreateInstance(CLSID_CoS);
ReturnCheck(_T("CreateInstance"), res);
long a = 123;
long b = 456;
long c = spS->Add(a, b);
wcout << c << endl;
BSTR s = SysAllocString(L"ABC");
BSTR s2 = spS->Dup(s);
wcout << s2 << endl;
SysFreeString(s);
SysFreeString(s2);
BSTR temp = SysAllocString(L"ABC");
spS->PutIv(123);
spS->PutSv(temp);
SysFreeString(temp);
spS->M();
long iv = spS->GetIv();
BSTR sv = spS->GetSv();
wcout << iv << " " << sv << endl;
SysFreeString(sv);
spS = NULL;
}
catch (_com_error er)
{
_tprintf("%s\n", er.ErrorMessage());
}
//
CoUninitialize();
return 0;
}
Build:
cl /EHsc C1.cpp ole32.lib oleaut32.lib
Output:
579 ABCABC 124 ABCX
// C++
#include <iostream>
using namespace std;
// Windows
#include <windows.h>
#include <initguid.h>
#include <tchar.h>
// our stuff
#import "SNat.tlb" no_namespace named_guids
int main()
{
CoInitialize(NULL);
try
{
ISPtr spS(__uuidof(CoS));
long a = 123;
long b = 456;
long c = spS->Add(a, b);
wcout << c << endl;
BSTR s = SysAllocString(L"ABC");
BSTR s2 = spS->Dup(s);
wcout << s2 << endl;
SysFreeString(s);
SysFreeString(s2);
BSTR temp = SysAllocString(L"ABC");
spS->PutIv(123);
spS->PutSv(temp);
SysFreeString(temp);
spS->M();
long iv = spS->GetIv();
BSTR sv = spS->GetSv();
wcout << iv << " " << sv << endl;
SysFreeString(sv);
spS = NULL;
}
catch (_com_error er)
{
_tprintf("%s\n", er.ErrorMessage());
}
//
CoUninitialize();
return 0;
}
Build:
cl /EHsc C2.cpp ole32.lib oleaut32.lib
Output:
579 ABCABC 124 ABCX
program CProgram2;
uses
ActiveX,ComObj;
var
a, b, c : integer;
s, s2 : widestring;
sdn : Variant;
begin
CoInitialize(nil);
sdn := CreateOLEObject('COM.SNat');
a := 123;
b := 456;
c := sdn.Add(a, b);
writeln(c);
s := 'ABC';
s2 := sdn.Dup(s);
writeln(s2);
sdn.Iv := 123;
sdn.Sv := 'ABC';
sdn.M;
writeln(sdn.Iv:1,' ',sdn.Sv);
CoUninitialize;
end.
Note that Delphi/Lazarus in this example use IDispatch and the dynamic API.
Output:
579 ABCABC 124 ABCX
VMS is a special case as the operating system define a language neutral calling standard or calling convention.
Note that the VMS calling standard is procedural only - there is no object oriented version.
Arguments have the following attributes:
Let us see an example.
We will use this API:
S(iv1, iv2, sv1, sv2) Returns type: longword access: write only mechanism: by value Arguments iv1 type: longword access: read only mechanism: by value iv2 type: longword access: write only mechanism: by reference sv1 type: character string access: read only mechanism: by descriptor sv2 type: character string access: write only mechanism: by descriptor
Calling program:
PROGRAM P
INTEGER*4 IV1,IV2,RES
CHARACTER*10 SV1,SV2
INTEGER*4 S
IV1=123
SV1='ABC '
RES=S(%VAL(IV1),IV2,SV1,SV2)
WRITE(*,*) RES,IV2,SV2
END
program p(input, output);
type
fixstr10 = packed array [1..10] of char;
function s(%IMMED iv1 : integer;
var iv2 : integer;
sv1 : [class_s] packed array[low1..high1:integer] of char;
var sv2 : [class_s] packed array[low2..high2:integer] of char) : integer; external;
var
iv1, iv2, res : integer;
sv1, sv2 : fixstr10;
begin
iv1 := 123;
sv1 := 'ABC ';
sv2 := ' '; (* necessary or compiler complains *)
res := s(iv1, iv2, sv1, sv2);
writeln(res:1, ' ', iv2:1, ' ', sv2);
end.
#include <stdio.h>
#include <string.h>
#include <descrip.h>
int s(int iv1, int *iv2, struct dsc$descriptor_s *dsv1, struct dsc$descriptor_s *dsv2);
int main()
{
int iv1, iv2, res;
char sv1[11] = "ABC ";
char sv2[11];
struct dsc$descriptor_s dsv1, dsv2;
dsv1.dsc$w_length = strlen(sv1);
dsv1.dsc$b_dtype = DSC$K_DTYPE_T;
dsv1.dsc$b_class = DSC$K_CLASS_S;
dsv1.dsc$a_pointer = sv1;
dsv2.dsc$w_length = sizeof(sv2) - 1;
dsv2.dsc$b_dtype = DSC$K_DTYPE_T;
dsv2.dsc$b_class = DSC$K_CLASS_S;
dsv2.dsc$a_pointer = sv2;
iv1 = 123;
res = s(iv1, &iv2, &dsv1, &dsv2);
dsv2.dsc$a_pointer[sizeof(sv2) - 1] = 0;
printf("%d %d %s\n", res, iv2, dsv2.dsc$a_pointer);
return 0;
}
or if using $DESCRIPTOR macro to define descriptors:
#include <stdio.h>
#include <string.h>
#include <descrip.h>
int s(int iv1, int *iv2, struct dsc$descriptor_s *dsv1, struct dsc$descriptor_s *dsv2);
int main()
{
int iv1, iv2, res;
char sv1[11] = "ABC ";
char sv2[11];
$DESCRIPTOR(dsv1, sv1);
$DESCRIPTOR(dsv2, sv2);
iv1 = 123;
res = s(iv1, &iv2, &dsv1, &dsv2);
dsv2.dsc$a_pointer[sizeof(sv2) - 1] = 0;
printf("%d %d %s\n", res, iv2, dsv2.dsc$a_pointer);
return 0;
}
program p
declare integer iv1
declare integer iv2
declare integer res
map (sv1) string sv1 = 10
map (sv2) string sv2 = 10
external integer function s(integer by value, integer, string, string)
iv1 = 123
sv1 = "ABC"
res = s(iv1, iv2, sv1, sv2)
print res, iv2, sv2
end program
.title p
.psect $PDATA quad,pic,con,lcl,shr,noexe,nowrt
.psect $LOCAL quad,pic,con,lcl,noshr,noexe,wrt
iv1: .long 123
iv2: .long 0
sv1: .ascid "ABC "
sv2: .ascid " "
dir: .ascid "!SL !SL !AS"
res: .ascid " "
reslen: .long 0
.psect $CODE quad,pic,con,lcl,shr,exe,nowrt
.entry p,^m<>
pushal sv2
pushal sv1
pushal iv2
pushl iv1
calls #4,S
;
pushal sv2
pushl iv2
pushl r0
pushal res
pushal reslen
pushal dir
calls #6,G^LIB$SYS_FAO
;
pushal res
calls #1,G^LIB$PUT_OUTPUT
;
movl #1,r0
ret
.end p
Called function:
INTEGER*4 FUNCTION S(TEMPIV1,IV2,SV1,SV2)
INTEGER*4 IV1,IV2,TEMPIV1
CHARACTER*10 SV1,SV2
IV1=%LOC(TEMPIV1) ! hack because Fortran do not support pass by value
IV2=IV1+1
SV2=SV1
SV2(4:4)='X'
S=1
RETURN
END
module ms(input, output);
[global] function s(%IMMED iv1 : integer;
var iv2 : integer;
sv1 : [class_s] packed array[low1..high1:integer] of char;
var sv2 : [class_s] packed array[low2..high2:integer] of char) : integer;
begin
iv2 := iv1 + 1;
sv2 := sv1;
sv2[4] := 'X';
s := 1;
end;
end.
#include <string.h>
#include <descrip.h>
int s(int iv1, int *iv2, struct dsc$descriptor_s *dsv1, struct dsc$descriptor_s *dsv2)
{
*iv2 = iv1 + 1;
memcpy(dsv2->dsc$a_pointer, dsv1->dsc$a_pointer, dsv1->dsc$w_length);
dsv2->dsc$a_pointer[3] = 'X';
return 1;
}
function integer s(integer iv1 by value, integer iv2, string sv1, string sv2)
iv2 = iv1 + 1
sv2 = sv1
mid$(sv2, 4, 1) = "X"
s = 1
end function
.title s
iv1=4
iv2=8
sv1=12
sv2=16
X=88
.psect $CODE quad,pic,con,lcl,shr,exe,nowrt
.entry s,^m<r2,r3,r4,r5,r6,r7,r8>
movl iv1(ap),@iv2(ap)
incl @iv2(ap)
movl sv1(ap),r6
movl sv2(ap),r7
movc3 (r6),@4(r6),@4(r7)
addl3 #3,4(r7),r8
movb #X,(r8)
movl #1,r0
ret
.end
Version | Date | Description |
---|---|---|
1.0 | February 2nd 2020 | Initial version |
1.1 | February 9th 2020 | Add direct Lazarus/Delphi to C and Windows COM |
See list of all articles here
Please send comments to Arne Vajhøj