Private Sub Command1_Click()

 

Set oSFTPServer = CreateObject("SFTPCOMInterface.CIServer") 'instantiate EFT/GSFTPS COM Object

 

'=====================================================================

'                   Initialize connection parameters

'=====================================================================

 

Dim sAdminID, sAdminPassword, sAdminServer, oSites, oSite

 

sAdminID = "admin"

sAdminPassword = "test"

sAdminPort = "1100" '1100 for EFT or 1000 for Secure FTP Server by default

sAdminServer = "localhost" 'enter the IP address for the admin connection to the server

 

'=====================================================================

'                   Initialize the user parameters

'=====================================================================

Dim sUsrID, sUsrPasswd, sUsrDesc

 

sUsrID = "roslin"

sUsrPasswd = "test"

sUsrDesc = "Trading Partner Account"

sGroup = "Trading"

 

'=====================================================================

'                   Connect to the server

'=====================================================================

 

On Error Resume Next

oSFTPServer.Connect sAdminServer, sAdminPort, sAdminID, sAdminPassword

If Err.Number <> 0 Then

    Set oSFTPServer = Nothing

    MsgBox "Could not connect to the server with the specified parameters.", vbCritical, vbOKOnly, "Error Connecting to Server"

    Exit Sub

End If

        

        

'=====================================================================

'Obtain a handle to all sites and then to the first site in this example

'=====================================================================

       

Set oSites = oSFTPServer.Sites

Set oSite = oSites.Item(0)

 

'=====================================================================

'                   Conditionally create the user

'=====================================================================

Dim arUsers() As Variant

Dim bUserExist As Boolean

 

arUsers = oSite.GetUsers()

j = 0

For j = LBound(arUsers) To UBound(arUsers)

    If arUsers(j) = sUsrID Then

        bUserExist = True

    End If

Next

 

If bUserExist = False Then

Call oSite.CreateuserEx(sUsrID, sUsrPasswd, 0, sUsrDesc, sUsrID, True, False)

End If

 

'=====================================================================

'    Create some virtual folders and point those to physical ones

'=====================================================================

 

'note: The physical folders must exist on the drive!

Call oSite.CreateVirtualFolder("/Usr/" & sUsrID & "/INBD", "D://EDITPS//EDITPS//TradingPartners//" & sUsrID & "//INBD//")

Call oSite.CreateVirtualFolder("/Usr/" & sUsrID & "/OUTBD", "D://EDITPS//EDITPS//TradingPartners//" & sUsrID & "//OUTBD//")

Call oSite.CreateVirtualFolder("/Usr/" & sUsrID & "/LOG", "D://EDITPS//EDITPS//TradingPartners//" & sUsrID & "//LOG//")

 

 

'=====================================================================

'           Add this user to a group

'=====================================================================

 

'first see if group exists

Dim arGroup() As Variant

Dim bGroupExist As Boolean

 

arGroup = oSite.GetPermissionGroups()

j = 0

bGroupExist = False

For j = LBound(arGroup) To UBound(arGroup)

    If arGroup(j) = sGroup Then

        bGroupExist = True

    End If

Next

 

'now check to see if that user exists in the group

Dim arPermGroupOfUser() As Variant

Dim bExistsInGroup As Boolean

arPermGroupOfUser = oSite.GetPermissionGroupsOfUser(sUsrID)

h = 0

bExistsInGroup = False

For h = LBound(arPermGroupOfUser) To UBound(arPermGroupOfUser)

    If arPermGroupOfUser(h) = sGroup Then

        bExistsInGroup = True

    End If

Next

 

'create the group if it doesn't exist

If bGroupExist = False Then

    Call oSite.CreatePermissionGroup(sGroup)

End If

 

'add the user to the group if it doesn't exist

If bExistsInGroup = False Then

    Call oSite.AddUserToPermissionGroup(sUsrID, sGroup)

End If

 

'=====================================================================

'             Disable non-secure FTP Access for this user

'=====================================================================

Dim oUsrSettings As Variant

oUsrSettings = oSite.GetUserSettings(sUsrID)

oUsrSettings.SetClearFTP (0)

oUsrSettings.SetSSL (1)

 

'==================================================================

'           Assign folder permissions for this user

'==================================================================

 

Dim aIN, aOUT, aLo, sUsrDir

 

sUsrDir = "\Usr\" & sUsrID & "\INBD\"

Set aIN = oSite.GetBlankPermission(sUsrDir, sUsrID)

aIN.DirShowInList = True

aIN.DirList = True

aIN.FileUpload = True

Call oSite.SetPermission(aIN)

 

sUsrDir = "\Usr\" & sUsrID & "\OUTBD\"

Set aOUT = oSite.GetBlankPermission(sUsrDir, sUsrID)

aOUT.DirShowInList = True

aOUT.DirList = True

aOUT.FileDelete = True

aOUT.FileDownload = True

Call oSite.SetPermission(aOUT)

 

sUsrDir = "\Usr\" & sUsrID & "\LOG\"

Set aLo = oSite.GetBlankPermission(sUsrDir, sUsrID)

aLo.DirShowInList = True

aLo.DirList = True

aLo.FileDownload = True

Call oSite.SetPermission(aLo)

       

 

'==================================================================

'          Apply changes and close connection to the server

'==================================================================

 

Call oSFTPServer.ApplyChanges

Call oSFTPServer.Close

End Sub