Erro ODBC

[Marcelino 1]

Ola, pessoal todas os scripts que baixo e tento ver aqui não consui que eles executem corretamente sempre mostra esse erro abaixo o que fazer.

----------------------------------------------------

Tipo de erro:

Microsoft OLE DB Provider for ODBC Drivers (0x80004005)

[Microsoft][Driver ODBC para Microsoft Access] A operação deve usar uma consulta atualizável.

aqui mostra diretoria e linha de erro

 

Aguadeço quem poder me ajudar.

[Libos 0]

Qual o sistema operacional que você está usando ? XP?

[Mário Monteiro 179]

posta o codigo que você esta utilizando para conectar com o bd

[Marcelino 1]

Eu uso o Win2000 PRO.

 

O o do estou fazendo é esse abaixo mais esse erro ocoreu com todos os que tentão acessar o banco para fazer registro, pois envie o mesmo Scrpt para um Servidor(Mural) Gratuito e pegou legal. mais aqui!!....

 

<%

'/////////////////////////////////////////////////////

' Guestbook database

' format parameters

'/////////////////////////////////////////////////////

dim gb_db

dim gb_colorHead, gb_colorMessage, gb_fontText, gb_fontEnd, gb_fontTool, gb_fontHead

dim gb_pageSeparator,gb_pageSeparatorLong

gb_pageSeparator=" "

gb_pageSeparatorLong=" ... "

gb_colorHead="666666"

gb_colorMessage="666666"

gb_fontHead="<FONT SIZE=1 FACE=Verdana,sans-serif COLOR=white>"

gb_fontText="<FONT SIZE=2 FACE=Verdana,sans-serif COLOR=navy>"

gb_fontTool="<FONT SIZE=1 FACE=Verdana,sans-serif COLOR=navy>"

gb_fontEnd="</FONT>"

 

sub gb_SendMail(strFrom,strTo,strSubject,strBody) ' Uses CDONTS.NewMail object to send mail

dim mail

set mail=Server.CreateObject("CDONTS.NewMail")

mail.From=strFrom

mail.To=strTo

mail.Subject=strSubject

mail.Body=strBody

mail.Send

set mail=nothing

end sub

 

dim gb_aMonth(12)

gb_aMonth(1)="Janeiro"

gb_aMonth(2)="Fevereiro"

gb_aMonth(3)="Março"

gb_aMonth(4)="Abril"

gb_aMonth(5)="Maio"

gb_aMonth(6)="Junnho"

gb_aMonth(7)="Julho"

gb_aMonth(8)="Agosto"

gb_aMonth(9)="Setembro"

gb_aMonth(10)="Outubro"

gb_aMonth(11)="Novembro"

gb_aMonth(12)="Dezembro"

function gb_show_datetime(dt) ' show date and time

dim s

s=day(dt) & "." & gb_aMonth(month(dt)) & "." & year(dt) & " "

dim sm

sm=":" & minute(dt)

if len(sm)=2 then sm=":0" & minute(dt)

s=s & hour(dt) & sm

gb_show_datetime=s

end function

 

function gb_encode_html(str) ' like Server.HTMLEncode(...)

str=replace(str,"&","&")

str=replace(str,"<","<")

str=replace(str,">",">")

str=replace(str,"""",""")

gb_encode_html=str

end function

 

function gb_SQLDATE(d) ' make "#year/month/day#" from date

dim strYear,strMonth,strDay

strYear = CStr(Year(d))

strMonth = CStr(Month(d))

if Month(d) < 10 then

strMonth = "0" & strMonth

end if

strDay = CStr(Day(d))

if Day(d) < 10 then

strDay = "0" & strDay

end if

SQLDATE="#" & strYear & "/" & strMonth & "/" & strDay & "#"

end function

 

function gb_doCode(str, oTag, cTag, roTag, rcTag) ' replace guestbook codes

dim i,cnt,p,tmp,tmp1,url

dim tx,t

tx = split(str, cTag)

t = ""

for i = 0 to ubound(tx)

if lcase(oTag) = "[a]" then

p = instr(1, tx(i), "[a]", 1)

if p <> 0 then

tmp = mid(tx(i), p)

url = mid(tmp, 4)

if instr(1,url,":")>0 then

tmp1 = Replace(tmp, "[a]"&url, "<A HREF=""" & url & """ TARGET=_Blank>" & gb_fontText & url & gb_fontEnd & "</A>", 1, -1, 1)

else

tmp1 = Replace(tmp, "[a]"&url, "<A HREF=""http://" & url & """ TARGET=_Blank>" & gb_fontText & url & gb_fontEnd & "</A>", 1, -1, 1)

end if

t =t & Replace(tx(i), tmp, tmp1)

else

t = t & tx(i)

end if

else

cnt = instr(1,tx(i), oTag,1)

select case cnt

case 0

t=t&tx(i) & " "

case else

t = t & Replace(tx(i), oTag, roTag,1,1,1)

't = t & " " & rcTag & " "

t = t & rcTag

end select

end if

next

gb_doCode = t

end function

 

Function gb_smile(s) ' replace smiles

dim rsIcons

set rsIcons=gb_db.Execute("SELECT * FROM icons")

while not rsIcons.EOF

dim strIcon

strIcon="<IMG SRC=""" & rsIcons("icon_url") & """ WIDTH=" & rsIcons("icon_width") & " HEIGHT=" & rsIcons("icon_height") & " ALIGN=absmiddle>"

s = replace(s, rsIcons("icon_code"), strIcon)

rsIcons.MoveNext

wend

rsIcons.Close

set rsIcons=nothing

gb_smile = s

End function

 

Function gb_chkString(str)

if str = "" then

gb_chkString=""

exit function

End If

 

dim rsAdmin

set rsAdmin=gb_db.Execute("SELECT * FROM admin")

 

if rsAdmin("allow_codes") then

str = gb_doCode(str, "[a]", "[/a]", "<A>", "</A>")

str = gb_doCode(str, "", "", "<B>", "</B>")

str = gb_doCode(str, "", "", "<I>", "</I>")

str = gb_doCode(str, "[c]", "[/c]", "<CENTER>", "</CENTER>")

str = gb_doCode(str, "

", "

", "<PRE>", "</PRE>")

end if

 

if rsAdmin("allow_icons") then

str=gb_smile(str)

end if

rsAdmin.Close

set rsAdmin=nothing

 

' Replace CR & LF with <BR>

str = Replace(str, vbCrLf,"<BR>")

str = Replace(str, vbCr,"<BR>")

str = Replace(str, vbLf,"<BR>")

 

gb_chkString = str

End Function

 

sub gb_Write(byref s,s1)

s=s+gb_fontText & s1 & gb_fontEnd

end sub

 

sub gb_Write1(byref s,s1)

s=s+gb_fontHead & s1 & gb_fontEnd

end sub

 

sub gb_Write2(byref s,s1)

s=s+gb_fontTool & s1 & gb_fontEnd

end sub

 

function gb_GetUrl

dim url

url="http://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL")

gb_GetUrl=url

end function

 

function gb_redirectToView(bUsePage)

dim url

url=gb_GetUrl

if bUsePage And Request.QueryString("page")<>"" then url=url & "?page=" & Request.QueryString("page")

Response.Redirect(url)

Response.Flush

Response.End

end function

 

Function gb_removeRecord

gb_db.Execute("DELETE * FROM gb WHERE id=" & Request.QueryString("id"))

gb_redirectToView true

gb_removeRecord=""

end Function

 

Function gb_editRecord

dim s

s=""

dim r

set r=gb_db.Execute("SELECT * FROM gb WHERE id=" & Request.QueryString("id"))

 

if not r.EOF then

s=s & "<FORM ACTION=""" & gb_GetUrl() & "?action=update&id=" & r("id") & """ METHOD=post NAME=edit>"

s=s & "<TABLE CELLPADDING=2 CELLSPACING=0>"

s=s & "<TR><TD ALIGN=center COLSPAN=2>"

gb_Write2 s,"<BIG><B>Editar Mensagem<B></BIG>"

s=s & "</TD></TR>"

s=s & "<TR><TD VALIGN=top ALIGN=right>"

gb_Write2 s,"Nome:"

s=s & "</TD><TD><INPUT TYPE=text VALUE=""" & gb_encode_html(r("name")) & """ SIZE=10 NAME=name>"

s=s & "</TD></TR>"

 

s=s & "<TR><TD VALIGN=top ALIGN=right>"

gb_Write2 s,"Para:"

s=s & "</TD><TD><INPUT TYPE=text VALUE=""" & gb_encode_html(r("to")) & """ SIZE=10 NAME=to>"

s=s & "</TD></TR>"

 

s=s & "<TR><TD VALIGN=top ALIGN=right>"

gb_Write2 s,"E-mail:"

s=s & "</TD><TD><INPUT TYPE=text VALUE=""" & gb_encode_html(r("email")) & """ SIZE=10 NAME=email>"

s=s & "</TD></TR>"

 

s=s & "<TR><TD VALIGN=top ALIGN=right>"

gb_Write2 s,"Mensagem:"

s=s & "</TD><TD><TEXTAREA ROWS=7 COLS=30 NAME=text>" & r("text1") & "</TEXTAREA>"

s=s & "</TD></TR>"

 

s=s & "<TR><TD VALIGN=top ALIGN=right>"

gb_Write2 s,"Resposta:"

s=s & "</TD><TD><TEXTAREA ROWS=7 COLS=30 NAME=resp>" & r("resp") & "</TEXTAREA>"

s=s & "</TD></TR>"

 

s=s & "<TR><TD ALIGN=center COLSPAN=2><INPUT TYPE=submit VALUE=Atualizar>"

s=s & "</TABLE>"

s=s & "</FORM>"

end if

 

r.Close

set r=nothing

 

gb_editRecord=s

end Function

 

Function gb_addRecord

dim s

s=""

 

s=s & "<FORM ACTION=""" & gb_GetUrl() & "?action=submit"" METHOD=post id=form1 name=form1>"

s=s & "<TABLE WIDTH=400 BORDER=0 CELLPADDING=0 CELLSPACING=3>"

s=s & "<TR><TD COLSPAN=2 ALIGN=center><DIV STYLE=""margin: 10"">"

gb_Write2 s,"<A HREF=""" & gb_GetUrl() & """><B>Ver mensagens</B></A> * <A HREF=""" & gb_GetUrl() & "?action=help""><B>Ajuda</B></A>"

s=s & "</TD></TR>"

s=s & "<TR><TD ALIGN=center COLSPAN=2><EM>"

gb_Write2 s,"Por favor, preencha os campos abaixo"

s=s & "</EM></TD></TR>"

s=s & "<TR><TD VALIGN=top ALIGN=right>"

gb_Write2 s,"Nome:"

s=s & "</TD>"

s=s & "<TD><INPUT TYPE=text SIZE=20 NAME=name></TD></TR>"

s=s & "<TR><TD VALIGN=top ALIGN=right>"

gb_Write2 s,"E-mail:"

s=s & "</TD>"

s=s & "<TD><INPUT TYPE=text SIZE=20 NAME=email></TD></TR>"

s=s & "<TR><TD VALIGN=top ALIGN=right>"

gb_Write2 s,"Para:"

s=s & "</TD>"

s=s & "<TD><INPUT TYPE=text SIZE=20 NAME=to></TD></TR>"

s=s & "<TR><TD VALIGN=top ALIGN=right>"

gb_Write2 s,"Mensagem:"

s=s & "</TD>"

s=s & "<TD><TEXTAREA NAME=text ROWS=7 COLS=30 WRAP=soft></TEXTAREA></TD></TR>"

s=s & "<TR><TD COLSPAN=2 ALIGN=center>"

s=s & "<INPUT TYPE=submit VALUE=""Enviar"">"

s=s & "<INPUT TYPE=reset VALUE=""Limpar"">"

s=s & "</TD></TR>"

s=s & "</TABLE></FORM>"

 

gb_addRecord=s

end Function

 

Function gb_submitRecord(bSendNotify,strEmail)

if len(Request.Form("name"))=0 or len(Request.Form("text"))=0 then

gb_submitRecord="<H5>Erro em campos:('nome' ou 'texto')=0</H5>"

else

dim r

set r=Server.CreateObject("ADODB.RecordSet")

r.Open "SELECT * FROM gb",gb_db,,3

r.AddNew

r("date1")=now()

r("name")=mid(Request.Form("name"),1,50)

r("to")=mid(Request.Form("to"),1,50)

r("email")=mid(Request.Form("email"),1,100)

r("text1")=mid(Request.Form("text"),1,4096)

if bSendNotify then

dim strBody

strBody=gb_show_datetime(r("date1")) & vbCrLf

strBody=strBody & "De: " & r("name") & "(" & r("email") & ") Para: " & r("to") & vbCrLf

strBody=strBody & r("text1")

gb_SendMail "nobody@nowhere",strEmail,"GuestBook notification",strBody

end if

r.Update()

r.Close

set r=nothing

 

gb_redirectToView false

gb_submitRecord=""

end if

end Function

 

Function gb_updateRecord

dim r

set r=Server.CreateObject("ADODB.RecordSet")

 

r.Open "SELECT * FROM gb WHERE id=" & Request.QueryString("id"),gb_db,,3

r("name")=mid(Request.Form("name"),1,50)

r("to")=mid(Request.Form("to"),1,50)

r("email")=mid(Request.Form("email"),1,100)

r("text1")=mid(Request.Form("text"),1,4096)

r("resp")=mid(Request.Form("resp"),1,4096)

r.Update()

 

r.Close

set r=nothing

 

gb_redirectToView true

gb_updateRecord=""

end Function

 

Function gb_invokeHelp(bAllowCodes,bAllowIcons)

dim s

s=""

s=s & "<CENTER>"

gb_Write2 s,"<A HREF=""" & gb_GetUrl() & """><B>Ver mensagens</B></A> * <A HREF=""" & gb_GetUrl & "?action=sign""><B>Criar mensagem</B></A>" & gb_fontEnd

s=s & "<BR><BR>"

if bAllowCodes then

gb_Write s,"<BIG><B>Códigos do Mural</B></BIG>"

s=s & "</CENTER>"

s=s & "<TABLE WIDTH=100% CELLPADDING=2 CELLSPACING=2>"

s=s & "<TR><TD COLSPAN=2>"

gb_Write2 s,"<B>Comandos de texto:</B>"

s=s & "</TD></TR>"

 

s=s & "<TR BGCOLOR=" & gb_colorHead & ">"

s=s & "<TD>"

gb_Write1 s,"Formatação"

s=s & "</TD><TD>"

gb_Write1 s,"Descrição"

s=s & "</TD></TR>"

 

s=s & "<TR BGCOLOR=" & gb_colorMessage & ">"

s=s & "<TD>"

gb_Write s,"<B>[a]</B>url<B>[/a]</B>"

s=s & "</TD><TD>"

gb_Write s,"Insere eum hyperlink"

s=s & "</TD></TR>"

 

s=s & "<TR BGCOLOR=" & gb_colorMessage & ">"

s=s & "<TD>"

gb_Write s,"<B></B>text<B></B>"

s=s & "</TD><TD>"

gb_Write s,"Colaca em negrito"

s=s & "</TD></TR>"

 

s=s & "<TR BGCOLOR=" & gb_colorMessage & ">"

s=s & "<TD>"

gb_Write s,"<B></B>text<B></B>"

s=s & "</TD><TD>"

gb_Write s,"Colaca em itálico"

s=s & "</TD></TR>"

 

s=s & "<TR BGCOLOR=" & gb_colorMessage & ">"

s=s & "<TD>"

gb_Write s,"<B>

</B>text<B>

</B>"

s=s & "</TD><TD>"

gb_Write s,"Coloca em code (<pre> tag)"

s=s & "</TD></TR>"

 

s=s & "</TABLE><BR>"

end if

 

if bAllowIcons then

s=s & "<TABLE WIDTH=100% CELLPADDING=2 CELLSPACING=2>"

s=s & "<TR><TD COLSPAN=3>"

gb_Write2 s,"<B>Emoticons:</B>"

s=s & "</TD></TR>"

s=s & "<TR BGCOLOR=" & gb_colorHead & ">"

s=s & "<TD>"

gb_Write1 s,"Icone"

s=s & "</TD><TD>"

gb_Write1 s,"Código"

s=s & "</TD><TD WIDTH=100%" & ">"

gb_Write1 s,"Descrição"

s=s & "</TD></TR>"

 

dim rsIcons

set rsIcons=gb_db.Execute("SELECT * FROM icons")

while not rsIcons.EOF

dim strIcon

strIcon="<IMG SRC=""" & rsIcons("icon_url") & """ WIDTH=" & rsIcons("icon_width") & " HEIGHT=" & rsIcons("icon_height") & ">"

s=s & "<TR BGCOLOR=" & gb_colorMessage & ">"

s=s & "<TD ALIGN=center>"

s=s & strIcon

s=s & "</TD><TD ALIGN=center>"

gb_Write s,rsIcons("icon_code")

s=s & "</TD><TD WIDTH=100%" & ">"

gb_Write s,rsIcons("icon_description")

s=s & "</TD></TR>"

rsIcons.MoveNext

wend

rsIcons.Close

set rsIcons=nothing

s=s & "</TABLE>"

end if

 

if not bAllowCodes and not bAllowIcons then

s=s & "<CENTER><B>"

gb_Write2 s,"<BIG>Guestbook codes and smiles are disabled</BIG>"

s=s & "</B></CENTER>"

end if

gb_invokeHelp=s

end Function

 

sub gb_pageNav(s,page,current_page)

if current_page=page then

s=s & "<B>" & page & "</B>"

else

s=s & "<A HREF=""" & gb_GetUrl() & "?page=" & page & """>" & page & "</A>"

end if

end sub

 

Function gb_viewAll(bAdmin,nPageSize)

dim s

 

s=s & "<TABLE WIDTH=100% BORDER=0 CELLPADDING=2 CELLSPACING=0>"

 

s=s & "<TR><TD ALIGN=center COLSPAN=3><BR>"

gb_Write2 s,"<A HREF=""" & gb_GetUrl & "?action=sign""><B>Escrever no Mural</B></A>" & gb_fontEnd

s=s & "<BR> </TD></TR>"

 

dim r

set r=Server.CreateObject("ADODB.Recordset")

' count records

r.Open "SELECT count(id) as r_c FROM gb",gb_db

dim TotalRecords

TotalRecords=r("r_c")

r.Close

 

dim max_page,page

max_page=TotalRecords\nPageSize

if TotalRecords mod nPageSize>0 then max_page=max_page+1

page=CLng(Request.QueryString("page"))

if page<1 then page=1

if page>max_page then

page=max_page

end if

 

dim first_record

first_record=(page-1)*nPageSize

 

r.Open "SELECT * FROM gb ORDER BY date1 DESC,id DESC",gb_db

 

while first_record>0 and not r.EOF

r.MoveNext

first_record=first_record-1

wend

 

if r.EOF then

s=s & "<TR BGCOLOR=" & gb_colorHead & "><TD ALIGN=center COLSPAN=3>"

gb_Write1 s,"Não há mensagens gravadas no momento."

s=s & "</TD></TR>"

end if

while not r.EOF and nPageSize>0

nPageSize=nPageSize-1

s=s & "<TR BGCOLOR=" & gb_colorHead & ">"

s=s & "<TD VALIGN=top>"

gb_Write1 s,gb_show_datetime(r("date1"))

s=s & "</TD>"

s=s & "<TD WIDTH=50% VALIGN=top>"

s=s & "<TABLE WIDTH=100% CELLSPACING=0 CELLPADDING=0>"

s=s & "<TR><TD ALIGN=right>"

gb_Write1 s,"From: " & gb_encode_html(r("name"))

s=s & "</TD></TR>"

if r("email")<>"" then

s=s & "<TR><TD ALIGN=right><A HREF=""mailto:" & gb_encode_html(r("email")) & """>"

gb_Write1 s,r("email")

s=s & "</A>"

s=s & "</TD></TR>"

end if

s=s & "</TABLE>"

s=s & "</TD>"

s=s & "<TD WIDTH=50% ALIGN=right VALIGN=top>"

if len(r("to"))>0 then

gb_Write1 s,"To: " & gb_encode_html(r("to"))

else

gb_Write1 s,"To: All"

end if

s=s & "</TD></TR>"

' Message

s=s & "<TR BGCOLOR=" & gb_colorMessage & ">"

s=s & "<TD COLSPAN=3>"

gb_Write s,gb_chkString(gb_encode_html(r("text1")))

s=s & "</TD></TR>"

' Response

dim s_resp

s_resp=r("resp")

if Len(s_resp)>0 then

s=s & "<TR BGCOLOR=" & gb_colorHead & ">"

s=s & "<TD COLSPAN=3>"

gb_Write1 s,"Reply:"

s=s & "</TD></TR>"

s=s & "<TR BGCOLOR=" & gb_colorMessage & ">"

s=s & "<TD COLSPAN=3>"

gb_Write s,gb_chkString(gb_encode_html(s_resp))

s=s & "</TD></TR>"

end if

' End of record

s=s & "<TR>"

s=s & "<TD STYLE=""margin: 2"" COLSPAN=3 ALIGN=center>"

s=s & gb_fontTool

if bAdmin then

s=s & "|"

s=s & "<A HREF=""" & gb_GetUrl() & "?action=remove&id=" & r("id") & """>apagar</a>"

s=s & "--"

s=s & "<A HREF=""" & gb_GetUrl() & "?action=edit&id=" & r("id") & """>editar</a>"

s=s & "|"

else

s=s & "***"

end if

s=s & gb_fontEnd

s=s & "</TD></TR>"

r.MoveNext

wend

 

s=s & "</TABLE>"

r.Close

set r=nothing

 

if max_page>1 then

s=s & "<CENTER>" & gb_fontTool & "Pages: "

dim i

if max_page<=10 then

for i=1 to max_page

gb_pageNav s,i,page

if i<max_page then s=s & gb_pageSeparator

next

elseif page<=6 then

for i=1 to 9

gb_pageNav s,i,page

if i<9 then s=s & gb_pageSeparator

next

s=s & gb_pageSeparatorLong

gb_pageNav s,max_page,page

elseif page>=max_page-5 then

gb_pageNav s,1,page

s=s & gb_pageSeparatorLong

for i=max_page-8 to max_page

gb_pageNav s,i,page

if i<max_page then s=s & gb_pageSeparator

next

else

gb_pageNav s,1,page

s=s & gb_pageSeparatorLong

for i=page-4 to page+4

gb_pageNav s,i,page

if i<page+4 then s=s & gb_pageSeparator

next

s=s & gb_pageSeparatorLong

gb_pageNav s,max_page,page

end if

s=s & "" & gb_fontEnd & "</CENTER>"

end if

 

gb_viewAll=s

end Function

 

function gb_adminPage(bAdmin)

dim s

s=""

s=s & "<CENTER>"

gb_Write2 s,"<A HREF=""" & gb_GetUrl() & """><B>Ver mensagens</B></A> * <A HREF=""" & gb_GetUrl & "?action=sign""><B>Criar mensagem</B></A>" & gb_fontEnd

s=s & "<BR><BR>"

s=s & "<FORM METHOD=post ACTION=""" & gb_GetUrl() & "?action=admin"">"

s=s & "<TABLE CELLPADDING=2>"

if bAdmin then

dim rsAdmin

set rsAdmin=gb_db.Execute("SELECT * FROM admin")

 

s=s & "<TR><TD ALIGN=right>"

gb_Write2 s,"Nova Senha:"

s=s & "</TD><TD>"

s=s & "<INPUT TYPE=password NAME=new_password>"

s=s & "</TD></TR>"

 

s=s & "<TR><TD ALIGN=right>"

gb_Write2 s,"Permitir Codigos:"

s=s & "</TD><TD>"

if rsAdmin("allow_codes") then

s=s & "<SELECT NAME=allow_codes SIZE=1><OPTION VALUE=true SELECTED>Yes<OPTION VALUE=false>No</SELECT>"

else

s=s & "<SELECT NAME=allow_codes SIZE=1><OPTION VALUE=true>Yes<OPTION VALUE=false SELECTED>No</SELECT>"

end if

s=s & "</TD></TR>"

 

s=s & "<TR><TD ALIGN=right>"

gb_Write2 s,"Permitir ícones:"

s=s & "</TD><TD>"

if rsAdmin("allow_icons") then

s=s & "<SELECT NAME=allow_icons SIZE=1><OPTION VALUE=true SELECTED>Yes<OPTION VALUE=false>No</SELECT>"

else

s=s & "<SELECT NAME=allow_icons SIZE=1><OPTION VALUE=true>Yes<OPTION VALUE=false SELECTED>No</SELECT>"

end if

s=s & "</TD></TR>"

 

s=s & "<TR><TD ALIGN=right>"

gb_Write2 s,"Registro por página"

s=s & "</TD><TD>"

s=s & "<INPUT TYPE=text NAME=page_size VALUE=""" & rsAdmin("page_size") & """>"

s=s & "</TD></TR>"

 

s=s & "<TR><TD ALIGN=right>"

gb_Write2 s,"Enviar Noticicação:"

s=s & "</TD><TD>"

if rsAdmin("send_notify") then

s=s & "<SELECT NAME=send_notify SIZE=1><OPTION VALUE=true SELECTED>Yes<OPTION VALUE=false>No</SELECT>"

else

s=s & "<SELECT NAME=send_notify SIZE=1><OPTION VALUE=true>Yes<OPTION VALUE=false SELECTED>No</SELECT>"

end if

s=s & "</TD></TR>"

 

s=s & "<TR><TD ALIGN=right>"

gb_Write2 s,"Notificar E-mail:"

s=s & "</TD><TD>"

s=s & "<INPUT TYPE=text NAME=email VALUE=""" & rsAdmin("email") & """>"

s=s & "</TD></TR>"

 

s=s & "<TR><TD ALIGN=center COLSPAN=2>"

s=s & "<INPUT TYPE=submit VALUE=Update>"

 

rsAdmin.Close

set rsAdmin=nothing

else

s=s & "<TR><TD>"

gb_Write2 s,"Senha:"

s=s & "</TD><TD>"

s=s & "<INPUT TYPE=password NAME=password>"

s=s & "</TD></TR>"

s=s & "<TR><TD ALIGN=center COLSPAN=2>"

s=s & "<INPUT TYPE=submit VALUE=Logar>"

end if

s=s & "</TD></TR></TABLE>"

s=s & "</FORM>"

gb_adminPage=s

end function

 

'//////////////////////////////////////////////////////

' Main guestbook routine. Returns whole html coded

' guestbook as a result.

' Parameters:

' src = guestbook database connection string

'//////////////////////////////////////////////////////

function gb_init(src)

'on error resume next

dim action

action=Request.QueryString("action")

 

set gb_db= Server.CreateObject("ADODB.Connection")

gb_db.Open(src)

dim r

set r=Server.CreateObject("ADODB.RecordSet")

' begin processing

dim bAdmin

dim nMaxRecords

 

' store password in session object

if Request.Form("password")<>"" then

Session("password")=Request.Form("password")

action="admin"

end if

 

bAdmin=false

 

' Check admin rights & change password

r.Open "SELECT * FROM admin",gb_db,,3 ' only one record in this table

if Session("password")=r("password") then bAdmin=true ' check password

if action="admin" and bAdmin then

dim bUpdate

bUpdate=false

if Request.Form("new_password")<>"" then ' change admin password

r("password")=Request.Form("new_password")

Session("password")=Request.Form("new_password")

bUpdate=true

end if

if Request.Form("allow_codes")<>"" then

r("allow_codes")=Request.Form("allow_codes")

bUpdate=true

end if

if Request.Form("allow_icons")<>"" then

r("allow_icons")=Request.Form("allow_icons")

bUpdate=true

end if

if Request.Form("page_size")<>"" then

r("page_size")=Request.Form("page_size")

bUpdate=true

end if

if Request.Form("send_notify")<>"" then

r("send_notify")=Request.Form("send_notify")

bUpdate=true

end if

if Request.Form("email")<>"" then

r("email")=Request.Form("email")

bUpdate=true

end if

if bUpdate then

r.Update()

end if

end if

' Load maximum records per page value

nMaxRecords=r("page_size")

 

' process action

select case action

case "remove"

if bAdmin then

gb_init=gb_removeRecord

else

gb_init=gb_viewAll(bAdmin,nMaxRecords)

end if

case "edit"

if bAdmin then

gb_init=gb_editRecord

else

gb_init=gb_viewAll(bAdmin,nMaxRecords)

end if

case "sign"

gb_init=gb_addRecord

case "submit"

gb_init=gb_submitRecord(r("send_notify"),r("email"))

case "admin"

gb_init=gb_adminPage(bAdmin)

case "update"

if bAdmin then

gb_init=gb_updateRecord

else

gb_init=gb_viewAll(bAdmin,nMaxRecords)

end if

case "help"

gb_init=gb_invokeHelp(r("allow_codes"),r("allow_icons"))

case else

gb_init=gb_viewAll(bAdmin,nMaxRecords)

end select

' Close admin recordset

r.Close

 

' cleanup and exit

set r=nothing

gb_db.Close()

set gb_db=nothing

end function

%>

[rjunior 0]

Da uma olhada nisso cara...

 

 

http://support.microsoft.com/default.aspx?...b;EN-US;q306269

[Marcelino 1]

Valew Junior, aqui tem uma dicas legais, vou dar uma checada aqui e depois eu respondo se não resolver meu problema.Pois até onde li, parte de permições necesarias para acessar o banco eu já tinha definido tudo corretamente mais vou averiguar, caso faltou alguma coisa.