I have a VB application and i can easily install in any operating system.
My VB application always using the DB thats in its application folder.
Once you delete the DB from this application folder and if try to start the application it will show the error like DB is not found. This is the normal working.
My problem is under vista machine, once i installed the application in vista and if i delete the DB from the application folder still the program is running. The reason is application taking the DB from the UAC.
I am using Inno script to make the installer for my application. Now i want to avoid this placing of DB file in UAC. I cant tell the customers to off the UAC. Instead i want to do something with Inno or by programically.
I have a VB application and i can easily install in any operating system.
My VB application always using the DB thats in its application folder.
Once you delete the DB from this application folder and if try to start the application it will show the error like DB is not found. This is the normal working.
My problem is under vista machine, once i installed the application in vista and if i delete the DB from the application folder still the program is running. The reason is application taking the DB from the UAC.
I am using Inno script to make the installer for my application. Now i want to avoid this placing of DB file in UAC. I cant tell the customers to off the UAC. Instead i want to do something with Inno or by programically.
Can any one help me...
Regards,
Susan.
Hi Susan,
With Vista it is no longer allowed to write to the Program Files folder. Because of this I've written a module that takes care of this by checking which OS your app is running on and act accordingly.
I'll attach a sample project that demonstrates how it works and includes the module. If you can, run it on an XP and Vista box.
Please note that it is also recommended by Microsoft that you don't save data files to Program Files and instead use the proper paths also on Windows 2000 and Windows XP as well, not only on Windows Vista. This behavior should also be mirrored to legacy Windowses (where you actually see data being saved to C:\Windows\Application Data\ by recent programs).
The major problem with the code above is that it automatically suggests the Application Data folder of the current user only, not the path used by all users, which is what will be desired in most cases when data has been saved to Program Files.
The major problem with the code above is that it automatically suggests the Application Data folder of the current user only, not the path used by all users, which is what will be desired in most cases when data has been saved to Program Files.
Thats easy to solve, in the declaration section of AppData.bas do the following:
Its always best to turn off the UAC when installing and then turn it back on after your done as that will also help prevent issues during installation and increase installation speed too.
VB/Office Guru™ (AKA: Gangsta Yoda™ ®)
I dont answer coding questions via PM. Please post a thread in the appropriate forum.
I couldn't get sleep so I coded this while trying to make myself more tired:
Code:
' goes into a module
Option Explicit
Public Enum SystemPathType
[Type Current] = &H0&
[Type Default] = &H1&
End Enum
Public Enum SystemPathVariable
[Path Desktop] = &H0&
[Path Internet]
[Path Programs]
[Path Controls]
[Path Printers]
[Path Personal]
[Path Favorites]
[Path Startup]
[Path Recent]
[Path SendTo]
[Path BitBucket]
[Path StartMenu]
[Path My Documents]
[Path My Music]
[Path My Video]
[Path Desktop Directory] = &H10&
[Path Drives]
[Path Network]
[Path Network Neighborhood]
[Path Fonts]
[Path Templates]
[Path StartMenu All Users]
[Path Programs All Users]
[Path StartUp All Users]
[Path Desktop Directory All Users]
[Path AppData]
[Path Printers Neighborhood]
[Path AppData Current User]
[Path StartUp Alternative]
[Path StartUp Alternative All Users]
[Path Favorites All Users]
[Path Internet Cache]
[Path Cookies]
[Path History]
[Path AppData All Users]
[Path Windows]
[Path System]
[Path Program Files]
[Path My Pictures]
[Path Profile]
[Path System X86]
[Path Program Files X86]
[Path Program Files All Users]
[Path Program Files X86 All Users]
[Path Templates All Users]
[Path Documents All Users]
[Path AdminTools All Users]
[Path AdminTools]
[Path Connections]
[Path Music All Users] = &H35&
[Path Pictures All Users]
[Path Video All Users]
[Path Resources]
[Path Resources Localized]
[Path OEM Links All Users]
[Path CD Burn Area]
[Path Computers Near Me] = &H3D&
End Enum
Private Const CSIDL_FLAG_PER_USER_INIT = &H800&
Private Const CSIDL_FLAG_NO_ALIAS = &H1000&
Private Const CSIDL_FLAG_DONT_VERIFY = &H4000&
Private Const CSIDL_FLAG_CREATE = &H8000&
Private Const CSIDL_FLAG_MASK = &HFF00&
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
Private Declare Function SHGetFolderPathShell32 Lib "shell32.dll" Alias "SHGetFolderPathW" (ByVal hWndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, ByVal dwReserved As Long, ByVal lpszPath As Long) As Long
Private Declare Function SHGetFolderPathSHFolder Lib "shfolder.dll" Alias "SHGetFolderPathW" (ByVal hWndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, ByVal dwReserved As Long, ByVal lpszPath As Long) As Long
Public Function GetSystemPath(ByVal SystemPath As SystemPathVariable, Optional ByVal PathType As SystemPathType, Optional ByVal CreateIfNotExists As Boolean = True, Optional ByVal hWndDialUpParent As Long, Optional ByVal UserToken As Long) As String
Static blnChecked As Boolean, blnShell32 As Boolean, blnSHFolder As Boolean, blnSpecialFolder As Boolean
Dim bytPath(513) As Byte, lngPos As Long, lngFlags As Long
' small speed optimization: no need to check for function being supported every time we run this
If blnChecked Then
Else
' check for supported functions
blnShell32 = IsFunctionSupported("SHGetFolderPathW", "shell32")
If Not blnShell32 Then
blnSHFolder = IsFunctionSupported("SHGetFolderPathW", "shfolder")
If Not blnSHFolder Then
' drop back as far as to GetSpecialFolderPath?
blnSpecialFolder = IsFunctionSupported("SHGetSpecialFolderPathW", "shell32")
End If
End If
' mark we have done this
blnChecked = True
End If
' see if the path will be created if it is missing
If CreateIfNotExists Then lngFlags = SystemPath Or CSIDL_FLAG_CREATE Else lngFlags = SystemPath
' support for this started from Windows 2000 and Windows ME, but may also be supported on older systems via shell32
If blnShell32 Then
' attempt to get the path
If SHGetFolderPathShell32(hWndDialUpParent, lngFlags, UserToken, CLng(PathType), VarPtr(bytPath(0))) = 0& Then
' get string length
lngPos = InStr(bytPath, vbNullChar)
' get the path if has some length
If lngPos > 1 Then GetSystemPath = Left$(bytPath, lngPos - 1)
End If
ElseIf blnSHFolder Then
' attempt to get the path
If SHGetFolderPathSHFolder(hWndDialUpParent, lngFlags, UserToken, CLng(PathType), VarPtr(bytPath(0))) = 0& Then
' get string length
lngPos = InStr(bytPath, vbNullChar)
' get the path if has some length
If lngPos > 1 Then GetSystemPath = Left$(bytPath, lngPos - 1)
End If
'ElseIf blnSpecialFolder Then
' ... in case somebody really thinks he needs to support this ...
Else
' YOU MUST MAKE SURE THAT YOU ACTUALLY GET A FOLDER FROM THIS FUNCTION
' IF STRING IS EMPTY, TRY ANOTHER PATH, IF STILL FAILS, YOU ARE AT CRITICAL ERROR
End If
End Function
Private Function IsFunctionSupported(ByRef FunctionName As String, ByRef ModuleName As String) As Boolean
Dim lngModule As Long, blnUnload As Boolean
' get handle to module
lngModule = GetModuleHandleA(ModuleName)
' if getting the handle failed...
If lngModule = 0 Then
' try loading the module
lngModule = LoadLibraryA(ModuleName)
' we have to unload it too if that succeeded
blnUnload = (lngModule <> 0)
End If
' now if we have a handle to module...
If lngModule <> 0 Then
' see if the queried function is supported; return True if so, False if not
IsFunctionSupported = (GetProcAddress(lngModule, FunctionName) <> 0)
' see if we have to unload the module
If blnUnload Then FreeLibrary lngModule
End If
End Function
And a short test program, requires a list box:
Code:
Option Explicit
Private Sub Form_Load()
Dim lngA As Long, strPath As String
For lngA = 0 To [Path Computers Near Me]
strPath = GetSystemPath(lngA)
If LenB(strPath) Then List1.AddItem Right$("0" & Hex$(lngA), 2) & vbTab & strPath
Next lngA
List1.ListIndex = 0
End Sub
What I've fixed here are:
Complete error detection.
Enums being used for greatly helping with the usage of the function.
Unicode support: these paths can be configured to Unicode paths. Unlikely, but it can be done.
Ability to select any folder of interest. It is up to the function user to check whether they actually got a result or not. Ie. if they don't get a folder for any Application Data results, they can assume an older Windows and manually create C:\Windows\Application Data\.
Ability to get any user's (shared) folders (by passing the token value).
Ability to get the default location vs. user's current location.
I have tested your code but I was unable to get the Unicode paths to work and I was wondering if you might have any insight to the situation.
For testing purposes, I have created a user account with a Japanese character in its name (using Windows Character Map). My Vista system is default en-us charset.
When I log into this account and call GetSystemPath([Path AppData]), the return is:
"C:\Users\?\AppData\Roaming"
So, I am assuming there is something wrong, because I can not work with this path. For ex,
dim sPath as string
sPath = GetSystemPath([Path AppData])
mkdir sPath & "\test"
The "test" directory was not created. I also tried several other tests directly using sPath.
Ultimately, I would like to be able to call GetShortPathName() on the sPath to make it VB6 safe to call WritePrivateProfileString() so that I can read/write application data saved inside "User\AppData", even if there is Unicode characters in the Username.
VB6's native controls aren't able to show Unicode characters. There is really no way around. However, internally the string is actually 16-bit Unicode/BSTR, so it has the value correctly. The listbox or another control just displays it incorrectly.
hi, thanks for the quick reply. Im actually not working with any controls.
as shown in the sample, im trying to use this string path directly after returning from the GetSystemPath call.
for sake of simplicity, i was showing that even mkdir sPath & "\test" fails, but I had also tried passing this sPath return value to several other unicode-aware API calls, such as GetShortPathNameW, or even WritePrivateProfileStringW.
Were you able to get the GetSystemPath() return value path working with other unicode-aware API calls?
ok... after further testing, i found that the code does work if the "system default locale" is set the same as the unicode characters in question.. but as i originally noticed, it will not return a proper working path if the system default locale is set to anything else. i am using Microsoft AppLocale to test.
so i can confirm this is a bug (as originally stated, Japanese character in the pathname, but using en-US system default locale) but at this point, im guessing there isnt a possible fix.
MkDir is also a function that doesn't support Unicode. It fails since there is no folder "?". A lot of VB's native functions coerce to ANSI, including all the file handling functions. If you want to handle Unicode filenames, you have to use Unicode aware API calls.
Byte arrays are directly converted to strings without applying ANSI coercion. The same happens the other way around, you can apply a string to a byte array and Unicode is preserved. It is a direct memory copy of the string where nothing is ever changed.
StrConv(bytArray, vbUnicode) actually just adds in extra zero bytes, although I guess it may also work a bit by the locale and apply certain character codes above the 255 byte range, and thus use the equivalent Unicode character codes instead. I haven't really tested it too well, or, I can't remember how it worked if I did test it out at some point.
I made my own test program. I changed the folder "C:\Users\Vesa\Favorites\" to "C:\Users\Vesa\ふぁヴぉりてす\"
Then I ran this simple code (also having the module I posted above):
Code:
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function DrawText Lib "user32" Alias "DrawTextW" (ByVal hDC As Long, ByVal lpStr As Long, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Sub Form_Load()
Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Paint()
Dim bytText() As Byte, udtRECT As RECT
bytText = GetSystemPath([Path Favorites]) & "\"
With udtRECT
.Bottom = Me.ScaleHeight
.Right = Me.ScaleWidth
End With
DrawText Me.hDC, VarPtr(bytText(0)), (UBound(bytText) + 1) \ 2, udtRECT, 0
End Sub
Nicely shows you the Japanese there, and that the function works as I told
Thank you very much for your help with this issue. I used your test code and it indeed works on Unicode pathnames, even if the system default locale isnt set to the same locale as the unicode characters.
Also, It seems that I was not implementing the Unicode calls correctly but I was able to fix them after I realized from your code that I forgot strptr() for INPUT and varptr(btyARR) for OUTPUT vars (neat trick instead of requiring CopyMemory on the return string pointer) from the Unicode API calls.
So, I was able to use your code for the SpecialFolders to properly have my application read/save settings to the AppData folder, even if there are unicode characters in the path!
In any case, if anyone stumbles upon this thread, as I have migrating my VB6 code to be Vista compatible and also making changes to have my code Unicode aware, here are some basic working functions for handling Unicode directories and reading/writing INI files with Unicode characters in the path/name from within VB6.
Code:
' goes into a module
Option Explicit
Private Declare Function GetPrivateProfileStringU _
Lib "kernel32" _
Alias "GetPrivateProfileStringW" (ByVal pszApplicationName As Long, _
ByVal pszKeyName As Long, _
ByVal pszDefault As Long, _
ByVal pszReturnedString As Long, _
ByVal nSize As Long, _
ByVal pszFileName As Long) As Long
Private Declare Function WritePrivateProfileStringU _
Lib "kernel32" _
Alias "WritePrivateProfileStringW" (ByVal lpApplicationName As Long, _
ByVal lpKeyName As Long, _
ByVal lpString As Long, _
ByVal lplFileName As Long) As Long
Private Declare Function GetShortPathNameU _
Lib "kernel32" _
Alias "GetShortPathNameW" (ByVal lpszLongPath As Long, _
ByVal lpszShortPath As Long, _
ByVal nBufferLength As Long) As Long
Private Declare Function CreateDirectoryU Lib "kernel32" Alias "CreateDirectoryW" (ByVal lpPathName As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Function GetShortNameU(ByVal sLongPath As String) As String
On Error Resume Next
Const MAX_LEN = 2048
Dim lRet As Long
Dim bytShortPath(MAX_LEN) As Byte
lRet = GetShortPathNameU(StrPtr(sLongPath), ByVal VarPtr(bytShortPath(0)), MAX_LEN)
If lRet > 0 Then
GetShortNameU = Left$(bytShortPath, lRet)
Else
GetShortNameU = sLongPath
End If
End Function
Public Function GetUnicodeINI(ByVal sAppName As String, _
ByVal sKeyName As String, _
ByVal sFilename As String, _
Optional ByVal sDefault As String = vbNullString)
On Error Resume Next
Const MAX_LEN = 2048
Dim lRes As Long
Dim bytRet(MAX_LEN) As Byte
lRes = GetPrivateProfileStringU(StrPtr(sAppName), StrPtr(sKeyName), StrPtr(sDefault), ByVal VarPtr(bytRet(0)), MAX_LEN, StrPtr(sFilename))
If lRes > 0 Then
GetUnicodeINI = Left$(bytRet, lRes)
Else
GetUnicodeINI = sDefault
End If
End Function
Public Function WriteUnicodeINI(ByVal sAppName As String, _
ByVal sKeyName As String, _
ByVal sWord As String, _
ByVal sFilename As String)
On Error Resume Next
Call WritePrivateProfileStringU(StrPtr(sAppName), StrPtr(sKeyName), StrPtr(sWord), StrPtr(sFilename))
End Function
Public Function MakeDirU(ByVal sPath As String) As Boolean
On Error Resume Next
Dim udtSA As SECURITY_ATTRIBUTES
Dim lRet As Long
lRet = CreateDirectoryU(StrPtr(sPath), udtSA)
If lRet Then MakeDirU = True
End Function
also note, taking the GetShortPathName of a path with Unicode characters will allow most VB controls/functions that are not Unicode aware to fully work
VB6 Vista UAC Problem
Reply With Quote
Originally Posted by Susan82
