[Microsoft][ODBC Microsoft Access Driver] Operation must use an updateable query.

graphikart

Nuovo Utente
6 Apr 2008
12
0
0
Salve... avevo un sito fatto in asp (nn da me) caricato su un altro server
l'ho spostato su aruba... ora mi compare:

Microsoft OLE DB Provider for ODBC Drivers error '80004005'

[Microsoft][ODBC Microsoft Access Driver] Operation must use an updateable query.

/inc/adrot.inc.asp, line 38


Ho settato i permessi delel cartelle speciali sull'admin di aruba. Ma nulla

qualcuno sa come aiutarmi???? grazie
 

lukeonweb

Utente Attivo
5 Mar 2003
5.175
13
38
45
Napoli
www.lucaruggiero.it
Potrebbe non essere un permesso di scrittura, non sempre IIS è precisu su determinati errori e se non sbaglio questo... è uno di quelli.

Descrivi cosa fa la tua applicazione in questa fase e posta solo le poche rigne interessate intorno a quella dell'errore (compresa quella dell'errore, ovviamente).

Ciao
 

graphikart

Nuovo Utente
6 Apr 2008
12
0
0
bene. ti spiego
questo sito in asp prima risiedeva su un altro server... l'ho spostato su aruba...
a parte quel problema che ho risolto... ora c'è un problema ocn cdsys o qualcosa del genere...
se accedi al sito e provi a registrarti o ad andare alla voce job... ed ad inviare un curriculum vedrai lerrore...

www.biennepi.biz
 

PoLe

MRW Moderator
6 Giu 2005
2.198
3
0
40
.: Venezia :.
www.bzconsulting.it
Dato che Luca non ha ancora avuto tempo di risponderti, lo faccio io: ;)
quandi si lavora su un dominio Aruba bisogna sempre tenere presente che il database deve essere contenuto in una cartella di nome mdb-database, altrimenti si potrà accedere al DB solo in modalità di lettura.

Devi quindi spostare il tuo DB in tale cartella, e ovviamente modificare il path di connessione ad esso.

Se ancora ti darà problemi, ti consiglio di contattare il servizio di assistenza
:byebye:
 

graphikart

Nuovo Utente
6 Apr 2008
12
0
0
Già fatto... il problema è nell'impostazione del cdsys con win2003 su aruba...

... e il servizio di assistenza ha già testato con nn so cosa che funziona.. è un problema di codice (il sito è stato fatto per windows2000 su aruba c'è windows2003)...
 
Ultima modifica:

lukeonweb

Utente Attivo
5 Mar 2003
5.175
13
38
45
Napoli
www.lucaruggiero.it
Eccomi!

Scusa la domanda, ma se il problema è sul database, cosa c'entra CDOSYS?

Hai spostato il database nella cartella mdb-database? e quindi hai cambiato la stringa di connessione?

Facci sapere ;)
 

graphikart

Nuovo Utente
6 Apr 2008
12
0
0
questo è quello che si trova in connectionstring.inc:

<%
'Conn_ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source="&server.mappath("/mdb-database/ecom.mdb")
Conn_ConnectionString="driver={Microsoft Access Driver (*.mdb)};dbq="&server.mappath("\mdb-database\ecom.mdb")

Set Conn = Server.CreateObject("ADODB.Connection")
'if session("lingua")<>"ITA" or request("lingua")<> "ITA" then
Conn.open Conn_ConnectionString 'session("conn_ita")
'else
' Conn.open session("conn_ing")
'end if

Conn_ConnectionString2 ="driver={Microsoft Access Driver (*.mdb)};dbq="&server.mappath("\mdb-database\AVG_utenti.mdb")
Set Conn2 = Server.CreateObject("ADODB.Connection")
Conn2.open Conn_ConnectionString2
%>


e questo è quello che cè in Global.asa:

<SCRIPT LANGUAGE=VBScript RUNAT=Server>



Sub session_OnStart


'Conn_ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source="&server.mappath("/mdb-database/ecom.mdb")
'Conn_ConnectionString_ING = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source="&server.mappath("/mdb-database/ecom_ing.mdb")
Conn_ConnectionString="driver={Microsoft Access Driver (*.mdb)};dbq="&server.mappath("/mdb-database/ecom.mdb")

'session("conn_ita")=Conn_ConnectionString
'session("Conn_ing")=Conn_ConnectionString_ING
session("conn")=Conn_ConnectionString
'inizializzo session
session("user")=""
session("paswword")=""

' setta il timeout di default 10
Session.Timeout = 10
Application.Lock
Application("ActiveUsers") = Application("ActiveUsers") + 1
Application.UnLock
end sub

Sub session_OnEnd
session("user")=""
session("password")=""
session("conn_ita")=""
session("Conn_ing")=""
session("lingua")=""
' quando il visitatore esce (-1)
Application.Lock
Application("ActiveUsers") = Application("ActiveUsers") - 1
Application.UnLock
end sub

Sub Application_OnStart
Application("ActiveUsers") = 0
End Sub




</SCRIPT>



ho cambiato i percorsi del db... c'è altro da fare??? (cmq questo l'avevo già fatto!!!)
 
Ultima modifica:

lukeonweb

Utente Attivo
5 Mar 2003
5.175
13
38
45
Napoli
www.lucaruggiero.it
Perchè usi la stringa di connessione sia nel file .inc che nel Global.asa?

Il problema lo ricevi in scrittura o anche in lettura?

Cosa c'è scritto alla riga:

/inc/adrot.inc.asp, line 38

che ti da l'errore?
 

graphikart

Nuovo Utente
6 Apr 2008
12
0
0
Perchè usi la stringa di connessione sia nel file .inc che nel Global.asa?

boh... nn lo so (il sito nn l'ho fatto io :crying:)


Il problema lo ricevi in scrittura o anche in lettura?

boh... credo in scrittura


Cosa c'è scritto alla riga: /inc/adrot.inc.asp, line 38 che ti da l'errore?

rsBanner.open QueryUpdateBanner,Conn,1,2
 

lukeonweb

Utente Attivo
5 Mar 2003
5.175
13
38
45
Napoli
www.lucaruggiero.it
Ok, piano piano ci arriviamo :)

La variabile QueryUpdateBanner deve contenere una stringa SQL: me la mostri?

Inoltre, poi, vedremo l'uso dei cursori (1, 2 - non mi piacciono molto).

Fammi sapere!
 

graphikart

Nuovo Utente
6 Apr 2008
12
0
0
premetto che il sito nn lìho fatto io e che sul server dove stava prima funzionava alla grande!

La variabile QueryUpdateBanner deve contenere una stringa SQL: me la mostri?

non so di cosa parli (nn ho conoscenze di asp).. mi dovresti portar per mano!!! :crying:

Inoltre, poi, vedremo l'uso dei cursori (1, 2 - non mi piacciono molto)

ma prima funzionava... (sull'altro server)

grazie...:)
 

lukeonweb

Utente Attivo
5 Mar 2003
5.175
13
38
45
Napoli
www.lucaruggiero.it
Apri il codice della pagina che da errore e cerca un'occorrenza di "QueryUpdateBanner" (senza i doppi apici) e vedi cosa che scritto dopo =

Mi rendo conto che non conosci ASP, ma se non riesci ad aiutarmi ad aiutarti mi sa che posso fare ben poco...
 

graphikart

Nuovo Utente
6 Apr 2008
12
0
0
<!--#include file="connectionstring.inc"-->
<!--#include virtual="/_ini/banner.ini.asp"-->
<%
'Set BanConn = Server.Createobject("ADODB.Connection")
'BanConn.Open ini_DSN_BANNER,"",""

If ZonaBanner <> "" Then
QueryZone = "SELECT * FROM Zona WHERE NomeZona ='" & ZonaBanner & "'"
set RsZone=server.CreateObject("ADODB.recordset")

rsZone.open QueryZone,Conn,1,2
'Set RsZone = Conn.execute(QueryZone)
If NOT RsZone.EOF Then
nZona = RsZone("IDZona")
Else
nZona = Ini_strNomeADROTFileDef
End If
RsZone.Close
Set RsZone = Nothing
Else
nZona = Ini_strNomeADROTFileDef
End If

Set Ad = Server.CreateObject("MSWC.Adrotator")
If Ini_boolADROTBanTarget Then
Ad.TargetFrame = "target=_NEW"
End If

strAdrotFile = ini_strPathADROTFiles & "adrot" & nZona & ".txt"
strBanner = Ad.GetAdvertisement(strAdrotFile)
Response.Write strBanner
numStartNomeBanner = InstrRev(strBanner,"/",Len(strBanner)-4,1)
numEndNomeBanner = Instr(1,strBanner,"ALT=",1)-3
numLungNomeBanner = Len(Left(strBanner,numEndNomeBanner)) - numStartNomeBanner
strNomeBanner = Mid(strBanner, numStartNomeBanner+1, numLungNomeBanner)
QueryUpdateBanner = "UPDATE Banner SET Impression = Impression + 1 WHERE NomeFile ='" & strNomeBanner & "' AND IDZona = " & nZona
set RsBanner=server.CreateObject("ADODB.recordset")
rsBanner.open QueryUpdateBanner,Conn,1,2
'Set RsBanner = Conn.execute(QueryUpdateBanner)
'rsBanner.close
'set rsBanner=nothing
'BanConn.Close
'Set BanConn = Nothing
Session(ini_BANNER_ZONA) = nZona
%>

il conentuto del file che da errore (vedi prima pagina del topic)
 

lukeonweb

Utente Attivo
5 Mar 2003
5.175
13
38
45
Napoli
www.lucaruggiero.it
Ok, come pensavo, la query che quella variabile esegue è un UPDATE che serve ad aggiungere una unità al contatore delle impressions dei banner:

QueryUpdateBanner = "UPDATE Banner SET Impression = Impression + 1 WHERE NomeFile ='" & strNomeBanner & "' AND IDZona = " & nZona

Prova a non usare il recordset ma la connection.

Ti riposto tutto il codic che mi hai scritto modificandolo.

Attenzione: fai una copia del file col codice cosi com'è!!!

Ecco il codice

HTML:
<!--#include file="connectionstring.inc"-->
<!--#include virtual="/_ini/banner.ini.asp"-->
<%
'Set BanConn = Server.Createobject("ADODB.Connection")
'BanConn.Open ini_DSN_BANNER,"",""

If ZonaBanner <> "" Then
QueryZone = "SELECT * FROM Zona WHERE NomeZona ='" & ZonaBanner & "'"
set RsZone=server.CreateObject("ADODB.recordset")

rsZone.open QueryZone,Conn,1,2
'Set RsZone = Conn.execute(QueryZone)
If NOT RsZone.EOF Then
nZona = RsZone("IDZona")
Else
nZona = Ini_strNomeADROTFileDef
End If
RsZone.Close
Set RsZone = Nothing
Else 
nZona = Ini_strNomeADROTFileDef
End If

Set Ad = Server.CreateObject("MSWC.Adrotator")
If Ini_boolADROTBanTarget Then
Ad.TargetFrame = "target=_NEW"
End If

strAdrotFile = ini_strPathADROTFiles & "adrot" & nZona & ".txt"
strBanner = Ad.GetAdvertisement(strAdrotFile)
Response.Write strBanner
numStartNomeBanner = InstrRev(strBanner,"/",Len(strBanner)-4,1)
numEndNomeBanner = Instr(1,strBanner,"ALT=",1)-3
numLungNomeBanner = Len(Left(strBanner,numEndNomeBanner)) - numStartNomeBanner
strNomeBanner = Mid(strBanner, numStartNomeBanner+1, numLungNomeBanner)
QueryUpdateBanner = "UPDATE Banner SET Impression = Impression + 1 WHERE NomeFile ='" & strNomeBanner & "' AND IDZona = " & nZona
Conn.execute(QueryUpdateBanner)
Session(ini_BANNER_ZONA) = nZona
%>

Se ancora non funziona allora insisto: non hai i permessi in scrittura e devi vedere come farteli assegnare.

Fammi sapere.
 

graphikart

Nuovo Utente
6 Apr 2008
12
0
0
Grazie.. provo subito
provo a modificare solo quel file...

cmq i permessi sono tutti ok!!!


grazie
 

graphikart

Nuovo Utente
6 Apr 2008
12
0
0
Luca nn ci capisco più nulla... ho provato a modifcare ma nn mi ha fatto nulla... forse nn era quello il file
ti riposto il tutto...

se vado alla sezione job e provo ad inviare una candidatura compare:

Server object error 'ASP 0177 : 800401f3'

Server.CreateObject Failed

/inc/function.inc, line 31

800401f3


e nella barra degli indirizzi c'è scritto: http://www.biennepi.biz/asp/InsertCollab.asp

ti posto il contenuto del function.inc:
<%
'************Controllo validita indirizzo EMAIL

Function RegExpTest(patrn, strng)
Dim regEx
Set regEx = New RegExp ' Creo una regular Expression
regEx.Pattern = patrn ' Determino il pattern di validazione
regEx.IgnoreCase = True ' E' inutile suonare qui non vi aprirà nessuno (nessuna differenza tra maiuscole e minuscole)
RegExpTest = regEx.Test(strng) ' torna TRUE se la stringa è valida, FALSE se non corrisponde alle caratteristiche richieste

End Function

'****************************************************
sub InvioMail(byval mailserver,byVal Mittente, byVal Destinatario, byVal Titolo, byVal Corpo)

'---Script per CDOSYS
' Dim Mail
' Set Mail = Server.CreateObject("CDOSYS.NewMail")
' Mail.From = Mittente
' Mail.To = Destinatario
' Mail.Subject = Titolo
' Mail.Body = Corpo
' Mail.BodyFormat = 1
' Mail.MailFormat = 1
' On Error Resume Next
' Mail.Send

' Set Mail = Nothing


Set mailer = Server.CreateObject("ASPMAIL.ASPMailCtrl.1")
recipient = destinatario
sender = mittente
subject = titolo
message = corpo
mailserver = "smtp.aruba.it"
result = mailer.XHeader("Content-Type", "text/plain; charset=""iso-8859-1""")
result = mailer.SendMail(mailserver, recipient, sender, subject, message)
End sub

'****************************************************
sub InvioMailEAllegato(byval mailserver,byVal Mittente, byVal Destinatario, byVal Titolo, byVal Corpo, ByVal Allegato)
Set mailer = Server.CreateObject("ASPMAIL.ASPMailCtrl.1")
recipient = destinatario
sender = mittente
subject = titolo
message = corpo
attach = allegato
mailserver = "smtp.aruba.it"
' if attach = "" then
result = mailer.XHeader("Content-Type", "text/plain; charset=""iso-8859-1""")
' result = mailer.SendMail(mailserver, recipient, sender, subject, message)
' else
result = mailer.XHeader("Content-Type", "text/plain; charset=""iso-8859-1""")
result = mailer.SMAttach(mailserver, recipient, sender, subject, message, attach)
' end if
End sub

sub InvioMailHTML(byval mailserver,byVal Mittente, byVal Destinatario, byVal Titolo, byVal Corpo)

'---Script per CDOSYS
'Dim Mail
'Set Mail = Server.CreateObject("CDONTS.NewMail")
'Mail.From = Mittente
'Mail.To = Destinatario
'Mail.Subject = Titolo
'Mail.Body = Corpo
'Mail.BodyFormat = 0
'Mail.MailFormat = 0
'On Error Resume Next
'Mail.Send

'Set Mail = Nothing

Set mailer = Server.CreateObject("ASPMAIL.ASPMailCtrl.1")
recipient = destinatario
sender = mittente
subject = titolo
message = corpo

mailserver = "smtp.aruba.it"
result = mailer.XHeader("Content-Type", "text/plain; charset=""iso-8859-1""")
result = mailer.SendMail(mailserver, recipient, sender, subject, message)




End sub

'*********************controllo se in un file ci sono dei link
Function GetLink(Str)
MoreLink = true
StopPos = 0
var1=0
var2=0
OldStartPos = 0
OldStopPos = 0
TmpStr = ""
While MoreLink
LinkType=""
var1=instr(StopPos + 1, LCase(Str), "http://")
var2=instr(StopPos + 1, LCase(Str), "www")
if var1<>0 and var2<>0 then
if var1<var2 then
StartPos = var1
else
StartPos = var2
end if
else
if var1<var2 then
StartPos=var2
else
StartPos=var1
end if
end if

if StartPos=instr(StopPos + 1, LCase(Str), "www") then
LinkType="http://"
end if
if StartPos > 0 then
var1 = Instr(StartPos, Str, " ")
var2 = Instr(StartPos, Str, vbCrLF)
if var1 <> 0 and var2 <> 0 then
if var1 < var2 then
StopPos = var1
else
StopPos = var2
end if
else
if var1 < var2 then
StopPos = var2
else
StopPos = var1
end if
end if
if StopPos = 0 then
StopPos = Instr(StartPos, Str, vbCrLF)
if StopPos = 0 then
StopPos = Len(Str)
end if
end if
StrLink = Mid(Str, StartPos, StopPos - StartPos + 1)
LenLink = Len(StrLink)
TmpStr = TmpStr & Mid(Str, OldStopPos + 1, StartPos - OldStartPos - 1) & "&nbsp;<a href=" & LinkType & StrLink & " target='_blank'><font color='Blue'>" & StrLink & " </font></a>"
'response.write ("<BR>Zero MoreLink=" & MoreLink & " StartPos=" & StartPos & " StopPos=" & StopPos & " OldStopPos=" & OldStopPos & "<br>" & TmpStr)

OldStartPos = StartPos + LenLink
OldStopPos = StopPos
else
MoreLink = false
end if
wend
'response.write ("<BR>Uno MoreLink=" & MoreLink & " StartPos=" & StartPos & " StopPos=" & StopPos & " OldStopPos=" & OldStopPos & "<br>" & TmpStr)
If TmpStr = "" then
GetLink = Str
else
' response.write("<br>Due OldStopPos=" & OldStopPos & " - ")
GetLink = TmpStr & Mid(Str, OldStopPos + 1)
end if
End Function

'*******************************
'Toglie apice dalle stringhe e lo sostituisce con doppio apice per evitare problemi nelle query
'*******************************
Function formatta(str)
If len(str) >= 1 then
formatta = replace(str,"'","''")
else
formatta = str
end if
end function
'*******************************
'Il contrario di quanto sopra per la visualizzazione
'*******************************
Function Sformatta(str)
if len(str) > 2 then
Sformatta = replace(str,"''", "'")
else
Sformatta = str
end if
End Function


'*********************************
' GESTIONE ERRORE NELLA CANCELLAZIONE RECORD
'*************************************

Function gestione_errore (numerrore)
if numerrore <>0 then
gestione_errore= true
end if
end function

'********************************
'Formatta date
'********************************

Function formattadata(data)
formattadata=year(data)&"/"&month(data)&"/"&day(data)
end function

'*******************************
'Prende i primi NChar caratteri di una stringa senza troncare le parole e aggiunge i puntini di commento
'es "Tutta la gente che è al mondo vive abbastanza bene" con NChar = 10 diventa
' "Tutta la..."
'*******************************
Function ClipString(Str, NChar)
If Len(Str) < NChar then
Nchar = Len(Str)
ClipString = Str
else
NChar = NChar - 3
Str = Left(Str, NChar)
Idx = NChar
Do while Mid(Str, Idx, 1) <> " "
Idx = Idx - 1
if Idx <= 1 then
idx = Nchar
exit do
end if
Loop
ClipString = Left(Str, Idx - 1) & "..."
end if
End Function

Function RicavaMese (numeromese)
select case numeromese
case 1
strmese="Gennaio"
case 2
strmese="Febbraio"
case 3
strmese="Marzo"
case 4
strmese="Aprile"
case 5
strmese="Maggio"
case 6
strmese="Giugno"
case 7
strmese="Luglio"
case 8
strmese="Agosto"
case 9
strmese="Settembre"
case 10
strmese="Ottobre"
case 11
strmese="Novembre"
case 12
strmese="Dicembre"
end select
Ricavamese=strmese
End function
%>


continua dopo...
 

graphikart

Nuovo Utente
6 Apr 2008
12
0
0
... continua da prima

Se invece faccio una registrazione da registrati, compare:

Server object error 'ASP 0177 : 800401f3'

Server.CreateObject Failed

/carrello/include/inc_libreria.asp, line 92

800401f3


e nella barra degli indirizzi:
http://www.biennepi.biz/carrello/aggiungi_utente_dasito.asp

il contenuto del file inc_libreria.asp
<%
'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, Data, Ora, Minuto, Secondo
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 CDOSYS
' Dim Mail
' Set Mail = Server.CreateObject("CDOSYS.NewMail")
' Mail.From = Mittente
' Mail.To = Destinatario
' Mail.Subject = Titolo
' Mail.Body = Corpo
' Mail.BodyFormat = 1
' Mail.MailFormat = 1

' On Error Resume Next
' Mail.Send
' InvioMail = True
' Set Mail = Nothing

'-------Script per ASPMailCtrl.1
Dim mailer, recipient, sender, subject, message, mailserver, result
Set mailer = Server.CreateObject("ASPMAIL.ASPMailCtrl.1")
recipient = destinatario
sender = mittente
subject = titolo
message = corpo
mailserver = servermail
result = mailer.XHeader("Content-Type", "text/plain; charset=""iso-8859-1""")
result = mailer.SendMail(mailserver, recipient, sender, subject, message)
if result="" then
Inviomail=true
else
Inviomail=false
end if

'---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)
if IsNull(VisualizzaPrezzo_StringaPrezzo) then VisualizzaPrezzo_StringaPrezzo = 0 end if
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_StringaPrezzo)

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_StringaDecimale)/(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


'**********Controllo esistenza campo in tabella
sub sub_Ctrlcampo(tabella,campo,valore,criterio,criterio2)
dim rsctrlcampo
dim sql

set rsctrlcampo=server.CreateObject("ADODB.recordset")
sql="Select * from "&tabella&" where "&campo&criterio&trim(valore)&" "&criterio2
'response.write sql
'response.end
rsctrlcampo.open sql,Conn,1,2
if not rsctrlcampo.eof then
response.redirect "errore.asp?Esiste già un elemento con questa "&campo&""
end if
rsctrlcampo.close
set rsctrlcampo=nothing

end sub
'*********************************************
'**************inserimento in tabella

sub sub_Addnewrecord (tabella,tblcampi,valori)
'Set objConn = Server.CreateObject ("ADODB.Connection")
'objConn.Open "driver={Microsoft Access Driver (*.mdb)};dbq="&Server.MapPath (strDB),user,psw
dim sql
dim rs

sql = "insert into " & tabella & " (" & tblcampi & ") values (" & valori & ")"

Application.lock
'response.write sql
'response.end
set RS = Conn.Execute(sql)
Application.unlock

end sub
'***************Modifica record
sub sub_Updaterecord (tabella,tblcampivalore,campowhere)
dim sql
dim rs
sql = "update " & tabella & " set " & tblcampivalore & " where " & campowhere

Application.lock
'response.write sql
'response.end
set RS = Conn.Execute(sql)
Application.unlock

end sub

'**********************************
'*******************************
'Toglie apice dalle stringhe e lo sostituisce con doppio apice per evitare problemi nelle query
'*******************************
Function formatta(str)
If len(str) >= 1 then
formatta = replace(str,"'","''")
else
formatta = str
end if
end function

' ***************************
' formattazzione testo per l'inserimento nel db senza tag htm
' ***************************
Function fn_nohtml(campo)

fn_nohtml = Replace(campo,"""","&quot;")
fn_nohtml = Replace(fn_nohtml,"<","&lt;")
fn_nohtml = Replace(fn_nohtml,">","&gt;")
fn_nohtml = Replace(fn_nohtml,"'","'")

End function

Function ControlloDate(dataA, dataDa)
dim data_dal,data,data_al,Ctrl_data_da,ctrl_data_a
ControlloDate=""
on error resume next 'nel caso si inserisca una data sbagliata
if dataDa ="nodate" then
data_dal=split(dataA,"/")
data=cdate(dataA)
if err.number <>0 or cint(data_dal(1))>12 then
ControlloDate="La data inserita è sbagliata!!!"
end if
else

data_dal=split(dataA,"/")
data_al=split(dataDa,"/")

Ctrl_data_da =day(dataA)& "/" & month(dataA) &"/"& year(dataA)
ctrl_data_a = day(dataDa)& "/" & month(dataDa) &"/"& year(dataDa)


if err.number <>0 or cint(data_dal(1))>12 or cint(data_al(1))>12 then
ControlloDate="Una delle date inserite è sbagliata!!!"
else
if cdate(Ctrl_data_da) > cdate(ctrl_data_a) then
ControlloDate="La data iniziale è maggiore di quella finale!!!"
end if
end if
end if

on error goto 0


end function

'*******************************
'Prende i primi NChar caratteri di una stringa senza troncare le parole e aggiunge i puntini di commento
'es "Tutta la gente che è al mondo vive abbastanza bene" con NChar = 10 diventa
' "Tutta la."
'*******************************
Function ClipString(Str, NChar)
If Len(Str) < NChar then
Nchar = Len(Str)
ClipString = Str
else
ClipString = Left(Str,Nchar) & "."
'NChar = NChar - 3
'Str = Left(Str, NChar)
'Idx = NChar
'Do while Mid(Str, Idx, 1) <> " "
' Idx = Idx - 1
' if Idx <= 1 then
' idx = Nchar
' exit do
' end if
'Loop
'ClipString = Left(Str, Idx - 1) & "."
end if
End Function
'*******************************
%>


Spero di averti dato informazioni necessarie per capire il problema... Tieni conto di quanto scritto in questi due ultimi thread.. grazie un milione
 
Discussioni simili
Autore Titolo Forum Risposte Data
C Microsoft OLE DB Provider for ODBC Drivers error '80040e37' Classic ASP 0
R Microsoft OLE DB Provider for ODBC Drivers error '80004005' Classic ASP 4
B Microsoft OLE DB Provider for ODBC Drivers error '80004005' Classic ASP 7
B Non riesco a trovare i cognomi con i caratteri speciali in Access (Microsoft 365) MS Access 0
G Appicazione HTML per inserimento dai in Database Access Microsoft HTML e CSS 0
L microsoft oauth codeigniter PHP 0
W Microsoft OLE DB Provider for Visual FoxPro error '80040e14' Function name is missing ). Classic ASP 0
W Errore di run-time di Microsoft VBScript error '800a0035' Impossibile trovare il file Classic ASP 0
G PHP e Microsoft Teams: generare link videocall PHP 15
G mettere account posta in Microsoft outlook 2016 di gmail Posta Elettronica 0
ges Microsoft ACCESS oltre ogni limite (tre manuali) Altri Annunci 2
G Con Microsoft Outlook 2016 come si possono cancellare le mail doppie? Posta Elettronica 0
maria_ia Microsoft Access Windows e Software 0
E [ASP.Net] Access 2016 ? Non si usa Microsoft Jet 4.0 ma Engine 2016 o 2010. Non va ! ASP.NET 2
G Non mi arriva più la posta in microsoft outlook 2007 Posta Elettronica 23
Best Engage [Offro] lavoro [Retribuito] sistemista MICROSOFT E VMWARE SENIOR a Roma Offerte e Richieste di Lavoro e/o Collaborazione 0
L microsoft print PDF Windows e Software 18
otto9due Problema installazione "Microsoft Camera Codec Pack (6.3.9721.0)" su win 7 64bit Windows e Software 4
felino Microsoft Excel: somma su un'intera colonna Windows e Software 1
F I titolari di P. IVA, possono usare la versione non commerciale di Microsoft Word? Leggi, Normative e Fisco 0
filippino Microsoft Outlook, IMAP e cancellazione posta Posta Elettronica 0
T [Microsoft SQL Server 2008 (SP3)] log delle transazioni è pieno Database 1
A [CERCO LAVORO] Microsoft .NET - Analista programmatore Offerte e Richieste di Lavoro e/o Collaborazione 0
M Creazione di una videoteca in collegamento fra Access 2003 e Microsoft Visual Web Dev ASP.NET 1
R Microsoft SQL Manager Studio Database 0
F Cercasi System Engineer Microsoft JUNIOR - Torino Altri Annunci 0
F System Engineer Microsoft - Unified Communications Altri Annunci 0
voldemort Microsoft Office for Mac VS. iWork Mac e Software 1
F Assumiamo Sistemista Microsoft Offerte e Richieste di Lavoro e/o Collaborazione 0
F [Retribuito] Cercasi System Engineer Microsoft - Unified Communications Offerte e Richieste di Lavoro e/o Collaborazione 0
F Ricerca Sistemista Microsoft Offerte e Richieste di Lavoro e/o Collaborazione 0
Elychan Cambio password Microsoft Outlook Exchange Web Windows e Software 3
E Job position: Application developer microsoft dynamics ax Offerte e Richieste di Lavoro e/o Collaborazione 0
M anteprima con Microsoft Expression Web HTML e CSS 3
S Fino a quanto durerá il supporto di Microsoft ad ASP? Classic ASP 3
grottafelix Microsoft VBScript compilation error '800a0401' Classic ASP 3
B meta name="Microsoft Border" HTML e CSS 1
G Disponibile Microsoft Windows XP SP3 in italiano Windows e Software 1
D Siti web con Microsoft Visual Web Developer 2005 Express Edition ASP.NET 0
J Microsoft JET Database E+Errore non previsto del driver del database esterno (11265). Classic ASP 4
R Microsoft JET Database Engine error '80040e37' Classic ASP 7
M Che cosa ne pensate di Microsoft Expression? Discussioni Varie 5
T problemi con Microsoft outlook Windows e Software 0
P collegamento ad outlook microsoft Javascript 1
R Creare un file di Microsoft Word con ASP : Testo Ok. E le immagini? Classic ASP 1
N Webcast Microsoft su un prodotto per gestire e controllare l'infrastruttura IT Altri Annunci 1
A Aggiungere templates a Microsoft FrontPage Windows e Software 0
S errore -->microsoft message HTML e CSS 2
claverx Concorso Gatekeeper Test della Microsoft Sicurezza e Virus 0
metalgemini Microsoft JET Database Engine error '80040e37' Classic ASP 2

Discussioni simili