Class clsGestMail

[ubbicom]

Ciao a tutti.

Ho sempre usato la classe clsGestMail per aggiungere tramite web nuovi indirizzi email ad un dominio registrato presso il provider aruba.

Improvvisamente la classe ha smesso di funzionare, cioè non dà errori ma la casella non si crea all'interno del dominio, perchè?

<%

	' XMLHttp ProgID
	Const XMLHTTP_PROGID = "Microsoft.XMLHTTP"
	'Const XMLHTTP_PROGID = "MSXML2.ServerXMLHTTP.4.0"


	Class clsGestMail


	
	' ********************************************************************************
	' Private variables
	' ********************************************************************************

		Private strDomain			' Domain name
		Private strPwd				' Domain password
		Private strLogTime			' Contains infos about login time to pass to page requests

		
	
	' ********************************************************************************
	' Constructor and Destructor
	' ********************************************************************************

		' Class constructor
		Private Sub Class_Initialize

			strDomain  = ""
			strPwd     = ""
			strLogTime = ""
		
		End Sub
	
		' Class destructor
		Private Sub Class_Terminate

		End Sub


		
	' ********************************************************************************
	' Properties
	' ********************************************************************************

		' Domain
		Public Property Get Domain ()
		
			Domain = strDomain
			
		End Property
		Public Property Let Domain (newValue)
		
			If VarType(newValue) <> vbString Then
				Err.Raise 450 ' Wrong number of arguments or invalid property assignment
			End If


			strDomain = newValue
			
		End Property
		
		' Password
		Public Property Get Password ()
		
			Password = strPwd
			
		End Property
		Public Property Let Password (newValue)
		
			If VarType(newValue) <> vbString Then
				Err.Raise 450 ' Wrong number of arguments or invalid property assignment
			End If
		
			
			strPwd = newValue
			
		End Property



	' ********************************************************************************
	' Methods
	' ********************************************************************************

		' Execute the login
		Public Sub Login ()
		
			Dim objSrvHTTP
			Dim rs
			Dim strHTML

			' Check domain and password
			If (strDomain = "") Or (strPwd = "") Then
				Err.Raise vbObjectError + 1002		' I dati per il login non sono stati impostati
			End If

			' Create the XMLHttp object
			Set objSrvHTTP = Server.CreateObject(XMLHTTP_PROGID)

			' Set the url to open
			objSrvHTTP.Open "POST", "http://mailrr.aruba.it/cgi-bin/qmailadmin", False

			' Post the login data
			objSrvHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
			objSrvHTTP.Send             "username=postmaster&domain=" & strDomain & "&password=" & strPwd
			If objSrvHTTP.Status <> 200 Then		' Impossible to load the page
				Err.Raise vbObjectError + 1001		' Impossibile comunicare con il server
			End If
			
			' Decode data
			Set rs = Server.CreateObject("ADODB.Recordset")
			rs.Fields.Append "text", 201, -1	' text field
			rs.Open
			rs.AddNew
			rs("text").AppendChunk objSrvHTTP.responseBody
			strHTML = rs("text")
			rs.Delete
			rs.Update
			rs.Close
			Set rs=Nothing

			Set objSrvHTTP = Nothing
			
			' Wrong login data
			If Instr(strHTML, "Username") <> 0 Then
				Err.Raise vbObjectError + 1003		' I dati per il login non sono corretti
			End If

			' Get login time
			strLogTime = Mid(strHTML,Instr(strHTML,"time=") + 5 , 10)

		End Sub

		' Create a new mailbox
		Public Sub AddMailBox (ByVal MailBox, ByVal Password)
		
			Dim objSrvHTTP
			Dim rs
			Dim strHTML

			' Validate parameters
			If VarType(MailBox) <> vbString Then
				Err.Raise 450 ' Wrong number of arguments or invalid property assignment
			End If
			If VarType(Password) <> vbString Then
				Err.Raise 450 ' Wrong number of arguments or invalid property assignment
			End If

			' Check for login
			If strLogTime = "" Then
				Err.Raise vbObjectError + 1004		' Il login non è stato effettuato
			End If

			' Create the XMLHttp object
			Set objSrvHTTP = Server.CreateObject(XMLHTTP_PROGID)

			' Set the url to open
			objSrvHTTP.Open "POST", "http://mailrr.aruba.it/cgi-bin/qmailadmin/com/addusernow", False

			' Post the data
			objSrvHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
			objSrvHTTP.Send             "newu=" & MailBox & "&password1=" & Password & "&password2=" & Password & "&do.login=add&gecos=&number_of_mailinglist=0&aggiungi=aggiungi&user=postmaster&time=" & strLogTime & "&dom=" & strDomain 
			If objSrvHTTP.Status <> 200 Then		' Impossible to load the page
				Err.Raise vbObjectError + 1001		' Impossibile comunicare con il server
			End If

			' Decode data
			Set rs = Server.CreateObject("ADODB.Recordset")
			rs.Fields.Append "text", 201, -1	' text field
			rs.Open
			rs.AddNew
			rs("text").AppendChunk objSrvHTTP.responseBody
			strHTML = rs("text")
			rs.Delete
			rs.Update
			rs.Close
			Set rs=Nothing

			Set objSrvHTTP = Nothing

			' Check for already used mailbox name
			response.write strHTML
			If Instr(strHTML, "Name already used") <> 0 Then
				Err.Raise vbObjectError + 1005		' Il nome scelto per la mailbox è già in uso
			End If

			' Check for invalid mailbox name
			response.write strHTML
			If Instr(strHTML, "it cannot be added") <> 0 Then
				Err.Raise vbObjectError + 1005		' Il nome scelto per la mailbox è già in uso
			End If

			' Check for invalid mailbox name
			response.write strHTML
			If Instr(strHTML, "Not valid address email ") <> 0 Then
				Err.Raise vbObjectError + 1006		' Il nome scelto per la mailbox non è valido
			End If

		End Sub

		' Delete a mailbox
		Public Sub RemoveMailBox (ByVal MailBox)
		
			Dim objSrvHTTP
			Dim rs
			Dim strHTML

			' Validate parameters
			If VarType(MailBox) <> vbString Then
				Err.Raise 450 ' Wrong number of arguments or invalid property assignment
			End If

			' Check for login
			If strLogTime = "" Then
				Err.Raise vbObjectError + 1004		' Il login non è stato effettuato
			End If

			' Create the XMLHttp object
			Set objSrvHTTP = Server.CreateObject(XMLHTTP_PROGID)

			' Set the url to open
			objSrvHTTP.Open "POST", "http://mailrr.aruba.it/cgi-bin/qmailadmin/com/delusernow", False

			' Post the data
			objSrvHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
			objSrvHTTP.Send             "Conferma cancellazione=Conferma cancellazione&do.login=DeleteUser&user=postmaster&time=" & strLogTime & "&dom=" & strDomain & "&deluser=" & MailBox
			If objSrvHTTP.Status <> 200 Then		' Impossible to load the page
				Err.Raise vbObjectError + 1001		' Impossibile comunicare con il server
			End If

			Set objSrvHTTP = Nothing

		End Sub


	
	End Class


%>