Profiles.bas
上传用户:guantou168
上传日期:2015-06-25
资源大小:74k
文件大小:5k
源码类别:

Ftp服务器

开发平台:

Visual Basic

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