Ir para conteúdo
Fórum Script Brasil

Roberto Carvalho

Membros
  • Total de itens

    30
  • Registro em

  • Última visita

Tudo que Roberto Carvalho postou

  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. Olá, Preciso de alguêm que faça algumas alterações num sistema já existente. Nada muito complicado.. criar um relatórios..modificar outros e fazer algumas pequenas alterações. Pago R$500,00 Se alguêm se interessar responda o tópico..
  4. 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.
  5. 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
  6. Roberto Carvalho

    Super Busca

    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.
  7. Exatamente isso cara... Muito obrigado.
  8. 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á.
  9. 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.
  10. 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 %>
  11. Não funcionou... não quero que ele execute a função quando a pagina carregar e sim entre os loops do meu codigo ASP. Mesmo assim obrigado. Sera que alguém tem uma solução diferente?
  12. 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 %>
  13. 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.
  14. 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 %>
  15. 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á.
  16. 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.
  17. E ai galera, alguém sabe se tem alguma função que verifica se o usuário possui uma webcam ou não???
  18. Roberto Carvalho

    Webcam

    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....
  19. Sim, mas esta tabela de preços pode ser mudada a qualquer momento, eu queria uma função que funciona-sse em todos.... mesmo assim o brigado pela ajuda.
  20. 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??????????????
  21. 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
  22. 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%>
  23. 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á.
  24. 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...