なんだか無駄が多い関数のような気がしますが、とりあえず動くということで。。。
'############################################
' 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
'############################################
' 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