'VBA-Code von Access97 SR1 deutsch
'auf NT4 SP5 deutsch

Private Const ShareInfo502                        As Long = 502         'Kennung f�r SHARE_INFO_502-Struktur
Private Const STYPE_DISKTREE                      As Long = &H0         'disk share
Private Const SHI_USES_UNLIMITED                  As Long = -1

Private Type SHARE_INFO_502           'Information zu einer Freigabe (Share)
  shi502_netname As Long              'Zeiger zum Namen der Freigabe
  shi502_type As Long                 'Art der Freigabe
  shi502_remark As Long               'Bemerkung zur Freigabe
  shi502_permissions As Long          'Berechtigungen f�r Share-Level-Security
  shi502_max_uses As Long             'max. Anzahl der Verbindungen
  shi502_current_uses As Long         'Anzahl der akt. Verbindungen
  shi502_path As Long                 'Zeiger zum Pfad
  shi502_passwd As Long               'Zeiger zum Pa�wort
  shi502_reserved As Long             'reserviert; immer 0
  shi502_security_descriptor As Long  'Zeiger auf Struktur Sicherheitsinformationen
End Type

Private Type ACL                  'Header der Access Control List (beinhaltet evtl. mehrere ACE's)
   AclRevision As Byte            'ACL Revisionsstand
   Sbz1 As Byte                   'alingment (F�llbyte)
   AclSize As Integer             'Gr��e von ACL mit allen ACE's in Bytes
   AceCount As Integer            'Anzahl der ACE's in der ACL
   Sbz2 As Integer                'alingment (zwei F�llbytes)
End Type

Private Type SECURITY_DESCRIPTOR  'Sicherheitsinformationen
   Revision As Byte               'Revisionsstand
   Sbz1 As Byte                   'alingment (F�llbyte)
   Control As Long
   Owner As Long                  'SID
   Group As Long                  'SID
   sACL As ACL                    'System ACL
   Dacl As ACL                    'discretionary ACL
End Type

'Der Security Descriptor wurde zuvor erfolgreich angelegt 
'mit folgenden Zeilen (Code unvollst�ndig)   
'sUserName = "mustema" & Chr(0)                            'Username
'sAdminName = "Administratoren" & Chr(0)                   'Name des Administrators
'UserRechte = GENERIC_READ Or GENERIC_WRITE Or _
'    GENERIC_EXECUTE Or DELETE                             'Recht: Lesen, Schreiben, Ausf�hren und L�schen
'AdminRechte = GENERIC_ALL                               'Fileberechtigungen f�r den Admin
'sDomainName = Space(255)
'Ergebnis = LookupAccountName(strPrimaryDC, sUserName, _
'      bUserSid(0), 255, sDomainName, lDomainNameLength, _
'      lSIDType)
'sDomainName = Space(lDomainNameLength)
'Ergebnis = LookupAccountName(strPrimaryDC, sUserName, _
'      bUserSid(0), 255, sDomainName, lDomainNameLength, _
'      lSIDType)
'sDomainName = Space(255)
'Ergebnis = LookupAccountName(vbNullString, sAdminName, _
'       bAdminSid(0), 255, sDomainName, lDomainNameLength, _
'       lSIDType)
'sDomainName = Space(lDomainNameLength)                             'Buffer zur�cksetzen
'Ergebnis = LookupAccountName(vbNullString, sAdminName, _
'       bAdminSid(0), 255, sDomainName, lDomainNameLength, _
'       lSIDType)                                                   'Nun erhalten wir die richtige SID
'lNewACLSize = Len(sACL) + _
'    Len(sCurrentACE) + GetLengthSid(bUserSid(0)) - Len(sCurrentACE.SidStart) + _
'    Len(sCurrentACE) + GetLengthSid(bAdminSid(0)) - Len(sCurrentACE.SidStart)
'ReDim bNewACL(lNewACLSize)
'Ergebnis = InitializeAcl(bNewACL(0), lNewACLSize, ACL_REVISION2)
'Ergebnis = AddAccessAllowedAce(bNewACL(0), ACL_REVISION2, UserRechte, bUserSid(0))
'Ergebnis = AddAccessAllowedAce(bNewACL(0), ACL_REVISION2, AdminRechte, bAdminSid(0))
'Ergebnis = InitializeSecurityDescriptor(sNewSD, SECURITY_DESCRIPTOR_REVISION)
'Ergebnis = SetSecurityDescriptorDacl(sNewSD, 1, bNewACL(0), 0)

Sub MakeShare 
  Dim MyShi5 As SHARE_INFO_502
  Dim sNewSD As SECURITY_DESCRIPTOR                       'New security descriptor.
  Dim strShareName As String
  Dim strShareREM As String
  Dim strSharePfad As String
  Dim strServer As String                                 

' Angaben f�r den Filer
  strShareName = "mustema$" & Chr(0)                  	  'Name des Shares
  strShareREM = Format(Now, "dd.mm.yyyy") & Chr(0)        'Bemerkung zum Share: Erstelldatum
  strSharePfad = "C:\vol\nt01\users\mustema" 		  'SharePfad
  strServer = "\\Cobfile01" & Chr(0)          		  'Server auf dem das Share angelegt wird

' Mit diesen Angaben hat's noch funktioniert. Da handelt es sich noch um einen 
' echten NT-Server 
'  strShareName = "mustete$" & Chr(0)                  	  'Name des Shares
'  strShareREM = Format(Now, "dd.mm.yyyy") & Chr(0)       'Bemerkung zum Share: Erstelldatum
'  strSharePfad = "F:\Users\mustete" 		  	  'SharePfad
'  strServer = "\\Cobserv15" & Chr(0)          		  'Server auf dem das Share angelegt wird

  MyShi5.shi502_netname = StrPtr(strShareName)    'Zeiger auf ShareName
  MyShi5.shi502_type = STYPE_DISKTREE             'Share auf eine Datei/ein Verzeichnis
  MyShi5.shi502_remark = StrPtr(strShareREM)      'Zeiger auf Share-Bemerkung
  MyShi5.shi502_permissions = 0                   'keine Rechte f�r Share-Level-Security
  MyShi5.shi502_max_uses = SHI_USES_UNLIMITED     'unbegrenzte anzahl von User-Zugriffen
  MyShi5.shi502_current_uses = 0                  'akt. Anzahl der Zugriffe auf Share
  MyShi5.shi502_path = StrPtr(strSharePfad)       'Zeiger auf SharePfad
  MyShi5.shi502_passwd = 0                        'kein Share-Pa�wort
  MyShi5.shi502_reserved = 0                      'reserviert
  MyShi5.shi502_security_descriptor = _
    VarPtr(sNewSD)                                'Zeiger auf SecuritryDescriptor-Struktur
  
' seit wir auf den Filer umgezogen sind gibt diese Funktion die Fehlernummer 2116 zur�ck!
' die Funktion GetErrorString gibt zu dieser Fehlernummer keinen Text zur�ck!
  Ergebnis = NetShareAdd(StrPtr(strServer), _
    ShareInfo502, VarPtr(MyShi5), 0)              'erstelle Share
  If Ergebnis <> 0 Then                           'Fehler?
    StatusTF = StatusTF & vbCrLf & _
      "Das Share konnte nicht hinzugef�gt werden!"
    StatusTF = StatusTF & vbCrLf & GetErrorString(Ergebnis) 'Fehlermeldung ausgeben
    GoTo MyExitHandler
  Else
    StatusTF = StatusTF & vbCrLf & "Das Share wurde hinzugef�gt."
  End If
End Sub

Private Function GetErrorString(ByVal LastErrorValue As Long) As String
   Dim Bytes&
   Dim s As String
   s = String$(1290, 0)
   Bytes = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, LastErrorValue, 0, s$, 1280, 0)
   If Bytes > 0 Then
      GetErrorString = Left$(s, Bytes)
   End If
End Function