Math Is Fun Forum

Option Explicit

' api declarations for ini services
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Global inipath As String

Global Output As String

Global SearchedHeader As String
Global SearchedValue As String

-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Function fullpath(ByVal dirpath As String, ByVal fileName As String) As String
'
' Purpose: Returns full path
'
' Inputs: dirpath and filename strings
'
' Outputs: string representing the full path including the filename
'
' Globals:
'
' Modifications:
'
' Comments:

If (Right$(dirpath, 1) = "") Then
fullpath = dirpath & fileName
Else
fullpath = dirpath & "" & fileName
End If

End Function

-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Function getprivateprofile(ByVal section As String, ByVal KeyName As String, ByVal default As String) As String
'
' Purpose: Low level driver interface to obtain .ini info
'
' Inputs: section,keyname and default strings
'
' Outputs: String representing requested .ini item
'
' Globals:None
'
' Modifications:
'
' Comments:


Dim buffer As String
Dim i As Integer

buffer = String$(512, 0)

If (Len(KeyName) = 0) Then
i = GetPrivateProfileString(section, ByVal 0&, default, buffer, 512, inipath)
Else
i = GetPrivateProfileString(section, ByVal KeyName, default, buffer, 512, inipath)
End If
getprivateprofile = Left$(buffer, i)

End Function

-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Sub OnStartup()
'
' Purpose: Loads data from ini file
'
' Inputs: None
'
' Outputs:None
'
' Globals:
'
' Modifications:
'
' Comments:

Dim dummy As String
Dim errmsg As String
Dim tempport As String
Dim tempsettings As String
Dim inierrormsg As String

'frmmain.txtinstructions

inipath = fullpath("C:\Documents and Settings\new user\My Documents", "Document") & ".txt"

SearchedHeader = "Names"
SearchedValue = "Name1"
dummy = (getprivateprofile(SearchedHeader, SearchedValue, ""))
Output(cycler) = dummy

Exit Sub

fferr:

MsgBox errmsg
'SetFail

End Sub

Sub OnExit()
'
' Purpose: Close comm ports and exit loops
'
' Inputs: None
'
' Outputs: None
'
' Globals:
'
' Modifications:
'
' Comments:


' update ini file
UPdateIni

End Sub

-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Function WriteProfileStuff(KeyName As String, KeyValue As String, Optional AppName As String = "?", Optional IniLoc As String = "?") As Boolean
'
' Purpose: Low level ini file write function
'
' Inputs: keyname = ini entry definition, KeyValue = value to be written, AppName = ini file section name
'
' Outputs: flag = pass/fail
'
' Globals:
'
' Modifications:
'
' Comments:

Dim retval As Long
Dim ibuf As Long
Dim DefValue As String
Dim Results As String

On Error GoTo WriteprofileStuff_Error

' Inilialize varables
ibuf = 255                   'Set buffer length for API code

If IniLoc = "?" Then IniLoc = "C:\Documents and Settings\new user\My Documents\Document.txt"


retval = WritePrivateProfileString(AppName, KeyName, KeyValue, IniLoc)

' Return back to calling procedure with INI file infomation/
If retval = 1 Then
    WriteProfileStuff = True
Else
    WriteProfileStuff = False
End If

Exit Function

   ' Return back to calling procedure with Error measage
WriteprofileStuff_Error:
    MsgBox "System error attempting to write ini file data " & Err.Description, vbCritical
    WriteProfileStuff = False
End Function

-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Function UPdateIni() As Boolean
'
' Purpose: Updates ini entries
'
' Inputs: None
'
' Outputs: None
'
' Globals:
'
' Modifications:
'
' Comments:

Dim retval As Boolean
Dim msg As String

retval = WriteProfileStuff(WriteValue, msg, WriteGroup)
If retval = False Then GoTo errr

UPdateIni = True

Exit Function

errr:

UPdateIni = False

End Function

Dim CompiledString As String
Dim Output As String
Dim x As Integer