Lunatic Sol

IT Tips

GetPrivateProfileString - VBScript で使うための独自ファンクション

2005-11-27 16:48:27 | VBScript
なんだか無駄が多い関数のような気がしますが、とりあえず動くということで。。。

'############################################
' GLOBAL
'############################################
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const ERR_NOERROR = 0
Const ERR_UNKNOWN = 1
Const ERR_APPNOTFOUND = 2
Const ERR_KEYNOTFOUND = 3

'############################################
' GetPrivateProfileString
' lpAppName セクション名
' lpKeyName キー名
' lpDefault デフォルト文字列
' lpReturnedString 戻り値
' nSize 情報バッファのサイズ
' lpFileName .ini ファイルの名前
'############################################
Function GetPrivateProfileString(lpAppName, lpKeyName, lpDefault, lpReturnedString, nSize, lpFileName)
  GetPrivateProfileString = ERR_NOERROR
  Dim oFs, oTs, strLine
  Dim appFound
  appFound = 0
  Set oFs = CreateObject("Scripting.FileSystemObject")
  Set oTs = oFs.OpenTextFile(lpFileName, ForReading, True)
  Do While Not oTs.AtEndOfStream
    strLine = oTs.ReadLine
    If appFound = 0 Then
      If strLine = "[" & lpAppName & "]" Then
        appFound = 1
      End If
    Else
      If Left(strLine,1) = "[" and Right(strLine,1) = "]" Then
        If lpDefault <> "" Then
          lpReturnedString = lpDefault
        Else
          GetPrivateProfileString = ERR_KEYNOTFOUND
        End If
        Exit Function
      Else
        If Trim(Left(strLine,InStr(strLine, "=")-1)) = lpKeyName Then
          lpReturnedString = Trim(Mid(strLine, InStr(strLine, "=")+2))
          If lpReturnedString = "" Then
            lpReturnedString = lpDefault
          End If
          Exit Function
        End If
      End If
    End If
  Loop
  If appFound = 0 Then
    GetPrivateProfileString = ERR_APPNOTFOUND
  Else
    GetPrivateProfileString = ERR_UNKNOWN
  End If
End Function

最新の画像もっと見る