Erro ao entrar na página

[Flecha]

Olá

Mandei uma página publicando um Banco de dados do Access

Criei o programa pelo ASPRUNNERPRO

Ná máquina local ele roda direitinho e no servidor não.

Não sei o que é esse erro e não abre a página.

ERRO

Server object error 'ASP 0177 : 800401f3'

Server.CreateObject Failed

/_____19_/flecha/novo/libs/xtempl.asp, line 122

800401f3

O arquivo do erro

<%

class XTempl

    public xt_vars
    private xt_stack
    private template
    private fetch_mode
    private strout
    
Private Sub Class_Initialize()
    set xt_vars=CreateObject("Scripting.Dictionary")
    set xt_stack=CreateObject("Scripting.Dictionary")
    xt_stack.Add 0,xt_vars
    fetch_mode=false
    
    dim arrHeader
    set arrHeader = CreateObject("Scripting.Dictionary")
    arrHeader("file")="include/header.asp"
    assign_function "header","xt_include",arrHeader
    dim arrFooter
    set arrFooter = CreateObject("Scripting.Dictionary")
    arrFooter("file")="include/footer.asp"
    assign_function "footer","xt_include",arrFooter
    dim arrEmpty
    set arrEmpty = CreateObject("Scripting.Dictionary")
    assign_function "event","xt_doevent",arrEmpty
    assign_function "label","xt_label",arrEmpty
    assign_function "caption","xt_caption",arrEmpty
End Sub

Public sub assign(name,val)
    if xt_vars.Exists(name) then _
        xt_vars.Remove(name)
    xt_vars.Add name,val
end sub

Public sub assign_section(name,strbegin,strend)
    dim arr
    set arr = CreateObject("Scripting.Dictionary")
    arr("begin")=strbegin
    arr("end")=strend
    assign name,arr
end sub

public sub assign_loopsection(name,data)
    dim arr
    set arr = CreateObject("Scripting.Dictionary")
    arr.Add "data",data
    assign name,arr
end sub


public sub assign_function(name,func,params)
    dim arr
    set arr = CreateObject("Scripting.Dictionary")
    arr("func")=func
    arr.Add "params",params
    assign name,arr
end sub

private sub xt_getvar(name,var)
    dim i
    for i=1 to xt_stack.Count
        if xt_stack(xt_stack.Count-i).Exists(name) then
            if vartype(xt_stack(xt_stack.Count-i)(name))<>9 then
                var = xt_stack(xt_stack.Count-i)(name)
            else
                set var = xt_stack(xt_stack.Count-i)(name)
            end if
            if vartype(var)=11 then
                if not var then var=null
            end if
            exit sub
        end if
    next
    var=null
end sub

public function fetch_loaded(filtertag)
        fetch_mode=true
        strout=""
        display_loaded(filtertag)
        fetch_mode=false
        fetch_loaded=strout
end function

public function fetch_loaded_before(filtertag)
        dim pos1,str
        pos1=instr(template,"{BEGIN " & filtertag & "}")
        if pos1=0 then 
            fetch_loaded_before=""
            exit function
        end if
        str=mid(template,1,pos1)
        fetch_mode=true
        xt_process_template(str)
        fetch_mode=false
        fetch_loaded_before=strout
end function

public function fetch_loaded_after(filtertag)
        dim pos2,str
        pos2=instr(template,"{END " & filtertag & "}")
        if pos=0 then 
            fetch_loaded_after=""
            exit function
        end if
        str=mid(template,pos2+len("{END " & filtertag & "}"))
        fetch_mode=true
        xt_process_template(str)
        fetch_mode=false
        fetch_loaded_after=strout
end function

public sub load_template(filename)

    Dim Filepath
    Filepath = Server.MapPath("templates\" & Filename)    
    dim stream

    set stream=Server.CreateObject("ADODB.Stream")
    stream.CharSet=cCharset
    stream.type=2
    stream.Open
    stream.LoadFromFile Filepath

    template = stream.ReadText
    stream.Close
    set stream=nothing
end sub

public function display_loaded(filtertag)
    dim str,pos1,pos2,pos,endpos
    str=template
    if filtertag<>"" then
        pos1=instr(1,template,"{BEGIN " & filtertag & "}")
        pos2=instr(1,template,"{END " & filtertag & "}")
            if pos1=0 or pos2=0 then _
                exit function
            pos2 = pos2+len("{END " & filtertag & "}")
            str = mid(template,pos1,pos2-pos1)
    end if
    xt_process_template(str)
end function

public function display(filename)
    load_template(filename)
    xt_process_template(template)
end function
    
private sub print(str)
    if not fetch_mode then
        response.write str
    else
        strout = strout & str
    end if
end sub

public sub xt_process_template(str)
'    parse template file tag by tag
    dim strlen,pos,section,var,message,endpos,endpos1,endtag,start
    start=1
    strlen = len(str)
    dim continue
    do
    do
        continue=false
        pos = instr(start,str,"{")
        if pos=0 then
            print mid(str,start,strlen-start+1)
            exit do
        end if
        section=false
        var=null
        message=false
        if mid(str,pos+1,6)="BEGIN " then
            section=true
        elseif mid(str,pos+1,1)="$" then
            var=true
        elseif mid(str,pos+1,14)="mlang_message " then
            message=true
        else
'    no tag, just '{' char
            print mid(str,start,pos-start+1)
            start=pos+1
            continue=true
            exit do
        end if
        print mid(str,start,pos-start)
        if section then
'    section
            endpos=instr(pos,str,"}")
            if endpos=0 then
                print_error("Page is broken")
                exit sub
            end if
            section_name=trim(mid(str,pos+7,endpos-pos-7))
            endtag="{END " & section_name & "}"
            endpos1=instr(endpos,str,endtag)
            if endpos1=0 then
                print_error("End tag not found:" & endtag)
                exit sub
            end if
            section=mid(str,endpos+1,endpos1-endpos-1)
            start=endpos1+len(endtag)
            xt_getvar section_name,var
            if isnull(var) then
                continue=true
                exit do
            end if
            strbegin=""
            strend=""
            if vartype(var)=9 then
                strbegin=var("begin")
                strend=var("end")
                if vartype(var("data"))=9 then
                    set var=var("data")
                else
                    var=var("data")
                end if
            end if
            if vartype(var)<>9 then
'    if section
                print strbegin
                xt_process_template(section)
                print strend
            else
'    foreach section
                print strbegin
                dim keys1
                keys1=var.keys()
                for each i in keys1
                    xt_stack.Add xt_stack.Count,var(i)
                    if vartype(var(i))=9 then
                        if var(i).Exists("begin") then _
                            print var(i)("begin")
                    end if
                    xt_process_template(section)
                    xt_stack.Remove xt_stack.Count-1
                    if vartype(var(i))=9 then
                        if var(i).Exists("end") then _
                            print var(i)("end")
                    end if
                next
                print strend
            end if
        elseif not isnull(var) then
'    display a variable or call a function
            endpos=instr(pos,str,"}")
            if endpos=0 then
                print_error("Page is broken")
                exit sub
            end if
            varparams = split(trim(mid(str,pos+2,endpos-pos-2))," ")
            var_name = varparams(0)
            start=endpos+1
            xt_getvar var_name,var
            if isnull(var) then 
                continue=true
                exit do
            end if
            if vartype(var)<>9 then
'    just display a value
                print var
            else
'    call a function
                if not var.Exists("func") then
                    print_error("Incorrect variable value - " & var_name)
                    exit sub
                end if
                if var.Exists("params") then
                    set params=var("params")
                else
                    set params=CreateObject("Scripting.Dictionary")
                end if
                dim paramkeys,key,paramindex
                paramindex=0
                for each key in varparams
                    params("custom" & paramindex) = key
                    paramindex=paramindex+1
                next
                Execute var("func") & " params"
            end if
        elseif message then
            endpos=instr(pos,str,"}")
            if endpos=0 then
                print_error("Page is broken")
                exit sub
            end if
            tag = trim(mid(str,pos+15,endpos-pos-15))
            start=endpos+1
            print my_htmlspecialchars(mlang_message(tag))
        end if
    loop while true
    if not continue then _
        exit do
    loop while true
end sub

'    BuildEditControl wrapper
private sub xt_buildeditcontrol(params)
    dim mode
    dim fformat,field,id
    field=params("field")
    
    if params("mode")="edit" then
        mode=MODE_EDIT
    elseif params("mode")="add" then
        mode=MODE_ADD
    elseif params("mode")="inline_edit" then
        mode=MODE_INLINE_EDIT
    elseif params("mode")="inline_add" then
        mode=MODE_INLINE_ADD
    else
        mode=MODE_SEARCH
    end if
    
    if mode=MODE_ADD and postvalue("editType")="onthefly" then
        mode=MODE_INLINE_ADD
        id=postvalue("id")
    else
        id=params("id")
    end if
    
    fformat=GetEditFormat(field,"")
    if (mode=MODE_EDIT or mode=MODE_ADD or mode=MODE_INLINE_EDIT or mode=MODE_INLINE_ADD) and fformat=EDIT_FORMAT_READONLY then
        response.Write readonlyfields(field)
    end if
    if mode=MODE_SEARCH then
        fformat=editformats(field)
    end if
    BuildEditControl field,CStr(dbvalue(params("value"))),fformat,mode,params("second"),id
end sub

private sub xt_showchart(params)

dim width,height
width=700
height=530
if params.exists("custom1") then _
    width = params("custom1")
if params.exists("custom2") then _
    width = params("custom2")
%>


<div id='<%=params("chartname")%>'>
<noscript>
    <object id="<%=params("chartname")%>" 
            name="<%=params("chartname")%>" 
            classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000" 
            width="100%" 
            height="100%" 
            codebase="http://fpdownload.macromedia.com/get/flashplayer/current/swflash.cab">
        <param name="movie" value="libs/swf/Preloader.swf" />
        <param name="bgcolor" value="#FFFFFF" />

        <param name="allowScriptAccess" value="always" />
        <param name="flashvars" value="swfFile=<% response.write "dchartdata.asp%3Fchartname%3D" & params("chartname") %>" />
        
        <embed type="application/x-shockwave-flash" 
               pluginspage="http://www.adobe.com/go/getflashplayer" 
               src="libs/swf/Preloader.swf" 
               width="100%" 
               height="100%" 
               id="<%=params("chartname")%>" 
               name="<%=params("chartname")%>" 
               bgColor="#FFFFFF" 
               allowScriptAccess="always" 
               flashvars="swfFile=<% response.write "dchartdata.asp%3Fchartname%3D" & params("chartname") %>" />
    </object>                
</noscript>
&lt;script type="text/javascript" language="javascript">
    //<![CDATA[
    var chart = new AnyChart('libs/swf/AnyChart.swf','libs/swf/Preloader.swf');
    chart.width = '<%=width%>';
    chart.height = '<%=height%>';

    var xmlFile = 'dchartdata.asp%3Fchartname%3D<%=params("chartname")%>';
    xmlFile += '%26ctype%3D<%=params("ctype")%>';
    chart.setXMLFile(xmlFile);
    chart.write('<%=params("chartname")%>');
    //]]>
</script>
</div>
<%
DoEvent params("chartname")
        
end sub
end class

Sub print_error(str)

Response.Write str

End Sub

sub xt_include(params)
    set fs=Server.CreateObject("Scripting.FileSystemObject") 
    if fs.FileExists(Server.Mappath(params("file"))) then 
        Server.Execute(params("file"))
    end if
end sub

sub xt_doevent(params)
    DoEvent "Call " & params("custom1")
end sub


sub xt_label(params)
    response.write GetFieldLabel(params("custom1"),params("custom2"))
end sub

sub xt_caption(params)
    response.write GetTableCaption(params("custom1"))
end sub

%>

Editado Junho 26, 2009 por Jonathan Queiroz
Adcionar tag's (Jonathan)

[Jonathan Queiroz]

Qual é a linha 122 ?

Provavelmente o servidor não tem suporte ao componente que está tentando utilizar

[Flecha]

Me parece que é esta aqui

set stream=Server.CreateObject("ADODB.Stream")

Flecha

[Rafael Spilki]

Então, é exatamente como o Jonathan suspeitava. Seu servidor não tem ou não disponibiliza esse componente pra você.. Entre em contato com o suporte técnico do seu provedor e veja se essa informação realmente confere... derepente, em raríssimos casos, eles podem instalar isso pra você!

[]'s Rafael Spilki

[bareta]

bom se analisar o adodb.stream... é o mesmo componente de conexão...

so vi em servers free ele desativado... e é o q pode acontecer do server ter bloqueado esse uso... entre em contato com seu server a respeito do adodb.stream não funcionar...

http://en.wikipedia.org/wiki/ActiveX_Data_Objects