Solved

Trap error: No more connections can be made to this remote computer

Posted on 2002-05-21
5
730 Views
Last Modified: 2011-09-20
Hi there,

I am writing an application that copies certain local directories to a network share. This share is restricted to allow maximum 10 concurrent connections.
I need to trap the error that the maximum number of connections has been reached.

When i connect with Windows Explorer to the share I get the error:
"No more connections can be made to this remote computer at this time because there are already as many connections as the computer can accept."

when i connect using VB I get the error "Disk not Ready (Error 71) "
I connected by:
1. tring to open a file on the share.
2. the API function WNetAddConnection2
Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long


I need a connection method that will result me the proper error as Windows Explorer does.
I think this should be achieved with a API function

Can anyone help me with this?

Thanks in advance,

Draak
0
Comment
Question by:Draak
  • 3
  • 2
5 Comments
 
LVL 26

Expert Comment

by:EDDYKT
Comment Utility
Use error lookup program that come with VS6.0

I get 'No more connections can be made to this remote computer at this time because there are already as many connections as the computer can accept. '

with error number = 71

?->
0
 
LVL 26

Accepted Solution

by:
EDDYKT earned 200 total points
Comment Utility
Try this


Option Explicit

'Create a new project and add this code to Form1
Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Const LANG_NEUTRAL = &H0
Const SUBLANG_DEFAULT = &H1
Const ERROR_BAD_USERNAME = 2202&
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim Buffer As String
    'Create a string buffer
    Buffer = Space(200)
    'Set the error number
    SetLastError 71
    'Format the message string
    FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, GetLastError, LANG_NEUTRAL, Buffer, 200, ByVal 0&
    'Show the message
    MsgBox Buffer
End Sub

0
 
LVL 5

Author Comment

by:Draak
Comment Utility
I had not discovered the error lookup tool yet.

Thanks for your help
0
 
LVL 5

Author Comment

by:Draak
Comment Utility
How can I get the error? With what function can I generate the error?

I try to open a file on the share, but it does not generate error 71, but error 52. What can I do to get the error 71?
0
 
LVL 26

Expert Comment

by:EDDYKT
Comment Utility
That's what you told me

>>when i connect using VB I get the error "Disk not Ready (Error 71) "


error 52 is 'A duplicate name exists on the network.'
Do you try to run WNetAddConnection2 twice?->


You can run hte following routine because calling WNetAddConnection2 to check to see weather the connection is there


Good Luck


Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCE_CONNECTED = &H1
Private Type NETRESOURCE
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As Long
    lpRemoteName As Long
    lpComment As Long
    lpProvider As Long
End Type
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As Any, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Function LetterToUNC(DriveLetter As String) As String
    Dim hEnum As Long
    Dim NetInfo(1023) As NETRESOURCE
    Dim entries As Long
    Dim nStatus As Long
    Dim LocalName As String
    Dim UNCName As String
    Dim i As Long
    Dim r As Long

    ' Begin the enumeration
    nStatus = WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, 0&, ByVal 0&, hEnum)

    LetterToUNC = DriveLetter

    'Check for success from open enum
    If ((nStatus = 0) And (hEnum <> 0)) Then
        ' Set number of entries
        entries = 1024

        ' Enumerate the resource
        nStatus = WNetEnumResource(hEnum, entries, NetInfo(0), CLng(Len(NetInfo(0))) * 1024)

        ' Check for success
        If nStatus = 0 Then
            For i = 0 To entries - 1
                ' Get the local name
                LocalName = ""
                If NetInfo(i).lpLocalName <> 0 Then
                    LocalName = Space(lstrlen(NetInfo(i).lpLocalName) + 1)
                    r = lstrcpy(LocalName, NetInfo(i).lpLocalName)
                End If

                ' Strip null character from end
                If Len(LocalName) <> 0 Then
                    LocalName = Left(LocalName, (Len(LocalName) - 1))
                End If

                If UCase$(LocalName) = UCase$(DriveLetter) Then
                    ' Get the remote name
                    UNCName = ""
                    If NetInfo(i).lpRemoteName <> 0 Then
                        UNCName = Space(lstrlen(NetInfo(i).lpRemoteName) + 1)
                        r = lstrcpy(UNCName, NetInfo(i).lpRemoteName)
                    End If

                    ' Strip null character from end
                    If Len(UNCName) <> 0 Then
                        UNCName = Left(UNCName, (Len(UNCName) - 1))
                    End If

                    ' Return the UNC path to drive
                    'added the [] to seperate on printout only
                    LetterToUNC = UNCName

                    ' Exit the loop
                    Exit For
                End If
            Next i
        End If
    End If

    ' End enumeration
    nStatus = WNetCloseEnum(hEnum)
End Function
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    '-> This sample was created by Donald Grover
    MsgBox "C: UNC path: " + LetterToUNC("C:")
End Sub

0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now