'***************************************************************
' Generic functions for many proposes!!!
' - User name, computer name, write and read .INI files
' return special folders and etc. MUST SEE.
' Place all this code in a module
'***************************************************************
Option Explicit
'---Read and Write INI (cfg) files
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
'---Special Directorys and Files
Private Declare Function PathAddBackslash Lib "shlwapi.dll" Alias "PathAddBackslashA" (ByVal pszPath As String) As Long
Private Declare Function PathRemoveBackslash Lib "shlwapi.dll" Alias "PathRemoveBackslashA" (ByVal pszPath As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
'---Information
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Const UNLEN As Long = 256
Private Declare Function GetComputerName Lib "kernel32.dll" Alias "GetComputerNameA" (ByVal lpBuffer As String, ByRef nSize As Long) As Long
Private Const MAX_COMPUTERNAME_LENGTH As Long = 31
'---Return the username logged in
Public Function FUN_GetUserName() As String
Dim lstrBuffer As String
Dim llngSize As Long
Dim llngRet As Long
On Error Resume Next
llngSize = UNLEN + 1
lstrBuffer = Space$(llngSize)
llngRet = GetUserName(lstrBuffer, llngSize)
If (llngRet <> 0) Then
FUN_GetUserName = Left$(lstrBuffer, llngSize - 1)
Else
FUN_GetUserName = ""
End If
End Function
'---Return the computer name
Public Function FUN_GetComputerName() As String
Dim lstrBuffer As String
Dim llngSize As Long
Dim llngRet As Long
On Error Resume Next
llngSize = MAX_COMPUTERNAME_LENGTH + 1
lstrBuffer = Space$(llngSize)
llngRet = GetComputerName(lstrBuffer, llngSize)
If (llngRet <> 0) Then
FUN_GetComputerName = Left$(lstrBuffer, llngSize)
Else
FUN_GetComputerName = ""
End If
End Function
'---Add Backslash to path
Public Function FUN_PathAddBackslash(ByVal AnyPath As String) As String
Dim lstrBuffer As String
Dim llngRet As Long
On Error Resume Next
lstrBuffer = AnyPath & vbNullChar
llngRet = PathAddBackslash(lstrBuffer)
If (llngRet <> 0) Then
If (InStr(1, lstrBuffer, vbNullChar) <> 0) Then
FUN_PathAddBackslash = Left$(lstrBuffer, InStr(1, lstrBuffer, vbNullChar) - 1)
Else
FUN_PathAddBackslash = lstrBuffer
End If
Else
FUN_PathAddBackslash = ""
End If
End Function
'---Remove Backslash to path
Public Function FUN_PathRemoveBackslash(ByVal AnyPath As String) As String
Dim lstrBuffer As String
Dim llngRet As Long
On Error Resume Next
lstrBuffer = AnyPath & vbNullChar
llngRet = PathRemoveBackslash(lstrBuffer)
If (llngRet <> 0) Then
FUN_PathRemoveBackslash = Left$(lstrBuffer, InStr(1, lstrBuffer, vbNullChar) - 1)
Else
FUN_PathRemoveBackslash = ""
End If
End Function
'---Return the TEMP folder
Public Function FUN_GetTempPath() As String
Dim lstrBuffer As String
Dim llngSize As Long
Dim llngRet As Long
On Error Resume Next
llngSize = MAX_PATH + 1
lstrBuffer = Space$(llngSize)
llngRet = GetTempPath(llngSize, lstrBuffer)
If (llngRet <> 0) Then
FUN_GetTempPath = Left$(lstrBuffer, llngRet)
Else
FUN_GetTempPath = ""
End If
End Function
'---Return the SYSTEM folder
Public Function FUN_GetSystemDirectory() As String
Dim lstrBuffer As String
Dim llngSize As Long
Dim llngRet As Long
On Error Resume Next
llngSize = MAX_PATH + 1
lstrBuffer = Space$(llngSize)
llngRet = GetSystemDirectory(lstrBuffer, llngSize)
If (llngRet <> 0) Then
FUN_GetSystemDirectory = Left$(lstrBuffer, llngRet)
Else
FUN_GetSystemDirectory = ""
End If
End Function
'---Return the WINDOWS folder
Public Function FUN_GetWindowsDirectory() As String
Dim lstrBuffer As String
Dim llngSize As Long
Dim llngRet As Long
On Error Resume Next
llngSize = MAX_PATH + 1
lstrBuffer = Space$(llngSize)
llngRet = GetWindowsDirectory(lstrBuffer, llngSize)
If (llngRet <> 0) Then
FUN_GetWindowsDirectory = Left$(lstrBuffer, llngRet)
Else
FUN_GetWindowsDirectory = ""
End If
End Function
'---Read a configuraton file
Public Function FUN_GetPrivateProfileString(ByVal Section As String, ByVal Key As String, Optional Default As String = "") As String
Dim lstrBuffer As String
Dim llngSize As Long
Dim llngRet As Long
Dim lstrConfigFile As String
On Error Resume Next
llngSize = MAX_PATH + 1
lstrBuffer = Space(llngSize)
lstrConfigFile = FUN_PathAddBackslash(App.Path) & App.EXEName & ".ini"
llngRet = GetPrivateProfileString(Section, Key, Default, lstrBuffer, llngSize, lstrConfigFile)
If (llngRet <> 0) Then
FUN_GetPrivateProfileString = Left$(lstrBuffer, llngRet)
Else
FUN_GetPrivateProfileString = ""
End If
End Function
Public Sub FUN_WritePrivateProfileString(ByVal Section As String, ByVal Key As String, ByVal Value As String)
Dim llngRet As Long
Dim lstrConfigFile As String
On Error Resume Next
lstrConfigFile = FUN_PathAddBackslash(App.Path) & App.EXEName & ".ini"
llngRet = WritePrivateProfileString(Section, Key, Value, lstrConfigFile)
End Sub