Laufwerk/Ordner im Netzwerk freigeben Dieses Beispiel zeigt, wie sich ein Laufwerk oder ein Ordner für den Netzwerk-Zugriff freigeben lässt.
Autor:   Thomas Grey	Bewertung:	Views:  23.910
die-software-schmiede.de	System:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10	Beispielprojekt auf CD

Das nachfolgende Beispiel zeigt, wie sich ein Laufwerk oder ein Ordner für den gemeinsamen Zugriff in einem Netzwerk freigeben lässt.

Kopieren Sie hierzun nachfolgenden Code in ein Modul:

' Im Modul
Public Const NERR_SUCCESS As Long = 0&
 
' Freigabe Typen
Private Const STYPE_ALL       As Long = -1
Private Const STYPE_DISKTREE  As Long = 0
Private Const STYPE_PRINTQ    As Long = 1
Private Const STYPE_DEVICE    As Long = 2
Private Const STYPE_IPC       As Long = 3
Private Const STYPE_SPECIAL   As Long = &H80000000
 
' Rechte
Private Const ACCESS_READ     As Long = &H1
Private Const ACCESS_WRITE    As Long = &H2
Private Const ACCESS_CREATE   As Long = &H4
Private Const ACCESS_EXEC     As Long = &H8
Private Const ACCESS_DELETE   As Long = &H10
Private Const ACCESS_ATRIB    As Long = &H20
Private Const ACCESS_PERM     As Long = &H40
Private Const ACCESS_ALL      As Long = ACCESS_READ Or _
                                        ACCESS_WRITE Or _
                                        ACCESS_CREATE Or _
                                        ACCESS_EXEC Or _
                                        ACCESS_DELETE Or _
                                        ACCESS_ATRIB Or _
                                        ACCESS_PERM
 
Private Type SHARE_INFO_2
  shi2_netname       As Long
  shi2_type          As Long
  shi2_remark        As Long
  shi2_permissions   As Long
  shi2_max_uses      As Long
  shi2_current_uses  As Long
  shi2_path          As Long
  shi2_passwd        As Long
End Type
 
Private Declare Function NetShareAdd Lib "netapi32" ( _
  ByVal servername As Long, _
  ByVal level As Long, _
  buf As Any, _
  parmerr As Long) As Long

' ********************************************************
'  Prozedur :              ShareAdd
'  Erstell Datum :         25.10.02 14:17
'  Datum letzte Änderung : 25.10.02 14:17
'  Autor :                 Thomas Grey & Marcel Olstowski
'  Beschreibung :          Api Funktion um Freigaben eines
'                          Ordners zu realisieren
'                          Übergabe: Server, FreigabePfad,
'                          FreigabeName, Remark, FreigabePw
' 
' ********************************************************
Function ShareAdd(Server As String, _
  FreigabePfad As String, _
  FreigabeName As String, _
  Remark As String, _
  FreigabePW As String) As Long
 
  Dim dwServer   As Long
  Dim dwNetname  As Long
  Dim dwPath     As Long
  Dim dwRemark   As Long
  Dim dwPw       As Long
  Dim parmerr    As Long
  Dim si2        As SHARE_INFO_2
 
  ' Setze Pointer zu Server Freigabe Pfad und Name
  dwServer = StrPtr(Server)
  dwNetname = StrPtr(FreigabeName)
  dwPath = StrPtr(FreigabePfad)
 
  ' Wenn Remark und Passwort gesetzt sind,
  ' setze Pointer zur Auswahl
  If Len(Remark) > 0 Then
    dwRemark = StrPtr(Remark)
  End If
 
  If Len(FreigabePW) > 0 Then
    dwPw = StrPtr(FreigabePW)
  End If
 
  ' SHARE_INFO_2 Struktur erstellen
  With si2
    .shi2_netname = dwNetname
    .shi2_path = dwPath
    .shi2_remark = dwRemark
    .shi2_type = STYPE_DISKTREE
    .shi2_permissions = ACCESS_ALL
    .shi2_max_uses = -1
    .shi2_passwd = dwPw
  End With
 
  ' Freigabe hinzufügen
  ShareAdd = NetShareAdd(dwServer, 2, _
    si2, parmerr)
End Function

Hinweis:: Um die Funktion nutzen zu können benötigen Sie die entsprechenden Systemrechte!

Der Aufruf der Funktion erfolgt dann so:

' Servername (Rechnername)
Dim sServer As String
sServer = "\\SERVER"
 
' Ordner, der freigegeben werden soll
Dim sPath As String
Dim sPath = "C:\Test"
 
' Freigabe-Name
Dim sName As String
sName = "TEST$"
 
' Kommentar (optional)
Dim sRemark As String
sRemark = "Ihr Kommentar"
 
' Password (optional)
Dim sPassword As String
sPassword = "12345"
 
' Ordner freigeben
Dim nResult As Long
 
nResult = ShareAdd(sServer, sPath, sName, sRemark, sPassword)
If nResult <> NERR_SUCCESS Then
  MsgBox "Fehler beim Versuch den Ordner freizugeben!"
End If

Copyright ©2000-2023 [email protected] Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.