- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Is there any way in Fortran (or C++) to read the ethernet addresses, hard drive serial ID or other computer hardware specific components from Windows OS IVF compiler?? If so, what is the best way to do it and how?
Link Copied
4 Replies
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I think I have posted this before, but here it is again. This routine populates some static text blocks in a dialog with the MAC and IP addresses. The method is very representative of how Windows works: you define an API type which is passed to the API and filled in by a call to an API function, and the returned components tell you what you want to know (probably more than you wanted to know).
[bash]MODULE MAC USE ifwinty IMPLICIT NONE PUBLIC GetMacInfo 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 [/bash]
[bash]MODULE MAC USE ifwinty IMPLICIT NONE PUBLIC GetMacInfo 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 [/bash]
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hello,
This is something I have been looking for!
Could you also submit the module "contwrap" ?
And an example of how to call GetMacInfo?
Best regards
Reidar
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi Paul! Thanks =) This will work perfectly.
One question: Do you have code for the module "USE contwrap"?? Or can you explain what it does so I can try to code it myself?
One question: Do you have code for the module "USE contwrap"?? Or can you explain what it does so I can try to code it myself?
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Contwrap is simply a collection of wrapper routines grouping common tasks associated with calling the more atomic WinAPI functions, and also has internal mechanisms (specific to my codes) for error reporting and the like. Here is an example,
[bash]! Sets the text of a static control. ! SUBROUTINE StaticSetText (hwnd, controlID, text) IMPLICIT NONE INTEGER(HANDLE), INTENT(IN) :: hwnd INTEGER, INTENT(IN) :: controlID CHARACTER(LEN=*), INTENT(IN) :: text CHARACTER(LEN=100) :: tbuf INTEGER :: rval, nc ! null-terminate the correct portion of the string nc = chcnt(text, LEN(text)) tbuf = text(1:nc)//CHAR(0) rval = SendControlMessage (hwnd, controlId, WM_SETTEXT, 0, LOC(tbuf)) IF (rval /= TRUE) THEN CALL ControlError ("StaticSetText", controlID, "WM_SETTEXT") END IF END SUBROUTINE StaticSetText [/bash]
[bash]! Sets the text of a static control. ! SUBROUTINE StaticSetText (hwnd, controlID, text) IMPLICIT NONE INTEGER(HANDLE), INTENT(IN) :: hwnd INTEGER, INTENT(IN) :: controlID CHARACTER(LEN=*), INTENT(IN) :: text CHARACTER(LEN=100) :: tbuf INTEGER :: rval, nc ! null-terminate the correct portion of the string nc = chcnt(text, LEN(text)) tbuf = text(1:nc)//CHAR(0) rval = SendControlMessage (hwnd, controlId, WM_SETTEXT, 0, LOC(tbuf)) IF (rval /= TRUE) THEN CALL ControlError ("StaticSetText", controlID, "WM_SETTEXT") END IF END SUBROUTINE StaticSetText [/bash]
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