Rubrik: HTML/Internet/Netzwerk · Netzwerk | VB-Versionen: VB6 | 28.09.09 |
Einfache Funktion zum Auffinden von Server (Domain) Diese Funktion sucht den Server (Domain) über das Vorhandensein des Vergleichswertes (sFolder) | ||
Autor: Norbert Grimm | Bewertung: | Views: 8.898 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Diese Funktion sucht den Server (Domain) über das Vorhandensein des Vergleichswertes (sFolder)
' Die Function (fsoMyServer_Ex) sucht den Server(Domain) über das Vorhandensein ' des Vergleichswertes (sFolder) ' ' Parameter ' sFolder <Byval> : [optional] Verzeichnis ' sServer <ByRef> : [Rückgabe] '\\MyServer' (String) ' : ' : > 0 , Server gefunden, Übereinstimmung ' : = 0 , ungültig ' Function fsoMyServer_Ex(Optional ByRef sServer As String, _ Optional ByVal sFolder As String) As Integer Dim B As Boolean Dim iTyp As Integer Dim nErr As Long Dim errMsg As String Dim sPath As String Dim sServ As String Dim fso As Object Dim D As Variant Const cFSO As String = "Scripting.FileSystemObject" On Error GoTo Err_fso Set fso = CreateObject(cFSO) ' Vergleichswert If sFolder = "" Then sFolder = "\Firma\Daten" ' default Verzeichnis Else sFolder = UCase(sFolder) End If With fso ' durchlaufe Auflistung Laufwerke For Each D In .Drives iTyp = D.DriveType ' nur Server ' 0= UnKnownType ' 1= Removable ' 2= Festplatte [Fixed] If iTyp = 3 Then ' 3= Server [Remote] (Domain) ' 4= CDRom, 5= Ram sServ = D.ShareName sServ = UCase(sServ) sPath = sServ & sFolder If .FolderExists(sPath) Then ' vergleiche enthält 'sFold' If InStr(1, sPath, sFolder) Then sServer = sServ B = True Exit For End If End If End If Next D End With fsoMyServer_Ex = B Exit_fso: Set fso = Nothing Exit Function Err_fso: With Err nErr = .Number errMsg = .Description .Clear End With MsgBox nErr & vbCr & errMsg, vbCritical, "fsoMyServer_Ex" Resume Exit_fso End Function