Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here


Network connection hang problem.

Network connection hang problem.

Network connection hang problem.

I have incorporated in a vb6 app a routine to automatically copy a 20mb database file to a number of network servers on a fibre optic local network at midnight every night.

Problem is if the server permission has not been left open for me or it asks for a password(such as left in nobody logged on state), it will hang for up to a minute suspending all other tasks.
The remote server can still be pinged in this condition so this would not indicate that the file access was not open.
Currently I ping each server first then copy the file only if successful to avoid a hang if the server is completely off line.

Q 1. Is there a way of making a file copy routine that is effectively asynchronous with a callback to start the copy or at least reducing the hang wait period to a few seconds?

I guess the long wait is a carry over from the old days when computers and networks were 100 times slower. I remember when a fast network speed was 10 meg!

Related problem:-
The network people now want to also restrict pinging through their firewall for security purposes. If they do this I won't be able to pre-ping any computer off line before I try to copy to avoid a hang.

Q 2.The answer to the first question should solve this one too or is there a different way

(Using a Pinging routine was as a result to an answer I got in this forum years ago.)

RE: Network connection hang problem.

>Using a Pinging routine was as a result to an answer I got in this forum years ago

Indeed - but I seem to recall comments related to security on the network you were using. Looks like your 'network people' are beginning to catch up ...

Anyway - you might want to have a look at RoboCopy

RE: Network connection hang problem.

You could just keep it simple.

Write a VBScript that establishes a connection with user/pw and performs the file operations required.

For the first part you'd want to enumerate the FSO.Drives collection to find a free drive letter, and then use WshNetwork.MapNetworkDrive (and when done .RemoveNetworkDrive). For the second part you'd use FSO methods to copy, rename, etc.

Your program could just call Shell() to start cscript.exe passing the name of your VBScript source file. Before that you'd write an "instructions" file someplace where the script can find it. The script could read and interpret that, or it might be actual VBScript statements included by the script.

With ptoper error trapping the script could log actions, success or failure, etc. to another "known file." By using "shell and poll" techniques your VB6 program can start the script and then poll the process for completion using a Timer. When found to be terminated your program could read the "known" output file for status or even details of the action (successful copies, failed ones, etc.).

Simple VB6 AsyncShell demo:


Option Explicit

Private Const SYNCHRONIZE = &H100000
Private Const WAIT_OBJECT_0 = 0
Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
    ByVal hProcess As Long, _
    ByRef ExitCode 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 WaitForSingleObject Lib "kernel32" ( _
    ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) As Long

Private hProcess As Long
Private Function ShellAsync( _
    ByVal PathName As String, _
    ByVal WindowStyle As VbAppWinStyle) As Long
    'Shell and get process handle.  Return 0 for success.
    Dim Pid As Long
    On Error Resume Next
    Pid = Shell(PathName, WindowStyle)
    On Error GoTo 0
    If Pid Then
        hProcess = OpenProcess(SYNCHRONIZE _
                            Or PROCESS_QUERY_INFORMATION, 0, Pid)
        'Failed to open child process:
        If hProcess = 0 Then ShellAsync = Err.LastDllError
        ShellAsync = -1 'Failed to Shell child process.
    End If
End Function

Private Sub cmdDoSomething_Click()
    'Just something that shows the parent process is not blocked (i.e.
    'is still responsive).
    BackColor = IIf(BackColor = vbButtonFace, vbButtonText, vbButtonFace)
End Sub

Private Sub cmdStart_Click()
    Dim Result As Long
    Result = ShellAsync("wscript test.vbs", vbHide)
    If Result Then
        MsgBox "ShellAsync test.vbs failed: " & CStr(Result)
        cmdStart.Enabled = False
        cmdDoSomething.Enabled = True
        With tmrPoll
            .Interval = 100
            .Enabled = True
        End With
    End If
End Sub

Private Sub Form_Load()
    cmdDoSomething.Enabled = False
End Sub

Private Sub tmrPoll_Timer()
    Dim ExitCode As Long
    If WaitForSingleObject(hProcess, 0) = WAIT_OBJECT_0 Then
        tmrPoll.Enabled = False
        BackColor = vbButtonFace
        cmdDoSomething.Enabled = False
        cmdStart.Enabled = True
        If GetExitCodeProcess(hProcess, ExitCode) Then
            CloseHandle hProcess
            MsgBox "Success, return code: " & CStr(ExitCode)
            CloseHandle hProcess
            MsgBox "Failed to retrieve exit code, error " _
                 & CStr(Err.LastDllError)
        End If
    End If
End Sub 

Simple test.vbs:


MsgBox "Ready when you are...", vbOkOnly, "External Process"
WScript.Quit -3007 

When you run the program it sits until you click "Start" when it fires off the script (WScript in this case so we can use MsgBox). You can click on "Do Something" and see it flip/flop the Form's BackColor. When you Ok the script's MsgBox the polling timer's event handler detects script termination.

A fancier version of this would involve more directly starting cscript.exe and redirecting its StdIO streams to anonymous pipes, and writing to and monitoring those in your VB6 program. That skips the "disk files as mailboxes" but adds a little complexity and a lot more API calls. It still requires a Timer as well since async I/O on pipes isn't offered by VB6 or easily accomplished there.

RE: Network connection hang problem.

You could Shell RoboCopy in a similar manner, but you'd probably have more trouble knowing where it failed and succeeded. However if fine granularity isn't required you could just look at the ExitCode.


RE: Network connection hang problem.

Thanks for that info.
I notice in Wiki that robocopy has a "mirror" bug (whatever that is) in OSs older than Vista.
Half the computers are still using XP so is that likely to be a problem in this case?

RE: Network connection hang problem.


Well, unless:

a) you expect file permissions on a file to regularly change between copies
b) you are unable to make the minor change to the robocopy command line that deals with this issue

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close