bCheckTrnsfr = remote.FileXferFromHost(sHostFile, sRemoteFile)
If bCheckTrnsfr = True And fso.FileExists(sRemoteFile) Then
Print #1, "File transferred from host " & sHostID
Else
If iRetryXfr < 2 Then
iRetryXfr = iRetryXfr + 1
GoTo UTransfer:
End If
End IfDim t As Thread
Dim lStartTime As Long
Dim remote As Object'**********************************************************************************
'Start Thread to check status of File Transfers.
'Multi Threading does not work in VB IDE.
'Compile to EXE for StatusCheck Thread to work
'or remark this section to run in VB IDE.
'Note that locked file transfers will not be detected if this is remarked.
'**********************************************************************************
lStartTime = 0
Set t = New Thread
t.StartThread "CheckStatus", "none", Me'**********************************************************************************
'CheckStatus is run in a separate thread. It monitors the time elapsed since each
'file transfer started and will kill PCanywhere if a file transfer locks up or
'does not complete within 30 seconds
'**********************************************************************************
Sub CheckStatus(dummy As Variant)
Do
If Timer > lStartTime + 30 And lStartTime <> 0 Then
Set remote = CreateObject("Awrem32.Application")
Call remote.awDisconnect
Set remote = Nothing
lStartTime = 0
End If
Loop
End SublStartTime = Timer
bCheckTrnsfr = remote.FileXferFromHost(sHostFile, sRemoteFile)
lStartTime = 0'check to see if the connection was lost
'if it was, reconnect
If remote.ConnectionStatus <> 1 Then
iReconnect = iReconnect + 1
Print #1, Format$(Now, "mm-dd hh:mm:ss") & " Lost connection. Attempting reconnect #" & iReconnect
bWentOK = remote.awDisconnect()
Set remote = Nothing
GoTo Reconnect:
End If' Used to find a windows handle
Private Const GW_HWNDFIRST = 0&
Private Const GW_HWNDLAST = 1&
Private Const GW_HWNDNEXT = 2&
Private Const GW_CHILD = 5&
Private Const GWL_EXSTYLE = -20&
Private Const GWL_HINSTANCE = -6&
Private Const GWL_HWNDPARENT = -8&
Private Const GWL_ID = -12&
Private Const GWL_STYLE = -16&
Private Const GWL_USERDATA = -21&
Private Const GWL_WNDPROC = -4&
' Used by OpenProcess function
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
' API's used to get window info
Private Declare Function GetWindowText _
Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare Function GetWindow _
Lib "user32" _
(ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetDesktopWindow _
Lib "user32" () As Long
Private Declare Function DestroyWindow _
Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function IsWindow _
Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function OpenProcess _
Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle _
Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function TerminateProcess _
Lib "kernel32" _
(ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
Private Declare Function GetWindowThreadProcessId _
Lib "user32" _
(ByVal hwnd As Long, _
lpdwProcessId As Long) As Long
Dim plngPID As Long
Dim plngRtn As Long
Dim plngWndHwnd As Long
Dim plngOpenProcHwnd As LongSub CheckStatus(dummy As Variant)
Do
If Timer > lStartTime + 30 And lStartTime <> 0 Then
Set remote = CreateObject("Awrem32.Application")
Call remote.awDisconnect
Set remote = Nothing
KillProcess ("File Transfer Status") 'kills locked file transfer
KillProcess ("Program Error") 'kill errors from AWREM32.EXE
Pause (2)
lStartTime = 0
End If
Loop
End Sub'*************************************************************
'Passed a partial or complete window title, forcefully kills it
'*************************************************************
Public Function KillProcess(PartialTitle As String)
plngWndHwnd = GetWindowFromTitle(PartialTitle)
plngRtn = GetWindowThreadProcessId(plngWndHwnd, plngPID)
If plngPID > 0 Then
plngOpenProcHwnd = OpenProcess(PROCESS_ALL_ACCESS, 0&, plngPID)
If plngOpenProcHwnd <> 0 Then
KillWindow plngWndHwnd, plngOpenProcHwnd
plngRtn = CloseHandle(plngOpenProcHwnd)
End If
End If
End Function
'****************************************************
' Passed a partial or complete window title, return
' the handle of the first title found matching
' the passed string.
' NOTE: Case insensitive
'****************************************************
Public Function GetWindowFromTitle(xstrPartialTitle As String) As Long
Dim pstrTitle As String * 256
Dim plngHwnd As Long
Dim plngRtn As Long
Dim pstrMatch As String
Dim pstrPassed As String
GetWindowFromTitle = 0
'Make sure passed string is uppercase
pstrPassed = UCase$(xstrPartialTitle)
'The desktop is the highest window
plngHwnd = GetDesktopWindow()
'It's first child is the 1st top level window
plngHwnd = GetWindow(plngHwnd, GW_CHILD)
'Get the text of the window
plngRtn = GetWindowText(plngHwnd, pstrTitle, Len(pstrTitle))
On Error Resume Next
If plngRtn = 0 Then
pstrMatch = ""
Else
pstrMatch = UCase$(Mid$(pstrTitle, 1, plngRtn))
End If
'Check to see if first child contains the passed string
If Len(pstrMatch) > 0 Then
If InStr(pstrPassed, pstrMatch) > 0 Then
GetWindowFromTitle = plngHwnd
Exit Function
End If
End If
On Error GoTo 0
'Now check all the top level windows
Do
plngHwnd = GetWindow(plngHwnd, GW_HWNDNEXT)
'Get the text of the window
pstrTitle = ""
plngRtn = GetWindowText(plngHwnd, pstrTitle, Len(pstrTitle))
On Error Resume Next
If plngRtn = 0 Then
pstrMatch = ""
Else
pstrMatch = UCase$(Mid$(pstrTitle, 1, plngRtn))
End If
'Check to see if this window contains the passed string
If Len(pstrMatch) > 0 Then
If InStr(pstrMatch, pstrPassed) > 0 Then
GetWindowFromTitle = plngHwnd
Exit Function
End If
End If
On Error GoTo 0
Loop While plngHwnd <> 0
GetWindowFromTitle = 0
End Function
'******************************************************
' Passed a Windows handle and a Process handle, kill it
'******************************************************
Public Sub KillWindow(xlngHwnd As Long, xlngProcessHwnd As Long)
Dim plngRtn As Long
Dim plngProcessHwnd As Long
Dim plngThreadHwnd As Long
Dim plngExitCode As Long
plngExitCode = 0&
If xlngHwnd <> 0 Then
If IsWindow(xlngHwnd) <> 0 Then
plngRtn = TerminateProcess _
(xlngProcessHwnd, _
plngExitCode)
If plngRtn = 0 Then
'MsgBox "Failed to destroy window: Error #" & _
Err.LastDllError & ", " & _
ReturnApiErrString(Err.LastDllError)
Else
'MsgBox "Destroyed window!"
End If
End If
End If
End Sub