Searching the entire network how?

I would like some code to search our entire company network for any Access databases and return their UNC path name and filename back.
This is to search any computers that are on teh company network and I am able to search with the right permissions.
homey_the_clownAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

TimCotteeHead of Software ServicesCommented:
This is a multi stage process, firstly you would need to enumerate all the machines on the network, I have some code for this that I can send to you, it works on NT,Novell etc but would need tailoring to your specific configuration. The second stage then if you are using NT would be to enumerate the administrative shares (C$/D$/E$) etc for each machine returned. Then you would need to use something like the dirwalk example from microsoft to scan all directories on the drive for anything with an mdb extension.
0
TimCotteeHead of Software ServicesCommented:
I have an example of this that I have quickly worked out, I can email you the basic project files if you post your address or EMail me on TimCottee@earthling.net. I may not get these to you until later today or early tomorrow as I am just leaving the office.

Tim.
0
VBGuruCommented:
TimCottee, it would be great if you can send me the code at sirigere@email.com
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

bja1Commented:
are all the drives mapped or do you need to do that on the fly?
0
TimCotteeHead of Software ServicesCommented:
No drive mappings are used, the machines are enumerated using API calls, then the drives are searched using the administrative shares in NT by using UNC path names. This eliminates the need to map drives. You can however map drives if you wish on the fly, but that would be another question.
0
mcriderCommented:
TimCottee

Instead of emailing the code, please post it so that anyone else buying this question doesn't get jipped.

Cheers!
0
TimCotteeHead of Software ServicesCommented:
Create a form with 4 text boxes, one list box and two command buttons, one called cmdSearch the other cmdStop. Paste the following code into the form.

Private Sub cmdSearch_Click()
    lstWorkstations.Clear
    Dim nr As NETRESOURCE
    EnumContainer nr, 0
End Sub

Private Sub cmdStop_Click()
    basGlobalSearch.blnStop = True
End Sub

Paste this into a module.

Public Const strDomainName = "MYDOMAIN" ' Change This to your domain name
Public Const strExtension = "mdb|ldb|mde" ' include extensions of files to find on any member

Public blnStop As Boolean

Public 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
Public Declare Function GlobalAlloc Lib "Kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "Kernel32" (ByVal hMem As Long) As Long
Public Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function CopyPointer2String Lib "Kernel32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long

Public 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
Public Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, ByVal lpBuffer As Long, lpBufferSize As Long) As Long
Public Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long

' RESOURCE ENUMERATION
Public Const RESOURCE_CONNECTED = &H1
Public Const RESOURCE_GLOBALNET = &H2
Public Const RESOURCE_REMEMBERED = &H3
Public Const RESOURCE_CONTEXT = &H4

Public Const RESOURCETYPE_ANY = &H0
Public Const RESOURCETYPE_DISK = &H1
Public Const RESOURCETYPE_PRINT = &H2
Public Const RESOURCETYPE_UNKNOWN = &HFFFF

Public Const RESOURCEUSAGE_CONNECTABLE = &H1
Public Const RESOURCEUSAGE_CONTAINER = &H2
Public Const RESOURCEUSAGE_RESERVED = &H80000000
Public Const RESOURCEDISPLAYTYPE_GENERIC = &H0
Public Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
Public Const RESOURCEDISPLAYTYPE_SERVER = &H2
Public Const RESOURCEDISPLAYTYPE_SHARE = &H3
Public Const RESOURCEDISPLAYTYPE_FILE = &H4
Public Const RESOURCEDISPLAYTYPE_GROUP = &H5
Public Const RESOURCEDISPLAYTYPE_SHAREADMIN = &H6

Public Sub EnumContainer(nr As NETRESOURCE, intCount As Integer)
    Dim hEnum1 As Long, lpBuff1 As Long, nr1 As NETRESOURCE
    Dim cbBuff1 As Long, cCount1 As Long
    Dim p1 As Long, res1 As Long, i1 As Long
    Dim txtLevel As String, intLevel As Integer, txtIPAddress As String
    DoEvents
    nr1.dwUsage = RESOURCEUSAGE_CONTAINER
    nr1.lpRemoteName = 0
    cbBuff1 = 100000
    cCount1 = &HFFFFFFFF
    res1 = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, nr, hEnum1)
    If res1 = 0 Then
        lpBuff1 = GlobalAlloc(GPTR, cbBuff1)
        res1 = WNetEnumResource(hEnum1, cCount1, lpBuff1, cbBuff1)
        If res1 = 0 Then
            p1 = lpBuff1
            For i1 = 1 To cCount1
                CopyMemory nr1, ByVal p1, LenB(nr1)
                p1 = p1 + LenB(nr1)
                If intCount = 2 Then
                    frmMain.lstWorkstations.AddItem PointerToString(nr1.lpRemoteName)
                    LocateFiles PointerToString(nr1.lpRemoteName)
                End If
                If (intCount = 0 And PointerToString(nr1.lpRemoteName) = "Microsoft Windows Network") _
                    Or (intCount = 1 And PointerToString(nr1.lpRemoteName) = strDomainName) Then
                    EnumContainer nr1, intCount + 1
                End If
                If blnStop Then Exit For
            Next i1
        End If
        If lpBuff1 <> 0 Then GlobalFree (lpBuff1)
        WNetCloseEnum (hEnum1) 'Close the enumeration
    End If
End Sub

Public Function PointerToString(p As Long) As String
    'The values returned in the NETRESOURCE structures are pointers to
    'ANSI strings so they need to be converted to Visual Basic Strings
    Dim s As String
    s = String(255, Chr$(0))
    CopyPointer2String s, p
    PointerToString = Left(s, InStr(s, Chr$(0)) - 1)
End Function

Public Sub LocateFiles(strMachineName As String)
    Dim fsoRemote As New FileSystemObject
    Dim fsfRootFolder As Folder
    'Dim ffcFolders As Folders
    Dim fsfSubFolder As Folder
    Dim drvRemote As Drive
    Dim filRemote As File
    frmMain.Text1.Text = strMachineName
    frmMain.Refresh
    For intCount = 3 To 8
        frmMain.Text2.Text = Chr(64 + intCount) & "$"
        frmMain.Refresh
        If fsoRemote.FolderExists(strMachineName & "\" & Chr(64 + intCount) & "$") Then
            Set fsfRootFolder = fsoRemote.GetFolder(strMachineName & "\" & Chr(64 + intCount) & "$")
            For Each fsfSubFolder In fsfRootFolder.SubFolders
                For Each filRemote In fsfSubFolder.Files
                    frmMain.Text3.Text = filRemote.Path
                    frmMain.Text4.Text = filRemote.Name
                    'frmMain.Refresh
                    DoEvents
                    If InStr(UCase(strExtension), UCase(Right(filRemote.Name, 3))) > 0 Then
                        frmMain.lstWorkstations.AddItem Space(5) & filRemote.Path
                        frmMain.lstWorkstations.Refresh
                    End If
                    If blnStop Then Exit For
                Next
                If blnStop Then Exit For
            Next
        Else
            Exit For
        End If
        If blnStop Then Exit For
    Next
End Sub

And run it. It may not be perfect but it seems to work.

Thanks mcrider for reminding me. Sometimes though the solutions are too complicated to post in this way, if only there was a library or something to post sample projects to!
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mcriderCommented:
TimCottee

You can always open your .FRM files with notepad and paste them...  It's all ASCII in VB4/32-bit, VB5, and VB6.

See http://www.experts-exchange.com/jsp/qShow.jsp?ta=visualbasic&qid=10244400 
for an example...

Cheers!
0
TimCotteeHead of Software ServicesCommented:
True, but I never remember this when it comes to it!
0
TimCotteeHead of Software ServicesCommented:
I noticed that I forgot something quite important here, the code as posted only checks the top level folders from the root, rather than going down all the levels. The following version should iterate through all the subfolders as well.

Public Const strDomainName = "MYDOMAIN" ' Change This to your domain name
Public Const strExtension = "mdb|ldb|mde" ' include extensions of files to find on any member

Public blnStop As Boolean

Public 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
Public Declare Function GlobalAlloc Lib "Kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "Kernel32" (ByVal hMem As Long) As Long
Public Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function CopyPointer2String Lib "Kernel32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long

Public 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
Public Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, ByVal lpBuffer As Long, lpBufferSize As Long) As Long
Public Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long

' RESOURCE ENUMERATION
Public Const RESOURCE_CONNECTED = &H1
Public Const RESOURCE_GLOBALNET = &H2
Public Const RESOURCE_REMEMBERED = &H3
Public Const RESOURCE_CONTEXT = &H4

Public Const RESOURCETYPE_ANY = &H0
Public Const RESOURCETYPE_DISK = &H1
Public Const RESOURCETYPE_PRINT = &H2
Public Const RESOURCETYPE_UNKNOWN = &HFFFF

Public Const RESOURCEUSAGE_CONNECTABLE = &H1
Public Const RESOURCEUSAGE_CONTAINER = &H2
Public Const RESOURCEUSAGE_RESERVED = &H80000000
Public Const RESOURCEDISPLAYTYPE_GENERIC = &H0
Public Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
Public Const RESOURCEDISPLAYTYPE_SERVER = &H2
Public Const RESOURCEDISPLAYTYPE_SHARE = &H3
Public Const RESOURCEDISPLAYTYPE_FILE = &H4
Public Const RESOURCEDISPLAYTYPE_GROUP = &H5
Public Const RESOURCEDISPLAYTYPE_SHAREADMIN = &H6

Public Sub EnumContainer(nr As NETRESOURCE, intCount As Integer)
    Dim hEnum1 As Long, lpBuff1 As Long, nr1 As NETRESOURCE
    Dim cbBuff1 As Long, cCount1 As Long
    Dim p1 As Long, res1 As Long, i1 As Long
    Dim txtLevel As String, intLevel As Integer, txtIPAddress As String
    DoEvents
    nr1.dwUsage = RESOURCEUSAGE_CONTAINER
    nr1.lpRemoteName = 0
    cbBuff1 = 100000
    cCount1 = &HFFFFFFFF
    res1 = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, nr, hEnum1)
    If res1 = 0 Then
        lpBuff1 = GlobalAlloc(GPTR, cbBuff1)
        res1 = WNetEnumResource(hEnum1, cCount1, lpBuff1, cbBuff1)
        If res1 = 0 Then
            p1 = lpBuff1
            For i1 = 1 To cCount1
                CopyMemory nr1, ByVal p1, LenB(nr1)
                p1 = p1 + LenB(nr1)
                If intCount = 2 Then
                    frmMain.lstWorkstations.AddItem PointerToString(nr1.lpRemoteName)
                    LocateFiles PointerToString(nr1.lpRemoteName)
                End If
                If (intCount = 0 And PointerToString(nr1.lpRemoteName) = "Microsoft Windows Network") _
                    Or (intCount = 1 And PointerToString(nr1.lpRemoteName) = strDomainName) Then
                    EnumContainer nr1, intCount + 1
                End If
                If blnStop Then Exit For
            Next i1
        End If
        If lpBuff1 <> 0 Then GlobalFree (lpBuff1)
        WNetCloseEnum (hEnum1) 'Close the enumeration
    End If
End Sub

Public Function PointerToString(p As Long) As String
    'The values returned in the NETRESOURCE structures are pointers to
    'ANSI strings so they need to be converted to Visual Basic Strings
    Dim s As String
    s = String(255, Chr$(0))
    CopyPointer2String s, p
    PointerToString = Left(s, InStr(s, Chr$(0)) - 1)
End Function

Public Sub LocateFiles(strMachineName As String)
    Dim fsoRemote As New FileSystemObject
    Dim fsfRootFolder As Folder
    'Dim ffcFolders As Folders
    Dim fsfSubFolder As Folder
    Dim drvRemote As Drive
    Dim filRemote As File
    frmMain.Text1.Text = strMachineName
    frmMain.Refresh
    For intCount = 3 To 8
        frmMain.Text2.Text = Chr(64 + intCount) & "$"
        frmMain.Refresh
        If fsoRemote.FolderExists(strMachineName & "\" & Chr(64 + intCount) & "$") Then
            Set fsfRootFolder = fsoRemote.GetFolder(strMachineName & "\" & Chr(64 + intCount) & "$")
            IterateFolders fsfRootFolder
        Else
            Exit For
        End If
        If blnStop Then Exit For
    Next
End Sub

Public Sub IterateFolders(fsfFolder As Folder)
    Dim fsfSubFolder As Folder
    Dim drvRemote As Drive
    Dim filRemote As File
    For Each fsfSubFolder In fsfFolder.SubFolders
        IterateFolders fsfSubFolder
        For Each filRemote In fsfSubFolder.Files
            frmMain.Text3.Text = filRemote.Path
            frmMain.Text4.Text = filRemote.Name
            'frmMain.Refresh
            DoEvents
            If InStr(UCase(strExtension), UCase(Right(filRemote.Name, 3))) > 0 Then
                frmMain.lstWorkstations.AddItem Space(5) & filRemote.Path
                frmMain.lstWorkstations.Refresh
            End If
            If blnStop Then Exit For
        Next
        If blnStop Then Exit For
    Next
End Sub

0
TimCotteeHead of Software ServicesCommented:
At the risk of overburdening everyone with code pastes, here is a "Final" version, at least I don't intend to do much more on this. It includes pastes of the project file, form and module. This allows the domain and search pattern to be entered prior to the search and statistics on time taken, files scanned per second etc are displayed. I accept that this is probably not a perfect application but feel free to amend it to your own purposes.

**********************************************
Project File
**********************************************

Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\WINNT\SYSTEM32\stdole2.tlb#OLE Automation
Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#..\..\WINNT\System32\SCRRUN.DLL#Microsoft Scripting Runtime
Form=frmMain.frm
Module=basGlobalSearch; basGlobalSearch.bas
Startup="frmMain"
Command32=""
Name="GlobalFindFiles"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Ocular Sciences UK Limited"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

**********************************************
frmMain
**********************************************

VERSION 5.00
Begin VB.Form frmMain
   Caption         =   "Domain Member Search"
   ClientHeight    =   7200
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10725
   LinkTopic       =   "Form1"
   ScaleHeight     =   7200
   ScaleWidth      =   10725
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox Text10
      Height          =   285
      Left            =   5760
      TabIndex        =   22
      Top             =   720
      Width           =   3375
   End
   Begin VB.TextBox Text9
      Height          =   285
      Left            =   2040
      TabIndex        =   20
      Top             =   720
      Width           =   1815
   End
   Begin VB.TextBox Text8
      Height          =   285
      Left            =   5160
      Locked          =   -1  'True
      TabIndex        =   18
      Top             =   360
      Width           =   1935
   End
   Begin VB.TextBox Text7
      Height          =   285
      Left            =   3360
      Locked          =   -1  'True
      TabIndex        =   17
      Top             =   360
      Width           =   1455
   End
   Begin VB.TextBox Text6
      Height          =   285
      Left            =   3360
      Locked          =   -1  'True
      TabIndex        =   16
      Top             =   0
      Width           =   1455
   End
   Begin VB.Timer Timer1
      Left            =   7800
      Top             =   3000
   End
   Begin VB.TextBox Text5
      Height          =   285
      Left            =   7680
      Locked          =   -1  'True
      TabIndex        =   7
      Top             =   360
      Width           =   1455
   End
   Begin VB.CommandButton cmdStop
      Caption         =   "S&top"
      Height          =   615
      Left            =   9240
      TabIndex        =   6
      Top             =   0
      Width           =   1455
   End
   Begin VB.TextBox Text4
      Height          =   285
      Left            =   4920
      Locked          =   -1  'True
      TabIndex        =   5
      Top             =   6240
      Width           =   5775
   End
   Begin VB.TextBox Text3
      Height          =   285
      Left            =   0
      Locked          =   -1  'True
      TabIndex        =   4
      Top             =   6840
      Width           =   10695
   End
   Begin VB.TextBox Text2
      Height          =   285
      Left            =   2400
      Locked          =   -1  'True
      TabIndex        =   3
      Top             =   6240
      Width           =   2415
   End
   Begin VB.TextBox Text1
      Height          =   285
      Left            =   0
      Locked          =   -1  'True
      TabIndex        =   2
      Top             =   6240
      Width           =   2295
   End
   Begin VB.CommandButton cmdSearch
      Caption         =   "&Search"
      Height          =   615
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   1455
   End
   Begin VB.ListBox lstWorkstations
      Height          =   4740
      Left            =   0
      TabIndex        =   0
      Top             =   1080
      Width           =   10695
   End
   Begin VB.Label Label10
      Caption         =   "Extension(s) To Match"
      Height          =   255
      Left            =   3960
      TabIndex        =   21
      Top             =   720
      Width           =   1695
   End
   Begin VB.Label Label9
      Caption         =   "Domain To Search"
      Height          =   255
      Left            =   0
      TabIndex        =   19
      Top             =   720
      Width           =   1935
   End
   Begin VB.Label Label8
      Caption         =   "Total Time Taken"
      Height          =   255
      Left            =   5280
      TabIndex        =   15
      Top             =   0
      Width           =   1695
   End
   Begin VB.Label Label7
      Caption         =   "Total Files Found"
      Height          =   255
      Left            =   1560
      TabIndex        =   14
      Top             =   360
      Width           =   1815
   End
   Begin VB.Label Label6
      Caption         =   "Workstations Found"
      Height          =   255
      Left            =   1560
      TabIndex        =   13
      Top             =   0
      Width           =   1695
   End
   Begin VB.Label Label5
      Caption         =   "Files Scanned / Sec"
      Height          =   255
      Left            =   7680
      TabIndex        =   12
      Top             =   0
      Width           =   1455
   End
   Begin VB.Label Label4
      Caption         =   "Full UNC Path Name To File"
      Height          =   255
      Left            =   0
      TabIndex        =   11
      Top             =   6600
      Width           =   2295
   End
   Begin VB.Label Label3
      Caption         =   "File Name"
      Height          =   255
      Left            =   4920
      TabIndex        =   10
      Top             =   6000
      Width           =   2295
   End
   Begin VB.Label Label2
      Caption         =   "Administrative Share"
      Height          =   255
      Left            =   2400
      TabIndex        =   9
      Top             =   6000
      Width           =   2295
   End
   Begin VB.Label Label1
      Caption         =   "Machine Name"
      Height          =   255
      Left            =   0
      TabIndex        =   8
      Top             =   6000
      Width           =   2295
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public lngFiles As Long
Public lngFound As Long
Public lngSeconds As Long
Public dttStart As Date

Private Sub cmdSearch_Click()
    basGlobalSearch.strDomainName = Text9.Text
    basGlobalSearch.strExtension = Text10.Text
    basGlobalSearch.blnStop = False
    lstWorkstations.Clear
    dttStart = Now()
    lngFiles = 0
    lngFound = 0
    lngSeconds = 0
    Timer1.Interval = 1000
    Dim nr As NETRESOURCE
    EnumContainer nr, 0
End Sub

Private Sub cmdStop_Click()
    basGlobalSearch.blnStop = True
    Timer1.Interval = 0
End Sub

Private Sub lstWorkstations_Click()
'    Timer1.Interval = 1000
'    lngSeconds = 0
'    lngFiles = 0
'    basGlobalSearch.blnStop = False
'    LocateFiles lstWorkstations.Text, lstWorkstations.ListIndex + 1
End Sub

Private Sub Timer1_Timer()
    lngSeconds = lngSeconds + 1
    Text5.Text = CStr(Round(lngFiles / lngSeconds, 2))
    Text8.Text = Format(Now() - dttStart, "Hh:Mm:Ss")
End Sub

**********************************************
basGlobalSearch Module
**********************************************

Attribute VB_Name = "basGlobalSearch"
Option Explicit
Public strDomainName As String
Public strExtension As String

Public blnStop As Boolean

Public 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

Public Declare Function GlobalAlloc Lib "Kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "Kernel32" (ByVal hMem As Long) As Long
Public Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function CopyPointer2String Lib "Kernel32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long

Public 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
Public Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, ByVal lpBuffer As Long, lpBufferSize As Long) As Long
Public Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long

' RESOURCE ENUMERATION
Public Const RESOURCE_CONNECTED = &H1
Public Const RESOURCE_GLOBALNET = &H2
Public Const RESOURCE_REMEMBERED = &H3
Public Const RESOURCE_CONTEXT = &H4

Public Const RESOURCETYPE_ANY = &H0
Public Const RESOURCETYPE_DISK = &H1
Public Const RESOURCETYPE_PRINT = &H2
Public Const RESOURCETYPE_UNKNOWN = &HFFFF

Public Const RESOURCEUSAGE_CONNECTABLE = &H1
Public Const RESOURCEUSAGE_CONTAINER = &H2
Public Const RESOURCEUSAGE_RESERVED = &H80000000
Public Const RESOURCEDISPLAYTYPE_GENERIC = &H0
Public Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
Public Const RESOURCEDISPLAYTYPE_SERVER = &H2
Public Const RESOURCEDISPLAYTYPE_SHARE = &H3
Public Const RESOURCEDISPLAYTYPE_FILE = &H4
Public Const RESOURCEDISPLAYTYPE_GROUP = &H5
Public Const RESOURCEDISPLAYTYPE_SHAREADMIN = &H6

Public Sub EnumContainer(nr As NETRESOURCE, intCount As Integer)
    basGlobalSearch.blnStop = False
    Dim hEnum1 As Long, lpBuff1 As Long, nr1 As NETRESOURCE
    Dim cbBuff1 As Long, cCount1 As Long
    Dim p1 As Long, res1 As Long, i1 As Long
    Dim txtLevel As String, intLevel As Integer, txtIPAddress As String
    Dim GPTR As Long
    Dim intWorkstations As Integer
    DoEvents
    nr1.dwUsage = RESOURCEUSAGE_CONTAINER
    nr1.lpRemoteName = 0
    cbBuff1 = 100000
    cCount1 = &HFFFFFFFF
    res1 = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, nr, hEnum1)
    If res1 = 0 Then
        lpBuff1 = GlobalAlloc(GPTR, cbBuff1)
        res1 = WNetEnumResource(hEnum1, cCount1, lpBuff1, cbBuff1)
        If res1 = 0 Then
            p1 = lpBuff1
            For i1 = 1 To cCount1
                CopyMemory nr1, ByVal p1, LenB(nr1)
                p1 = p1 + LenB(nr1)
                If intCount = 2 Then
                    frmMain.lstWorkstations.AddItem PointerToString(nr1.lpRemoteName)
                    intWorkstations = intWorkstations + 1
                    frmMain.Text6.Text = intWorkstations
                    LocateFiles PointerToString(nr1.lpRemoteName)
                End If
                If (intCount = 0 And PointerToString(nr1.lpRemoteName) = "Microsoft Windows Network") _
                    Or (intCount = 1 And PointerToString(nr1.lpRemoteName) = strDomainName) Then
                    EnumContainer nr1, intCount + 1
                End If
                If basGlobalSearch.blnStop Then Exit For
            Next i1
        End If
        If lpBuff1 <> 0 Then GlobalFree (lpBuff1)
        WNetCloseEnum (hEnum1) 'Close the enumeration
    End If
End Sub

Public Function PointerToString(p As Long) As String
    'The values returned in the NETRESOURCE structures are pointers to
    'ANSI strings so they need to be converted to Visual Basic Strings
    Dim s As String
    s = String(255, Chr$(0))
    CopyPointer2String s, p
    PointerToString = Left(s, InStr(s, Chr$(0)) - 1)
End Function

Public Sub LocateFiles(strMachineName As String)
    Dim fsoRemote As New FileSystemObject
    Dim fsfRootFolder As Folder
    'Dim ffcFolders As Folders
    Dim fsfSubFolder As Folder
    Dim drvRemote As Drive
    Dim filRemote As File
    Dim intCount As Integer
    frmMain.Text1.Text = strMachineName
    frmMain.Refresh
    For intCount = 3 To 8
        frmMain.Text2.Text = Chr(64 + intCount) & "$"
        frmMain.Refresh
        If fsoRemote.FolderExists(strMachineName & "\" & Chr(64 + intCount) & "$") Then
            Set fsfRootFolder = fsoRemote.GetFolder(strMachineName & "\" & Chr(64 + intCount) & "$")
            IterateFolders fsfRootFolder
        Else
            Exit For
        End If
        If basGlobalSearch.blnStop Then Exit For
    Next
End Sub

Public Sub IterateFolders(fsfFolder As Folder)
    Dim fsfSubFolder As Folder
    Dim drvRemote As Drive
    Dim filRemote As File
    For Each fsfSubFolder In fsfFolder.SubFolders
        IterateFolders fsfSubFolder
        For Each filRemote In fsfSubFolder.Files
            frmMain.Text3.Text = filRemote.Path
            frmMain.Text4.Text = filRemote.Name
            'frmMain.Refresh
            DoEvents
            frmMain.lngFiles = frmMain.lngFiles + 1
            frmMain.Text7.Text = CStr(frmMain.lngFound) & " / " & CStr(frmMain.lngFiles)
            If InStr(UCase(strExtension), UCase(Right(filRemote.Name, 3))) > 0 Then
                frmMain.lngFound = frmMain.lngFound + 1
                frmMain.lstWorkstations.AddItem Space(5) & filRemote.Path
                frmMain.lstWorkstations.Refresh
            End If
            If basGlobalSearch.blnStop Then Exit For
        Next
        If basGlobalSearch.blnStop Then Exit For
    Next
End Sub
0
homey_the_clownAuthor Commented:
Excellent. thank you.
0
gnetgnetCommented:
I have had no luck trying to compile this code.  It seems to be incomplete.
Can someone please let me know where I can find this code?
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.