par Michael DELIQUE » 14 Nov 2013 à 16:34
ya une petit subtilité...
je me suis bien arraché les cheveux avant d'y arriver
il faut quand meme passer le chemin d'une id a créer. si j'ai bien compris l'id est créé sur le disque et ensuite remonter sur le server comme un piece jointe.
une fonction générique que j'utilise
- Code : Tout sélectionner
Public Function Admin_UserCreate(wlstParam List As String) As String
%REM
Created Mar 1, 2012 by mdelique
Description: create a user
liste des parametres à la fin de la fonction
ATTENTION MEME SI l'id est stocké dans le vault il faut qu'elle soit temporaire créé sur le disque
le parametre IDFILE doit être renseigné
ATTENTION la gestion des quotas ne fonctionnes pas : BUG IBM. les quotas doivent être inséré à part.
%END REM
Dim Registration As NotesRegistration
Dim nmServer As NotesName
Dim dtExpiration As NotesDateTime
Dim nbOk As Boolean
Dim nbUserType As Integer
Dim nbPasswordQuality As Integer
Dim vrRetour As Variant
Dim i As Integer
Dim Server As String
Const Separator = ";"
On Error GoTo CatchError
Admin_UserCreate = ""
If IsEmpty(wlstParam) = True Then
Error 9999,"wlstParam is Empty"
Exit Function
End If
If session Is Nothing Or DB Is Nothing Then
Set session = New NotesSession
Set DB = Session.CurrentDatabase
End If
Set Registration = New NotesRegistration
If Trim(wlstParam("ALTORGUNIT"))<>"" Then
Registration.Altorgunit = Split(wlstParam("ALTORGUNIT"),Separator)
End If
If Trim(wlstParam("ALTORGUNITLANG"))<> "" Then
Registration.Altorgunitlang = Split(wlstParam("ALTORGUNITLANG"),Separator)
End If
Registration.Usecertificateauthority = False
If IsElement(wlstParam("USECERTIFICATEAUTHORITY")) = True Then
Select Case UCase(Trim(wlstParam("USECERTIFICATEAUTHORITY")))
Case "YES","Y","TRUE","T","1",CStr(True)
Registration.Usecertificateauthority = True
Case "","NO","N","FALSE","F","0","DEFAULT","D",CStr(False)
Registration.Usecertificateauthority = False
Case Else
Error 9999,"UseCertificateAuthority, bad value : "+wlstParam("USECERTIFICATEAUTHORITY")
Exit Function
End Select
End If
If Registration.Usecertificateauthority = True Then
If IsElement(wlstParam("CERTIFIERNAME")) = False Then
Error 9999,"CertifierName value is not defined"
Exit Function
End If
If Trim(wlstParam("CERTIFIERNAME"))= "" Then
Error 9999,"CertifierName value is Empty"
Exit Function
End If
Set nmServer = New NotesName(Trim(wlstParam("CERTIFIERNAME")))
Registration.Certifiername = nmServer.Canonical
Set nmServer = Nothing
Else
If IsElement(wlstParam("CERTIFIERIDFILE")) = False Then
Error 9999,"CertifierIDFile value is not defined"
Exit Function
End If
If Trim(wlstParam("CERTIFIERIDFILE")) = "" Then
Error 9999,"CertifierIDFile value is Empty"
Exit Function
End If
If IsElement(wlstParam("CERTPW")) = False Then
Error 9999,"CertPW value is not defined"
Exit Function
End If
If Trim(wlstParam("CERTPW")) = "" Then
Error 9999,"CertPW value is Empty"
Exit Function
End If
Registration.Certifieridfile = Trim(wlstParam("CERTIFIERIDFILE"))
End If
If IsElement(wlstParam("CREATEMAILDB")) = False Then
Error 9999,"Createmaildb value is not defined"
Exit Function
End If
Select Case UCase(Trim(wlstParam("CREATEMAILDB")))
Case "YES","Y","TRUE","T","1",CStr(True)
Registration.Createmaildb = True
Case "NO","N","FALSE","F","0",CStr(False)
Registration.Createmaildb = False
Case ""
Error 9999,"CreateMailDB value is Empty"
Exit Function
Case Else
Error 9999,"CreateMailDB, bad value : "+wlstParam("CREATEMAILDB")
Exit Function
End Select
Registration.EnforceUniqueShortName = False
If IsElement(wlstParam("ENFORCEUNIQUESHORTNAME")) = True Then
Select Case UCase(Trim(wlstParam("ENFORCEUNIQUESHORTNAME")))
Case "YES","Y","TRUE","T","1",CStr(True)
Registration.EnforceUniqueShortName = True
Case "","NO","N","FALSE","F","0","DEFAULT","D",CStr(False)
Registration.EnforceUniqueShortName = False
Case Else
Error 9999,"EnforceUniqueShortName, bad value : "+wlstParam("ENFORCEUNIQUESHORTNAME")
Exit Function
End Select
End If
If IsElement(wlstParam("EXPIRATION")) = True Then
If Trim(wlstParam("EXPIRATION"))<> "" Then
If CCur(Format(Trim(wlstParam("EXPIRATION")),"YYYYMMDD"))< CCur(Format(Now(),"YYYYMMDD")) Then
Error 9999,"Expiration Date ("+Format(Trim(wlstParam("EXPIRATION")),"YYYY-MM-DD")+") is less than today ("+Format(Now(),"YYYY-MM-DD")+")"
Exit Function
End If
Set dtExpiration = New NotesDateTime(Trim(wlstParam("EXPIRATION")))
Registration.Expiration = DateNumber(Year(dtExpiration.Dateonly),Month(dtExpiration.Dateonly),Day(dtExpiration.Dateonly))
Set dtExpiration = Nothing
End If
End If
If IsElement(wlstParam("GROUPLIST")) = True Then
If Trim(wlstParam("GROUPLIST"))<>"" Then
Registration.GroupList = Split(wlstParam("GROUPLIST"),Separator)
End If
End If
If IsElement(wlstParam("IDTYPE")) = False Then
Error 9999,"IDType value is not defined"
Exit Function
End If
Select Case UCase(Trim(wlstParam("IDTYPE")))
Case "F","FLAT","ID_FLAT","171",CStr(ID_FLAT)
Registration.IDType = ID_FLAT
Case "H","HIERARCHICAL","ID_HIERARCHICAL","172",CStr(ID_HIERARCHICAL)
Registration.IDType = ID_HIERARCHICAL
Case "C","CERTIFIER","ID_CERTIFIER","173",CStr(ID_CERTIFIER)
Registration.IDType = ID_CERTIFIER
Case ""
Error 9999,"IDType value is Empty"
Exit Function
Case Else
Error 9999,"IDType, bad value : "+wlstParam("IDTYPE")
Exit Function
End Select
Registration.IsNorthAmerican = True
If IsElement(wlstParam("ISNORTHAMERICAN")) = True Then
Select Case UCase(Trim(wlstParam("ISNORTHAMERICAN")))
Case "YES","Y","TRUE","T","1",CStr(True)
Registration.IsNorthAmerican = True
Case "","NO","N","FALSE","F","0","DEFAULT","D",CStr(False)
Registration.IsNorthAmerican = False
Case Else
Error 9999,"IsNorthAmerican, bad value : "+wlstParam("ISNORTHAMERICAN")
Exit Function
End Select
End If
Registration.IsRoamingUser = False
If IsElement(wlstParam("ISROAMINGUSER")) = True Then
Select Case UCase(Trim(wlstParam("ISROAMINGUSER")))
Case "YES","Y","TRUE","T","1",CStr(True)
Registration.IsRoamingUser = True
nbOK = False
If IsElement(wlstParam("ROAMINGCLEANUPPERIOD")) = True Then
If Trim(wlstParam("ROAMINGCLEANUPPERIOD"))<> "" Then
If IsNumeric(Trim(wlstParam("ROAMINGCLEANUPPERIOD"))) = False Then
Error 9999,"RoamingCleanupPeriod value is is not a numeric : "+wlstParam("ROAMINGCLEANUPPERIOD")
End If
If IsElement(wlstParam("ROAMINGCLEANUPSETTING")) = False Then
Error 9999,"RoamingCleanupSetting value is not defined. Must be defined for RoamingCleanupPeriod"
Exit Function
End If
Registration.RoamingCleanupPeriod = CInt(Trim(wlstParam("ROAMINGCLEANUPPERIOD")))
nbOk = True
End If
End If
Select Case UCase(Trim(wlstParam("ROAMINGCLEANUPSETTING")))
Case "REG_ROAMING_CLEANUP_AT_SHUTDOWN","2","AT_SHUTDOWN","SHUTDOWN",CStr(REG_ROAMING_CLEANUP_AT_SHUTDOWN)
If nbOk = True Then
Error 9999,"RoamingCleanupSetting, value not allowed : REG_ROAMING_CLEANUP_AT_SHUTDOWN (2)"
Exit Function
End If
Registration.RoamingCleanupSetting = 2
Case "REG_ROAMING_CLEANUP_EVERY_NDAYS","1","EVERY_NDAYS","NDAYS",CStr(REG_ROAMING_CLEANUP_EVERY_NDAYS)
Registration.RoamingCleanupSetting = 1
Case "REG_ROAMING_CLEANUP_NEVER","0","DEFAULT","D","NEVER",CStr(REG_ROAMING_CLEANUP_NEVER)
If nbOk = True Then
Error 9999,"RoamingCleanupSetting, value not allowed : REG_ROAMING_CLEANUP_NEVER (0)"
Exit Function
End If
Registration.RoamingCleanupSetting = 0
Case "REG_ROAMING_CLEANUP_PROMPT","3","PROMPT",CStr(REG_ROAMING_CLEANUP_PROMPT)
If nbOk = True Then
Error 9999,"RoamingCleanupSetting, value not allowed : REG_ROAMING_CLEANUP_PROMPT (3)"
Exit Function
End If
Registration.RoamingCleanupSetting = 3
Case ""
Error 9999,"RoamingCleanupSetting value is Empty"
Exit Function
Case Else
Error 9999,"RoamingCleanupSetting, bad value : "+wlstParam("ROAMINGCLEANUPSETTING")
Exit Function
End Select
Registration.RoamingServer = ""
If IsElement(wlstParam("ROAMINGSERVER")) = True Then
If Trim(wlstParam("ROAMINGSERVER")) <> "" Then
Set nmServer = New NotesName(Trim(wlstParam("ROAMINGSERVER")))
Registration.RoamingServer = nmServer.Canonical
Set nmServer = Nothing
End If
End If
If IsElement(wlstParam("ROAMINGSUBDIR")) = False Then
Error 9999,"RoamingSubdir value is not defined"
Exit Function
End If
If Trim(wlstParam("ROAMINGSUBDIR"))= "" Then
Error 9999,"RoamingSubdir value is Empty"
Exit Function
End If
Registration.RoamingSubdir = Trim(wlstParam("ROAMINGSUBDIR"))
Case "","NO","N","F","FALSE","0",CStr(False)
Registration.IsRoamingUser = False
Case Else
Error 9999,"IsRoamingUser, bad value : "+wlstParam("ISROAMINGUSER")
Exit Function
End Select
End If
Registration.MailOwnerAccess = 0
If IsElement(wlstParam("MAILOWNERACCESS")) = True Then
Select Case UCase(Trim(wlstParam("MAILOWNERACCESS")))
Case "D","DESIGNER","REG_MAIL_OWNER_ACL_DESIGNER","1"
Registration.MailOwnerAccess = 1
Case "E","EDITOR","REG_MAIL_OWNER_ACL_EDITOR","2"
Registration.MailOwnerAccess = 2
Case "","M","MANAGER","REG_MAIL_OWNER_ACL_MANAGER","0","DEFAULT"
Registration.MailOwnerAccess = 0
Case Else
Error 9999,"MailOwnerAccess, bad value : "+wlstParam("MAILOWNERACCESS")
Exit Function
End Select
End If
If IsElement(wlstParam("MAILACLMANAGER")) = True Then
If Trim(wlstParam("MAILACLMANAGER")) <> "" Then
Set nmServer = New NotesName(Trim(wlstParam("MAILACLMANAGER")))
Registration.MailACLManager = nmServer.Canonical
Set nmServer = Nothing
End If
End If
If IsElement(wlstParam("MAILCREATEFTINDEX")) = True Then
If Trim(wlstParam("MAILCREATEFTINDEX")) <> "" Then
Select Case UCase(Trim(wlstParam("MAILCREATEFTINDEX")))
Case "YES","Y","TRUE","T","1",CStr(True)
Registration.MailCreateFTIndex = True
Case "","NO","N","FALSE","F","0","DEFAULT","D",CStr(False)
Registration.MailCreateFTIndex = False
Case Else
Error 9999,"MailCreateFTIndex, bad value : "+wlstParam("MAILCREATEFTINDEX")
Exit Function
End Select
End If
End If
If IsElement(wlstParam("MAILINTERNETADDRESS")) = True Then
If Trim(wlstParam("MAILINTERNETADDRESS")) <> "" Then
Registration.MailInternetAddress = Trim(wlstParam("MAILINTERNETADDRESS"))
End If
End If
Registration.MailQuotaSizeLimit = 0
If IsElement(wlstParam("MAILQUOTASIZELIMIT")) = True Then
If Trim(wlstParam("MAILQUOTASIZELIMIT")) <> "" Then
If IsNumeric(Trim(wlstParam("MAILQUOTASIZELIMIT"))) = False Then
Error 9999,"MailQuotaSizeLimit value is not a numeric : "+wlstParam("MAILQUOTASIZELIMIT")
Exit Function
End If
Registration.MailQuotaSizeLimit = CLng(Trim(wlstParam("MAILQUOTASIZELIMIT")))
End If
End If
Registration.MailQuotaWarningThreshold = 0
If IsElement(wlstParam("MAILQUOTAWARNINGTHRESOLD")) = True Then
If Trim(wlstParam("MAILQUOTAWARNINGTHRESOLD")) <> "" Then
If IsNumeric(Trim(wlstParam("MAILQUOTAWARNINGTHRESOLD"))) = False Then
Error 9999,"MailQuotaWarningThreshold value is not a numeric : "+wlstParam("MAILQUOTAWARNINGTHRESOLD")
Exit Function
End If
Registration.MailQuotaWarningThreshold = CLng(Trim(wlstParam("MAILQUOTAWARNINGTHRESOLD")))
End If
End If
If IsElement(wlstParam("MAILSERVER"))= False Then
wlstParam("MAILSERVER")= ""
End If
If Trim(wlstParam("MAILSERVER")) <> "" Then
Set nmServer = New NotesName(Trim(wlstParam("MAILSERVER")))
wlstParam("MAILSERVER") = nmServer.Canonical
Set nmServer = Nothing
End If
REM This property applies only to clustered servers.
If IsElement(wlstParam("MAILREPLICASERVERS")) = True Then
If Trim(wlstParam("MAILREPLICASERVERS")) <> "" Then
vrRetour = Split(wlstParam("MAILREPLICASERVERS"),Separator)
If IsArray(vrRetour) = True Then
If IsEmpty(vrRetour) = False Then
Server = ""
i=0
ForAll value In vrRetour
If Trim(CStr(Value)) <> "" Then
Set nmServer = New NotesName(Trim(CStr(Value)))
If Trim(wlstParam("MAILSERVER")) <> nmServer.Canonical Then
i=i+1
If Trim(Server) = "" Then
Server = nmServer.Canonical
Else
Server = Server +";"+ nmServer.Canonical
End If
End If
Set nmServer = Nothing
End If
End ForAll
If i>0 Then
Registration.MailReplicaServers = Split(Server,";")
End If
Server = ""
i=0
End If
End If
vrRetour = Null
End If
End If
Registration.MailSystem = 0
If IsElement(wlstParam("MAILSYSTEM")) = True Then
Select Case UCase(Trim(wlstParam("MAILSYSTEM")))
Case "IMAP","REG_MAILSYSTEM_IMAP","2"
Registration.MailSystem =2
Case "INOTES","INOTE","REG_MAILSYSTEM_INOTES","3"
Registration.MailSystem = 3
Case "INTERNET","REG_MAILSYSTEM_INTERNET","4"
Registration.MailSystem = 4
Case "NONE","REG_MAILSYSTEM_NONE","6"
Registration.MailSystem = 6
Case "","DEFAULT","NOTES","NOTE","REG_MAILSYSTEM_NOTES","0"
Registration.MailSystem = 0
Case "OTHER","REG_MAILSYSTEM_OTHER","5"
Registration.MailSystem = 5
Case "POP","REG_MAILSYSTEM_POP","1"
Registration.MailSystem = 1
Case Else
Error 9999,"MailSystem, bad value : "+wlstParam("MAILSYSTEM")
Exit Function
End Select
End If
Registration.MailTemplateName = ""
If IsElement(wlstParam("MAILTEMPLATENAME")) = True Then
If Trim(wlstParam("MAILTEMPLATENAME")) <> "" Then
Registration.MailTemplateName = wlstParam("MAILTEMPLATENAME")
End If
End If
If IsElement(wlstParam("MINPASSWORDLENGTH")) = False Then
Error 9999,"MinPasswordLength value is not defined"
Exit Function
End If
Select Case UCase(Trim(wlstParam("MINPASSWORDLENGTH")))
Case "0","1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16"
Registration.MinPasswordLength = CInt(Trim(wlstParam("MINPASSWORDLENGTH")))
Case ""
Error 9999,"MinPasswordLength value is Empty"
Exit Function
Case Else
Error 9999,"MinPasswordLength, bad value : "+wlstParam("MINPASSWORDLENGTH")
Exit Function
End Select
If IsElement(wlstParam("IDFILE"))= False Then
wlstParam("IDFILE")= ""
End If
Registration.NoIDFile = False
If IsElement(wlstParam("NOIDFILE")) = True Then
Select Case UCase(Trim(wlstParam("NOIDFILE")))
Case "YES","Y","TRUE","T","1",CStr(True)
Registration.NoIDFile = True
Case "","NO","N","FALSE","F","0","DEFAULT","D",CStr(False)
Registration.NoIDFile = False
Case Else
Error 9999,"NoIDFile, bad value : "+wlstParam("NOIDFILE")
Exit Function
End Select
End If
Registration.StoreIDInAddressBook = False
If Registration.NoIDFile = False Then
If Trim(wlstParam("IDFILE"))= "" Then
Error 9999,"IDFile value is not defined"
Exit Function
End If
If IsElement(wlstParam("STOREIDINADDRESSBOOK")) = False Then
Error 9999,"StoreIDInAddressBook value is not defined"
Exit Function
End If
Select Case UCase(Trim(wlstParam("STOREIDINADDRESSBOOK")))
Case "YES","Y","TRUE","T","1",CStr(True)
Registration.StoreIDInAddressBook = True
Case "NO","N","FALSE","F","0",CStr(False)
Registration.StoreIDInAddressBook = False
Case ""
Error 9999,"StoreIDInAddressBook value is Empty"
Exit Function
Case Else
Error 9999,"StoreIDInAddressBook, bad value : "+wlstParam("STOREIDINADDRESSBOOK")
Exit Function
End Select
End If
If IsElement(wlstParam("ORGUNIT"))= True Then
If Trim(wlstParam("ORGUNIT"))<> "" Then
Set nmServer = New NotesName(Trim(wlstParam("ORGUNIT")))
Registration.OrgUnit = nmServer.Abbreviated
Set nmServer = Nothing
End If
End If
If IsElement(wlstParam("POLICYNAME"))= True Then
If Trim(wlstParam("POLICYNAME"))<> "" Then
Registration.PolicyName = Trim(wlstParam("POLICYNAME"))
End If
End If
If IsElement(wlstParam("REGISTRATIONLOG"))= True Then
If Trim(wlstParam("REGISTRATIONLOG"))<> "" Then
Registration.RegistrationLog = Trim(wlstParam("REGISTRATIONLOG"))
End If
End If
If IsElement(wlstParam("REGISTRATIONSERVER"))= False Then
Error 9999,"RegistrationServer value is not defined"
Exit Function
End If
If Trim(wlstParam("REGISTRATIONSERVER"))="" Then
Error 9999,"RegistrationServer value is Empty"
Exit Function
End If
Set nmServer = New NotesName(Trim(wlstParam("REGISTRATIONSERVER")))
Registration.RegistrationServer = nmServer.canonical
Set nmServer = Nothing
If IsElement(wlstParam("SHORTNAME"))= True Then
If Trim(wlstParam("SHORTNAME"))<> "" Then
Registration.ShortName = Trim(wlstParam("SHORTNAME"))
End If
End If
Registration.StoreIDInMailfile = False
If IsElement(wlstParam("STOREIDINMAILFILE"))= True Then
Select Case UCase(Trim(wlstParam("STOREIDINMAILFILE")))
Case "YES","Y","TRUE","T","1",CStr(True)
Registration.StoreIDInMailfile = True
If Registration.MailSystem <> 3 Then
Error 9999,"If StoreIDInMailfile = True then MailSystem = 3. MailSystem = "+CStr(Registration.MailSystem)
Exit Function
End If
Case "","NO","N","FALSE","F","0","DEFAULT","D",CStr(False)
Registration.StoreIDInMailfile = False
Case Else
Error 9999,"StoreIDInMailfile, bad value : "+wlstParam("STOREIDINMAILFILE")
Exit Function
End Select
End If
Registration.SynchInternetPassword = False
If IsElement(wlstParam("SYNCHINTERNETPASSWORD"))= True Then
Select Case UCase(Trim(wlstParam("SYNCHINTERNETPASSWORD")))
Case "YES","Y","TRUE","T","1",CStr(True)
Registration.SynchInternetPassword = True
Case "NO","N","FALSE","F","0",CStr(False)
Registration.SynchInternetPassword = False
Case ""
Error 9999,"SynchInternetPassword value is Empty"
Exit Function
Case Else
Error 9999,"SynchInternetPassword, bad value : "+wlstParam("SYNCHINTERNETPASSWORD")
Exit Function
End Select
End If
If IsElement(wlstParam("UPDATEADDRESSBOOK"))= False Then
Error 9999,"UpdateAddressBook value is not defined"
Exit Function
End If
Select Case UCase(Trim(wlstParam("UPDATEADDRESSBOOK")))
Case "YES","Y","TRUE","T","1",CStr(True)
Registration.UpdateAddressBook = True
Case "NO","N","F","FALSE","0",CStr(False)
Registration.UpdateAddressBook = False
Case ""
Error 9999,"UpdateAddressBook value is Empty"
Exit Function
Case Else
Error 9999,"UpdateAddressBook, bad value : "+wlstParam("UPDATEADDRESSBOOK")
Exit Function
End Select
REM valeurs passé en parametre a RegisterNewUser
If IsElement(wlstParam("LASTNAME"))= False Then
Error 9999,"LASTNAME value is not defined"
Exit Function
End If
If Trim(wlstParam("LASTNAME"))="" Then
Error 9999,"LASTNAME value is Empty"
Exit Function
End If
If IsElement(wlstParam("FIRSTNAME"))= False Then
Error 9999,"FIRSTNAME value is not defined"
Exit Function
End If
If IsElement(wlstParam("FIRSTNAME"))= False Then
Error 9999,"FIRSTNAME value is not defined"
Exit Function
End If
If Trim(wlstParam("USERTYPE"))="" Then
Error 9999,"USERTYPE value is not defined"
Exit Function
End If
Select Case UCase(Trim(wlstParam("USERTYPE")))
Case "NOTES_DESKTOP_CLIENT","DESKTOP","D","175",CStr(NOTES_DESKTOP_CLIENT)
nbUserType = NOTES_DESKTOP_CLIENT
Case "NOTES_FULL_CLIENT","FULL","F","176",CStr(NOTES_FULL_CLIENT)
nbUserType = NOTES_FULL_CLIENT
Case "NOTES_LIMITED_CLIENT","LIMITED","LIMIT","L","174",CStr(NOTES_LIMITED_CLIENT)
nbUserType = NOTES_LIMITED_CLIENT
Case ""
Error 9999,"USERTYPE value is Empty"
Exit Function
Case Else
Error 9999,"USERTYPE, bad value : "+wlstParam("USERTYPE")
Exit Function
End Select
If IsElement(wlstParam("MIDDLE"))= False Then
wlstParam("MIDDLE")= ""
End If
If IsElement(wlstParam("ALTNAME"))= False Then
wlstParam("ALTNAME")= ""
End If
If IsElement(wlstParam("ALTNAMELANG"))= False Then
wlstParam("ALTNAMELANG")= ""
End If
If Trim(wlstParam("ALTNAMELANG")) <> "" Then
If LocalLanguageCodeIsValide(Trim(wlstParam("ALTNAMELANG"))) = False Then
Error 9999,"ALTNAMELANG, bad value : "+wlstParam("ALTNAMELANG")
End If
End If
If IsElement(wlstParam("CERTPW"))= False Then
wlstParam("CERTPW")= ""
End If
If IsElement(wlstParam("LOCATION"))= False Then
wlstParam("LOCATION")= ""
End If
If IsElement(wlstParam("COMMENT"))= False Then
wlstParam("COMMENT")= ""
End If
If IsElement(wlstParam("MAILDBPATH"))= False Then
wlstParam("MAILDBPATH")= ""
End If
If IsElement(wlstParam("FWDDOMAIN"))= False Then
wlstParam("FWDDOMAIN")= ""
End If
If IsElement(wlstParam("USERPW"))= False Then
wlstParam("USERPW")= ""
End If
nbPasswordQuality = PasswordQuality_LS(wlstParam("USERPW"))
If nbPasswordQuality < Registration.MinPasswordLength Then
Error 9999,"the password quality ("+CStr(nbPasswordQuality)+") is less than the 'MinPasswordLength' ("+CStr(Registration.MinPasswordLength)+")"
Exit Function
End If
vrRetour = Registration.RegisterNewUser(Trim(wlstParam("LASTNAME")),Trim(wlstParam("IDFILE")),Trim(wlstParam("MAILSERVER")),Trim(wlstParam("FIRSTNAME")),Trim(wlstParam("MIDDLE")),Trim(wlstParam("CERTPW")),Trim(wlstParam("LOCATION")),Trim(wlstParam("COMMENT")),Trim(wlstParam("MAILDBPATH")),Trim(wlstParam("FWDDOMAIN")),Trim(wlstParam("USERPW")),nbUserType, Trim(wlstParam("ALTNAME")) ,Trim(wlstParam("ALTNAMELANG")))
Set Registration = Nothing
If vrRetour = False Then
If Trim(Admin_UserCreate) = "" Then
Admin_UserCreate = "Registration.RegisterNewUser not processed"
End If
End If
%REM
liste des paramètres
dim lstParam list as string
lstParam("ALTORGUNIT") = ""
lstParam("ALTORGUNITLANG") = ""
lstParam("USECERTIFICATEAUTHORITY") = ""
lstParam("CERTIFIERNAME") = ""
lstParam("CERTIFIERIDFILE") = ""
lstParam("CREATEMAILDB") = ""
lstParam("ENFORCEUNIQUESHORTNAME") = ""
lstParam("EXPIRATION") = ""
lstParam("GROUPLIST") = ""
lstParam("IDTYPE") = ""
lstParam("ISNORTHAMERICAN") = ""
lstParam("ISROAMINGUSER") = ""
lstParam("ROAMINGCLEANUPPERIOD") = ""
lstParam("ROAMINGCLEANUPSETTING") = ""
lstParam("ROAMINGSERVER") = ""
lstParam("ROAMINGSUBDIR") = ""
lstParam("MAILOWNERACCESS") = ""
lstParam("MAILACLMANAGER") = ""
lstParam("MAILCREATEFTINDEX") = ""
lstParam("MAILINTERNETADDRESS") = ""
lstParam("MAILQUOTASIZELIMIT") = ""
lstParam("MAILQUOTAWARNINGTHRESOLD") = ""
lstParam("MAILREPLICASERVERS") = ""
lstParam("MAILSYSTEM") = ""
lstParam("MAILTEMPLATENAME") = ""
lstParam("MINPASSWORDLENGTH") = ""
lstParam("NOIDFILE") = ""
lstParam("ORGUNIT") = ""
lstParam("POLICYNAME") = ""
lstParam("REGISTRATIONLOG") = ""
lstParam("REGISTRATIONSERVER") = ""
lstParam("SHORTNAME") = ""
lstParam("STOREIDINADDRESSBOOK") = ""
lstParam("STOREIDINMAILFILE") = ""
lstParam("SYNCHINTERNETPASSWORD") = ""
lstParam("UPDATEADDRESSBOOK") = ""
lstParam("LASTNAME") = ""
lstParam("FIRSTNAME") = ""
lstParam("USERTYPE") = ""
lstParam("MIDDLE") = ""
lstParam("ALTNAME") = ""
lstParam("ALTNAMELANG") = ""
lstParam("IDFILE") = ""
lstParam("MAILSERVER") = ""
lstParam("CERTPW") = ""
lstParam("LOCATION") = ""
lstParam("COMMENT") = ""
lstParam("MAILDBPATH") = ""
lstParam("FWDDOMAIN") = ""
lstParam("USERPW") = ""
%END REM
Exit Function
CatchError:
Set Registration = Nothing
Select Case Err
Case 4299,4005,4183,4288
Admin_UserCreate = CStr(Error)+" ("+CStr(Err)+")"
Exit Function
Case Else
MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
Call ErreurGestion(ErrorAction,"", "","",Nothing,"","", Structure_Log, CStr(GetThreadInfo(10)), CStr(GetThreadInfo (1)), CStr(Err),CStr(Error),CStr(Erl),Nothing,"",False)
Admin_UserCreate = "("+CStr(Err)+") "+CStr(Error)
End Select
Exit Function
End Function
Cordialement
Michael (SMS-Phobique)
----------------------------
"La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi."
Albert EINSTEIN