soccer jersey forums.silverfrost.com :: View topic - WinAPI-Call fails under Windows 10
forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

WinAPI-Call fails under Windows 10

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support
View previous topic :: View next topic  
Author Message
jlb



Joined: 21 Oct 2020
Posts: 73
PostPosted: Thu Apr 08, 2021 4:48 pm    Post subject: WinAPI-Call fails under Windows 10 Reply with quote
The following codes uses a WinAPI-Call to GetVolumeInformationA to read out the volume serial number that the operating system assigns when a hard disk is formatted, like the command VOL. It runs as awaited unter Windows 7 but fails now under Windows 10, where it worked some months ago. However I am not certain wether it is a windows issue. I would be grateful if somebody could test it.
Code:
PROGRAM SerialNumber
USE mswin, ONLY : GetVolumeInformation
USE ISO_FORTRAN_ENV, ONLY : COMPILER_VERSION
IMPLICIT NONE
INTEGER(KIND=4) :: VolumeSerialNumber, MaxCompLength, FileSystemFlags, FileSystemNameSize, VolumeNameSize
CHARACTER(LEN=256) :: VolumeName, FileSystemName, PathName='C:\'
LOGICAL(KIND=3) :: Res
Res=GetVolumeInformation(PathName, VolumeName, VolumeNameSize, VolumeSerialNumber, &
    & MaxCompLength, FileSystemFlags, FileSystemName, FileSystemNameSize)
WRITE(*,'(1X,L1)') Res
WRITE(*,'(1X,A,Z8)') 'Volume Serial Number is ', VolumeSerialNumber
WRITE(*,*) 'Volumename is ', TRIM(VolumeName)
WRITE(*,*) 'Filesystem is ', TRIM(FileSystemName)
WRITE(*,*) 'Compiler is ', COMPILER_VERSION()
END PROGRAM SerialNumber

Output under Windows 7
Quote:
T
Volume Serial Number is 2A7F77E6
Volumename is
Filesystem is NTFS
Compiler is FTN95 v8.71

Output under Windows 10
Quote:
F
Volume Serial Number is 0
Volumename is
Filesystem is 5%j�Ad<
Compiler is FTN95 v8.71
Back to top
View user's profile Send private message
jlb



Joined: 21 Oct 2020
Posts: 73
PostPosted: Mon Apr 12, 2021 12:31 pm    Post subject: Reply with quote
After further investigation, the code runs normally under Windows 10 when setting SET __COMPAT_LAYER=WIN7RTM before calling the executable from the console.

When starting the executable from Plato, the same can be achieved by setting the Windows compatibilty mode of Plato.exe to "Windows 7"

On some Windows 10 machines, it might be necessary to use INTEGER (KIND=3) to retrieve the correct volume serial number.

All operating systems used are 64 bit. Methink it is possibly a FTN95 issue.
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 8036
Location: Salford, UK
PostPosted: Thu Apr 15, 2021 7:23 am    Post subject: Reply with quote
I have made a note to look into this.
Back to top
View user's profile Send private message AIM Address
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 8036
Location: Salford, UK
PostPosted: Thu Apr 15, 2021 1:55 pm    Post subject: Reply with quote
Two of the arguments need to be input values...

Code:
PROGRAM SerialNumber
STDCALL GETVOLUMEINFORMATION'GetVolumeInformationA'(STRING,STRING,VAL,REF,REF,REF,STRING,VAL):LOGICAL*4
INTEGER(KIND=3) :: VolumeSerialNumber, MaxCompLength, FileSystemFlags
CHARACTER(LEN=256) :: VolumeName, FileSystemName, PathName='C:\'
INTEGER(KIND=3),PARAMETER::VolumeNameSize=256,FileSystemNameSize=256
CHARACTER(LEN=*),PARAMETER::fmt='(1X,A,Z8)'
LOGICAL(KIND=3) :: Res
Res=GetVolumeInformation(PathName, VolumeName, VolumeNameSize, VolumeSerialNumber, &
    & MaxCompLength, FileSystemFlags, FileSystemName, FileSystemNameSize)
WRITE(*,'(1X,L1)') Res
WRITE(*,fmt) 'Volume Serial Number is ', VolumeSerialNumber
WRITE(*,*) 'Volumename is ',             TRIM(VolumeName)
WRITE(*,*) 'Filesystem is ',             TRIM(FileSystemName)
WRITE(*,fmt) 'VolumeSerialNumber is ',   VolumeSerialNumber
WRITE(*,*) 'MaxCompLength is  ',         MaxCompLength
WRITE(*,fmt) 'FileSystemFlags is ',      FileSystemFlags
END PROGRAM SerialNumber
Back to top
View user's profile Send private message AIM Address
jlb



Joined: 21 Oct 2020
Posts: 73
PostPosted: Thu Apr 15, 2021 3:06 pm    Post subject: Reply with quote
Paul

Thanks a lot for your help. The pseudo-workaround I had found let me forget checking the basics. Sorry for this.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group