' Credits to Cobein for the CallApi Module
Option Explicit
Declare Sub RtlMoveMemory Lib "kernel32" ( _
dest As Any, _
src As Any, _
ByVal L As Long)
 
Declare Function CallWindowProcA Lib "user32" ( _
ByVal addr As Long, _
ByVal p1 As Long, _
ByVal p2 As Long, _
ByVal p3 As Long, _
ByVal p4 As Long) As Long
 
Declare Function GetProcAddress Lib "kernel32" ( _
ByVal hModule As Long, _
ByVal lpProcName As String) As Long
 
Declare Function LoadLibraryA Lib "kernel32" ( _
ByVal lpLibFileName As String) As Long
 
Const CSIDL_LOCAL_APPDATA                   As Long = &H1C
Const CSIDL_APPDATA                         As Long = &H1A
 
'------------------------------------------------------------------------------------
'--------------------------- CallApiByName by Cobein -----------------------
'------------------------------------------------------------------------------------
Function CallFunctions(ByVal sLib As String, ByVal sMod As String, ParamArray Params()) As Long ' CallApiByName de Cobein
On Error Resume Next
  Dim lPtr                As Long
  Dim bvASM(&HEC00& - 1)  As Byte
  Dim I                   As Long
  Dim lMod                As Long
 
  lMod = GetProcAddress(LoadLibraryA(sLib), sMod)
  If lMod = 0 Then Exit Function
 
  lPtr = VarPtr(bvASM(0))
  RtlMoveMemory ByVal lPtr, &H59595958, &H4:              lPtr = lPtr + 4
  RtlMoveMemory ByVal lPtr, &H5059, &H2:                  lPtr = lPtr + 2
  For I = UBound(Params) To 0 Step -1
      RtlMoveMemory ByVal lPtr, &H68, &H1:                lPtr = lPtr + 1
      RtlMoveMemory ByVal lPtr, CLng(Params(I)), &H4:     lPtr = lPtr + 4
  Next
  RtlMoveMemory ByVal lPtr, &HE8, &H1:                    lPtr = lPtr + 1
  RtlMoveMemory ByVal lPtr, lMod - lPtr - 4, &H4:         lPtr = lPtr + 4
  RtlMoveMemory ByVal lPtr, &HC3, &H1:                    lPtr = lPtr + 1
  CallFunctions = CallWindowProcA(VarPtr(bvASM(0)), 0, 0, 0, 0)
 
End Function
 
'------------------------------------------------------------------------------------
'------------ Retrieve Special folder locations by its CSIDL --------------
'------------------------------------------------------------------------------------
Function GetSpecialFolderPath(FolderConst As Long) As String
    On Error Resume Next
    Dim Location(512) As Byte
 
    Call CallFunctions("shell32", _
                        "SHGetSpecialFolderPathW", _
                        0&, _
                        VarPtr(Location(0)), _
                        FolderConst, VarPtr(False))
 
    GetSpecialFolderPath = Left$(Location, InStr(Location, Chr$(0)) - 1)
End Function
 
'------------------------------------------------------------------------------------
'---------------- Retieve LimeWire Download Folder --------------------
'------------------------------------------------------------------------------------
Public Function GetLimewireShared() As String
 
    Dim strPropfile     As String
    Dim strLine         As String
    Dim ParseFile()     As String
    Dim strRes          As Variant
 
    Open GetSpecialFolderPath(CSIDL_APPDATA) & "\LimeWire\limewire.props" For Input As #1
    Do Until EOF(1)
        Line Input #1, strLine
        strPropfile = strPropfile + strLine + vbCrLf
    Loop
    Close #1
 
 
    ParseFile = Split(strPropfile, vbCrLf)
 
    For Each strRes In ParseFile
        If InStr(strRes, "DIRECTORY_FOR_SAVING_FILES") Then
            strRes = CStr(strRes)
            strRes = Right(strRes, Len(strRes) - InStr(strRes, "="))
            strRes = Replace(strRes, "\\", "æ")
            strRes = Replace(strRes, "\", "")
            GetLimewireShared = Replace(strRes, "æ", "\")
 
        End If
    Next
 
End Function

Private 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
Private 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
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim Ret As String, NC As Long
    'Write the setting to the file (c:\test.ini) under
    '   Project1 -> Keyname
    WritePrivateProfileString App.Title, "KeyName", "This is the value", "c:\test.ini"
    'Create a buffer
    Ret = String(255, 0)
    'Retrieve the string
    NC = GetPrivateProfileString(App.Title, "KeyName", "Default", Ret, 255, "C:\test.ini")
    'NC is the number of characters copied to the buffer
    If NC <> 0 Then Ret = Left$(Ret, NC)
    'Show our string
    MsgBox Ret
    'Delete the file
    Kill "c:\test.ini"
End Sub

'Example by Antti Häkkinen (antti@theredstar.f2s.com)
'Visit his website at http://www.theredstar.f2s.com/
'require variable declaration
Option Explicit
 
'declares for ini controlling
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private 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
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Private 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
 
'when form is loaded
Private Sub Form_Load()
 
'if error occures resume still
On Error Resume Next
 
'local variables
Dim File As String, OFLen As Double, _
    Str As String
 
'set our varibles
File = "C:\temp.txt"
OFLen = FileLen(File)
 
'write few example sections:
WriteIniSection File, "Test1", ""
WriteIniSection File, "Test2", "Here shoud be found some text"
 
'write few ini strings
WriteIni File, "Test3", "Ini1", "This is ini 1"
WriteIni File, "Test1", "Ini2", "This is ini 2"
 
'inform we're written the data
MsgBox Format((FileLen(File) - OFLen) / 1024, "0.00") & " KB data written to " & Chr(34) & File & Chr(34)
 
'read the ini file
Str = Str & "Test2 section: " & vbTab & ReadIniSection(File, "Test2") & vbCrLf
Str = Str & "Test1 section: " & vbTab & ReadIniSection(File, "Test1") & vbCrLf
Str = Str & "Ini1 string: " & vbTab & ReadIni(File, "Test3", "Ini1") & vbCrLf
Str = Str & "Ini2 string: " & vbTab & ReadIni(File, "Test1", "Ini2") & vbCrLf
 
'show data
MsgBox Str
 
'end application
End
 
End Sub
 
'// INI CONTROLLING PROCEDURES

'reads ini string
Public Function ReadIni(Filename As String, Section As String, Key As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileString(Section, Key, "", RetVal, 255, Filename)
ReadIni = Left(RetVal, v - 1)
End Function
 
'reads ini section
Public Function ReadIniSection(Filename As String, Section As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileSection(Section, RetVal, 255, Filename)
ReadIniSection = Left(RetVal, v - 1)
End Function
 
'writes ini
Public Sub WriteIni(Filename As String, Section As String, Key As String, Value As String)
WritePrivateProfileString Section, Key, Value, Filename
End Sub
 
'writes ini section
Public Sub WriteIniSection(Filename As String, Section As String, Value As String)
WritePrivateProfileSection Section, Value, Filename
End Sub