When I download a textfile to read the content, the next time I do not get the the changed content of the file. Somehow the cache file is read and not the updated file on the Internet site.
Is there a way to delete a specific file from cache straight after downloading and reading it?
'API used:
Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
'Internet Read Text File Content
If FileExists(FileToCreate) = True Then
Kill (FileToCreate) ' kill it to make sure it is created by this routine
End If
If INetThere = True Then ' checks if there is an Internet connection
On Error Resume Next ' Issue with Digital Certification, to be resolved later.
BaK = URLDownloadToFile(0, FileToGet, FileToCreate, 0, 0)
On Error GoTo 0
If Err.Number <> 0 Then MsgBox (Err.Number)
End If
If FileExists(FileToCreate) Then ' get content: CACHE problem, reads old file from memory instead of Internet file content
VrijeFile = FreeFile
Open FileToCreate For Input As #VrijeFile
Line Input #VrijeFile, VersionBAK ' this line gets the data from the old, previously read file in chache
Close #VrijeFile
Kill (FileToCreate)
End If
If VersionBAK <> "" Then
LeesRegeL = VersionBAK
UpdateMajor = VBA.Val(VBA.Trim$(Chop_On(vbDot)))
UpdateMinor = VBA.Val(VBA.Trim$(Chop_On(vbDot)))
UpdateRevision = VBA.Val(VBA.Trim$(LeesRegeL))
End If
New_LCWin_Version = (UpdateMajor > LCWinMajoR) Or (UpdateMinor > LCWinMinoR) Or (UpdateRevision > LCWinReviSioN)
CheckForUpdate = New_LCWin_Version ' end result for the function returned
Issue resolved:
The file was not made public by the Internet provider although I could view the new content of the file, it was not available for the public, the old one was.
Therefore it is not the cache that is not updated, it is the website itself.
thanks for viewing and contributing.
Case closed and hopefully helpful for others.
Related
I have a webform displayed in a WebBrowser control in a Visual Basic application to allow users to upload files to my webserver. Unusually for this type of thing, I know in advance the folder they need to browse to (I want them to upload a file which the VB application has generated) and I would like the Browse dialog box to default to that folder but it seems to default to whichever folder was last used by any application for File / Open.
I've tried using ChDir in VB to set the current folder but that doesn't work.
Is there any way I can persuade the Browse box to default to my desired folder?
First of all, I ought to state that there is no reliable way of doing this. The reason why it is so hard is for security reasons. There is a defaultValue and value property for the INPUT TYPE=FILE element, but if programmers had access to this, this could be used to suck files from the client machine - definitely not a good idea.
In Internet Explorer, the browse file dialogue is actually implemented by a Windows Common Dialog component. However, you have no direct access to this component.
There is no reliable browser-independent way of doing this. And I certainly don't recommend you reverse-engineer the "Last Recently Used" file list for the Common Dialog control (see jac's link). Doing that is very dangerous, since it is an internal-algorithm likely to change. And worse, you are hacking global state to solve a local problem (see Old New Thing blog, ad nauseam).
A solution that doesn't violate global state, but still hacky is to take advantage of the fact we know what the text is on the file upload dialogue. After your document has loaded, you can use a Timer to wait for the dialogue to appear, and at that point, paste the correct directory into the dialogue.
In my sample, I have code where the web browser control sits, and the BrowserHack.bas module.
Form code:
Option Explicit
Private Sub cmdLoadPage_Click()
' Store the default path into the .Tag property.
tmrWaitForDialogue.Tag = "C:\Windows\System32"
' Load URL.
wbMain.Navigate "<URL>"
End Sub
Private Sub Form_Load()
tmrWaitForDialogue.Enabled = False
tmrWaitForDialogue.Interval = 100 ' 10th of a second delay.
End Sub
Private Sub tmrWaitForDialogue_Timer()
If BrowserHack.IsBrowserFileDialogueVisible Then
' We don't want the Timer to fire again.
tmrWaitForDialogue.Enabled = False
' Copy the directory onto the clipboard.
Clipboard.Clear
Clipboard.SetText tmrWaitForDialogue.Tag
' The focus will be on the file path text box in the Open dialogue.
' Use CTL-V to paste the text, and then followed by an Enter character to
' dismiss the dropdown, and another to Open the folder.
SendKeys "^V"
SendKeys "{ENTER}"
SendKeys "{ENTER}"
End If
End Sub
Private Sub wbMain_DocumentComplete(ByVal pDisp As Object, URL As Variant)
tmrWaitForDialogue.Enabled = True
End Sub
BrowserHack:
' Purpose: Code to look for the WebBrowser (Internet Explorer) dialogue which appears when a File Upload control is clicked.
' Notes: Internet Explorer version dependent.
Option Explicit
Private Declare Function EnumThreadWindows Lib "User32.dll" ( _
ByVal dwThreadId As Long, _
ByVal lpfn As Long, _
ByVal lParam As Long _
) As Long
Private Declare Function GetClassName Lib "User32.dll" Alias "GetClassNameW" (ByVal hWnd As Long, ByVal lpClassName As Long, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "User32.dll" Alias "GetWindowTextW" (ByVal hWnd As Long, ByVal lpString As Long, ByVal nMaxCount As Long) As Long
Private Declare Function IsWindowVisible Lib "User32.dll" (ByVal hWnd As Long) As Long
Private Const APITRUE As Long = 1 ' Win32 API TRUE value
Private Const APIFALSE As Long = 0 ' Win32 API FALSE value
' This dialogue class is pretty universal.
Private Const m_ksDialogueClass As String = "#32770"
Private Const m_knDialogueClassLen As Long = 6
' This text may well change every time the browser is updated.
Private Const m_ksDialogueText As String = "Choose File to Upload"
Private Const m_knDialogueTextLen As Long = 21
' Buffers to be used for these strings.
Private m_sClassNameBuffer As String
Private m_sWindowNameBuffer As String
' Callback from the EnumThreadWindow() function.
Private Function EnumThreadWndProc( _
ByVal hWnd As Long, _
ByVal lParam As Long _
) As Long
Dim nRet As Long
' Filter out hidden windows.
If IsWindowVisible(hWnd) = APITRUE Then
' Retrieve the class name of the window.
' Note that this function requires you to allocate a buffer *including* the terminating null character.
' Since VB strings *always* are null terminated, we can add one to the string length.
nRet = GetClassName(hWnd, StrPtr(m_sClassNameBuffer), (m_knDialogueClassLen + 1))
' If the classes match, then try for a match on the window's text.
If m_sClassNameBuffer = m_ksDialogueClass Then
' Ditto GetClassName().
nRet = GetWindowText(hWnd, StrPtr(m_sWindowNameBuffer), (m_knDialogueTextLen + 1))
If m_sWindowNameBuffer = m_ksDialogueText Then
' This return value says "stop the enumeration".
' In this case EnumThreadWindow() with also return APIFALSE.
EnumThreadWndProc = APIFALSE
Exit Function
End If
End If
End If
EnumThreadWndProc = APITRUE
End Function
' Purpose: If the browser window is detected
Public Function IsBrowserFileDialogueVisible() As Boolean
' If this is the first time this function has been called, the buffers will not be allocated.
' Do this now.
If LenB(m_sClassNameBuffer) = 0 Then
m_sClassNameBuffer = Space$(m_knDialogueClassLen)
m_sWindowNameBuffer = Space$(m_knDialogueTextLen)
End If
' Enumerate through all windows on this thread. VB apps are single-threaded, and all GUI elements are forced to be on this thread, so this is ok.
If EnumThreadWindows(App.ThreadID, AddressOf EnumThreadWndProc, 0&) = APIFALSE Then
IsBrowserFileDialogueVisible = True
Else
IsBrowserFileDialogueVisible = False
End If
End Function
If you have an embedded resource in your VB6 project that contains a binary file, what code would cause this file to be copied to another location, without ever making a copy of the file on the local system?
I have done something like this before in .NET but I fear it is not possible in VB6.
From http://support.microsoft.com/kb/q194409/ :
Public Function SaveResItemToDisk( _
ByVal iResourceNum As Integer, _
ByVal sResourceType As String, _
ByVal sDestFileName As String _
) As Long
'=============================================
'Saves a resource item to disk
'Returns 0 on success, error number on failure
'=============================================
'Example Call:
' iRetVal = SaveResItemToDisk(101, "CUSTOM", "C:\myImage.gif")
Dim bytResourceData() As Byte
Dim iFileNumOut As Integer
On Error GoTo SaveResItemToDisk_err
'Retrieve the resource contents (data) into a byte array
bytResourceData = LoadResData(iResourceNum, sResourceType)
'Get Free File Handle
iFileNumOut = FreeFile
'Open the output file
Open sDestFileName For Binary Access Write As #iFileNumOut
'Write the resource to the file
Put #iFileNumOut, , bytResourceData
'Close the file
Close #iFileNumOut
'Return 0 for success
SaveResItemToDisk = 0
Exit Function
SaveResItemToDisk_err:
'Return error number
SaveResItemToDisk = Err.Number
End Function
I have a legacy VB6 application that uploads file attachments to a database BLOB field. It works fine unless a user has the file open.
I tried creating a copy of the file, then uploading that copy, but to my surprise, the FileCopy procedure gets a "permission denied" error whenever you try to copy a file that is open by the user.
This suprised me, because you can copy a file in Windows Explorer while it is open, and I was assuming that the FileCopy method used the same API call as explorer.
Anyway, my question is: How can I copy an open file in VB6?
Answering my own question:
Based on this article, the answer that worked for me is described below.
1 - Add this declaration to the VB file:
Declare Function apiCopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
2 - Create a little wrapper for that function, like so:
Sub CopyFileEvenIfOpen(SourceFile As String, DestFile As String)
Dim Result As Long
If Dir(SourceFile) = "" Then
MsgBox Chr(34) & SourceFile & Chr(34) & " is not valid file name."
Else
Result = apiCopyFile(SourceFile, DestFile, False)
End If
End Sub
3 - Replace my previous call to FileCopy with this:
CopyFileEvenIfOpen sourceFile, tempFile
If you would like to do the same without using the api:
Function SharedFilecopy(ByVal SourcePath As String, ByVal DestinationPath As String)
Dim FF1 As Long, FF2 As Long
Dim Index As Long
Dim FileLength As Long
Dim LeftOver As Long
Dim NumBlocks As Long
Dim filedata As String
Dim ErrCount As Long
On Error GoTo ErrorCopy
'-------------
'Copy the file
'-------------
Const BlockSize = 32767
FF1 = FreeFile
Open SourcePath$ For Binary Access Read As #FF1
FF2 = FreeFile
Open DestinationPath For Output As #FF2
Close #FF2
Open DestinationPath For Binary As #FF2
Lock #FF1: Lock #FF2
FileLength = LOF(FF1)
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
filedata = String$(LeftOver, 32)
Get #FF1, , filedata
Put #FF2, , filedata
filedata = ""
filedata = String$(BlockSize, 32)
For Index = 1 To NumBlocks
Get #FF1, , filedata
Put #FF2, , filedata
Next Index
Unlock #FF1: Unlock #FF2
SharedFilecopy = True
exitcopy:
Close #FF1, #FF2
Exit Function
ErrorCopy:
ErrCount = ErrCount + 1
If ErrCount > 2000 Then
SharedFilecopy = False
Resume exitcopy
Else
Resume
End If
End Function
Shorter solution:
1- Project -> References. Check "Microsoft Scripting Runtime"
2- Use this:
Dim fso As New FileSystemObject
fso.CopyFile file1, file2
I periodically break binary compatibility and need to recompile an entire vb6 application composed of several dozen ActiveX DLLs and OCXs in total. I've written a script to automate this process, but I have encountered a problem.
When an OCX is recompiled with project compatibility its version is incremented, and projects referencing the OCX will not recompile until their reference is updated to the new version. This is checked automatically when the project is opened normally, and the user is prompted to update the reference, but I need to do it in a script.
How do I do it?
We are doing similar things, i.e. manipulating the references to the used OCXs directly in VB6 .vbp files, in our VB6 Project References Update Tool (download here). Generally it is used to update the references when the used ActiveX change their version numbers, CLSIDs, etc.
The tools is open-source so everyone who is interested in this problem can borrow our VB code snippets to implement tasks like these.
Our tool is written in Visual Basic 6 and uses tlbinf32.dll (the TypeLib Information DLL) that allows you to programmatically extract information from type libraries.
My project, maintained over a decade, consists of a hierarchy of two dozen ActiveX DLLs and a half dozen controls. Compiled with a script system as well.
I don't recommend doing what you are doing.
What we do is as follows
Make our changes including additions
and test in the IDE.
We compile from the bottom of the
hierarchy to the top
we copy the newly complied files to
a revision directory for example
601,then 602 etc etc
we create the setup.exe
when the setup is finalized we copy
over the revision directory into our
compatibility director. Note we
never point to the compiled binary
in the project directory. Always to
a compability directory that has all
the DLLs.
The reason this works is that if you look at the IDL source using the OLE View tool you will find that any referenced control or dlls is added to the interface via a #include. If you point to the binary in your project directory then the include is picked up from the registry which can lead to a lot of strangness and compatibility.
However if the referenced DLL is present in the directory that binary exists while being used for binary compatibility, VB6 will use that instead of whatever in the registry.
Now there is one problem that you will get on an infrequent basis. Consider this heirarchy
MyUtilityDLL
MyObjectDLL
MyUIDLL
MyEXE
If you ADD a property or method to a class in MyUtilityDLL MyUIDLL may not compile giving a binary incompatibility error if you are lucky or a strange error like [inref]. In any case the solution is to compile MyUtilityDLL and then immediately copy MyUtilityDLL into the compatibility directory. Then the rest of the automated compile will work fine.
You may want to include this step in the automated build.
Note that in many cases the projects will work fine in the IDE. To if you are now aware of this you could be pulling your hair out.
I guess you would have to edit the project files (.vbp), Form files (.frm) and the control files (.ctl) that reference the DLLs and OCXs and increment the typelib version number.
You would find latest typelib version number for the control / DLL in the registry.
This could be a pain depending on how many files you have.
A hack would be to open main project with VB6 using your script and send keys to confirm the Update References and then save the project.
Good Luck
Self-answer: I have written some vb6 code to do the upgrade programmatically. It is not extensively tested, there are probably a few bugs here and there for corner cases, but I did use it successfully.
Option Explicit
Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const KEY_ENUMERATE_SUB_KEYS As Long = 8
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
'''Returns the expected major version of a GUID if it exists, and otherwise returns the highest registered major version.
Public Function GetOcxMajorVersion(ByVal guid As String, Optional ByVal expected_version As Long) As Long
Const BUFFER_SIZE As Long = 255
Dim reg_key As Long
Dim ret As Long
Dim enum_index As Long
Dim max_version As Long: max_version = -1
ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\TypeLib\{" & guid & "}", 0, KEY_ENUMERATE_SUB_KEYS, reg_key)
If ret <> 0 Then Err.Raise ret, , "Failed to open registry key."
Do
'Store next subkey name in buffer
Dim buffer As String: buffer = Space(BUFFER_SIZE)
Dim cur_buffer_size As Long: cur_buffer_size = BUFFER_SIZE
ret = RegEnumKeyEx(reg_key, enum_index, buffer, cur_buffer_size, ByVal 0&, vbNullString, ByVal 0&, ByVal 0&)
If ret <> 0 Then Exit Do
buffer = Left(buffer, cur_buffer_size)
'Keep most likely version
buffer = Split(buffer, ".")(0)
If Not buffer Like "*[!0-9A-B]*" And Len(buffer) < 4 Then
Dim v As Long: v = CLng("&H" & buffer) 'convert from hex
If v = expected_version Then
max_version = v
Exit Do
ElseIf max_version < v Then
max_version = v
End If
End If
enum_index = enum_index + 1
Loop
RegCloseKey reg_key
If max_version = -1 Then Err.Raise -1, , "Failed to enumerate any viable subkeys."
GetOcxMajorVersion = max_version
End Function
Public Function RemoveFilename(ByVal path As String) As String
Dim folders() As String: folders = Split(Replace(path, "/", "\"), "\")
RemoveFilename = Left(path, Len(path) - Len(folders(UBound(folders))))
End Function
'''Changes any invalid OCX references to newer registered version
Public Sub UpdateFileOCXReferences(ByVal path As String)
Dim file_data As String
Dim changes_made As Boolean
'Read
Dim fn As Long: fn = FreeFile
Open path For Input As fn
While Not EOF(fn)
Dim line As String
Line Input #fn, line
'check for ocx reference line
If LCase(line) Like "object*=*{*-*-*-*-*}[#]*#.#*[#]#*;*.ocx*" Then
'get guid
Dim guid_start As Long: guid_start = InStr(line, "{") + 1
Dim guid_end As Long: guid_end = InStr(line, "}")
Dim guid As String: guid = Mid(line, guid_start, guid_end - guid_start)
'get reference major version
Dim version_start As Long: version_start = InStr(line, "#") + 1
Dim version_end As Long: version_end = InStr(version_start + 1, line, ".")
Dim version_text As String: version_text = Mid(line, version_start, version_end - version_start)
'play it safe
If Len(guid) <> 32 + 4 Then Err.Raise -1, , "GUID has unexpected length."
If Len(version_text) > 4 Then Err.Raise -1, , "Major version is larger than expected."
If guid Like "*[!0-9A-F-]*" Then Err.Raise -1, , "GUID has unexpected characters."
If version_text Like "*[!0-9]*" Then Err.Raise -1, , "Major version isn't an integer."
'get registry major version
Dim ref_version As Long: ref_version = CLng(version_text)
Dim reg_version As Long: reg_version = GetOcxMajorVersion(guid, ref_version)
'change line if necessary
If reg_version < ref_version Then
Err.Raise -1, , "Registered version precedes referenced version."
ElseIf reg_version > ref_version Then
line = Left(line, version_start - 1) & CStr(reg_version) & Mid(line, version_end)
changes_made = True
End If
End If
file_data = file_data & line & vbNewLine
Wend
Close fn
'Write
If changes_made Then
Kill path
Open path For Binary As fn
Put fn, , file_data
Close fn
End If
End Sub
'''Changes any invalid in included files to newer registered version
Public Sub UpdateSubFileOCXReferences(ByVal path As String)
Dim folder As String: folder = RemoveFilename(path)
Dim fn As Long: fn = FreeFile
Open path For Input As fn
While Not EOF(fn)
Dim line As String
Line Input #fn, line
If LCase(line) Like "form=*.frm" _
Or LCase(line) Like "usercontrol=*.ctl" Then
Dim file As String: file = folder & Mid(line, InStr(line, "=") + 1)
If Dir(file) <> "" Then
UpdateFileOCXReferences file
End If
End If
Wend
Close fn
End Sub
I have read many articles about how to use an INI file within my VB6 project. I don't have a problem with the methods, my problem is how to make the EXE file find the INI file. I don't want to hard code the path in the program. I simply want the EXE to expect the INI file to be present in the same folder the EXE is executed from.
When I run the program from inside VB6 IDE, the INI is found and processed. When I compile the program and run the EXE, nothing is found.
My code looks like:
gServer = sGetINI(sINIFile, "TOOLBOM", "ServerName", "?")
where TOOLBOM is the [Section] and "ServerName" is the key for the value.
I obtained the following code for the API:
Rem API DECLARATIONS
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 WritePrivateProfileString Lib "kernel32" Alias _
"WritePrivateProfileStringA" (ByVal lpApplicationName _
As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
ByVal lpFileName As String) As Long
Public Function sGetINI(sINIFile As String, sSection As String, sKey _
As String, sDefault As String) As String
Dim sTemp As String * 256
Dim nLength As Integer
sTemp = Space$(256)
nLength = GetPrivateProfileString(sSection, sKey, sDefault, sTemp, _
255, sINIFile)
sGetINI = Left$(sTemp, nLength)
End Function
Public Sub writeINI(sINIFile As String, sSection As String, sKey _
As String, sValue As String)
Dim n As Integer
Dim sTemp As String
sTemp = sValue
Rem Replace any CR/LF characters with spaces
For n = 1 To Len(sValue)
If Mid$(sValue, n, 1) = vbCr Or Mid$(sValue, n, 1) = vbLf _
Then Mid$(sValue, n) = " "
Next n
n = WritePrivateProfileString(sSection, sKey, sTemp, sINIFile)
End Sub
In VB6 you can use the App.Path to specify the path to files that should be in the directory you are executing from. e.g.
sIniFile = App.Path & "\myIniFile.ini"
What is the error that you're getting?
Bob is right, this will fail as soon as anyone tries to run it on Vista or later. Writeable data files are not supposed to go in Program Files. Windows now enforces these rules. Global settings for all users belong in one folder, per-user settings in another, per-user roaming settings in another, etc.
This Visual Studio Magazine article by Karl Peterson gives some VB6 code you can drop into your project to find the locations of these folders at run-time. And then this previous article by the same author gives you a nice class for using INI files, to hide away those API declarations.
This will fail as soon as anyone tries to run it on Vista or later though.
Writeable data files are not supposed to go into Program Files. Since people did it anyway Windows began enforcing the rules beginning with Vista.
Global settings belong in an application folder under CommonAppData, per-user settings go below LocalAppData, per-using roaming settings under AppData, and so on. These locations are retrieved at runtime via Shell object or API calls.
You will want to use the FileSystemObject from the Scripting runtime to combine paths and filenames properly. Although it may seem a trivial issue in reality there are corner cases that the FileSystemObject handles.
app.path would return the path of the currently executing exe,use it
Keep the EXE in the same folder