Ir para conteúdo
Fórum Script Brasil

Roberto Carvalho

Membros
  • Total de itens

    30
  • Registro em

  • Última visita

Posts postados por Roberto Carvalho

  1. Olá amigos,

    Espero que possam me ajudar, tenho o seguinte array:

    $num = count($_SESSION["retorno"]);

    $_SESSION["retorno"][$num]['xtype'] = "fieldset";

    $_SESSION["retorno"][$num]['id'] = "Panel_$num" ;

    $_SESSION["retorno"][$num]['autoHeight'] = true;

    $_SESSION["retorno"][$num]['items'] = array();

    $_SESSION["retorno"][$num]['items'][0]['layout'] = "column";

    $_SESSION["retorno"][$num]['items'][0]['border'] = false;

    $_SESSION["retorno"][$num]['items'][0]['items'] = array();

    $_SESSION["retorno"][$num]['items'][0]['items'][0]["columnWidth"] = .9;

    $_SESSION["retorno"][$num]['items'][0]['items'][0]['border'] = false;

    $_SESSION["retorno"][$num]['items'][0]['items'][0]['items'] = array();

    $_SESSION["retorno"][$num]['items'][0]['items'][0]['items']["id"] = "Pergunta_$num";

    $_SESSION["retorno"][$num]['items'][0]['items'][0]['items']["xtype"] = "label";

    $_SESSION["retorno"][$num]['items'][0]['items'][0]['items']["text"] = "Digite aqui sua pergunta";

    $_SESSION["retorno"][$num]['items'][0]['items'][1]["columnWidth"] = .05;

    $_SESSION["retorno"][$num]['items'][0]['items'][1]['border'] = false;

    $_SESSION["retorno][$num]['items'][0]['items'][1]['items'] = array();

    $_SESSION["retorno][$num]['items'][0]['items'][1]['items']["xtype"] = "tbbutton";

    $_SESSION["retorno"][$num]['items'][0]['items'][1]['items']['tooltip'] = "Editar";

    $_SESSION["retorno"][$num]['items'][0]['items'][1]['items']['tooltipType'] = "title";

    $_SESSION["retorno"][$num]['items'][0]['items'][1]['items']['text'] = "";

    $_SESSION["retorno"][$num]['items'][0]['items'][1]['items']['iconCls'] = "edit";

    $_SESSION["retorno"][$num]['items'][0]['items'][1]['items']['handler'] = "function(){DoEdition(390, 'Pergunta_$num');}";

    $_SESSION["retorno"][$num]['items'][0]['items'][2]["columnWidth"] = .05;

    $_SESSION["retorno"][$num]['items'][0]['items'][2]['border'] = false;

    $_SESSION["retorno"][$num]['items'][0]['items'][2]['items'] = array();

    $_SESSION["retorno"][$num]['items'][0]['items'][2]['items']["xtype"] = "tbbutton";

    $_SESSION["retorno"][$num]['items'][0]['items'][2]['items']['tooltip'] = "Excluir";

    $_SESSION["retorno"][$num]['items'][0]['items'][2]['items']['tooltipType'] = "title";

    $_SESSION["retorno"][$num]['items'][0]['items'][2]['items']['text'] = "";

    $_SESSION["retorno"][$num]['items'][0]['items'][2]['items']['iconCls'] = "delete";

    $_SESSION["retorno"][$num]['items'][0]['items'][2]['items']['handler'] = "function(){Ext.get('Panel_$num').remove();}";

    $_SESSION["retorno"][$num]['items'][1]['xtype'] = "textfield";

    $_SESSION["retorno"][$num]['items'][1]['hideLabel'] = true;

    $_SESSION["retorno"][$num]['items'][1]['anchor'] = "100%";

    Vamos supor que eu queira excluir o elemento em vermelho, que por sua vez removeria os itens em verde. Eu poderia usar o seguinte:

    unset($_SESSION["retorno"][$num]['items'][0]['items'][1]['items']);

    Mas o problema é que vou excluir em outra pagina através de um botão, como faço para passar a localização do elemento que quero excluir para a pagina que faz a exclusão?

    Desde já agradeço.

  2. Olá galera, estou com uma duvida terrível e se vocês puderem me ajudar.

    É o seguinte tenho a seguinte tabela chamada Menu:

    ID

    TIPO(1 É MENU, 2 É SUBMENU)

    IDPAI

    TITULO

    NIVEL

    O que preciso fazer é mostrar na tela o menu e dentro do menu seus respectivos submenus e dentro dos submenus seus respectivos submenus e assim por diante. Ou seja:

    ID TIPO IDPAI TITULO NIVEL

    1 1 Pagina Inicial

    2 1 Noticias

    3 1 Circulares

    4 2 1 Pagina Inicial1 1

    5 2 1 Pagina Inicial2 1

    6 2 3 Circulares1 3

    7 2 5 Pagina Inicial2(1) 1,5

    Gostaria de escrever o seguinte na tela:

    Menu

    Pagina Inicial

    >>Pagina Inicial1

    >>Pagina Inicial2

    >>>>Pagina Inicial2(1)

    Noticias

    Circulares

    >>Circulares1

    Alguêm pode ajudar como fazer isso.

    Desde já aeu agradeço.

  3. Os dados ficariam assim:

    table_Palavras

    Id,data,idioma,palavra

    38,13/10/2008 15:30:30,pt,cabelo

    39,13/10/2008 15:30:30,en,hair

    40,13/10/2008 15:30:30,cro,kosa

    table_traducoes

    Id,Idpalavra,data,idioma,traducao

    1,38,13/10/2008 15:30:30,en,hair

    2,38,13/10/2008 15:30:30,es,pelo

    3,38,13/10/2008 15:30:30,al,haar

    4,39,13/10/2008 15:30:30,it,capelli

    5,39,13/10/2008 15:30:30,cro,kosa

    6,39,13/10/2008 15:30:30,viet,tóc

    6,40,13/10/2008 15:30:30,din,hår

    então se a pessoa digita-sse cabelo na busca ela encontraria:

    38,13/10/2008 15:30:30,pt,cabelo

    39,13/10/2008 15:30:30,en,hair

    40,13/10/2008 15:30:30,cro,kosa

    que são as formas de escrever cabelo nos idiomas cadastrados na tabela table_Palavras. que contém nas possíveis traduções da tabela table_traducoes.

  4. Até ai tudo bem se digitar cabelo ela encontra a palavra hair. Mas o quero é se alguém já cadastrou essa hair e cadastrou outras possíveis traduções ele também as encontre.

    ou seja:

    Português: cabelo

    Possíveis traduções:

    Inglês: hair

    Espanhol: pelo

    Alemão: Haar

    Inglês: Hair

    Possíveis traduções:

    Italiano: capelli

    Croata: kosa

    vietnamita: tóc

    Croata: Kosa

    Possíveis traduções:

    Dinamarquês: hår

    Russo: волосы

    Sérvio: коса

    Ou seja: se a pessoa digitar a palavra cabelo o sistema iria encontrar:

    cabelo, hair e Kosa

  5. Vou tentar explicar o que quero fazer, tenho uma aplicação em asp com bd mysql. Nessa aplicação tenho a seguinte tabela:

    table_Palavras

    Campos:

    Id,data,idioma,palavra

    E tenho uma outra tabela:

    table_traducoes

    Campos:

    Id,Idpalavra,data,idioma,traducao

    O que quero é o seguinte, quando uma pessoa cadastra uma palavra no site ela também cadastra sua possíveis traduções ou seja:

    cadastro na tabela table_Palavras Idioma:Português, palavra:Cabelo em seguida vou para a tela de possíveis traduções e cadastro na tabela table_traducoes Idioma:Inglês,palavra:Hair e assim por diante posso cadastrar até 3 possíveis traduções.

    se alguém entrar no site e cadastrar na tabela table_Palavras a palavra hair em ingles e nas possiveis traduções colocar a palavra em arabe,espanhol,frances e depois alguém cadastrar em francês e colocar como possíveis traduções a palavra em alemão,italiano,etc...

    Eu quero que quando a pessoa digite a palavra no campo de busca seja identificado todas as suas possíveis traduções e o resultado venha todos os cadastros da tabela table_Palavras que estejam presentes na tabela table_traducoes linkados, ou seja se eu digitar a palavra cabelo ela não somente encontre as possiveis traduções da palavra cabelo mas sim também as possíveis traduções da palavra hair e qualquer outra lingua que esta palavra esteja cadastrada.

    Não sei se fui bem claro nem mesmo sei se não teria que postar no forum de Mysql mas como a aplicação é em asp resolvi postar aqui.

    Se alguêm poder me ajudar desde já agradeço.

  6. Deixa eu ser um pouco mais claro...

    Na verdade o que quero é o seguinte.. vou obter a resposta da porta paralela que é um numero que vai de 0 à 255.

    o quero é o seguinte dividir o numero que eu obter em partes,, ou seja tenho os seguintes numeros:

    1,2,4,8,16,32,64 e 128. Se a resposta da porta paralela for 129.. então quero que ele encontre as partes segundo os meus numeros ou seja, 128 e 1. Se o numero for 96 ele deve obter 32 e 64.... se for 10 ele deve obter 2 e 8..

    Espero ter sido mais claro..

    se alguém puder me ajudar.. agradeço desde já.

  7. Estou fazendo um programa para controle de porta paralela, mas estou com duvida pra fazer o seguinte.

    meu programa tem 8 labels sendo elas:

    bt(0),bt(1)...até...bt(7)

    quando o byte que corresponde a cada label esta ativado na porta paralela a label fica com o backcolor vermelho e quando não está fica verde.

    o envio de bytes é feito da seguinte maneira.. quando a pessoa clica no bt(0) por exemplo acontece isso:

    Private Sub bt(0)_Click()

    conta = Inp(Val("&H379"))

    If bt(0).BackColor = &HFF00& Then

    Out Val("&H378"), Val(conta + 1)

    bt(0).BackColor = &HFF&

    Else

    Out Val("&H378"), Val(conta - 1)

    bt(0).BackColor = &HFF00&

    End If

    End Sub

    Reparem que eu enviei 1 byte

    O valor de cada label é o seguinte?

    bt(0)=1 byte

    bt(1)=2 byte

    bt(2)=4 byte

    bt(3)=8 byte

    bt(4)=16 byte

    bt(5)=32 byte

    bt(6)=64 byte

    bt(7)=128 byte

    por exemplo se eu der um click nas labels bt(0) que vale 1 byte e bt(1) que vale 2 bytes minha resposta conta = Inp(Val("&H379")) seria de 3 bytes e as 2 duas labels estariam com o backcolor vermelho,, agora de eu clicar novamente na bt(0) ele vai pegar a resposta que seria 3 e subtrair por 1 e a resposta que vai ficar 2,, ou seja,, só o bt(1) está ativo ou seja vermelho.

    Minha pergunta é o seguinte como fazer no load no formulario uma função que pegue a reposta de quantos bytes estão sendo utilizados e deixe-os com o background vermelho sabendo que a soma de todos os bytes utilizados é 255 e 0 qaundo nenhum esta sendo utilizado.

    Desde já agradeço.

  8. Segue o Codigo de uma importação de arquivos em ASP com uma barra de progresso informando o andamento da importação:

    <html>
    
    <head>
    <meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
    <title>Importação de Arquivos</title>
        <style type="text/css">
        body{
            font-family: Trebuchet MS, Lucida Sans Unicode, Arial, sans-serif;
            background-color:#E2EBED;
            margin:0px;
            padding:0px;
            height:100%;
            width:100%;
            line-height:130%;
            font-size:0.9em;
            text-align:center;
        }
        #pageContent{
            width:760px;
            margin:0 auto;
            text-align:left;
            border-left:1px solid #000;
            border-right:1px solid #000;
            background-color:#FFF;
            height:100%;
        }
        #pageContent p{
            padding-left:10px;
            padding-right:10px;
        }
        #dhtmlgoodies_progressPane{
            width:100%;
            height:100%;
            background-color:#FFF;
            z-index:5000;
            position:absolute;
            left:0px;
            top:0px;
            
        }
        #dhtmlgoodies_progressBar_bg{
            position:absolute;
            left:50%;
            top:50%;
            width:300px;
            height:20px;
            border:1px solid #000;
            background-color:#EEE;
            margin-left:-150px;    
            margin-top:-20px;
            text-align:center;
        }
        #dhtmlgoodies_progressBar_outer{
            position:absolute;
            left:0px;
            top:0px;
            width:0px;    
            height:100%;
            overflow:hidden;    
        }
        
        #dhtmlgoodies_progressBar{
            position:absolute;
            left:0px;
            top:0px;
            width:300px;
            background-color:#184EB8;
            filter: Alpha(Opacity=0, FinishOpacity=100,Style=1,StartX=0, StartY=0, FinishX=200,FinishY=20);
            height:100%;
            z-index:5000;
        }
        #dhtmlgoodies_progressBar_txt{
            color:#000;
            z-index:10000;
            width:100%;
            height:100%;
            left:0px;
            top:0px;
            position:absolute;        
            font-family:arial;
            font-size:0.8em;
            line-height:20px;    /* Same as height of progress bar */
        }
        </style>
        <script type="text/javascript">
            
        var progressbar_steps = 100;    
        var dhtmlgoodies_progressPane = false;
        var dhtmlgoodies_progressBar_bg = false;
        var dhtmlgoodies_progressBar_outer = false;
        var dhtmlgoodies_progressBar_txt = false;
        var progressbarWidth;
        var currentStep = 0;
        function moveProgressBar(steps){
            if(!dhtmlgoodies_progressBar_bg){
                dhtmlgoodies_progressPane = document.getElementById('dhtmlgoodies_progressPane');
                dhtmlgoodies_progressBar_bg = document.getElementById('dhtmlgoodies_progressBar_bg');
                dhtmlgoodies_progressBar_outer = document.getElementById('dhtmlgoodies_progressBar_outer');
                dhtmlgoodies_progressBar_txt = document.getElementById('dhtmlgoodies_progressBar_txt');
                progressbarWidth = dhtmlgoodies_progressBar_bg.clientWidth;
            }
            if(!steps){
                dhtmlgoodies_progressBar_outer.style.width = progressbarWidth + 'px';
                dhtmlgoodies_progressBar_txt.innerHTML = '100%';
                
            }else{
                currentStep=steps;
                if(currentStep>progressbar_steps)currentStep = progressbar_steps;
                var width = Math.ceil(progressbarWidth * (currentStep / progressbar_steps));
                dhtmlgoodies_progressBar_outer.style.width = width + 'px';
                var percent = Math.ceil((currentStep / progressbar_steps)*100);
                dhtmlgoodies_progressBar_txt.innerHTML = percent + '%';
                if(currentStep==progressbar_steps){
                    
                }
            }
            
            
            
            
        }
        
        function demoProgressBar(step2)
        {
            if(currentStep<progressbar_steps){
                moveProgressBar(step2);
            }
        }
        
        
            
        </script>
        
    </head>
    
    <body>
    <div id="dhtmlgoodies_progressPane">
        <div id="dhtmlgoodies_progressBar_bg">
            <div id="dhtmlgoodies_progressBar_outer">
                <div id="dhtmlgoodies_progressBar"></div>
            </div>
            <div id="dhtmlgoodies_progressBar_txt">0 %</div>
        </div>
    </div>
    <div id="pageContent">
    
    
    
    
    
    
    </body>
    
    </html>
    
        <!--#include file="conn.asp"-->
    <%
    conta=0
    conta2=0
    Set FSO = Server.CreateObject("Scripting.FileSystemObject")
    Set leitura1 = fso.OpenTextFile(server.MapPath("teste.txt"), 1, False)
    Do While not leitura1.AtEndOfStream
    leitura1.readline
    conta= conta+1
    loop
    result= 100/conta
    
    
    leitura1.close
    set leitura1= nothing
    
    
    Set leitura = fso.OpenTextFile(server.MapPath("teste.txt"), 1, False)
    
    Do While not leitura.AtEndOfStream
    str= leitura.readline & vbcrlf
    tipo= Mid(str,1,1)
    tipo2= cint(tipo)
    cpf= Mid(str,2,11)
    valor= Mid(str,13,9)
    valor2 = valor / 100
    data= mid(str,28,2) & "/" & Mid(str,26,2) & "/" & Mid(str,22,4)
    data2 = cdate(data)
    Set rsUser = Server.CreateObject("ADODB.Recordset")
    rsUser.open "select * from clientes", conn, 3, 3
    rsuser.addnew
    rsuser("tipo")=tipo2
    rsuser("cpf")=cpf
    rsUser("valor") = valor2
    rsuser("data")=data2
    rsUser.Update
    conta2= conta2 + result
    if conta2>= "99" then 
    conta2="100"
    end if
    
    conta3=cint(conta2)
    if conta3>=100 then
    conta3=100
    end if
    %>
    
    <script language=javascript>
    demoProgressBar('<%=conta3%>')
    </script>
    
          <%
    Loop
    
    leitura.close
    set leitura=nothing
    rsUser.close
    set rsUser = nothing
    conn.close
    %>

  9. Tenho um arquivo js incluso na minha pagina asp porem quando chamo a função assim:

    onclick="myJsProgressBarHandler.setPercentage('element1','1');return false;"

    ela funciona normal.

    Porem eu quero que ela funciona sem precisar click e nem nada, ou seja meu codigo ASP da um loop e eu quero essa função entre o loop. meu codigo se trata de uma importação ao banco de dados e quero que a cada registro cadastrado execute essa função so que não sei como fazer funcionar, sewgue meu codigo abaixo:

    <div style="width:540px;margin : 0 auto; text-align:left;" >
    
            <h1> </h1>
    
            <div id="demo">
    
                <p style="text-align: center">
    
                <span style="color:#006600;font-weight:bold;">Status da Importação</span> <br/>
                <span class="progressBar percentImage1" id="element1">0%</span>
                            <br/><br/>
    
            </div>
    
        </div>
    
    </body>
    </html>
    <!--#include file="conn.asp"-->
    <%
    conta=0
    conta2=0
    Set FSO = Server.CreateObject("Scripting.FileSystemObject")
    Set leitura1 = fso.OpenTextFile(server.MapPath("teste.txt"), 1, False)
    Do While not leitura1.AtEndOfStream
    leitura1.readline
    conta= conta+1
    loop
    result= 100/conta
    
    
    leitura1.close
    set leitura1= nothing
    
    
    Set leitura = fso.OpenTextFile(server.MapPath("teste.txt"), 1, False)
    
    Do While not leitura.AtEndOfStream
    str= leitura.readline & vbcrlf
    tipo= Mid(str,1,1)
    tipo2= cint(tipo)
    cpf= Mid(str,2,11)
    valor= Mid(str,13,9)
    valor2 = valor / 100
    data= mid(str,28,2) & "/" & Mid(str,26,2) & "/" & Mid(str,22,4)
    data2 = cdate(data)
    Set rsUser = Server.CreateObject("ADODB.Recordset")
    rsUser.open "select * from clientes", conn, 3, 3
    rsuser.addnew
    rsuser("tipo")=tipo2
    rsuser("cpf")=cpf
    rsUser("valor") = valor2
    rsuser("data")=data2
    rsUser.Update
    conta2= conta2 + result
    if conta2>= "99" then 
    conta2="100"
    end if
    %>
    
    Aqui eu quero que execute a minha função... mas sozinha.. sem click...
    
    <%
    Loop
    
    leitura.close
    set leitura=nothing
    rsUser.close
    set rsUser = nothing
    conn.close
    %>

  10. Olá,

    Sei que via ASP não tem como imprimir direto na LTP1, então gostaria de saber se tem como criar uma dll com a função de imprimir direto na ltp1 no Vb e chama-la pelo asp. A função que tenho para impressão direto na Ltp1 no vb é essa:

    Dim n As Long

    n = FreeFile()

    Open "LPT1:" For Output As #n

    Print #n, "Hello world"

    Close #n

    como fazer para criar uma dll com essa função? e como chama-la pelo ASP?

    desde já agradeço.

  11. Consegui esse codigo... mas o problema é que ainda não esta alterando o arquivo... o que pode estar errado:

    <%

    Set objWord = CreateObject("Word.Application")

    Set objDoc = objWord.Documents.Open("c:\teste2")

    objWord.Visible = false

    DIM valor,arquivo

    arquivo = "C:\teste4.doc"

    TP_OnLoad("@casa")

    TP_OnLoad("@roberto")

    objWord.Application.ActiveDocument.SaveAs arquivo

    objWord.Application.ActiveWindow.Close

    Set objWord = nothing

    %>

    <%

    Function TP_OnLoad(header)

    Set myRange = objword.ActiveDocument.Range

    With myRange.Find

    .ClearFormatting

    .Text = header

    With .Replacement

    .ClearFormatting

    .Text = "End"

    End With

    .Execute , True, True, , , , , , True, , wdReplaceAll

    End With

    End Function

    %>

  12. Esse é o procediemento que eu uso no Visual Basic e funciona perfeitamente:

    Public objword As Word.Application

    Private Sub command1_click()

    Set objword = New Word.Application

    objword.Documents.Open ("c:\teste2.doc")

    objword.Visible = False

    Call Substitui_Var("@casa", "Minha Casa")

    Call Substitui_Var("@teste", "Mweu Teste")

    objword.ActiveDocument.SaveAs ("c:\teste3.doc")

    objword.Quit

    MsgBox "Replace Ok"

    Set objword = Nothing

    Exit Sub

    End Sub

    Private Sub Substitui_Var(Header As String, Data As String)

    With objword.Selection.Find

    .ClearFormatting

    .Text = Header

    .Execute Forward:=True

    End With

    Clipboard.Clear

    Clipboard.SetText (Data)

    objword.Selection.Paste

    Clipboard.Clear

    End Sub

    Mas em ASP ainda não consegui nada que chegasse nem perto.....

    Quem puder ajudar agradeço desde já.

  13. Olá,

    Eu já possuo um codigo que insere texto no word..... mas já tentei de tudo e ainda não consegui um jeito de editar palavras que já existam no arquivo..... Alias consegui um codigo em visual basic mas em asp ainda nada....

    O quero é o seguinte, criar um documento no Word com o seguinte modelo:

    Informações:

    Nome: @nome

    Endereço: @endereco

    e assim por diante...

    E atraves do codigo poder mudar esses parametros para informações que vem do meu banco de dados...

    Desde já agradeço.

  14. Bom minha duvida é o seguinte....

    to desenvolvendo um site que vai precisar ter uma conexão de webcams entre duas pessoas logadas no site.... ou seja elas poderão se comunicar mais ou menos como no MSN no computador da pessoa aparece uma imagem maior que seria a webcam da outra pessoa e em baixo uma menor com a dela....

    sei que em asp não seria possível desenvolver isso mas sera que associando o asp a alguma outra ferramenta não seria possível desenvolver?????

    Se alguém souber de algum modo alternativo ou outra linguagem que seria possível por favor me de essa força...

    Desde já agradeço....

  15. Pessoal estou fazendo um sistema de estacionamento so que estou me atrapalhando para informar o valor devido do cliente quando o sistema de cobrança esta por hora tenho as seguintes tabelas:

    Tabela horas iniciais:

    Tempo Valor Tolerância

    1:00 R$2,00 15

    2:00 R$2,00 15

    4:00 R$2,00 15

    tabela demais horas:

    Tempo Valor Tolerância

    1:00 R$2,00 15

    A tabela horas iniciais esta dizendo que:

    se o cliente ficar ate 1 hora ele paga R$2,00, nas proximas 2 horas ela paga mais R$2,00 e nas proximas R$4 horas ela paga mais R$2,00 , então se o cliente ficar 7 horas no estacinamento ele paga R$6,00. A tabela demais horas informa que se passou o tempo estipulado pelas horas iniciais para cada 1 hora vai cobrar mais R$2,00....

    Como faço isso??????????????

  16. Como faço para incluir no meu form um menu vertical parecido com aqueles de sistemas em Ms Dos, esse sistema so vai ser usado teclado, por isso precisava do menu com os itens e assim que o foco estivesse sobre o item e fosse pressionado a tecla Enter abrisse os sub-menus com as opções daquele item e quando pressionasse ESC ocultasse os submenus daquele item.

    Quem puder me ajudar.. Desde já agradeço

  17. Esquece obrigado, já resolvi.

    Juntei dois codigos diferentes que eu tinha num só para quem quiser usar segue o codigo:

    <table width=500 border=1>

    <tr>

    <!--#include file="conn.asp"-->

    <%

    sql = "select * from infpessoais"

    Set rs = Server.CreateObject("ADODB.Recordset")

    RS.PageSize = 5

    rs.Open sql, conn, 3, 3

    If RS.EOF then

    Response.Write "Nenhum registro encontrado!"

    Response.End

    Else

    If Request.QueryString("pagina")="" then

    intpagina=1

    Else

    If Cint(Request.QueryString("pagina"))<1 then

    intpagina=1

    Else

    If Cint(Request.QueryString("pagina"))>RS.PageCount then

    intpagina=RS.PageCount

    Else

    intpagina=Request.QueryString("pagina")

    End If

    End if

    End if

    End if

    RS.AbsolutePage=intpagina

    intrec=0

    %>

    <% Dim contador

    contador = 1

    maxcol = 3 '<------------------ numero de registros por colunas

    do while not rs.eof and intrec<RS.PageSize %>

    <%

    if contador <= maxcol then %>

    <td><img border="0" src=<%=rs("foto")%>><p><p align="center"><%=rs("nome")%>&nbsp;<%=rs("sobrenome")%></td>

    <%

    contador = contador + 1

    else %>

    </tr>

    <tr>

    <td><img border="0" src=<%=rs("foto")%>><p><p align="center"><%=rs("nome")%><%=rs("sobrenome")%></td>

    <%

    contador = 2

    end if

    rs.movenext

    intrec=intrec+1

    loop

    'completa as colunas

    do while contador <= maxcol %>

    <td>&nbsp;

    </td>

    <% contador = contador + 1

    loop %>

    <%

    If intpagina>1 then %>

    <a href="possibilidades4.asp?pagina=<%=intpagina-1%>">Anterior</a>

    <%end if

    For i=1 to RS.PageCount

    If i = Cint(intpagina) then%>

    [<%=i%>]

    <% else %>

    <a href="possibilidades4.asp?pagina=<%=i%>">[<%=i%>]</a>

    <%end if

    Next

    If strcomp(intpagina,RS.PageCount)<>0 then %>

    <a href="possibilidades4.asp?pagina=<%=intpagina+1%>">Próxima</a>

    <%end if%><%

    rs.close

    set rs=nothing

    conn.close

    set conn=nothing%>

  18. já procurei em varios foruns, mas não consegui um codigo que funcione perfeitamente, eu to precisando que as imagens fiquem alinhadas lado a lado em colunas e que eu defina quantos colunas devem ter, Alem disso preciso que tenham os links proximo e anterior para não ficar todos os registros numa so pagina.

    Se alguêm puder me ajudar agradeço desde já.

  19. Quando tento fazer um upload da o seguinte erro:

    Erro de tempo de execução do Microsoft VBScript- Error '800a000d'

    Tipos incompatíveis: 'GetUpload'

    C:\Documents and Settings\cintia\Meus documentos\Sistema\Codigos\upload3\upload.asp, line 21

    Segue o codigo abaixo:

    upload.asp:

    <html>

    <head>

    <title>:: Feira Mercado - O seu mercado feirense de vendas e compras - Em Feira

    de Santana e regiões ::</title>

    </head>

    <body>

    <form method=POST enctype="multipart/form-data">

    &nbsp;<input type="file" name="File1" size="32" style="font-family: Verdana; font-size: 10 px; color: #808080; border: 1px solid #808080"><br>

    &nbsp;<input type="submit" Name="Action" value="Enviar imagens..." style="font-family: Verdana; font-size: 10 px; color: #000000; border-style: solid; border-width: 1">

    </form>

    </body></HTML>

    <!---#INCLUDE FILE="upload.inc" --->

    <% Dim Fields, FilePath

    'Sauvegarde le fichier 'File1' sur le serveur dans le même répertoire que ce script

    'Modifier le FilePath pour le claquer ailleurs

    If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST" For get the fields

    Set Fields = GetUpload()

    FilePath = Server.MapPath(".\figuras") & "\" & Fields("File1").FileName

    Fields("File1").Value.SaveAs FilePath

    Response.Redirect "upload_enviado.asp"

    %>

    <%

    End If

    %>

    upload.inc:

    <script RUNAT=SERVER LANGUAGE=VBSCRIPT>

    Const IncludeType = 2

    'Vous pouvez utiliser ce composant d'upload pourr :

    ' 1. Uploader de petits fichiers sur le serveur (sauvegarde via les FileSystem object)

    ' 2. Uploader des fichiers binaires/texte de n'importe quelle taille sur une base de données serveur (RS("BinField") = Upload("FormField").Value)

    'restriction de la taille de l'upload

    Dim UploadSizeLimit

    '********************************** Méthode GetUpload **********************************

    'Cette fonction lit les champs de formulaires en entrée binaire et les renvoie en tant qu'objet du dictionnaire.

    Function GetUpload()

    Dim Result

    Set Result = Nothing

    If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'la méthode REQUEST doit être POST

    Dim CT, PosB, Boundary, Length, PosE

    CT = Request.ServerVariables("HTTP_Content_Type") ' lit le header

    If LCase(Left(CT, 19)) = "multipart/form-data" Then 'qui doit être de type "multipart/form-data"

    PosB = InStr(LCase(CT), "boundary=") 'Finds boundary

    If PosB > 0 Then Boundary = Mid(CT, PosB + 9) 'Separetes boundary

    '****** Erreur sur IE5.01 - doublement des entêtes http

    PosB = InStr(LCase(CT), "boundary=")

    If PosB > 0 then 'Patch pour l'erreur IE

    PosB = InStr(Boundary, ",")

    If PosB > 0 Then Boundary = Left(Boundary, PosB - 1)

    end if

    '****** Erreur sur IE5.01 - doublement des entêtes http

    Length = CLng(Request.ServerVariables("HTTP_Content_Length"))

    If "" & UploadSizeLimit <> "" Then

    UploadSizeLimit = CLng(UploadSizeLimit)

    If Length > UploadSizeLimit Then

    Request.BinaryRead (Length)

    Err.Raise 2, "GetUpload", "Upload size " & FormatNumber(Length, 0) & "B exceeds limit of " & FormatNumber(UploadSizeLimit, 0) & "B"

    Exit Function

    End If

    End If

    If Length > 0 And Boundary <> "" Then

    Boundary = "--" & Boundary

    Dim Head, Binary

    Binary = Request.BinaryRead(Length) 'lit les données à partir du poste client

    Set Result = SeparateFields(Binary, Boundary)

    Binary = Empty 'Mise à jour des variables

    Else

    Err.Raise 10, "GetUpload", "longueur nulle ."

    End If

    Else

    Err.Raise 11, "GetUpload", "Pas de fichier joint."

    End If

    Else

    Err.Raise 1, "GetUpload", "Mauvaise méthode de request."

    End If

    Set GetUpload = Result

    End Function

    '********************************** SeparateFields **********************************

    Function SeparateFields(Binary, Boundary)

    Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary

    Dim Fields

    Boundary = StringToBinary(Boundary)

    PosOpenBoundary = InStrB(Binary, Boundary)

    PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)

    Set Fields = CreateObject("Scripting.Dictionary")

    Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)

    'Entête et fichier source

    Dim HeaderContent, FieldContent, bFieldContent

    'entêtes

    Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type

    'variable

    Dim Field, TwoCharsAfterEndBoundary

    'Fin de l'entête

    PosEndOfHeader = InStrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

    'Séparation des champs de l'entêter

    HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

    'séparation du contenu

    bFieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

    'séparation des champs d'entête de l'entêter

    GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

    'Creation d'un champs et attribution des paramètres

    Set Field = CreateUploadField()'See the JS function bellow

    Set FieldContent = CreateBinaryData(bFieldContent,LenB(bFieldContent))

    ' FieldContent.ByteArray = bFieldContent

    ' FieldContent.Length = LenB(bFieldContent)

    Field.Name = FormFieldName

    Field.ContentDisposition = Content_Disposition

    Field.FilePath = SourceFileName

    Field.FileName = GetFileName(SourceFileName)

    Field.ContentType = Content_Type

    Field.Length = FieldContent.Length

    Set Field.Value = FieldContent

    ' response.write "<br>:" & FormFieldName

    Fields.Add FormFieldName, Field

    'Dernière borne ?

    TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))

    isLastBoundary = TwoCharsAfterEndBoundary = "--"

    If Not isLastBoundary Then 'Putain!!! Pas la dernière... on avance jusqu'au champ suivant.

    PosOpenBoundary = PosCloseBoundary

    PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary)

    End If

    Loop

    Set SeparateFields = Fields

    End Function

    '********************************** Utilities **********************************

    'Separation des champs d'entête de l'entête uploadé

    Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type)

    Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))

    Name = (SeparateField(Head, "name=", ";")) 'ltrim

    If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)

    FileName = (SeparateField(Head, "filename=", ";")) 'ltrim

    If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)

    Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))

    End Function

    'Separation du champ entre sStart et sEnd

    Function SeparateField(From, ByVal sStart, ByVal sEnd)

    Dim PosB, PosE, sFrom

    sFrom = LCase(From)

    PosB = InStr(sFrom, sStart)

    If PosB > 0 Then

    PosB = PosB + Len(sStart)

    PosE = InStr(PosB, sFrom, sEnd)

    If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf)

    If PosE = 0 Then PosE = Len(sFrom) + 1

    SeparateField = Mid(From, PosB, PosE - PosB)

    Else

    SeparateField = Empty

    End If

    End Function

    'Separation du nom de fichier du chemin

    Function GetFileName(FullPath)

    Dim Pos, PosF

    PosF = 0

    For Pos = Len(FullPath) To 1 Step -1

    Select Case Mid(FullPath, Pos, 1)

    Case "/", "\": PosF = Pos + 1: Pos = 0

    End Select

    Next

    If PosF = 0 Then PosF = 1

    GetFileName = Mid(FullPath, PosF)

    End Function

    Function BinaryToStringSimple(Binary)

    Dim I, S

    For I = 1 To LenB(Binary)

    S = S & Chr(AscB(MidB(Binary, I, 1)))

    Next

    BinaryToStringSimple = S

    End Function

    Function BinaryToString(Binary)

    ' BinaryToString = RSBinaryToString(Binary)

    ' Exit Function

    dim cl1, cl2, cl3, pl1, pl2, pl3

    Dim L', nullchar

    cl1 = 1

    cl2 = 1

    cl3 = 1

    L = LenB(Binary)

    Do While cl1<=L

    pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))

    cl1 = cl1 + 1

    cl3 = cl3 + 1

    if cl3>300 then

    pl2 = pl2 & pl3

    pl3 = ""

    cl3 = 1

    cl2 = cl2 + 1

    if cl2>200 then

    pl1 = pl1 & pl2

    pl2 = ""

    cl2 = 1

    End If

    End If

    Loop

    BinaryToString = pl1 & pl2 & pl3

    End Function

    Function RSBinaryToString(xBinary)

    Dim Binary

    if vartype(xBinary)=8 then Binary = MultiByteToBinary(xBinary) else Binary = xBinary

    Dim RS, LBinary

    Const adLongVarChar = 201

    Set RS = CreateObject("ADODB.Recordset")

    LBinary = LenB(Binary)

    if LBinary>0 then

    RS.Fields.Append "mBinary", adLongVarChar, LBinary

    RS.Open

    RS.AddNew

    RS("mBinary").AppendChunk Binary

    RS.Update

    RSBinaryToString = RS("mBinary")

    Else

    RSBinaryToString = ""

    End If

    End Function

    Function MultiByteToBinary(MultiByte)

    Dim RS, LMultiByte, Binary

    Const adLongVarBinary = 205

    Set RS = CreateObject("ADODB.Recordset")

    LMultiByte = LenB(MultiByte)

    if LMultiByte>0 then

    RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte

    RS.Open

    RS.AddNew

    RS("mBinary").AppendChunk MultiByte & ChrB(0)

    RS.Update

    Binary = RS("mBinary").GetChunk(LMultiByte)

    End If

    MultiByteToBinary = Binary

    End Function

    Function StringToBinary(String)

    Dim I, B

    For I=1 to len(String)

    B = B & ChrB(Asc(Mid(String,I,1)))

    Next

    StringToBinary = B

    End Function

    Function vbsSaveAs(FileName, ByteArray)

    Dim FS, TextStream

    Set FS = CreateObject("Scripting.FileSystemObject")

    Set TextStream = FS.CreateTextFile(FileName)

    TextStream.Write BinaryToString(ByteArray) ' BinaryToString is in upload.inc.

    TextStream.Close

    End Function

    </SCRIPT>

    <script RUNAT=SERVER LANGUAGE=JSCRIPT>

    function CreateUploadField(){ return new uf_Init() }

    function uf_Init(){

    this.Name = null

    this.ContentDisposition = null

    this.FileName = null

    this.FilePath = null

    this.ContentType = null

    this.Value = null

    this.Length = null

    }

    function CreateBinaryData(Binary, mLength){ return new bin_Init(Binary, mLength) }

    function bin_Init(Binary, mLength){

    this.ByteArray = Binary

    this.Length = mLength

    this.String = BinaryToString(Binary)

    this.SaveAs = jsSaveAs

    }

    //function jsBinaryToString(){

    // return BinaryToString(this.ByteArray)

    //};

    function jsSaveAs(FileName){

    return vbsSaveAs(FileName, this.ByteArray)

    }

    //Simulate ByteArray class by JS/VBS - end

    </SCRIPT>

×
×
  • Criar Novo...