首页 >

Fortran读取 ini 配置文件

作者:fcode  日期:02-09
来源:Fcode研讨团队
本例提供了Fortran读取ini配置文件的简单实现。与 windows 下 GetPrivateProfileInt 等函数类似,但更符合语法规范。

特点:
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  
常规|工具|专业|读物|
代码|教学|算法|
首页 >
FortranCoder手机版-导航