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

graphikart · 6 Apr 2008

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 · 6 Apr 2008

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 · 26 Apr 2008

Ciao Luca pposs piegarti il problema?

lukeonweb · 26 Apr 2008

Certo che puoi

graphikart · 26 Apr 2008

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 · 28 Apr 2008

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 · 28 Apr 2008

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)...

lukeonweb · 28 Apr 2008

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 · 30 Apr 2008

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!!!)

lukeonweb · 30 Apr 2008

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 · 1 Mag 2008

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 · 1 Mag 2008

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 · 3 Mag 2008

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 · 5 Mag 2008

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 · 5 Mag 2008

<%
'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 · 5 Mag 2008

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 · 6 Mag 2008

Grazie.. provo subito
provo a modificare solo quel file...

cmq i permessi sono tutti ok!!!

grazie

graphikart · 7 Mag 2008

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) & " <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 · 7 Mag 2008

... 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,"""",""")
fn_nohtml = Replace(fn_nohtml,"<","<")
fn_nohtml = Replace(fn_nohtml,">",">")
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

graphikart · 14 Mag 2008

:crying::crying::crying::crying::crying:

Nessuna Risposta!!!

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

Nuovo Utente

Utente Attivo

Nuovo Utente

Utente Attivo

Nuovo Utente

MRW Moderator

Nuovo Utente

Utente Attivo

Nuovo Utente

Utente Attivo

Nuovo Utente

Utente Attivo

Nuovo Utente

Utente Attivo

Nuovo Utente

Utente Attivo

Nuovo Utente

Nuovo Utente

Nuovo Utente

Nuovo Utente

Discussioni simili