ciao, mi da questo errore quando sto per inviare dati delle registrazione..
Server object error 'ASP 0177 : 800401f3'
Server.CreateObject Failed
/aspasp/MWOpen/include/inc_libreria.asp, line 78
800401f3
la riga 78 è: Set Mail = Server.CreateObject("CDONTS.NewMail")
come mai?cosa sbaglio ?
Sul PC che fa da server non c'è il componente CDONTS.
Usa il CDOSYS.
Probabilmente si tratta di un Windows XP Professional o Server 2003.
CDONTS sta solo sui sistemi Windows 2000 Server e Professional.
il codice è:
<%
'VERSIONE FILE 1.4.0
'---ELENCO DI FUNZIONI UTILIZZATE DI FREQUENTE
'---Funzioni per la conversione della data
Dim N_Caratteri, Stringa, Anno, Mese, Giorno, N
Function DataToStr(Data)
Anno = CStr(Year(Data))
Mese = CStr(Month(Data))
If Len(Mese) = 1 Then
Mese = "0" & Mese
End If
Giorno = CStr(Day(Data))
If Len(Giorno) = 1 Then
Giorno = "0" & Giorno
End If
DataToStr = Anno & Mese & Giorno
End Function
Function StrToData(Stringa)
Anno = Mid(Stringa, 1, 4)
Mese = Mid(Stringa, 5, 2)
Giorno = Mid(Stringa, 7, 2)
StrToData = CDate(Giorno & "/" & Mese & "/" & Anno)
End Function
'---Funzioni per la conversione oraria
Function OraToStr(Data)
Ora = CStr(Hour(Data))
If Len(Ora) = 1 Then
Ora = "0" & Ora
End If
Minuto = CStr(Minute(Data))
If Len(Minuto) = 1 Then
Minuto = "0" & Minuto
End If
Secondo = CStr(Second(Data))
If Len(Secondo) = 1 Then
Secondo = "0" & Secondo
End If
OraToStr = Ora & Minuto & Secondo
End Function
Function StrToOra(Stringa)
Ora = Mid(Stringa, 1, 2)
Minuto = Mid(Stringa, 3, 2)
Secondo = Mid(Stringa, 5, 2)
StrToOra = CDate(Ora & ":" & Minuto & ":" & Secondo)
End Function
'---Funzioni per inviare mail
Function InvioMail(byVal ServerMail, byVal Mittente, byVal Destinatario, byVal Titolo, byVal Corpo)
'---Script per ASPEmail
'Dim Mail
'Set Mail = Server.CreateObject("Persits.MailSender")
'Mail.Host = ServerMail
'Mail.From = Mittente
'Mail.AddAddress Destinatario
'Mail.Subject = Titolo
'Mail.Body = Corpo
'On Error Resume Next
'Mail.Send
'If Err <> 0 Then
' InvioMail = False
'Else
' InvioMail = True
'End If
'Set Mail = Nothing
'---Script per CDONTS
Dim Mail
Set Mail = Server.CreateObject("CDOSYS.NewMail")
Mail.From = Mittente
Mail.To = Destinatario
Mail.Subject = Titolo
Mail.Body = Corpo
On Error Resume Next
Mail.Send
InvioMail = True
Set Mail = Nothing
'---Script per QMail
' Dim Mail, Result
' Set Mail = Server.CreateObject("dkQmail.Qmail")
' Mail.FromEmail = Mittente
' Mail.ToEmail = Destinatario
' Mail.Subject = Titolo
' Mail.Body = Corpo
' Mail.MessageType = "TEXT"
' Result = Mail.SendMail()
'
' If Result = 1 Then
' InvioMail = True
' Else
' InvioMail = False
' End If
End Function
'---Funzione per generare un SessionID casuale
Function Casuale()
Dim N_Caratteri, Stringa, I, N
N_Caratteri = 15
Stringa = ""
Randomize Timer
For I = 1 To N_Caratteri
Do
N = Int(Rnd * 75) + 48
Loop Until ((N >= 48) AND (N <= 57)) OR ((N >= 65) AND (N <= 90)) OR ((N >= 97) AND (N <= 122))
Stringa = Stringa & Chr(N)
Next
Casuale = Stringa
End Function
'---Encode e decode UserID per mail di conferma
Function UserIDEncode(UserID)
Dim SetCaratteri, Lunghezza, I, Char, NewString, NewString2, LenUserID
SetCaratteri = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
Lunghezza = Round(Len(UserID) / 2) * 2
LenUserID = Hex(Instr(UserID, "{~}") - 1)
UserID = UCase(Replace(UserID, "{~}", ""))
For I = 1 To Lunghezza
Char = Mid(UserID, I, 1)
If InStr(SetCaratteri, Char) = 0 Then
Char = "_"
End If
NewString = NewString & Char
Next
For I = 1 To Lunghezza Step 2
NewString2 = NewString2 & Mid(NewString, I + 1, 1) & Mid(NewString, I, 1)
Next
UserIDEncode= "A" & Mid(LenUserID, 1, 1) & StrReverse(NewString2) & "A"
End Function
Function UserIDDecode(Stringa)
Dim Lunghezza, I, NewString, LenUserIDS, LenUserID
LenUserIDS = (Mid(Stringa, 2, 1))
Stringa = StrReverse(Mid(Stringa, 3, Len(Stringa) - 3))
If LenUserIDS = "A" Then LenUserID = 10 Else LenUserID = CInt(LenUserIDS)
Lunghezza = Int(Len(Stringa) / 2) * 2
For I = 1 To Lunghezza Step 2
NewString = NewString & Mid(Stringa, I + 1, 1) & Mid(Stringa, I, 1)
Next
If Len(Stringa) / 2 <> Len(Stringa) \ 2 Then NewString = NewString & Right(Stringa, 1)
NewString = Mid(NewString, 1, LenUserID) & "+" & Mid(NewString, LenUserID + 1)
UserIDDecode = Replace(NewString, "+", "{~}")
End Function
'---Funzione per gestire l'arrotondamento dell'Euro
Function ArrotondamentoPrezzo(ArrotondamentoPrezzo_Valore)
ArrotondamentoPrezzo = Round(ArrotondamentoPrezzo_Valore)
End Function
Function FormattaValore(Valore, Decimali, SeparatoreDecimale)
Dim ParteIntera, ParteDecimale
ParteIntera = CStr(Int(Valore))
If Decimali > 0 Then
ParteDecimale = Cstr(Int((Valore - Int(Valore))*(10 ^ Decimali)))
Do While Len(ParteDecimale) < Decimali
ParteDecimale = "0" & ParteDecimale
Loop
Else
SeparatoreDecimale = ""
ParteDecimale = ""
End If
FormattaValore = ParteIntera & SeparatoreDecimale & ParteDecimale
End Function
Function VisualizzaPrezzo(VisualizzaPrezzo_StringaPrezzo)
VisualizzaPrezzo_StringaPrezzo = Int(VisualizzaPrezzo_StringaPrezzo)
Do While Len(VisualizzaPrezzo_StringaPrezzo) < 3
VisualizzaPrezzo_StringaPrezzo = "0" & VisualizzaPrezzo_StringaPrezzo
Loop
Dim VisualizzaPrezzo_StringaDecimale, VisualizzaPrezzo_StringaIntero
VisualizzaPrezzo_StringaDecimale = Mid(VisualizzaPrezzo_StringaPrezzo, Len(VisualizzaPrezzo_StringaPrezzo) - 1, 2)
VisualizzaPrezzo_StringaIntero = Mid(VisualizzaPrezzo_StringaPrezzo, 1, Len(VisualizzaPrezzo_StringaPrezzo) - 2)
VisualizzaPrezzo = VisualizzaPrezzo_StringaIntero & "," & VisualizzaPrezzo_StringaDecimale
End Function
Function FormattaPrezzoPerDB(FormattaPrezzoPerDB_StringaPre zzo)
Dim FormattaPrezzoPerDB_StringaIntero, FormattaPrezzoPerDB_StringaDecimale
If InStr(FormattaPrezzoPerDB_StringaPrezzo, ",") > 0 Then
FormattaPrezzoPerDB_StringaDecimale = Mid(FormattaPrezzoPerDB_StringaPrezzo, Instr(FormattaPrezzoPerDB_StringaPrezzo, ",") + 1)
If Len(FormattaPrezzoPerDB_StringaDecimale) > 2 Then
FormattaPrezzoPerDB_StringaDecimale = Cstr(Round(CLng(FormattaPrezzoPerDB_StringaDecimal e)/(10 ^ (Len(FormattaPrezzoPerDB_StringaDecimale) - 2))))
Do While Len(FormattaPrezzoPerDB_StringaDecimale) < 2
FormattaPrezzoPerDB_StringaDecimale = "0" & FormattaPrezzoPerDB_StringaDecimale
Loop
Else
Do While Len(FormattaPrezzoPerDB_StringaDecimale) < 2
FormattaPrezzoPerDB_StringaDecimale = FormattaPrezzoPerDB_StringaDecimale & "0"
Loop
End If
FormattaPrezzoPerDB_StringaIntero = Mid(FormattaPrezzoPerDB_StringaPrezzo, 1, Instr(FormattaPrezzoPerDB_StringaPrezzo, ",") - 1)
Else
FormattaPrezzoPerDB_StringaDecimale = "00"
FormattaPrezzoPerDB_StringaIntero = FormattaPrezzoPerDB_StringaPrezzo
End If
FormattaPrezzoPerDB = FormattaPrezzoPerDB_StringaIntero & "" & FormattaPrezzoPerDB_StringaDecimale
End Function
Function UtilizzaPrezzo(UtilizzaPrezzo_StringaPrezzo)
UtilizzaPrezzo = CLng(UtilizzaPrezzo_StringaPrezzo)
End Function
Function CalcoloSpeseSpedizione(Totale, QuantitaTotale)
If AttenuaSS Then
If Totale > 0 And QuantitaTotale > 0 Then
'Funzione logaritmica sconsigliata
'CalcoloSpeseSpedizione = UtilizzaPrezzo(Log(QuantitaTotale + 2)/log(3) * (Totale / QuantitaTotale))
CalcoloSpeseSpedizione = UtilizzaPrezzo((Totale) - ((Totale/QuantitaTotale) * (QuantitaTotale - 1) / 2))
Else
CalcoloSpeseSpedizione = 0
End If
Else
CalcoloSpeseSpedizione = Totale
End If
End Function
%>
ho messo così: Set Mail = Server.CreateObject("CDOSYS.NewMail")
mi da ancora errore..
Microsoft VBScript runtime error '800a01b6'
Object doesn't support this property or method: 'Mail.Body'
/aspasp/MWOpen/include/inc_libreria.asp, line 82
Dim Mail
Set Mail = Server.CreateObject("CDO.Message")
Mail.From = Mittente
Mail.To = Destinatario
Mail.Subject = Titolo
Mail.Body = Corpo
On Error Resume Next
Mail.Send
InvioMail = True
Set Mail = Nothing
al posto di Mail.Body cosa devo inserire?
con
.TextBody = corpo
non va...
modificato così:
<%
'VERSIONE FILE 1.4.0 implementata con script per invio mail con CDOSYS
'---ELENCO DI FUNZIONI UTILIZZATE DI FREQUENTE
'---Funzioni per la conversione della data
Dim N_Caratteri, Stringa, Anno, Mese, Giorno, N
Function DataToStr(Data)
Anno = CStr(Year(Data))
Mese = CStr(Month(Data))
If Len(Mese) = 1 Then
Mese = "0" & Mese
End If
Giorno = CStr(Day(Data))
If Len(Giorno) = 1 Then
Giorno = "0" & Giorno
End If
DataToStr = Anno & Mese & Giorno
End Function
Function StrToData(Stringa)
Anno = Mid(Stringa, 1, 4)
Mese = Mid(Stringa, 5, 2)
Giorno = Mid(Stringa, 7, 2)
StrToData = CDate(Giorno & "/" & Mese & "/" & Anno)
End Function
'---Funzioni per la conversione oraria
Function OraToStr(Data)
Ora = CStr(Hour(Data))
If Len(Ora) = 1 Then
Ora = "0" & Ora
End If
Minuto = CStr(Minute(Data))
If Len(Minuto) = 1 Then
Minuto = "0" & Minuto
End If
Secondo = CStr(Second(Data))
If Len(Secondo) = 1 Then
Secondo = "0" & Secondo
End If
OraToStr = Ora & Minuto & Secondo
End Function
Function StrToOra(Stringa)
Ora = Mid(Stringa, 1, 2)
Minuto = Mid(Stringa, 3, 2)
Secondo = Mid(Stringa, 5, 2)
StrToOra = CDate(Ora & ":" & Minuto & ":" & Secondo)
End Function
'---Funzioni per inviare mail
Function InvioMail(byVal ServerMail, byVal Mittente, byVal Destinatario, byVal Titolo, byVal Corpo)
'---Script per ASPEmail
'Dim Mail
'Set Mail = Server.CreateObject("Persits.MailSender")
'Mail.Host = ServerMail
'Mail.From = Mittente
'Mail.AddAddress Destinatario
'Mail.Subject = Titolo
'Mail.Body = Corpo
'On Error Resume Next
'Mail.Send
'If Err <> 0 Then
' InvioMail = False
'Else
' InvioMail = True
'End If
'Set Mail = Nothing
'---Script per CDONTS
' Dim Mail
' Set Mail = Server.CreateObject("CDONTS.NewMail")
' Mail.BodyFormat=1
' Mail.MailFormat=0
' Mail.From = Mittente
' Mail.To = Destinatario
' Mail.Subject = Titolo
' Mail.Body = Corpo
'
' On Error Resume Next
' Mail.Send
' InvioMail = True
' Set Mail = Nothing
'---Script per CDOSYS
Dim Messaggio
Dim Confcdo
Dim Flds
Dim strHTML
Dim smtpserver
Const cdoSendUsingPort = 2
smtpserver = servermail
set Messaggio = CreateObject("CDO.Message")
set Confcdo = CreateObject("CDO.Configuration")
Set Flds = Confcdo.Fields
' impostazioni dei campi di configurazione di CDOSYS per usare la porta 25 sul server SMTP
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpserver
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 20
.Update
End With
With Messaggio
' applico i settaggi
Set .Configuration = Confcdo
.To = destinatario
.From = mittente
.Subject = titolo
.textbody = corpo
.Send
End With
' Pulizia delle variabili
Set Messaggio = Nothing
Set Confcdo = Nothing
Set Flds = Nothing
'---Script per QMail
' Dim Mail, Result
' Set Mail = Server.CreateObject("dkQmail.Qmail")
' Mail.FromEmail = Mittente
' Mail.ToEmail = Destinatario
' Mail.Subject = Titolo
' Mail.Body = Corpo
' Mail.MessageType = "TEXT"
' Result = Mail.SendMail()
'
' If Result = 1 Then
' InvioMail = True
' Else
' InvioMail = False
' End If
End Function
'---Funzione per generare un SessionID casuale
Function Casuale()
Dim N_Caratteri, Stringa, I, N
N_Caratteri = 15
Stringa = ""
Randomize Timer
For I = 1 To N_Caratteri
Do
N = Int(Rnd * 75) + 48
Loop Until ((N >= 48) AND (N <= 57)) OR ((N >= 65) AND (N <= 90)) OR ((N >= 97) AND (N <= 122))
Stringa = Stringa & Chr(N)
Next
Casuale = Stringa
End Function
'---Encode e decode UserID per mail di conferma
Function UserIDEncode(UserID)
Dim SetCaratteri, Lunghezza, I, Char, NewString, NewString2, LenUserID
SetCaratteri = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
Lunghezza = Round(Len(UserID) / 2) * 2
LenUserID = Hex(Instr(UserID, "{~}") - 1)
UserID = UCase(Replace(UserID, "{~}", ""))
For I = 1 To Lunghezza
Char = Mid(UserID, I, 1)
If InStr(SetCaratteri, Char) = 0 Then
Char = "_"
End If
NewString = NewString & Char
Next
For I = 1 To Lunghezza Step 2
NewString2 = NewString2 & Mid(NewString, I + 1, 1) & Mid(NewString, I, 1)
Next
UserIDEncode= "A" & Mid(LenUserID, 1, 1) & StrReverse(NewString2) & "A"
End Function
Function UserIDDecode(Stringa)
Dim Lunghezza, I, NewString, LenUserIDS, LenUserID
LenUserIDS = (Mid(Stringa, 2, 1))
Stringa = StrReverse(Mid(Stringa, 3, Len(Stringa) - 3))
If LenUserIDS = "A" Then LenUserID = 10 Else LenUserID = CInt(LenUserIDS)
Lunghezza = Int(Len(Stringa) / 2) * 2
For I = 1 To Lunghezza Step 2
NewString = NewString & Mid(Stringa, I + 1, 1) & Mid(Stringa, I, 1)
Next
If Len(Stringa) / 2 <> Len(Stringa) \ 2 Then NewString = NewString & Right(Stringa, 1)
NewString = Mid(NewString, 1, LenUserID) & "+" & Mid(NewString, LenUserID + 1)
UserIDDecode = Replace(NewString, "+", "{~}")
End Function
'---Funzione per gestire l'arrotondamento dell'Euro
Function ArrotondamentoPrezzo(ArrotondamentoPrezzo_Valore)
ArrotondamentoPrezzo = Round(ArrotondamentoPrezzo_Valore)
End Function
Function FormattaValore(Valore, Decimali, SeparatoreDecimale)
Dim ParteIntera, ParteDecimale
ParteIntera = CStr(Int(Valore))
If Decimali > 0 Then
ParteDecimale = Cstr(Int((Valore - Int(Valore))*(10 ^ Decimali)))
Do While Len(ParteDecimale) < Decimali
ParteDecimale = "0" & ParteDecimale
Loop
Else
SeparatoreDecimale = ""
ParteDecimale = ""
End If
FormattaValore = ParteIntera & SeparatoreDecimale & ParteDecimale
End Function
Function VisualizzaPrezzo(VisualizzaPrezzo_StringaPrezzo)
VisualizzaPrezzo_StringaPrezzo = Int(VisualizzaPrezzo_StringaPrezzo)
Do While Len(VisualizzaPrezzo_StringaPrezzo) < 3
VisualizzaPrezzo_StringaPrezzo = "0" & VisualizzaPrezzo_StringaPrezzo
Loop
Dim VisualizzaPrezzo_StringaDecimale, VisualizzaPrezzo_StringaIntero
VisualizzaPrezzo_StringaDecimale = Mid(VisualizzaPrezzo_StringaPrezzo, Len(VisualizzaPrezzo_StringaPrezzo) - 1, 2)
VisualizzaPrezzo_StringaIntero = Mid(VisualizzaPrezzo_StringaPrezzo, 1, Len(VisualizzaPrezzo_StringaPrezzo) - 2)
VisualizzaPrezzo = VisualizzaPrezzo_StringaIntero & "," & VisualizzaPrezzo_StringaDecimale
End Function
Function FormattaPrezzoPerDB(FormattaPrezzoPerDB_StringaPre zzo)
Dim FormattaPrezzoPerDB_StringaIntero, FormattaPrezzoPerDB_StringaDecimale
If InStr(FormattaPrezzoPerDB_StringaPrezzo, ",") > 0 Then
FormattaPrezzoPerDB_StringaDecimale = Mid(FormattaPrezzoPerDB_StringaPrezzo, Instr(FormattaPrezzoPerDB_StringaPrezzo, ",") + 1)
If Len(FormattaPrezzoPerDB_StringaDecimale) > 2 Then
FormattaPrezzoPerDB_StringaDecimale = Cstr(Round(CLng(FormattaPrezzoPerDB_StringaDecimal e)/(10 ^ (Len(FormattaPrezzoPerDB_StringaDecimale) - 2))))
Do While Len(FormattaPrezzoPerDB_StringaDecimale) < 2
FormattaPrezzoPerDB_StringaDecimale = "0" & FormattaPrezzoPerDB_StringaDecimale
Loop
Else
Do While Len(FormattaPrezzoPerDB_StringaDecimale) < 2
FormattaPrezzoPerDB_StringaDecimale = FormattaPrezzoPerDB_StringaDecimale & "0"
Loop
End If
FormattaPrezzoPerDB_StringaIntero = Mid(FormattaPrezzoPerDB_StringaPrezzo, 1, Instr(FormattaPrezzoPerDB_StringaPrezzo, ",") - 1)
Else
FormattaPrezzoPerDB_StringaDecimale = "00"
FormattaPrezzoPerDB_StringaIntero = FormattaPrezzoPerDB_StringaPrezzo
End If
FormattaPrezzoPerDB = FormattaPrezzoPerDB_StringaIntero & "" & FormattaPrezzoPerDB_StringaDecimale
End Function
Function UtilizzaPrezzo(UtilizzaPrezzo_StringaPrezzo)
UtilizzaPrezzo = CLng(UtilizzaPrezzo_StringaPrezzo)
End Function
Function CalcoloSpeseSpedizione(Totale, QuantitaTotale)
If AttenuaSS Then
If Totale > 0 And QuantitaTotale > 0 Then
'Funzione logaritmica sconsigliata
'CalcoloSpeseSpedizione = UtilizzaPrezzo(Log(QuantitaTotale + 2)/log(3) * (Totale / QuantitaTotale))
CalcoloSpeseSpedizione = UtilizzaPrezzo((Totale) - ((Totale/QuantitaTotale) * (QuantitaTotale - 1) / 2))
Else
CalcoloSpeseSpedizione = 0
End If
Else
CalcoloSpeseSpedizione = Totale
End If
End Function
%>
mi da errore:
CDO.Message.1 error '80040213'
The transport failed to connect to the server.
/aspasp/MWOpen/include/inc_libreria.asp, line 122
line 122: .Send
chi mi da una mano ?
grazie
QUI, nella sezione contributi......trovi MWOpen per Win 2003 e CDOSYS
grazie sandra ho scaricato il file MWOpen_v1r4_Win2003_IIS6_20060403_160132_johjoh2k, ho sostituito i file che erano all interno ma quando vado per inviare i dati della registrazione non mi arriva l email...mi dice:
Ok, sei stato iscritto con successo!
Per confermare l'iscrizione dovrai cliccare sul link che ti è stato inviato via EMail!
ma non mi arriva nulla
sai quale può essere il problema? ps. uso server aruba
anche usando il server gratuito asphost4free.com non mi arriva l email...
dove si setta per l invio delle mail con mwopen ?
Permessi di invio
Rispondi quotando