home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ftpser1a / profiles.bas < prev    next >
Encoding:
BASIC Source File  |  1999-08-24  |  4.7 KB  |  139 lines
  1. Attribute VB_Name = "Profiles"
  2. Option Explicit
  3.  
  4. Global Const MAX_N_USERS = 25        'maximum number of contemporary users
  5. Global Const N_RECOGNIZED_USERS = 3 'number of recognized users
  6. Global Const DEFAULT_DRIVE = "D:"   'default drive
  7.  
  8. Type Privtyp
  9.   Path As String
  10.   Accs As String '[R]ead,[W]rite,[D]elete,e[X]ecute > Files
  11.                  '[L]ist,[M]ake,[K]ill,[S]ubs       > Dirs
  12. End Type
  13. Global Privtyp As Privtyp
  14.  
  15. Type UserInfo
  16.   Name As String 'list of the users which can access to server file-system
  17.   Pass As String 'list of passwords of each user which can access to server file-system
  18.   Pcnt As Integer
  19.   Priv(20) As Privtyp
  20.   Home As String 'default directory of each user
  21. End Type
  22.  
  23. Type User_IDs
  24.   Count As Integer
  25.   No(0 To MAX_N_USERS) As UserInfo
  26. End Type
  27.  
  28. Global UserIDs As User_IDs
  29. 'the list of the access rights of each user,
  30. 'every element is a string formed by 2 characters:
  31. 'the 2nd char. is relative to write & delete right
  32. '(Y=Yes, N=No).
  33.  
  34. Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
  35.     (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, _
  36.     ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName _
  37.     As String) As Integer
  38.  
  39. Declare Function WritePrivateProfileString% Lib "kernel32" Alias "WritePrivateProfileStringA" _
  40.     (ByVal lpApplicationName$, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal _
  41.     lpFileName$)
  42. Global Version As Integer
  43. Global CurrentProfile As String
  44. '
  45. '   Loads program settings from disk.
  46. '
  47. Public Function LoadProfile(ByVal Filename As String) As Boolean
  48.   Dim tStr As String
  49.   Dim Ctr As Integer, x As Integer, Pcnt As Integer
  50.   Dim i As Integer, Number As Integer
  51.   '
  52.   '   Check for existence of INI file
  53.   '
  54.   On Error Resume Next
  55.   Ctr = FileLen(Filename)
  56.   If Err.Number > 0 Then
  57.     Err.Clear
  58.     LoadProfile = False
  59.     Exit Function
  60.   End If
  61.   On Error Resume Next
  62.   LoadProfile = True
  63.   If Ctr < 1 Then      ' ini file empty
  64.     Exit Function
  65.   End If
  66.   '
  67.   '   Load saved settings
  68.   '
  69.   Version = Val(GetFromIni("Settings", "Version", Filename))
  70.   If Len(Version) < 1 Then
  71.     LoadProfile = False
  72.     Exit Function
  73.   End If
  74.   '   Load Users
  75.   Number = Val(GetFromIni("Users", "Users", Filename))
  76.   UserIDs.Count = Number
  77.   If Number > 0 Then
  78.     For Ctr = 1 To Number
  79.       UserIDs.No(Ctr).Name = GetFromIni("Users", "Name" & Ctr, Filename)
  80.       UserIDs.No(Ctr).Pass = GetFromIni("Users", "Pass" & Ctr, Filename)
  81.       Pcnt = Val(GetFromIni("Users", "DirCnt" & Ctr, Filename))
  82.       UserIDs.No(Ctr).Pcnt = Pcnt
  83.       Debug.Print "User:" & Ctr & ", DirCnt=" & Pcnt
  84.       For x = 1 To Pcnt
  85.         tStr = GetFromIni("Users", "Access" & Ctr & "_" & x, Filename)
  86.         i = InStr(tStr, ",")
  87.         UserIDs.No(Ctr).Priv(x).Path = Left(tStr, i - 1)
  88.         UserIDs.No(Ctr).Priv(x).Accs = Right(tStr, (Len(tStr) - i))
  89.       Next
  90.       UserIDs.No(Ctr).Home = GetFromIni("Users", "Home" & Ctr, Filename)
  91.     Next
  92.   End If
  93.   CurrentProfile = Filename
  94. End Function
  95. '
  96. '   Saves program settings to disk.
  97. '
  98. Public Function SaveProfile(ByVal Filename As String, SaveSettings As Boolean) As Boolean
  99.   Dim Terminal As String, Alias As String
  100.   Dim Ctr As Integer, x As Integer
  101.   SaveProfile = False
  102.   If SaveSettings Then
  103.    ' SettingsChanged = False
  104.     If WritePrivateProfileString("Settings", "Version", _
  105.         App.Major & "." & App.Minor & "." & App.Revision, Filename) = 0 Then
  106.       SaveProfile = False
  107.       Exit Function
  108.     End If
  109.  
  110.     WritePrivateProfileString "Users", "Users", CStr(UserIDs.Count), Filename
  111.     For Ctr = 1 To UserIDs.Count
  112.       WritePrivateProfileString "Users", "Name" & Ctr, CStr(UserIDs.No(Ctr).Name), Filename
  113.       WritePrivateProfileString "Users", "Pass" & Ctr, UserIDs.No(Ctr).Pass, Filename
  114.       WritePrivateProfileString "Users", "DirCnt" & Ctr, CStr(UserIDs.No(Ctr).Pcnt), Filename
  115.       For x = 1 To UserIDs.No(Ctr).Pcnt
  116.         WritePrivateProfileString "Users", "Access" & Ctr & "_" & x, _
  117.           UserIDs.No(Ctr).Priv(x).Path & "," & UserIDs.No(Ctr).Priv(x).Accs, Filename
  118.         WritePrivateProfileString "Users", "Home" & Ctr, CStr(UserIDs.No(Ctr).Home), Filename
  119.       Next
  120.     Next
  121.  
  122.     CurrentProfile = Filename
  123.     SaveProfile = True
  124.   End If
  125. End Function
  126. '
  127. '   Gets a string from an INI file.
  128. '
  129. Public Function GetFromIni(strSectionHeader As String, strVariableName As _
  130.     String, strFileName As String) As String
  131.     Dim strReturn As String
  132.     strReturn = String(255, Chr(0))
  133.     GetFromIni = Left$(strReturn, _
  134.       GetPrivateProfileString(strSectionHeader, ByVal strVariableName, "", _
  135.       strReturn, Len(strReturn), strFileName))
  136. End Function
  137.  
  138.  
  139.