- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
-------------------------- my f90 file is (exf.f90):----------
module cprog
interface
subroutine SUBA(a)
!DEC$ ATTRIBUTES C,ALIAS:'_sub1'::SUBA
integer::a
!DEC$ ATTRIBUTES REFERENCE::a
end subroutine
subroutine SUBB(A)
!DEC$ ATTRIBUTES C,ALIAS:'_sub2'::SUBB
integer::a
!DEC$ ATTRIBUTES VALUE::a
end subroutine
end interface
end module cprog
program exf
use cprog
implicit none
integer::a=10
call SUBA(a)
call SUBB(a)
stop
end program exf
--------------- my C++ file is (exc.cpp): -----------------
#include
#indef __cplusplus
extern "C"{
#endif
void sub1(int *num)
{
printf("%d ",*num);
}
void sub2(int num)
{
printf("%d ",num)
}
#ifdef __cplusplus
}
#endif
---------------But I got the following error message after I insert the above two files, exf.f90 and exc.cpp, into my intel fortran project -----
TestCallC fatal error LNK1120: 2 unresolved externals
TestCallC error LNK2019: unresolved external symbol _sub1 referenced in function _MAIN__
TestCallC error LNK2019: unresolved external symbol _sub2 referenced in function _MAIN__
----------- what is the problem? thanks a lot for your help! ----------
module cprog
interface
subroutine SUBA(a)
!DEC$ ATTRIBUTES C,ALIAS:'_sub1'::SUBA
integer::a
!DEC$ ATTRIBUTES REFERENCE::a
end subroutine
subroutine SUBB(A)
!DEC$ ATTRIBUTES C,ALIAS:'_sub2'::SUBB
integer::a
!DEC$ ATTRIBUTES VALUE::a
end subroutine
end interface
end module cprog
program exf
use cprog
implicit none
integer::a=10
call SUBA(a)
call SUBB(a)
stop
end program exf
--------------- my C++ file is (exc.cpp): -----------------
#include
#indef __cplusplus
extern "C"{
#endif
void sub1(int *num)
{
printf("%d ",*num);
}
void sub2(int num)
{
printf("%d ",num)
}
#ifdef __cplusplus
}
#endif
---------------But I got the following error message after I insert the above two files, exf.f90 and exc.cpp, into my intel fortran project -----
TestCallC fatal error LNK1120: 2 unresolved externals
TestCallC error LNK2019: unresolved external symbol _sub1 referenced in function _MAIN__
TestCallC error LNK2019: unresolved external symbol _sub2 referenced in function _MAIN__
----------- what is the problem? thanks a lot for your help! ----------
Link Copied
9 Replies
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I am guessing that C++ is mangling the names. (to examine the names in the symbol table, use DUMPBIN on the generated C-object file).Try changing the C++ file extension to .C and having another go. Also, try ATTRIBUTES C, REFERENCE,ALIAS in your compiler directive, combined with
extern "C" { __cdecl void sub1(int *num) }
in your C code.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Can someone give me a successfully compiled project example?
I used IVF 9.1 and MS Visual Studio 2003 and tried some examples for calling C routine from Fortran program!
your help will be highly appreciated!
I used IVF 9.1 and MS Visual Studio 2003 and tried some examples for calling C routine from Fortran program!
your help will be highly appreciated!
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Steve:
Thank you very much for your kind help!
Thank you very much for your kind help!
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Why did I still meet with such a problem?
----- ------------ my .cpp file -----------------
#include
#include "tchar.h"
#include
//
#include // MFC core and standard components
#define MAX_KEY_LENGTH 256 // the maximum length of keynames
using namespace std;
extern "C" void c_setenv() ;
int GetKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[]);
int GetAppendKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[]);
int GetLoopKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[]);
extern "C" void c_setenv()
{
HKEY RootKey;
char sz[MAX_KEY_LENGTH];
CString FullLib(_T("lib=")), FullPath(_T("path="));
//const char* EnvLib, EnvPath;
int islib,ispath;
int iret;
...........
}
int GetKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
{
.......
}
int GetAppendKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
{
........
}
int GetLoopKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
{
.......
}
---------------my main .f90 file (modified from yours)--------------------
! Copyright (C) 2007 Intel Corporation. All Rights Reserved.
!
! The source code contained or described herein and all documents related to the source code
! ("Material") are owned by Intel Corporation or its suppliers or licensors. Title to the
! Material remains with Intel Corporation or its suppliers and licensors. The Material is
! protected by worldwide copyright laws and treaty provisions. No part of the Material may be
! used, copied, reproduced, modified, published, uploaded, posted, transmitted, distributed,
! or disclosed in any way except as expressly provided in the license provided with the
! Materials. No license under any patent, copyright, trade secret or other intellectual
! property right is granted to or conferred upon you by disclosure or delivery of the
! Materials, either expressly, by implication, inducement, estoppel or otherwise, except as
! expressly provided in the license provided with the Materials.
PROGRAM fmain
IMPLICIT NONE
! This is an example of a Fortran main program calling
! a C routine.
!
! Declare the interface for the C routine we'll call
!
INTERFACE
SUBROUTINE croutine (int_arg, str_in, str_out)
! Specify C calling and naming conventions
!DEC$ ATTRIBUTES C :: croutine
INTEGER, INTENT(IN) :: int_arg
CHARACTER(*) str_in,str_out
!
! Specify that the CHARACTER arguments are by reference
! with no hidden length
!DEC$ ATTRIBUTES REFERENCE :: str_in, str_out
END SUBROUTINE croutine
SUBROUTINE c_setenv()
! Specify C calling and naming conventions
!DEC$ ATTRIBUTES C :: c_setenv
END SUBROUTINE c_setenv
END INTERFACE
CHARACTER(80) OUTPUT_TEXT
INTEGER IN_ARG, OUTPUT_LEN, is1, is2
CHARACTER(80) INPUT_TEXT
character(255) mylib, mypath
INPUT_TEXT = "Testing..."C ! C suffix adds a null terminator
IN_ARG = 123
! Call c_routine. It will return text in OUTPUT_TEXT
!
CALL croutine (in_arg, input_text, output_text)
! Find the length of the output text, looking
! for the trailing blank
!
OUTPUT_LEN = INDEX(OUTPUT_TEXT," ")
IF (OUTPUT_LEN == 0) OUTPUT_LEN = 80
! Write the string to the console
!
WRITE (*,*) OUTPUT_TEXT(1:OUTPUT_LEN)
CALL c_setenv()
!
END
--------------- I got the errors ------------------
nafxcwd.lib(thrdcore.obj) : error LNK2019: unresolved external symbol __endthreadex referenced in function "void __stdcall AfxEndThread(unsigned int,int)" (?AfxEndThread@@YGXIH@Z)
nafxcwd.lib(thrdcore.obj) : error LNK2019: unresolved external symbol __beginthreadex referenced in function "public: int __thiscall CWinThread::CreateThread(unsigned long,unsigned int,struct _SECURITY_ATTRIBUTES *)" (?CreateThread@CWinThread@@QAEHKIPAU_SECURITY_ATTRIBUTES@@@Z)
Debug/Fmain.exe : fatal error LNK1120: 2 unresolved externals
---------------------------------
Moreover, in your example, you just gave an example to pass Fortran strings to C, but not C strings to Fortran,
I found that it may not be easy to pass C strings to Fortran,
Can you example code be modified to fullfil this purpose?
Thank you very much!
----- ------------ my .cpp file -----------------
#include
#include "tchar.h"
#include
//
#include
#define MAX_KEY_LENGTH 256 // the maximum length of keynames
using namespace std;
extern "C" void c_setenv() ;
int GetKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[]);
int GetAppendKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[]);
int GetLoopKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[]);
extern "C" void c_setenv()
{
HKEY RootKey;
char sz[MAX_KEY_LENGTH];
CString FullLib(_T("lib=")), FullPath(_T("path="));
//const char* EnvLib, EnvPath;
int islib,ispath;
int iret;
...........
}
int GetKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
{
.......
}
int GetAppendKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
{
........
}
int GetLoopKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
{
.......
}
---------------my main .f90 file (modified from yours)--------------------
! Copyright (C) 2007 Intel Corporation. All Rights Reserved.
!
! The source code contained or described herein and all documents related to the source code
! ("Material") are owned by Intel Corporation or its suppliers or licensors. Title to the
! Material remains with Intel Corporation or its suppliers and licensors. The Material is
! protected by worldwide copyright laws and treaty provisions. No part of the Material may be
! used, copied, reproduced, modified, published, uploaded, posted, transmitted, distributed,
! or disclosed in any way except as expressly provided in the license provided with the
! Materials. No license under any patent, copyright, trade secret or other intellectual
! property right is granted to or conferred upon you by disclosure or delivery of the
! Materials, either expressly, by implication, inducement, estoppel or otherwise, except as
! expressly provided in the license provided with the Materials.
PROGRAM fmain
IMPLICIT NONE
! This is an example of a Fortran main program calling
! a C routine.
!
! Declare the interface for the C routine we'll call
!
INTERFACE
SUBROUTINE croutine (int_arg, str_in, str_out)
! Specify C calling and naming conventions
!DEC$ ATTRIBUTES C :: croutine
INTEGER, INTENT(IN) :: int_arg
CHARACTER(*) str_in,str_out
!
! Specify that the CHARACTER arguments are by reference
! with no hidden length
!DEC$ ATTRIBUTES REFERENCE :: str_in, str_out
END SUBROUTINE croutine
SUBROUTINE c_setenv()
! Specify C calling and naming conventions
!DEC$ ATTRIBUTES C :: c_setenv
END SUBROUTINE c_setenv
END INTERFACE
CHARACTER(80) OUTPUT_TEXT
INTEGER IN_ARG, OUTPUT_LEN, is1, is2
CHARACTER(80) INPUT_TEXT
character(255) mylib, mypath
INPUT_TEXT = "Testing..."C ! C suffix adds a null terminator
IN_ARG = 123
! Call c_routine. It will return text in OUTPUT_TEXT
!
CALL croutine (in_arg, input_text, output_text)
! Find the length of the output text, looking
! for the trailing blank
!
OUTPUT_LEN = INDEX(OUTPUT_TEXT," ")
IF (OUTPUT_LEN == 0) OUTPUT_LEN = 80
! Write the string to the console
!
WRITE (*,*) OUTPUT_TEXT(1:OUTPUT_LEN)
CALL c_setenv()
!
END
--------------- I got the errors ------------------
nafxcwd.lib(thrdcore.obj) : error LNK2019: unresolved external symbol __endthreadex referenced in function "void __stdcall AfxEndThread(unsigned int,int)" (?AfxEndThread@@YGXIH@Z)
nafxcwd.lib(thrdcore.obj) : error LNK2019: unresolved external symbol __beginthreadex referenced in function "public: int __thiscall CWinThread::CreateThread(unsigned long,unsigned int,struct _SECURITY_ATTRIBUTES *)" (?CreateThread@CWinThread@@QAEHKIPAU_SECURITY_ATTRIBUTES@@@Z)
Debug/Fmain.exe : fatal error LNK1120: 2 unresolved externals
---------------------------------
Moreover, in your example, you just gave an example to pass Fortran strings to C, but not C strings to Fortran,
I found that it may not be easy to pass C strings to Fortran,
Can you example code be modified to fullfil this purpose?
Thank you very much!
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
You asked for an example of calling C from Fortran. Passing C strings to Fortran is easy and is documented in the Building Applications manual. On the Fortran side, declare the argument as CHARACTER(*) and add !DEC$ ATTRIBUTES REFERENCE for the character argument. Then add code to the Fortran routine that uses INDEX to find the trailing NUL to get the length.
An alternative, which is used in the "C_Calls_Fortran" sample attached to the samples thread in this forum is to have C pass the lengths by value at the end of the argument list. Then you don't use the ATTRIBUTES REFERENCE directive.
The linking error you're getting is entirely on the C++ side - it has nothing to do with Fortran. I'd guess that you need to perhaps link with the /MT switch, though I'm not sure.
An alternative, which is used in the "C_Calls_Fortran" sample attached to the samples thread in this forum is to have C pass the lengths by value at the end of the argument list. Then you don't use the ATTRIBUTES REFERENCE directive.
The linking error you're getting is entirely on the C++ side - it has nothing to do with Fortran. I'd guess that you need to perhaps link with the /MT switch, though I'm not sure.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I am not familar with VC, especially C/Fortran interface, I provide my code, here, wish you can give me a help!
--------------------Fmain.f90-(I add in another routine interface for calling setenvbyreg)--------------
! Copyright (C) 2007 Intel Corporation. All Rights Reserved.
!
! The source code contained or described herein and all documents related to the source code
! ("Material") are owned by Intel Corporation or its suppliers or licensors. Title to the
! Material remains with Intel Corporation or its suppliers and licensors. The Material is
! protected by worldwide copyright laws and treaty provisions. No part of the Material may be
! used, copied, reproduced, modified, published, uploaded, posted, transmitted, distributed,
! or disclosed in any way except as expressly provided in the license provided with the
! Materials. No license under any patent, copyright, trade secret or other intellectual
! property right is granted to or conferred upon you by disclosure or delivery of the
! Materials, either expressly, by implication, inducement, estoppel or otherwise, except as
! expressly provided in the license provided with the Materials.
PROGRAM fmain
IMPLICIT NONE
! This is an example of a Fortran main program calling
! a C routine.
!
! Declare the interface for the C routine we'll call
!
INTERFACE
SUBROUTINE croutine (int_arg, str_in, str_out)
! Specify C calling and naming conventions
!DEC$ ATTRIBUTES C :: croutine
INTEGER, INTENT(IN) :: int_arg
CHARACTER(*) str_in,str_out
!
! Specify that the CHARACTER arguments are by reference
! with no hidden length
!DEC$ ATTRIBUTES REFERENCE :: str_in, str_out
END SUBROUTINE croutine
! SUBROUTINE SetEnvByReg(is1, is2)
SUBROUTINE setenvbyreg()
! Specify C calling and naming conventions
!DEC$ ATTRIBUTES C:: setenvbyreg
END SUBROUTINE setenvbyreg
END INTERFACE
CHARACTER(80) OUTPUT_TEXT
INTEGER IN_ARG, OUTPUT_LEN, is1, is2
CHARACTER(80) INPUT_TEXT
INPUT_TEXT = "Testing..."C ! C suffix adds a null terminator
IN_ARG = 123
! Call c_routine. It will return text in OUTPUT_TEXT
!
CALL croutine (in_arg, input_text, output_text)
! Find the length of the output text, looking
! for the trailing blank
!
OUTPUT_LEN = INDEX(OUTPUT_TEXT," ")
IF (OUTPUT_LEN == 0) OUTPUT_LEN = 80
! Write the string to the console
!
WRITE (*,*) OUTPUT_TEXT(1:OUTPUT_LEN)
! CALL SetEnvByReg(is1,is2)
CALL setenvbyreg()
!
END
-------------------------Csub.cpp (your example routine)------
/*
! Copyright (C) 2007 Intel Corporation. All Rights Reserved.
!
! The source code contained or described herein and all documents related to the source code
! ("Material") are owned by Intel Corporation or its suppliers or licensors. Title to the
! Material remains with Intel Corporation or its suppliers and licensors. The Material is
! protected by worldwide copyright laws and treaty provisions. No part of the Material may be
! used, copied, reproduced, modified, published, uploaded, posted, t ransmitted, distributed,
! or disclosed in any way except as expressly provided in the license provided with the
! Materials. No license under any patent, copyright, trade secret or other intellectual
! property right is granted to or conferred upon you by disclosure or delivery of the
! Materials, either expressly, by implication, inducement, estoppel or otherwise, except as
! expressly provided in the license provided with the Materials.
*/
/* C routine called by Fortran main program
**
** Converts integer input argument to text, appends
** the text to string input argument and stores the
** result in the string output argument
*/
#include
#include
#include
void setenvbyreg();
extern "C" void croutine (
int int_arg,
char* input_text,
char* output_text
)
{
sprintf(output_text,"%s%i ",input_text,int_arg);
}
--------------------------SetEnv.cpp (my new c++ routine)----
/* C routine called by Fortran main program
**
** this C is to set environment for the main Fortran program
** full_lib is the returned full library
** full_path is the returned full path.
*/
#include
#include "tchar.h"
#include
//
#include // MFC core and standard components
//#include // MFC extensions
//#include // MFC support for Internet Explorer 4 Common Controls
//#include // MFC support for Windows Common Controls
#define MAX_KEY_LENGTH 256 // the maximum length of keynames
extern "C" void setenvbyreg() ;
unsigned int GetKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[]);
unsigned int GetAppendKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[]);
unsigned GetLoopKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[]);
extern "C" void setenvbyreg()
{
HKEY RootKey;
char sz[MAX_KEY_LENGTH];
//char* MyLib[MAX_KEY_LENGTH], MyPath[MAX_KEY_LENGTH];
CString cstrFileName(_T("rreg.dat")),FullLib(_T("lib=")), FullPath(_T("path="));
//DWORD dwtype, sl = 256;
int iret;
RootKey = HKEY_LOCAL_MACHINE ;
iret = GetKeyValue(RootKey, "SOFTWAREMicrosoftMSNMessenger","InstallationDirectory", sz);
// printf(sz);
if(iret==2)
{
CString cstrTemp1(sz);
// FullPath += cstrTemp1 + "GEODLLS;";
}
iret = GetAppendKeyValue(RootKey, "SOFTWAREIntelCompilersFortran", "ProductDir", sz);
//printf(sz);
if(iret==4)
{
CString cstrTemp2(sz);
FullLib += cstrTemp2 + "lib;";
FullPath += cstrTemp2 + "bin;";
}
iret = GetLoopKeyValue(RootKey, "SOFTWAREMicrosoftVisualStudio", "InstallDir", sz);
//printf(sz);
if(iret==4)
{
CString cstrTemp3(sz);
FullLib += cstrTemp3 + ";";
FullPath += cstrTemp3 + ";";
}
// printf("%s ", FullLib);
// printf("%s ", FullPath);
// Get CString pointers from "FullLib" and "FullPath";
const char* MyLib = (LPCTSTR)FullLib;
const char* MyPath = (LPCTSTR)FullPath;
printf("%s ", MyLib);
printf("%s ", MyPath);
}
unsigned int GetKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
{
HKEY hKey;
DWORD dwtype, sl = 256;
unsigned int iFlag;
iFlag = 0;
if(RegOpenKeyEx(RootKey, SubKey, NULL, KEY_READ, &hKey)==ERROR_SUCCESS)
iFlag = 1;
if(iFlag==1)
{
if(RegQueryValueEx(hKey, QKey, NULL, &dwtype, (LPBYTE)KeyValue, &sl)==ERROR_SUCCESS)
iFlag = 2; // Fully success;
}
RegCloseKey(hKey);
return iFlag;
}
// int GetAppendKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
unsigned int GetAppendKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
{
HKEY hKey, hKey1, hKey2;
DWORD dwNumSubKey=0, dwNumSSKey, dwLenSoftVer, dwtype, sl = 256;
CString cstrSubKey(SubKey);
TCHAR KeySoftVer[MAX_KEY_LENGTH];
unsigned int i, iFlag;
iFlag = 0;
if(RegOpenKeyEx(RootKey, cstrSubKey, NULL, KEY_READ, &hKey)==ERROR_SUCCESS)
iFlag = 1;
// RegCloseKey(hKey);
if(iFlag==1)
// Query the number of subkeys of current key ;
&nb sp; RegQueryInfoKey(hKey, NULL, NULL, NULL, &dwNumSubKey, NULL, NULL, NULL, NULL, NULL, NULL, NULL);
// If numSubKey is not zero, scan the subkeys !
if (dwNumSubKey)
{
for (i=0; i { /*the following two lines are important to intialize variables in each loop*/
KeySoftVer[0]= ''; //the 1st line is to NULL subkey;
dwLenSoftVer = MAX_KEY_LENGTH; //the 2nd line is to set length for buffer;
dwNumSSKey=0;
RegEnumKeyEx( hKey, // the Key handle;
i, // the subkey number;
KeySoftVer, // the returned subkeyname;
&dwLenSoftVer, // the returned size of buffer;
NULL, NULL, NULL, NULL);
/*Scan subkeys*/
RegOpenKeyEx(RootKey, // Root key to be opened
cstrSubKey+KeySoftVer+"", // Key to be opened
0, // must be 0
KEY_READ, // access authority
&hKey1); // the returned key handle
// Query the number of values of current key ;
RegQueryInfoKey(hKey1, // The Key handle;
NULL, NULL, NULL, NULL, NULL, NULL,
&dwNumSSKey, //Returned the number of values;
NULL, NULL, NULL, NULL);
if (dwNumSSKey)
{ iFlag = 2;
cstrSubKey = cstrSubKey+KeySoftVer+"IA32";
break;
}
} // End of Loop !
}
if(iFlag==2)
{
if(RegOpenKeyEx(RootKey, cstrSubKey, NULL, KEY_READ, &hKey2)==ERROR_SUCCESS)
iFlag = 3;
if(iFlag==3)
{
if(RegQueryValueEx(hKey2, QKey, NULL, &dwtype, (LPBYTE)KeyValue, &sl)==ERROR_SUCCESS)
iFlag = 4; // Fully success;
}
}
RegCloseKey(hKey); //the closing is necessary in case of slowing down computer!
RegCloseKey(hKey1);
RegCloseKey(hKey2);
return iFlag;
}
// int GetLoopKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
unsigned int GetLoopKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
{
HKEY hKey, hKey1;
DWORD dwNumSubKey=0, dwNumSSKey, dwLenSoftVer, dwtype, sl = 256;
CString cstrSubKey(SubKey);
TCHAR KeySoftVer[MAX_KEY_LENGTH];
unsigned i, iFlag;
iFlag = 0;
if(RegOpenKeyEx(RootKey, cstrSubKey, NULL, KEY_READ, &hKey)==ERROR_SUCCESS)
iFlag = 1;
&nb sp; // RegCloseKey(hKey);
if(iFlag==1)
// Query the number of subkeys of current key ;
RegQueryInfoKey(hKey, NULL, NULL, NULL, &dwNumSubKey, NULL, NULL, NULL, NULL, NULL, NULL, NULL);
// If numSubKey is not zero, scan the subkeys !
if (dwNumSubKey)
{
for (i=0; i { /*the following two lines are important to intialize variables in each loop*/
KeySoftVer[0]= ''; //the 1st line is to NULL subkey;
dwLenSoftVer = MAX_KEY_LENGTH; //the 2nd line is to set length for buffer;
dwNumSSKey=0;
RegEnumKeyEx( hKey, // the Key handle;
i, // the subkey number;
KeySoftVer, // the returned subkeyname;
&dwLenSoftVer, // the returned size of buffer;
NULL, NULL, NULL, NULL);
/*Scan subkeys*/
RegOpenKeyEx(RootKey, // Root key to be opened
cstrSubKey+KeySoftVer+"", // Key to be opened
0, // must be 0
KEY_READ, // access aut hority
&hKey1); // the returned key handle
// Query the number of values of current key ;
RegQueryInfoKey(hKey1, // The Key handle;
NULL, NULL, NULL, NULL, NULL, NULL,
&dwNumSSKey, //Returned the number of values;
NULL, NULL, NULL, NULL);
if (dwNumSSKey)
{ iFlag = 2;
break;
}
} // End of Loop !
}
else
{hKey1 = hKey;} // numSubKey == 0
if(iFlag==1)
{if(RegQueryValueEx(hKey1, QKey, NULL, &dwtype, (LPBYTE)KeyValue, &sl)==ERROR_SUCCESS)
iFlag = 3;
}
if(iFlag==2)
{ if(RegQueryValueEx(hKey1, QKey, NULL, &dwtype, (LPBYTE)KeyValue, &sl)==ERROR_SUCCESS)
iFlag = 4;
}
RegCloseKey(hKey); //the closing is necessary in case of slowing down computer!
RegCloseKey(hKey1);
return iFlag;
}
------------------------------------------------------------------
Could you help to see what's the problem?
Thank you very much!
lyricx
--------------------Fmain.f90-(I add in another routine interface for calling setenvbyreg)--------------
! Copyright (C) 2007 Intel Corporation. All Rights Reserved.
!
! The source code contained or described herein and all documents related to the source code
! ("Material") are owned by Intel Corporation or its suppliers or licensors. Title to the
! Material remains with Intel Corporation or its suppliers and licensors. The Material is
! protected by worldwide copyright laws and treaty provisions. No part of the Material may be
! used, copied, reproduced, modified, published, uploaded, posted, transmitted, distributed,
! or disclosed in any way except as expressly provided in the license provided with the
! Materials. No license under any patent, copyright, trade secret or other intellectual
! property right is granted to or conferred upon you by disclosure or delivery of the
! Materials, either expressly, by implication, inducement, estoppel or otherwise, except as
! expressly provided in the license provided with the Materials.
PROGRAM fmain
IMPLICIT NONE
! This is an example of a Fortran main program calling
! a C routine.
!
! Declare the interface for the C routine we'll call
!
INTERFACE
SUBROUTINE croutine (int_arg, str_in, str_out)
! Specify C calling and naming conventions
!DEC$ ATTRIBUTES C :: croutine
INTEGER, INTENT(IN) :: int_arg
CHARACTER(*) str_in,str_out
!
! Specify that the CHARACTER arguments are by reference
! with no hidden length
!DEC$ ATTRIBUTES REFERENCE :: str_in, str_out
END SUBROUTINE croutine
! SUBROUTINE SetEnvByReg(is1, is2)
SUBROUTINE setenvbyreg()
! Specify C calling and naming conventions
!DEC$ ATTRIBUTES C:: setenvbyreg
END SUBROUTINE setenvbyreg
END INTERFACE
CHARACTER(80) OUTPUT_TEXT
INTEGER IN_ARG, OUTPUT_LEN, is1, is2
CHARACTER(80) INPUT_TEXT
INPUT_TEXT = "Testing..."C ! C suffix adds a null terminator
IN_ARG = 123
! Call c_routine. It will return text in OUTPUT_TEXT
!
CALL croutine (in_arg, input_text, output_text)
! Find the length of the output text, looking
! for the trailing blank
!
OUTPUT_LEN = INDEX(OUTPUT_TEXT," ")
IF (OUTPUT_LEN == 0) OUTPUT_LEN = 80
! Write the string to the console
!
WRITE (*,*) OUTPUT_TEXT(1:OUTPUT_LEN)
! CALL SetEnvByReg(is1,is2)
CALL setenvbyreg()
!
END
-------------------------Csub.cpp (your example routine)------
/*
! Copyright (C) 2007 Intel Corporation. All Rights Reserved.
!
! The source code contained or described herein and all documents related to the source code
! ("Material") are owned by Intel Corporation or its suppliers or licensors. Title to the
! Material remains with Intel Corporation or its suppliers and licensors. The Material is
! protected by worldwide copyright laws and treaty provisions. No part of the Material may be
! used, copied, reproduced, modified, published, uploaded, posted, t ransmitted, distributed,
! or disclosed in any way except as expressly provided in the license provided with the
! Materials. No license under any patent, copyright, trade secret or other intellectual
! property right is granted to or conferred upon you by disclosure or delivery of the
! Materials, either expressly, by implication, inducement, estoppel or otherwise, except as
! expressly provided in the license provided with the Materials.
*/
/* C routine called by Fortran main program
**
** Converts integer input argument to text, appends
** the text to string input argument and stores the
** result in the string output argument
*/
#include
#include
#include
void setenvbyreg();
extern "C" void croutine (
int int_arg,
char* input_text,
char* output_text
)
{
sprintf(output_text,"%s%i ",input_text,int_arg);
}
--------------------------SetEnv.cpp (my new c++ routine)----
/* C routine called by Fortran main program
**
** this C is to set environment for the main Fortran program
** full_lib is the returned full library
** full_path is the returned full path.
*/
#include
#include "tchar.h"
#include
//
#include
//#include
//#include
//#include
#define MAX_KEY_LENGTH 256 // the maximum length of keynames
extern "C" void setenvbyreg() ;
unsigned int GetKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[]);
unsigned int GetAppendKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[]);
unsigned GetLoopKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[]);
extern "C" void setenvbyreg()
{
HKEY RootKey;
char sz[MAX_KEY_LENGTH];
//char* MyLib[MAX_KEY_LENGTH], MyPath[MAX_KEY_LENGTH];
CString cstrFileName(_T("rreg.dat")),FullLib(_T("lib=")), FullPath(_T("path="));
//DWORD dwtype, sl = 256;
int iret;
RootKey = HKEY_LOCAL_MACHINE ;
iret = GetKeyValue(RootKey, "SOFTWAREMicrosoftMSNMessenger","InstallationDirectory", sz);
// printf(sz);
if(iret==2)
{
CString cstrTemp1(sz);
// FullPath += cstrTemp1 + "GEODLLS;";
}
iret = GetAppendKeyValue(RootKey, "SOFTWAREIntelCompilersFortran", "ProductDir", sz);
//printf(sz);
if(iret==4)
{
CString cstrTemp2(sz);
FullLib += cstrTemp2 + "lib;";
FullPath += cstrTemp2 + "bin;";
}
iret = GetLoopKeyValue(RootKey, "SOFTWAREMicrosoftVisualStudio", "InstallDir", sz);
//printf(sz);
if(iret==4)
{
CString cstrTemp3(sz);
FullLib += cstrTemp3 + ";";
FullPath += cstrTemp3 + ";";
}
// printf("%s ", FullLib);
// printf("%s ", FullPath);
// Get CString pointers from "FullLib" and "FullPath";
const char* MyLib = (LPCTSTR)FullLib;
const char* MyPath = (LPCTSTR)FullPath;
printf("%s ", MyLib);
printf("%s ", MyPath);
}
unsigned int GetKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
{
HKEY hKey;
DWORD dwtype, sl = 256;
unsigned int iFlag;
iFlag = 0;
if(RegOpenKeyEx(RootKey, SubKey, NULL, KEY_READ, &hKey)==ERROR_SUCCESS)
iFlag = 1;
if(iFlag==1)
{
if(RegQueryValueEx(hKey, QKey, NULL, &dwtype, (LPBYTE)KeyValue, &sl)==ERROR_SUCCESS)
iFlag = 2; // Fully success;
}
RegCloseKey(hKey);
return iFlag;
}
// int GetAppendKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
unsigned int GetAppendKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
{
HKEY hKey, hKey1, hKey2;
DWORD dwNumSubKey=0, dwNumSSKey, dwLenSoftVer, dwtype, sl = 256;
CString cstrSubKey(SubKey);
TCHAR KeySoftVer[MAX_KEY_LENGTH];
unsigned int i, iFlag;
iFlag = 0;
if(RegOpenKeyEx(RootKey, cstrSubKey, NULL, KEY_READ, &hKey)==ERROR_SUCCESS)
iFlag = 1;
// RegCloseKey(hKey);
if(iFlag==1)
// Query the number of subkeys of current key ;
&nb sp; RegQueryInfoKey(hKey, NULL, NULL, NULL, &dwNumSubKey, NULL, NULL, NULL, NULL, NULL, NULL, NULL);
// If numSubKey is not zero, scan the subkeys !
if (dwNumSubKey)
{
for (i=0; i
KeySoftVer[0]= ''; //the 1st line is to NULL subkey;
dwLenSoftVer = MAX_KEY_LENGTH; //the 2nd line is to set length for buffer;
dwNumSSKey=0;
RegEnumKeyEx( hKey, // the Key handle;
i, // the subkey number;
KeySoftVer, // the returned subkeyname;
&dwLenSoftVer, // the returned size of buffer;
NULL, NULL, NULL, NULL);
/*Scan subkeys*/
RegOpenKeyEx(RootKey, // Root key to be opened
cstrSubKey+KeySoftVer+"", // Key to be opened
0, // must be 0
KEY_READ, // access authority
&hKey1); // the returned key handle
// Query the number of values of current key ;
RegQueryInfoKey(hKey1, // The Key handle;
NULL, NULL, NULL, NULL, NULL, NULL,
&dwNumSSKey, //Returned the number of values;
NULL, NULL, NULL, NULL);
if (dwNumSSKey)
{ iFlag = 2;
cstrSubKey = cstrSubKey+KeySoftVer+"IA32";
break;
}
} // End of Loop !
}
if(iFlag==2)
{
if(RegOpenKeyEx(RootKey, cstrSubKey, NULL, KEY_READ, &hKey2)==ERROR_SUCCESS)
iFlag = 3;
if(iFlag==3)
{
if(RegQueryValueEx(hKey2, QKey, NULL, &dwtype, (LPBYTE)KeyValue, &sl)==ERROR_SUCCESS)
iFlag = 4; // Fully success;
}
}
RegCloseKey(hKey); //the closing is necessary in case of slowing down computer!
RegCloseKey(hKey1);
RegCloseKey(hKey2);
return iFlag;
}
// int GetLoopKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
unsigned int GetLoopKeyValue(HKEY RootKey, char *SubKey, char *QKey, char KeyValue[])
{
HKEY hKey, hKey1;
DWORD dwNumSubKey=0, dwNumSSKey, dwLenSoftVer, dwtype, sl = 256;
CString cstrSubKey(SubKey);
TCHAR KeySoftVer[MAX_KEY_LENGTH];
unsigned i, iFlag;
iFlag = 0;
if(RegOpenKeyEx(RootKey, cstrSubKey, NULL, KEY_READ, &hKey)==ERROR_SUCCESS)
iFlag = 1;
&nb sp; // RegCloseKey(hKey);
if(iFlag==1)
// Query the number of subkeys of current key ;
RegQueryInfoKey(hKey, NULL, NULL, NULL, &dwNumSubKey, NULL, NULL, NULL, NULL, NULL, NULL, NULL);
// If numSubKey is not zero, scan the subkeys !
if (dwNumSubKey)
{
for (i=0; i
KeySoftVer[0]= ''; //the 1st line is to NULL subkey;
dwLenSoftVer = MAX_KEY_LENGTH; //the 2nd line is to set length for buffer;
dwNumSSKey=0;
RegEnumKeyEx( hKey, // the Key handle;
i, // the subkey number;
KeySoftVer, // the returned subkeyname;
&dwLenSoftVer, // the returned size of buffer;
NULL, NULL, NULL, NULL);
/*Scan subkeys*/
RegOpenKeyEx(RootKey, // Root key to be opened
cstrSubKey+KeySoftVer+"", // Key to be opened
0, // must be 0
KEY_READ, // access aut hority
&hKey1); // the returned key handle
// Query the number of values of current key ;
RegQueryInfoKey(hKey1, // The Key handle;
NULL, NULL, NULL, NULL, NULL, NULL,
&dwNumSSKey, //Returned the number of values;
NULL, NULL, NULL, NULL);
if (dwNumSSKey)
{ iFlag = 2;
break;
}
} // End of Loop !
}
else
{hKey1 = hKey;} // numSubKey == 0
if(iFlag==1)
{if(RegQueryValueEx(hKey1, QKey, NULL, &dwtype, (LPBYTE)KeyValue, &sl)==ERROR_SUCCESS)
iFlag = 3;
}
if(iFlag==2)
{ if(RegQueryValueEx(hKey1, QKey, NULL, &dwtype, (LPBYTE)KeyValue, &sl)==ERROR_SUCCESS)
iFlag = 4;
}
RegCloseKey(hKey); //the closing is necessary in case of slowing down computer!
RegCloseKey(hKey1);
return iFlag;
}
------------------------------------------------------------------
Could you help to see what's the problem?
Thank you very much!
lyricx
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
You have not said what problem you're having. I get lots of errors compiling your C++ code - perhsaps I don't have things set up right. I don't see anything relating to problems calling C from Fortran. If I comment out all the code from your setenvbyreg routine, it builds fine.
I'm not sure why you are using C++ for that registry code - it can all be done from Fortran.
In the future, rather than pasting source code into a reply, please use the Options tab when posting to attach a ZIP of files.
I'm not sure why you are using C++ for that registry code - it can all be done from Fortran.
In the future, rather than pasting source code into a reply, please use the Options tab when posting to attach a ZIP of files.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
After I change the my Fortran and c++ workspace from singlethread to multithread, the program can work normally.
Because my Fortran program can not read registry stablly(that is, sometimes, the reading of some key may not be successful), I have to turn to C++ , the observation is C++ routine can read registry stablly.
My current problem is the string cannot be writen normally in Fortran main program, but I found I can print out ("rreg.dat") correctly in C++ routine. Could you further or someone else can give me a help? I am just a beginner of C pregramming. Thank you again!
Because my Fortran program can not read registry stablly(that is, sometimes, the reading of some key may not be successful), I have to turn to C++ , the observation is C++ routine can read registry stablly.
My current problem is the string cannot be writen normally in Fortran main program, but I found I can print out ("rreg.dat") correctly in C++ routine. Could you further or someone else can give me a help? I am just a beginner of C pregramming. Thank you again!

Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page