ARCHIVE: TIPS & TRICKS
Wait...WAIT! Suppose your VB app has to wait
Derek Brown
10.17.2000
Rating: -3.60- (out of 5)
Wait...WAIT! Suppose Your VB App Has to Wait
SearchVB reader Derek E. Brown sends in this tip that should be very useful in a number of situations that can arise. The tip involves making a VB app wait for the completion of some other process outside VB. While Derek has a specific purpose in mind for this one, it should be fairly easy to modify for a number of different situations.
I found this to be an extremely useful piece of code for running an application from within VB and having the VB app wait until the outside process is complete. I have a program that has to wait until an uploaded zip file is unzipped before continued processing can take place. The code below involves a few API's, and though it's rather long and involved, I have yet to get an error using it.
'**************************************
'Windows API/Global Declarations for :Un
'zipper
'**************************************
Private Const ZIPSIG = &H4034B50
Private Const ziputil = "c:Program FilesPKUnzipPkzip25.exe"
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = &HFFFFFFFF
'API's to monitor the status of Pkzip
Private Declare Function OpenProcess Lib "kernel32" (ByVal DesiredAccess As
Long, _ ByVal bInheritHandle As Long, ByVal ProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle
As Long, _ ByVal Milliseconds As Long) As Long Private Declare Function
CloseHandle Lib "kernel32"
(ByVal hObject As Long) As Long Private Type ZFHeader Signature As Long End Type
***********************************
Function fn_UnZipQReportFile() As Boolean
Dim FileToUnzip As String
Dim int_FilNum As Integer
Dim zhdr As ZFHeader
On Error Goto ErrorHandler:
fn_UnZipQReportFile = False
int_FilNum = 1
FileToUnzip = "C:Test.zip"
If FSO.FileExists(FileToUnzip) Then
Open FileToUnzip For Binary Access Read As #int_FilNum
Get #int_FilNum, , zhdr
If zhdr.Signature = ZIPSIG Then
If Array(int_ArrayCount).Password = "" Then
Err.Description = "No password supplied. File will Not unzip
If password protected. & _ Check database For empty (null) report password."
Goto ErrorHandler Else CmdLine = ziputil & " -ext -pass=" &
Array(int_ArrayCount).Password & " -dir=full -over=all " & FileToUnzip &
" " & Array(int_ArrayCount).Path
End If RetVal = Shell(CmdLine, vbMinimizedNoFocus)
If RetVal <> 0 Then sb_WaitForTemination (RetVal)
fn_UnZipQReportFile = True Else
Err.Description = "Zip file doesn't exist, " & FileToUnzip &
" " Goto ErrorHandler End If Else
Err.Description = "Zip file is empty, " & FileToUnzip & " "
Goto ErrorHandler End If
End If Exit Function
ErrorHandler: Call sub_Error_Log 'A seperate sub to write to an error log.
Resume Next
End Function
*************************************************
Private Sub sb_WaitForTemination(RetVl As Integer)
On Error Goto ErrorHandler:
Dim phnd&
phnd = OpenProcess(SYNCHRONIZE, 0, RetVl)
If phnd <> 0 Then
Call WaitForSingleObject(phnd, INFINITE)
Call CloseHandle(phnd)
End If
Exit Sub
ErrorHandler:
Err.Source = "sb_WaitForTermination in class Unzip in UnZipper"
Call sub_Error_Log
Resume Next
End Sub
Thanks, Derek. We'll be sending you a SearchVB denim shirt as a thank you for your submission. If you have a different solution for this problem, be sure to let us know. You can send your solution to us at tips@searchvb.com.
|
|
|
|
|
|
