- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I'm doing a little project using fortran. A part of the code is designed to check the PC's mac address. Currently, I'm using call system command as follows:
CALL SYSTEM("ipconfig -all >result.tmp")
Above code will invoke the windows ipconfig-all command and output the information to an external file result.tmp. Later this file will be read to check the mac address.
Above works, except one annoying thing. The fortran code will be compiled as a dll and used by another C# program. The annoying thing is, whenever above code is executed in the C# program, a console window will be prompted shortly and then closed. I searched the forum to find if there is some way to disable the window prompt, it turns out there is some solution in the following link:
I tried that solution, it works fine for the system command "ipconfig -all", but I did not figure out how to output the result to an external file. Does anyone can give me some hints on how to achieve that ?
Thanks
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Here is a module to access MAC adapter info directly from Fortran, much easier than what you are doing now.
MODULE MAC USE ifwinty USE charfunc IMPLICIT NONE PUBLIC GetMacInfo !, PortExists PRIVATE SAVE INTEGER, PARAMETER :: MAX_ADAPTER_DESCRIPTION_LENGTH = 128 INTEGER, PARAMETER :: MAX_ADAPTER_NAME_LENGTH = 256 INTEGER, PARAMETER :: MAX_ADAPTER_ADDRESS_LENGTH = 8 INTEGER, PARAMETER :: MIB_IF_TYPE_ETHERNET = 6 ! Ipifcons.h TYPE IP_ADDRESS_STRING CHARACTER(LEN=16) :: String END TYPE IP_ADDRESS_STRING TYPE IP_MASK_STRING CHARACTER(LEN=16) :: String END TYPE IP_MASK_STRING TYPE t_IP_ADDR_STRING INTEGER (LPLONG) :: pNext TYPE (IP_ADDRESS_STRING) :: IpAddress TYPE (IP_MASK_STRING) :: IpMask INTEGER (DWORD) :: Context END TYPE t_IP_ADDR_STRING TYPE t_IP_ADAPTER_INFO INTEGER(LPLONG) :: pNext INTEGER(DWORD) :: ComboIndex CHARACTER(LEN=MAX_ADAPTER_NAME_LENGTH+4) :: AdapterName CHARACTER(LEN=MAX_ADAPTER_DESCRIPTION_LENGTH+4) :: Description INTEGER(UINT) :: AddressLength INTEGER(BYTE) :: Address(MAX_ADAPTER_ADDRESS_LENGTH) INTEGER(DWORD) :: Index INTEGER(ULONG) :: iType INTEGER(ULONG) :: DhcpEnabled INTEGER(LPLONG) :: pCurrentIpAddress TYPE(t_IP_ADDR_STRING) :: IpAddressList TYPE(t_IP_ADDR_STRING) :: GatewayList TYPE(t_IP_ADDR_STRING) :: DhcpServer INTEGER(BOOL) :: HaveWins TYPE(t_IP_ADDR_STRING) :: PrimaryWinsServer TYPE(t_IP_ADDR_STRING) :: SecondaryWinsServer INTEGER(ULONG) :: LeaseObtained INTEGER(ULONG) :: LeaseExpires END TYPE t_IP_ADAPTER_INFO ! must link with IpHlpApi.lib to access this API function; ! this interface is not included in ifwinty INTERFACE INTEGER(BOOL) FUNCTION GetAdaptersInfo (arg1, arg2) USE ifwinty !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'GetAdaptersInfo' :: GetAdaptersInfo INTEGER(LPLONG) :: arg1 INTEGER(LPLONG) :: arg2 END FUNCTION END INTERFACE CONTAINS SUBROUTINE GetMacInfo (hwnd, id) USE contwrap IMPLICIT NONE ! dialog window handle and set of static-text IDs for display INTEGER(HANDLE), INTENT(IN) :: hwnd INTEGER, INTENT(IN), DIMENSION(4) :: id CHARACTER(LEN=200) :: msg INTEGER :: i, nc, count INTEGER, PARAMETER :: acount = 16 TYPE(t_IP_ADAPTER_INFO),ALLOCATABLE :: ai(:) count = 0 ! allow for multiple adapters ALLOCATE (ai(acount)) nc = SIZEOF(ai) IF (GetAdaptersInfo(LOC(ai), LOC(nc)) == 0) THEN DO i = 1, acount SELECT CASE (ai(i)%iType) CASE (MIB_IF_TYPE_ETHERNET) ! line 1: description and MAC address !nc = INDEX(ai(i)%Description, CHAR(0)) - 1 !WRITE (msg, '(A,", ",5(Z2.2,"-"),Z2.2)') & ! ai(i)%Description(1:nc), & ! ai(i)%Address(1:ai(i)%AddressLength) nc = INDEX(ai(i)%Description, CHAR(0)) msg = ai(i)%Description(1:nc) count = count + 1 CALL StaticSetText (hwnd, id(count), msg) CALL ControlSetVisible (hwnd, id(count), .TRUE.) ! line 2: IP and Gateway addresses WRITE (msg, '("IP Addr: ",A," Gateway: ",A)') & ai(i)%IpAddressList%IpAddress%string, & ai(i)%GatewayList%IpAddress%string CALL remove_nulls (msg) count = count + 1 CALL StaticSetText (hwnd, id(count), msg) CALL ControlSetVisible (hwnd, id(count), .TRUE.) IF (count >= 4) EXIT END SELECT IF (ai(i)%pNext == NULL) EXIT END DO END IF DEALLOCATE (ai) END SUBROUTINE GetMacInfo END MODULE MAC
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Here is a module to access MAC adapter info directly from Fortran, much easier than what you are doing now.
MODULE MAC USE ifwinty USE charfunc IMPLICIT NONE PUBLIC GetMacInfo !, PortExists PRIVATE SAVE INTEGER, PARAMETER :: MAX_ADAPTER_DESCRIPTION_LENGTH = 128 INTEGER, PARAMETER :: MAX_ADAPTER_NAME_LENGTH = 256 INTEGER, PARAMETER :: MAX_ADAPTER_ADDRESS_LENGTH = 8 INTEGER, PARAMETER :: MIB_IF_TYPE_ETHERNET = 6 ! Ipifcons.h TYPE IP_ADDRESS_STRING CHARACTER(LEN=16) :: String END TYPE IP_ADDRESS_STRING TYPE IP_MASK_STRING CHARACTER(LEN=16) :: String END TYPE IP_MASK_STRING TYPE t_IP_ADDR_STRING INTEGER (LPLONG) :: pNext TYPE (IP_ADDRESS_STRING) :: IpAddress TYPE (IP_MASK_STRING) :: IpMask INTEGER (DWORD) :: Context END TYPE t_IP_ADDR_STRING TYPE t_IP_ADAPTER_INFO INTEGER(LPLONG) :: pNext INTEGER(DWORD) :: ComboIndex CHARACTER(LEN=MAX_ADAPTER_NAME_LENGTH+4) :: AdapterName CHARACTER(LEN=MAX_ADAPTER_DESCRIPTION_LENGTH+4) :: Description INTEGER(UINT) :: AddressLength INTEGER(BYTE) :: Address(MAX_ADAPTER_ADDRESS_LENGTH) INTEGER(DWORD) :: Index INTEGER(ULONG) :: iType INTEGER(ULONG) :: DhcpEnabled INTEGER(LPLONG) :: pCurrentIpAddress TYPE(t_IP_ADDR_STRING) :: IpAddressList TYPE(t_IP_ADDR_STRING) :: GatewayList TYPE(t_IP_ADDR_STRING) :: DhcpServer INTEGER(BOOL) :: HaveWins TYPE(t_IP_ADDR_STRING) :: PrimaryWinsServer TYPE(t_IP_ADDR_STRING) :: SecondaryWinsServer INTEGER(ULONG) :: LeaseObtained INTEGER(ULONG) :: LeaseExpires END TYPE t_IP_ADAPTER_INFO ! must link with IpHlpApi.lib to access this API function; ! this interface is not included in ifwinty INTERFACE INTEGER(BOOL) FUNCTION GetAdaptersInfo (arg1, arg2) USE ifwinty !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'GetAdaptersInfo' :: GetAdaptersInfo INTEGER(LPLONG) :: arg1 INTEGER(LPLONG) :: arg2 END FUNCTION END INTERFACE CONTAINS SUBROUTINE GetMacInfo (hwnd, id) USE contwrap IMPLICIT NONE ! dialog window handle and set of static-text IDs for display INTEGER(HANDLE), INTENT(IN) :: hwnd INTEGER, INTENT(IN), DIMENSION(4) :: id CHARACTER(LEN=200) :: msg INTEGER :: i, nc, count INTEGER, PARAMETER :: acount = 16 TYPE(t_IP_ADAPTER_INFO),ALLOCATABLE :: ai(:) count = 0 ! allow for multiple adapters ALLOCATE (ai(acount)) nc = SIZEOF(ai) IF (GetAdaptersInfo(LOC(ai), LOC(nc)) == 0) THEN DO i = 1, acount SELECT CASE (ai(i)%iType) CASE (MIB_IF_TYPE_ETHERNET) ! line 1: description and MAC address !nc = INDEX(ai(i)%Description, CHAR(0)) - 1 !WRITE (msg, '(A,", ",5(Z2.2,"-"),Z2.2)') & ! ai(i)%Description(1:nc), & ! ai(i)%Address(1:ai(i)%AddressLength) nc = INDEX(ai(i)%Description, CHAR(0)) msg = ai(i)%Description(1:nc) count = count + 1 CALL StaticSetText (hwnd, id(count), msg) CALL ControlSetVisible (hwnd, id(count), .TRUE.) ! line 2: IP and Gateway addresses WRITE (msg, '("IP Addr: ",A," Gateway: ",A)') & ai(i)%IpAddressList%IpAddress%string, & ai(i)%GatewayList%IpAddress%string CALL remove_nulls (msg) count = count + 1 CALL StaticSetText (hwnd, id(count), msg) CALL ControlSetVisible (hwnd, id(count), .TRUE.) IF (count >= 4) EXIT END SELECT IF (ai(i)%pNext == NULL) EXIT END DO END IF DEALLOCATE (ai) END SUBROUTINE GetMacInfo END MODULE MAC
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I agree with Paul that the Windows API is the way to go. For your general question, the problem is that SYSTEM doesn't execute a shell command, so you can't do redirection. I looked at ShellExecute, but it too doesn't support redirection. You'd probably have to go to CreateProcess and specify a file handle as standard output.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Actually, if you need redirection, then using the routine execute_command_line will do exactly what you want:
program run_command implicit none call execute_command_line( "ipconfig -all > cmd.out" ) end program run_command
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Simple hack to try
call execute_command_line( "start /B ipconfig -all > cmd.out" )
*** Note, program execution follows while started program is running.
Therefore, you will need to determine when the started program completes.
Possible method is to delete the output file (cmd.out), then execute the start, then
loop
attempt to open existing file (cmd.out) for exclusive use
on success, break
end loop
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
That exactly was how I implemented at the beginning. However, it turns out the getAdapterInfo method performs much faster than the execute_command_line( "start /B ipconfig -all > cmd.out" ) method, mainly because there is no associated file operation. As a result, I adopted the getAdapterInfo method for fast operation (the method will be invoked in a loop)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Paul Curtis wrote:Here is a module to access MAC adapter info directly from Fortran, much easier than what you are doing now.
MODULE MAC USE ifwinty USE charfunc IMPLICIT NONE PUBLIC GetMacInfo !, PortExists PRIVATE SAVE INTEGER, PARAMETER :: MAX_ADAPTER_DESCRIPTION_LENGTH = 128 INTEGER, PARAMETER :: MAX_ADAPTER_NAME_LENGTH = 256 INTEGER, PARAMETER :: MAX_ADAPTER_ADDRESS_LENGTH = 8 INTEGER, PARAMETER :: MIB_IF_TYPE_ETHERNET = 6 ! Ipifcons.h TYPE IP_ADDRESS_STRING CHARACTER(LEN=16) :: String END TYPE IP_ADDRESS_STRING TYPE IP_MASK_STRING CHARACTER(LEN=16) :: String END TYPE IP_MASK_STRING TYPE t_IP_ADDR_STRING INTEGER (LPLONG) :: pNext TYPE (IP_ADDRESS_STRING) :: IpAddress TYPE (IP_MASK_STRING) :: IpMask INTEGER (DWORD) :: Context END TYPE t_IP_ADDR_STRING TYPE t_IP_ADAPTER_INFO INTEGER(LPLONG) :: pNext INTEGER(DWORD) :: ComboIndex CHARACTER(LEN=MAX_ADAPTER_NAME_LENGTH+4) :: AdapterName CHARACTER(LEN=MAX_ADAPTER_DESCRIPTION_LENGTH+4) :: Description INTEGER(UINT) :: AddressLength INTEGER(BYTE) :: Address(MAX_ADAPTER_ADDRESS_LENGTH) INTEGER(DWORD) :: Index INTEGER(ULONG) :: iType INTEGER(ULONG) :: DhcpEnabled INTEGER(LPLONG) :: pCurrentIpAddress TYPE(t_IP_ADDR_STRING) :: IpAddressList TYPE(t_IP_ADDR_STRING) :: GatewayList TYPE(t_IP_ADDR_STRING) :: DhcpServer INTEGER(BOOL) :: HaveWins TYPE(t_IP_ADDR_STRING) :: PrimaryWinsServer TYPE(t_IP_ADDR_STRING) :: SecondaryWinsServer INTEGER(ULONG) :: LeaseObtained INTEGER(ULONG) :: LeaseExpires END TYPE t_IP_ADAPTER_INFO ! must link with IpHlpApi.lib to access this API function; ! this interface is not included in ifwinty INTERFACE INTEGER(BOOL) FUNCTION GetAdaptersInfo (arg1, arg2) USE ifwinty !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'GetAdaptersInfo' :: GetAdaptersInfo INTEGER(LPLONG) :: arg1 INTEGER(LPLONG) :: arg2 END FUNCTION END INTERFACE CONTAINS SUBROUTINE GetMacInfo (hwnd, id) USE contwrap IMPLICIT NONE ! dialog window handle and set of static-text IDs for display INTEGER(HANDLE), INTENT(IN) :: hwnd INTEGER, INTENT(IN), DIMENSION(4) :: id CHARACTER(LEN=200) :: msg INTEGER :: i, nc, count INTEGER, PARAMETER :: acount = 16 TYPE(t_IP_ADAPTER_INFO),ALLOCATABLE :: ai(:) count = 0 ! allow for multiple adapters ALLOCATE (ai(acount)) nc = SIZEOF(ai) IF (GetAdaptersInfo(LOC(ai), LOC(nc)) == 0) THEN DO i = 1, acount SELECT CASE (ai(i)%iType) CASE (MIB_IF_TYPE_ETHERNET) ! line 1: description and MAC address !nc = INDEX(ai(i)%Description, CHAR(0)) - 1 !WRITE (msg, '(A,", ",5(Z2.2,"-"),Z2.2)') & ! ai(i)%Description(1:nc), & ! ai(i)%Address(1:ai(i)%AddressLength) nc = INDEX(ai(i)%Description, CHAR(0)) msg = ai(i)%Description(1:nc) count = count + 1 CALL StaticSetText (hwnd, id(count), msg) CALL ControlSetVisible (hwnd, id(count), .TRUE.) ! line 2: IP and Gateway addresses WRITE (msg, '("IP Addr: ",A," Gateway: ",A)') & ai(i)%IpAddressList%IpAddress%string, & ai(i)%GatewayList%IpAddress%string CALL remove_nulls (msg) count = count + 1 CALL StaticSetText (hwnd, id(count), msg) CALL ControlSetVisible (hwnd, id(count), .TRUE.) IF (count >= 4) EXIT END SELECT IF (ai(i)%pNext == NULL) EXIT END DO END IF DEALLOCATE (ai) END SUBROUTINE GetMacInfo END MODULE MAC
Thank you for your suggestion Paul!. I've made a try, but the compiler reported an error, saying that Check include path for [CHARFUNC] and [ifwinty]. Besides, in your provided sample code, it is said "IpHlpApi.lib must be linked", Unfortunately, I searched the library file but it returns nothing. There is a IpHlpApi.dll located under windows/system32 though. I'm not quite familiar with fortran coding, will you give me some hints how to run your code? Truly appreciated for your help.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Arjen Markus wrote:Actually, if you need redirection, then using the routine execute_command_line will do exactly what you want:
program run_command implicit none call execute_command_line( "ipconfig -all > cmd.out" ) end program run_command
Thanks for your suggestion. Unfortunately I'm using IVF, which does not support the command execute_command_line yet
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Which version? The routine is a standard routine in Fortran 2008. It was already available in IVF 2017. A workaround might be to put the ipconfig command with the redirection in a batch file (perhaps written on the fly). Not very elegant and you may need to specify the command as: "cmd /c name-of-batch.bat", but it ought to work ;).
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
You can see from the release notes for IFort 16.0 that EXECUTE_COMMAND_LINE was added in that version:
https://software.intel.com/en-us/articles/intel-visual-fortran-compiler-160-for-windows-release-notes-for-intel-parallel-studio-xe#f08_f15
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Arjen Markus wrote:Which version? The routine is a standard routine in Fortran 2008. It was already available in IVF 2017. A workaround might be to put the ipconfig command with the redirection in a batch file (perhaps written on the fly). Not very elegant and you may need to specify the command as: "cmd /c name-of-batch.bat", but it ought to work ;).
I'm still using IVF 2013 -_-! Maybe I should update to IVF 2017 in future
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
My module was extracted from a larger program in which the recovered MAC info text was passed to a dialog for display. You can ignore (ie, delete) the reference to charfunc, and deal with the MAC strings however you want (ie, perhaps as returned args). I have attached IPHlpApi.lib as a zipfile.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thanks for the iPHlpApi.zip. I slightly modify the program as follows:
PROGRAM MAC
USE ifwinty
IMPLICIT NONE
!
INTEGER, PARAMETER :: MAX_ADAPTER_DESCRIPTION_LENGTH = 128 !// arb.
INTEGER, PARAMETER :: MAX_ADAPTER_NAME_LENGTH = 256 !// arb.
INTEGER, PARAMETER :: MAX_ADAPTER_ADDRESS_LENGTH = 8 !// arb.
!
TYPE :: IP_ADDRESS_STRING
CHARACTER (4) :: String(4)
END TYPE
TYPE :: IP_MASK_STRING
CHARACTER (4) :: String(4)
END TYPE
!
TYPE :: t_IP_ADDR_STRING
INTEGER (LPLONG) :: pNext
TYPE (IP_ADDRESS_STRING) :: IpAddress
TYPE (IP_MASK_STRING) :: IpMask
INTEGER (DWORD) :: Context
END TYPE
!
TYPE :: t_IP_ADAPTER_INFO
INTEGER (LPLONG) :: pNext
INTEGER (DWORD) :: ComboIndex
CHARACTER (LEN = MAX_ADAPTER_NAME_LENGTH + 4) :: AdapterName
CHARACTER (LEN = MAX_ADAPTER_DESCRIPTION_LENGTH + 4) :: Description
INTEGER (UINT) :: AddressLength
INTEGER (BYTE) :: Address(MAX_ADAPTER_ADDRESS_LENGTH)
INTEGER (DWORD) :: Index
INTEGER (ULONG) :: iType
INTEGER (ULONG) :: DhcpEnabled
INTEGER (LPLONG) :: pCurrentIpAddress
TYPE (t_IP_ADDR_STRING) :: IpAddressList
TYPE (t_IP_ADDR_STRING) :: GatewayList
TYPE (t_IP_ADDR_STRING) :: DhcpServer
INTEGER (BOOL) :: HaveWins
TYPE (t_IP_ADDR_STRING) :: PrimaryWinsServer
TYPE (t_IP_ADDR_STRING) :: SecondaryWinsServer
INTEGER (ULONG) :: LeaseObtained
INTEGER (ULONG) :: LeaseExpires;
END TYPE
!
INTERFACE
INTEGER (BOOL) FUNCTION GetAdaptersInfo(arg1, arg2)
USE ifwinty
!DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'GetAdaptersInfo' :: GetAdaptersInfo
INTEGER (LPLONG) :: arg1
INTEGER (LPLONG) :: arg2
END FUNCTION
END INTERFACE
!
TYPE (t_IP_ADAPTER_INFO) :: AdapterInfo(16)
CHARACTER(LEN=17)::MACAddr(16)
CHARACTER(LEN=500) :: str1,str2
TYPE (t_IP_ADDR_STRING) :: CurrentIpAddress
INTEGER (DWORD) :: dwRetVal
INTEGER (BOOL) :: iret
INTEGER :: i,j,m,k
LOGICAL::search4Next
CHARACTER(Len=500)::info_out(50)
dwRetVal = sizeof(AdapterInfo)
!dwRetVal=10240
PRINT*,dwRetVal
!PRINT*,AdapterInfo
iret = GetAdaptersInfo(LOC(AdapterInfo), LOC(dwRetVal))
IF (iret /= 0) STOP 'Error'
DO i = 1, 16
! PRINT *, AdapterInfo(1)%pNext
! PRINT *, AdapterInfo(1)%ComboIndex
! PRINT *, AdapterInfo(1)%AddressLength
PRINT *, AdapterInfo(i)%Description(1:INDEX(AdapterInfo(i)%Description(1:128), CHAR(0)))
PRINT *, AdapterInfo(i)%ITYPE
PRINT '(5(Z2.2,"-"), Z2.2)', AdapterInfo(i)%Address(1:AdapterInfo(i)%AddressLength)
write(MACAddr(i),'(5(Z2.2,"-"), Z2.2)') AdapterInfo(i)%Address(1:AdapterInfo(i)%AddressLength)
MACAddr(i)=TRIM(MACAddr(i))
j=1
str2=""
str1=TRIM(MACAddr(i))
DO m=1,100
k=INDEX(str1(j:),"-")
IF(k>0)THEN
str2=TRIM(str2)//str1(j:j+k-2)
ELSE
str2=TRIM(str2)//str1(j:)
!convert to small caps
CALL hadware_local_upper2lower(str2)
info_out(i)=TRIM(str2)
search4Next=.TRUE.
EXIT
ENDIF
j=j+k
ENDDO
IF (AdapterInfo(i)%pNext == NULL) THEN
EXIT
read(*,*)
ENDIF
END DO
read(*,*)
STOP
END PROGRAM MAC
!==================================================================================================
SUBROUTINE hadware_local_upper2lower(strs)
!***************************************************
! this subroutine is to convert the uppercase letters in the string
! to the lowercase letters
!***************************************************
IMPLICIT NONE
CHARACTER*(*),INTENT(INOUT) :: strs
INTEGER :: i,n
DO i=1,LEN_TRIM(strs)
n = ICHAR(strs(i:i))
IF(n >= 65 .AND. n <= 90) THEN
n = n + 32
ENDIF
strs(i:i) = CHAR(n)
ENDDO
ENDSUBROUTINE hadware_local_upper2lower
!==================================================================================================
The code works fine under x86 configuration. However, it does not work properly under x64 configuration. To be more precisely, the program will only produce the information of the first adapter information while it will produce a list of adapters information in x86 configuration. I also wrap the GetAdapterIno() in C#, both the x86 and x64 configuration produces a list of adapter information. Is there any way to make the code works in x64 with Fortran?
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page