特点：
1. 可提供对 ini 配置文件中的 整型，字符串，浮点数，双精度进行读取。
2. 无需按文件顺序
3. Section段，Key值区分大小写
4. 可自定义逻辑型的真假字符串，比如 "T|F" , "1|0" , "YES|NO"
5. 可设置默认值，当 Key 值在 ini 文件中不存在或设置错误时，变量赋为默认值。
例：如下的ini文件
[config] QQGroup = 2338021 Website = www.fcode.cn [Test] Age = 29 Weight = 31.415926 Name = 臭石头雪球 Home = /home/gao/ Married = Yes
Module ini_file_mod
!// INI file read module in Fortran95
!// Author: Gao , You may write to E-mail: gao@fcode.cn
!// version 1.4 @ 2015.11.6
!// usage:
!// use ini_file_mod
!// integer iErr
!// type( CLASS_INI ) :: ObjName
!// iErr = ObjName%Conn( "filename.ini" )
!// iErr = ObjName%Section( "SectionName" )
!// iErr = ObjName%Get( "IntegerKey" , var_int )
!// iErr = ObjName%Get( "RealKey" , var_real )
!// iErr = ObjName%Get( "RealKey" , var_double )
!// iErr = ObjName%Get( "StringKey" , var_char )
!// iErr = ObjName%Get( "IntegerKey" , var_int , int_def )
!// iErr = ObjName%Get( "LogicalKey" , var_logical , "T|F" )
!// call ObjName%Disconn()
Implicit None
Private
Integer , parameter , private :: DP = Selected_Real_Kind( p = 9 )
Type , public :: CLASS_INI
character( len = 64 ) , Private :: SectionName = ''
Integer , Private :: fileUnit = -1
contains
Procedure , private :: ReadINI_Int
Procedure , private :: ReadINI_String
Procedure , private :: ReadINI_Real
Procedure , private :: ReadINI_Double
Procedure , private :: ReadINI_Logic
Generic :: Get => ReadINI_Int,ReadINI_String,ReadINI_Real,ReadINI_Double,ReadINI_Logic
Procedure :: Conn
Procedure :: Section
Procedure :: DisConn
End Type CLASS_INI
contains
Integer Function Conn( this , INIFileName )
Class( CLASS_INI ) :: this
Character( Len = * ) , Intent( In ) :: INIFileName
integer :: iErr
Conn = 0
Open( NewUnit = this%fileUnit , File=INIFileName , status='old' , action='Read' , IoStat=iErr )
If (iErr/=0) return
Conn = 1
End Function Conn
Subroutine DisConn( this )
Class( CLASS_INI ) :: this
Close( this%fileUnit )
End Subroutine DisConn
Integer Function Section( this , sectionName )
Class( CLASS_INI ) :: this
Character( Len = * ) , Intent(In) :: sectionName
character(len=512) :: cRead
integer :: iErr
Section = 0
if ( CheckParNameValidity(Trim(sectionName)) ) return
Rewind( this%fileUnit )
Do
Read( this%fileUnit , '(a512)' , ioStat=iErr ) cRead
if( iErr/=0 ) exit
cRead = adjustl(cRead)
If ( index( cRead , '['//trim(sectionName)//']' ) == 1 ) then
this%SectionName = sectionName
Section = 1
exit
End If
End Do
End Function Section
Integer Function ReadINI_String( this , parName , value , defaultValue ) result( iRes )
Class( CLASS_INI ) :: this
Character( Len = * ) , Intent(In) :: parName
Character( len = * ) , Intent(OUT) :: Value
Character( len = * ) , Intent(In) , Optional :: defaultValue
character(len=512) :: cRead
integer :: iErr , iRead , k
Logical :: bOK
iRes = 0
iRead = 0
bOK = .false.
Do
Read( this%fileUnit , '(a512)' , ioStat=iErr ) cRead
if ( iErr /= 0 ) exit
cRead = adjustl(cRead)
iRead = iRead + 1
If ( cRead(1:1)== '[' ) exit
k = index( cRead , '=' )
If ( k < 2 ) cycle
If ( trim(cRead(1:k-1)) == parName ) then
value = adjustl(cRead(k+1:))
bOK = .true.
exit
End If
End Do
Do k = 1 , iRead
BackSpace( this%fileUnit )
End Do
If ( .Not.bOK .and. Present(defaultValue)) then
value = defaultValue
iRes = 1
Else If ( bOK ) then
iRes = 1
End If
End Function ReadINI_String
Integer Function ReadINI_Int( this , parName , value , defaultValue ) result( iRes )
Class( CLASS_INI ) :: this
Character( Len = * ) ,Intent(In) :: parName
Integer , Intent(In) , Optional :: defaultValue
Integer , Intent(OUT) :: Value
integer :: i , iErr
Character( len = 16 ) :: c
iRes = 0
if ( CheckParNameValidity( parName ) ) return
i = this%Get( parName , c )
If ( i==0 .and. Present(defaultValue)) then
value = defaultValue
iRes = 1
Else If ( i==1 ) then
Read( c , * , ioStat = iErr ) value
if ( iErr==0 ) iRes = 1
End If
End Function ReadINI_Int
Integer Function ReadINI_Real( this , parName , value , defaultValue ) result( iRes )
Class( CLASS_INI ) :: this
Character( Len = * ) ,Intent(In) :: parName
Real , Intent(In) , Optional :: defaultValue
Real , Intent(OUT) :: Value
integer :: i , iErr
Character( len = 16 ) :: c
iRes = 0
if ( CheckParNameValidity( parName ) ) return
i = this%Get( parName , c )
If ( i==0 .and. Present(defaultValue)) then
value = defaultValue
iRes = 1
Else If ( i==1 ) then
Read( c , * , ioStat = iErr ) value
if ( iErr==0 ) iRes = 1
End If
End Function ReadINI_Real
Integer Function ReadINI_Double( this , parName , value , defaultValue ) result( iRes )
Class( CLASS_INI ) :: this
Character( Len = * ) ,Intent(In) :: parName
Real(Kind=DP) , Intent(In) , Optional :: defaultValue
Real(Kind=DP) , Intent(OUT) :: Value
integer :: i , iErr
Character( len = 16 ) :: c
iRes = 0
if ( CheckParNameValidity( parName ) ) return
i = this%Get( parName , c )
If ( i==0 .and. Present(defaultValue)) then
value = defaultValue
iRes = 1
Else If ( i==1 ) then
Read( c , * , ioStat = iErr ) value
if ( iErr==0 ) iRes = 1
End If
End Function ReadINI_Double
Integer Function ReadINI_Logic( this , parName , value , TFStr ) result( iRes )
Class( CLASS_INI ) :: this
Character( Len = * ) , Intent(In) :: parName
Character( Len = * ) , Intent(In) , Optional :: TFStr
Logical , Intent(Out) :: Value
character(Len=20) :: RChar
character(Len=41) :: TFChar
integer :: Separator = 0
iRes = 0
if ( CheckParNameValidity( parName ) ) return
TFChar='1|0'
If ( Present(TFStr) ) TFChar=TFStr
Separator = Index( TFChar , '|' )
If ((Separator<=1).or.(Separator==Len_Trim(TFChar))) return
If ( this%Get( parName , RChar ) == 0 ) return
If ( Trim(RChar) == TFChar(1:Separator-1) ) then
Value = .True.
iRes = 1
Else If (Trim(RChar) == TFChar(Separator+1:Len_Trim(TFChar)) ) then
Value = .False.
iRes = 1
End If
End Function ReadINI_Logic
Logical Function CheckParNameValidity(ParName)
Character( Len = * ) , Intent(In) :: ParName
CheckParNameValidity = ( Scan(ParName,'[]/!@#$%&() =}{";:\|.><') /= 0 )
End Function CheckParNameValidity
End Module ini_file_mod
Program www_fcode_cn
use ini_file_mod
Implicit None
integer :: iErr , i
real :: r
real(kind=kind(0.d0)) :: rr
Character( Len = 50 ) :: c
logical :: l
Type( CLASS_INI ) :: MyINI
iErr = MyINI%Conn( "fcode.ini" ) !// 连接ini文件
iErr = MyINI%Section( "Test" ) !// 读取 Test 部分
iErr = MyINI%Get( "Home" , c )
write(*,*) '家路径:',Trim(c)
iErr = MyINI%Get( "Name" , c )
write(*,*) '姓名:',Trim(c)
iErr = MyINI%Get( "Weight" , r )
write(*,*) '体重:',r
iErr = MyINI%Get( "Weight" , rr )
write(*,*) '体重（双精度）:',rr
iErr = MyINI%Get( "Age" , i )
write(*,*) '年龄:',i
iErr = MyINI%Get( "Married" , l , "Yes|No" ) !// "T"表示真，"F"表示假
write(*,*) '是否已婚:',l
iErr = MyINI%Get( "不存在" , i , 30 )
write(*,*) '不存在的整型:',i !// 不存在值则以默认值为准
iErr = MyINI%Section( "config" )
iErr = MyINI%Get( "Website" , c )
write(*,*) '网站:',Trim(c)
iErr = MyINI%Get( "QQGroup" , i )
write(*,*) 'QQ群:',i
call MyINI%DisConn() !// 关闭 ini 文件
End Program www_fcode_cn
