Jump to content


Photo

FunçõEs Prontas


  • Faça o login para participar
45 replies to this topic

#1 cinraq

cinraq

    cinrASP

  • Usuários
  • 77 posts
  • Sexo:Não informado
  • Localidade:Rio de Janeiro

Posted 25/01/2003, 13:01

Esta seção se destina somente a postagem de códigos e funções em ASP, ASP.Net e VBScript. Se você tem alguma função que você ache interessante poste aqui para que todos tenham acesso a ela. E se você está procurando uma função procure aqui antes de postar no fórum, pois todos os tópicos abertos pedindo funções que estejam aqui serão fechados e direcionados para cá.

Estou abrindo este tópico porque às vezes em uma mesma semana existem mais de um post igual, perguntando se alguém tem aquela tal função pra isso, e pra aquilo, e a medida que os posts vão avançando elas vão ficando esquecidas e jogadas para o final do fórum até terem que ser apagadas para não sobrecarregar o banco de dados. Então espero que este tópico sirva de referência para todos, porque pra mim seria, com certeza.

Somente algumas regrinhas que peço que sejam cumpridas:
1 - Não poste aqui dúvidas
Caso tenha alguma dúvida sobre erro ou como utilizar o código abra um tópico para isso, isso para que não sobrecarregue mais ainda esta seção. Apenas comentários do postador do código serão aceitas dentro do próprio post, comentando como utilizar e comentários adicionais. E até a nota que dão para o código.
2 - Não adicione anexos nesta seção.
De forma nenhuma, caso tenha algo para dowload que complete o código, do tipo, algum banco de dados, ou outro arquivo, coloque apenas um link para ele.

Mas lembrem-se, este tópico não é para adicionar lojas virtuais, foruns, ou portais em ASP, e sim somente códigos ou funções específicas, do tipo, validação de e-mail, upload, etc. Ok? Até mais então, e qualquer dúvida me contatem.

P.S.: Estarei acrescentando umas funções postadas por outros usuários, com seus respectivos nomes, caso o postador queira adicioná-las como se fosse um post seu me avise que apagarei o meu post.


Para uma melhor organização do tópico

INDÍCE:

- Função para validar e-mail
- Função para validar e-mail '2'
- Código para ver caracteres
- Código para ver caracteres '2'
- Código para salvar arquivos .DOC e .XLS
- Usuários ON - LINE
- Up Load de arquivos em ASP.NET
- Componentes instalados no servidor
- Ver variáveis CGI
- Passar Sobre nome para frente do nome
- Mostrar apenas um pedaço de um texto ( ... )
- Verificação "real" de e-mail
- Listar tabelas de um banco de dados
- Validar CPF
- Tirar aspas simples
- Ver hora em dois paises
- Caracteres da tabela ACS
- Iniciando em ASP.NET
- Formulário postback integrando atecnologia ASP.NET
- Formatar Moedas
- Banner rotativo usando session
- Conexão Base de dados Oracle
- Inserir dados no DB
- Calcular idade
- Pegar data de uma string
- Retirar acentos e aspas
- Criptografar
- Filtro de BADWORDS
- Mostrar nome da imagem
- Select - insere e update do asp
- Calcula idade '2'
- Criptografia '2'
- Validar CNPJ

Este é o indice com todas as funções deste tópico, para achar algo com mais facilmente, digite 'CTRL + F' e digite uma palavra para a busca.

Edição feita por: Luis Otávio, 22/02/2005, 19:03.

"Moro no Brasil.
Não sei se moro muito bem ou muito mal.
Só sei que agora faço parte do país.
A inteligência é fundamental."
(Farofa Carioca)

#2 cinraq

cinraq

    cinrASP

  • Usuários
  • 77 posts
  • Sexo:Não informado
  • Localidade:Rio de Janeiro

Posted 25/01/2003, 13:05

FUNÇÃO PARA VALIDAR E-MAIL

<%
'FUNÇÃO QUE VALIDA O EMAIL
Function Valida_Email(strEmail)

Dim bIsValid

bIsValid = True

If Len(strEmail) < 5 Then

bIsValid = False

Else

If Instr(1, strEmail, " ") <> 0 Then

bIsValid = False

Else

If InStr(1, strEmail, "@", 1) < 2 Then

bIsValid = False

Else

If InStrRev(strEmail, ".") < InStr(1, strEmail, "@", 1) + 2 Then

bIsValid = False

End If

End If

End If

End If

Valida_Email = bIsValid

End Function

para fazer a verificação

if Valida_Email(nomedastrigdeemail) = true then
response.write "email válido"
else
response.write "e-mail inválido"
end if

"Moro no Brasil.
Não sei se moro muito bem ou muito mal.
Só sei que agora faço parte do país.
A inteligência é fundamental."
(Farofa Carioca)

#3 cinraq

cinraq

    cinrASP

  • Usuários
  • 77 posts
  • Sexo:Não informado
  • Localidade:Rio de Janeiro

Posted 25/01/2003, 13:34

FUNÇÃO PARA VALIDAR E-MAIL.
Esta função além de validar se tem "@" e "." também verifica se possui alguns caracteres inválidos, do tipo "/" "\" e outros.

CÓDIGO POSTADO POR Tarkan
<%
Sub chkmail(variavel)
Dim VAcha, XAcha

VAcha = 0
variavel = trim(variavel)

'***** Verifica se encontrou o valor
VAcha = InStr(1, variavel, "X") 
VAcha = VAcha + InStr(1, variavel, "/")
VAcha = VAcha + InStr(1, variavel, "\")
VAcha = VAcha + InStr(1, variavel, ",", 0)
VAcha = (VAcha + InStr(variavel, "@."))
VAcha = (VAcha + InStr(variavel, ".@"))
VAcha = (VAcha + InStr(variavel, ".."))
VAcha = (VAcha + InStr(variavel, " "))
VAcha = (VAcha + InStr(variavel, "*"))
VAcha = (VAcha + InStr(variavel, CHR(34)))
VAcha = (VAcha + InStr(variavel, CHR(60)))
VAcha = (VAcha + InStr(variavel, CHR(62)))
VAcha = (VAcha + InStr(variavel, ";"))
VAcha = (VAcha + InStr(variavel, ")"))
VAcha = (VAcha + InStr(variavel, "("))
VAcha = (VAcha + InStr(variavel, ":")) 

'***** Encontra na última posição 
XAcha = InStr(Len(variavel),variavel, "@")
If XAcha = Len(variavel) Then 
VAcha = VAcha + XAcha
End If

'***** Encontra na primeira posição 
XAcha = InStr(variavel, "@")
If XAcha = 1 Then
VAcha = VAcha + XAcha
End If

'***** Verifica se existe @ 
XAcha = InStr(variavel, "@")
If XAcha = 0 Then
VAcha = VAcha + 1
End If

'***** Verifica se existe . 
XAcha = InStr(variavel, ".")
If XAcha = 0 Then
VAcha = VAcha + 1
End If

'***** Resultado 
If vAcha = 0 Then
variavel="0" 'valido
Else
variavel="1" 'inválido
End If
End Sub
%>

"Moro no Brasil.
Não sei se moro muito bem ou muito mal.
Só sei que agora faço parte do país.
A inteligência é fundamental."
(Farofa Carioca)

#4 cinraq

cinraq

    cinrASP

  • Usuários
  • 77 posts
  • Sexo:Não informado
  • Localidade:Rio de Janeiro

Posted 25/01/2003, 13:37

CÓDIGO PARA VER CARACTERES

CÓDIGO POSTADO POR Firehalk

Ae pessoal,

é basico o codigo, mas é útil, para quem não sabe por exemplo que caractere é o 35, e assim por diante.. Ele lista todos os caracteres possiveis e indica o numero de cada um deles. Fiz isso por necessidade própria, mas quem quiser, aí está:

<%
For x=1 to 255
response.write "<font size=""2"" face=""verdana"">Caractere  " & x & " = <b>  " & chr(x) & "</b></font><br>"
next
%>

Abraços
"Moro no Brasil.
Não sei se moro muito bem ou muito mal.
Só sei que agora faço parte do país.
A inteligência é fundamental."
(Farofa Carioca)

#5 cinraq

cinraq

    cinrASP

  • Usuários
  • 77 posts
  • Sexo:Não informado
  • Localidade:Rio de Janeiro

Posted 25/01/2003, 13:46

CODIGO PARA VER CARACTERES

CÓDIGO POSTADO POR Tarkan
Interessante... ;)
Um amigo meu pediu ontem pra eu fazer um code pra ele, que listasse letras de A até Z, para um site de letras de músicas.
É + - isso que estão postando.
Segue o código para quem precisar:

letra = "A"

while letra <> chr(asc("Z")+1)
	response.write "<a href=coco.asp?artista=" & letra & ">" & letra & "</a>&nbsp;&nbsp;"
	letra = chr(asc(letra)+1)
wend

:D
"Moro no Brasil.
Não sei se moro muito bem ou muito mal.
Só sei que agora faço parte do país.
A inteligência é fundamental."
(Farofa Carioca)

#6 cinraq

cinraq

    cinrASP

  • Usuários
  • 77 posts
  • Sexo:Não informado
  • Localidade:Rio de Janeiro

Posted 25/01/2003, 13:51

CÓDIGO PARA SALVAR ARQUIVOS .DOC OU .XLS

CÓDIGO POSTADO POR yaru
Gente eu estava passeando por uns links qdo descobri, que alguem havia achado a solução para salvar arquivos como os doc, pdf e xls apenas com um script em asp!


bom o artigo tá ai!


<%
'Avisamos que o modelo do arquivo será para download
response.AddHeader "Content-Type","application/x-zip-compressed"

'Identificamos o nome que queremos para o arquivo de destino
'mude o Filename para o nome que você deseja !
response.AddHeader "Content-Disposition","attachment; filename=DemonsASPFX.XLS"
Response.Flush

Response.Buffer = True
Const adTypeBinary = 1
Dim strFilePath

'O ADODB Stream foi utilizado para lermos o arquivo em formato
'binário, o FileSystemObject não permite leituras binárias e 
'se fosse convertido para texto poderíamos danificar o arquivo.
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = adTypeBinary

'Informe aqui o caminho completo do arquivo no servidor,
'se você não souber o caminho completo, mude o "E:\Home..." por
'Server.MapPath("Nome_Do_Arquivo")
objStream.LoadFromFile "E:\Home\FatorX\Web\FXWeb\ASP\Download\DemonsASPFX.xls"

Response.BinaryWrite objStream.Read

objStream.Close
Set objStream = Nothing
Response.Flush
%>

"Moro no Brasil.
Não sei se moro muito bem ou muito mal.
Só sei que agora faço parte do país.
A inteligência é fundamental."
(Farofa Carioca)

#7 cinraq

cinraq

    cinrASP

  • Usuários
  • 77 posts
  • Sexo:Não informado
  • Localidade:Rio de Janeiro

Posted 25/01/2003, 13:55

USUÁRIOS ONLINE

CÓDIGO POSTADO POR O_Chacal
Ae eu lembro que tinha umas pessoas tentando achar um codigo que mostrava quais users estao online...pois bem...este que eu fiz faz isso e sem o global.asa..ai vai o codigo..

O banco de dados:
Você deve ter um tabela com os dados dos cadastrados em seu site...
Crie uma tabela chamada online com os campos
hora - texto
ip - texto
user - texto

A página:
Na pagina em que faz o login do user adicione uma Session que loga o login do usuario. Aqui irei usar como se fosse a session login.

<% Set Conexao = CreateObject("ADODB.CONNECTION")
conStr ="DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & server.MapPath("online")
Conexao.Open ConStr 

agora=Time()
ip=Request.ServerVariables("REMOTE_ADDR")

If Session("login") = "" Then
user=""
Else
user=Session("login")
End If

Sql="INSERT INTO online VALUES ('"&agora&"','"&ip&"','"&user&"')"
Conexao.Execute(Sql)

Sql="DELETE * FROM online WHERE hora < Time()-60 "
Conexao.Execute(Sql)

Sql = "SELECT DISTINCT ip FROM online"
Set RS = Server.CreateObject("ADODB.Recordset")
RS.open Sql,Conexao, 3, 3 
If rs.EOF Then %>
Nenhum usuario está online!
<% else %>
Existem <%=rs.recordcount%> online<BR>
<% Sql1 = "SELECT DISTINCT ip FROM online WHERE user <> '' "
Set RS1 = Server.CreateObject("ADODB.Recordset")
RS1.open Sql1,Conexao, 3, 3 %>
Sendo <%=rs1.recordcount%> membros e 
<%Sql2 = "SELECT DISTINCT ip FROM online WHERE user = '' "
Set RS2 = Server.CreateObject("ADODB.Recordset")
RS2.open Sql2,Conexao, 3, 3 %>
<%=rs2.recordcount%> visitantes.<BR>
<% Sql="Select * from online"
Set rs3=Conexao.Execute(Sql)
If rs1.EOF then %>
<% else %>
Os membros online são: 
<% While Not rs1.EOF %>
<%=rs3("user")%>, 
<% rs1.MoveNext
Wend 
End If 
End If %>


------------------
EH so isso.....se pode dar umas mlehoradas e tal..espero ter ajudado..qualquer duvida perguntem..
"Moro no Brasil.
Não sei se moro muito bem ou muito mal.
Só sei que agora faço parte do país.
A inteligência é fundamental."
(Farofa Carioca)

#8 cinraq

cinraq

    cinrASP

  • Usuários
  • 77 posts
  • Sexo:Não informado
  • Localidade:Rio de Janeiro

Posted 25/01/2003, 14:08

UPLOAD DE ARQUIVOS EM ASP.NET, FUNCIONA NO BRINKSTER.

O brinkster não possui componentes para upload de arquivo mas tem uma solução é em Asp.Net, com esse código que vou passar, só outra coisa, como a única pasta que tem permissão de gravação é a db, somente lá funcionará esse código, mas dentro dessa pasta você também pode criar outros diretórios que vão possuir também permissão de gravação.

arquivo upload.aspx
<script language="VB" runat="server">

	Sub Upload( Sender As Object, e As System.EventArgs )

  Dim sPath as String
  Dim sFile as String
  Dim colFiles As System.Web.HttpFileCollection   
  Dim i As System.Int32

    sPath = Server.MapPath(".")
      If Right(sPath, 1) <> "\" then sPath = sPath & "\"

    msg.Text=""
    colFiles = System.Web.HttpContext.Current.Request.Files 
    
   Try

  For i = 0 To colFiles.Count - 1 

    sFile = System.IO.Path.GetFileName( colFiles(i).FileName )         
   If sFile <> "" then 	 
    colFiles(i).SaveAs( sPath & sFile )
    msg.Text = msg.Text & "<br>" & sFile & " - <font color=red>Salvo</font>"
   End If

  Next

  Catch Ex as Exception
    msg.Text = msg.Text & "<br>???? " & sFile & " ??,?????: " & Ex.Message

   End Try

   If msg.Text = "" then msg.Text = "<br> - Salvo"

	End Sub

</script>
<html>
<head>
<title>Multiple File Upload Example</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<body>

      <form enctype="multipart/form-data" runat=server>
          
  <table border="0" cellspacing="0" cellpadding="4" style='border:1 solid #4358BE'>
    <tr>
      <td style='border-bottom:1 solid #4358BE;background-color:#7a96df;color:white'><b>????</b></td>
    </tr>
    <tr>
   <td><input id="file1" type=file runat=server><br>
    <input id="file2" type=file runat=server><br>
    <input id="file3" type=file runat=server><br>
    
      </td>
	</tr>
    <tr>
      <td align=right><asp:button id=Uploadbtn Text="Enviar" OnClick="Upload" width="70px" height="20px" runat=server/></td>
    </tr>
  </table>
  
<asp:label id="msg"  Font-Bold="True" runat=server/>

     </form>

   </body>
</html>

Você pode acrescentar quantos campos quiser, só modificar o id do campo: <input id="file3" type=file runat=server>, por exemplo file4, file5, etc...

não se esqueçam a extensão de Asp.Net é .aspx, portanto o arquivo tem que ser salvo como upload.aspx, ou outronome.aspx, ok???
"Moro no Brasil.
Não sei se moro muito bem ou muito mal.
Só sei que agora faço parte do país.
A inteligência é fundamental."
(Farofa Carioca)

#9 cinraq

cinraq

    cinrASP

  • Usuários
  • 77 posts
  • Sexo:Não informado
  • Localidade:Rio de Janeiro

Posted 25/01/2003, 15:25

CÓDIGO PARA VER OS COMPONENTES INSTALADOS NO SERVIDOR:

arquivo componentes.asp
<% @ Language="VBScript" %>
<% Option Explicit %>
<%
Dim theComponent(11)
Dim theComponentName(11)

' componentes
theComponent(0) = "ADODB.Connection"
theComponent(1) = "SoftArtisans.FileUp"
theComponent(2) = "AspHTTP.Conn"
theComponent(3) = "AspImage.Image"
theComponent(4) = "LastMod.FileObj"
theComponent(5) = "Scripting.FileSystemObject"
theComponent(6) = "SMTPsvg.Mailer"
theComponent(7) = "CDONTS.NewMail"
theComponent(8) = "Jmail.smtpmail"
theComponent(9) = "SmtpMail.SmtpMail.1"
theComponent(10) = "Persits.Upload.1"
theComponent(11) = "UnitedBinary.AutoImageSize"

' apelido do componente!
theComponentName(0) = "ADODB"
theComponentName(1) = "SA-FileUp"
theComponentName(2) = "AspHTTP"
theComponentName(3) = "AspImage"
theComponentName(4) = "LastMod"
theComponentName(5) = "FileSystemObject"
theComponentName(6) = "ASPMail"
theComponentName(7) = "CDONTS"
theComponentName(8) = "JMail"
theComponentName(9) = "SMTP"
'theComponentName(10) = "Persits Upload"
theComponentName(11) = "AutoImageSize"

Function IsObjInstalled(strClassString)
On Error Resume Next

IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
%>
<html>
<head>
<title>Componentes encontrados - www.asparena.eti.br </title>
</head>
<body>
<table>
<tr>
<td align="center"><b>Componentes 
instalados:</b></font></td>
</tr>
<tr>
<td> <font face="Arial" size="2">
<table border=1>
<% 
Dim i
For i=0 to UBound(theComponent)
If Not IsObjInstalled(theComponent(i)) Then

Else
Response.Write "<tr>" & vbCrLf
Response.Write "<td width=""100%"">" & vbCrLf
Response.Write "<b>" & theComponentName(i) & "</b>" & vbCrLf
Response.Write "</td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
End If
Next 
on error goto 0
%>
</table>
</font> 
</td>
</tr>
</table>
</BODY>
</HTML>

"Moro no Brasil.
Não sei se moro muito bem ou muito mal.
Só sei que agora faço parte do país.
A inteligência é fundamental."
(Farofa Carioca)

#10 <% developer %>

<% developer %>

    Só observando...

  • Usuários
  • 1029 posts
  • Sexo:Não informado
  • Localidade:Manaus - AM

Posted 25/01/2003, 18:26

olha só esse código para ver as variáveis CGI (ServerVariables)...

<% @LANGUAGE=VBSCRIPT %>
<HTML><HEAD><TITLE>Teste do Request - Developer</TITLE></HEAD>
<BODY>
<%FOR EACH ITEM IN Request.ServerVariables 
            Response.write ITEM & " - " & Request.ServerVariables(ITEM) & "<BR>"
      NEXT%>
</BODY></HTML>

falow :lol:
Você é de Manaus?

Quer fazer cursos de webdesign, com professor,
1 computador por aluno? E de graça?


Confira em
Fundação Paulo Feitoza

Links Legais:

Jogar Dominó Online

Jogar Xadrez Online


Códigos ASP para download

#11 Tarkan

Tarkan

    Powered by Linux - Que inglês! ;)

  • Ex-Admins
  • 651 posts
  • Sexo:Masculino
  • Localidade:Copacabana - RJ

Posted 25/01/2003, 20:23

O código abaixo serve para passar o sobrenome para frente do nome, como é usado para buscas em bibliotecas, etc.

Ex. 1: "Gustavo Veiga" ficaria "Veiga, Gustavo"
Ex. 2: "Miguel Pereira da Silva" ficaria "Silva, Miguel Pereira da"

Esse sistema foi pedido por um amigo exatamente para estes fins, e estou disponibilizando aqui também.

<%
Function VerNome(str)
	Dim strPos, strMid, strAnt

	strPos = InStrRev(str, " ")
	strMid = Mid(str, strPos, Len(str))
	strAnt = Left(str, strPos)

	VerNome = strMid & ", " & strAnt
End Function

Response.Write VerNome("Fulano da Silva Neto")
%>

:D
' nome: gustavo veiga
' profissão: ALOG Data Centers do Brasil (analista de sistemas)
' publicidade: ALOG Data Centers do Brasil

#12 ShitWeb

ShitWeb

    12 Horas

  • Usuários
  • 147 posts
  • Sexo:Não informado
  • Localidade:Araucária - PR

Posted 25/01/2003, 23:04

dae,
as vezes vc tem a necessidade de mostrar algum texto cortado para o visitante, muitos usam usam a função mid, essa função serve para cortar um texto sem cortar as palavras ao meio,

Function MidText(STR, QTDE)'STR: texto a ser cortado; QTDE: qtde de caracteres a serem cortados

Dim Texto, I, Tamanho, Resultado

Texto=Split(Trim(STR), " ")

For I=0 TO UBOUND(Texto)
Resultado=Resultado&" "&Texto(I)
IF LEN(Resultado)>=QTDE Then Exit For
Next

MidText=Server.HTMLEncode(Resultado)

End Function


Qualquer modificação ou bug corrigido mande uma Pm para mim...

Flw....

#13 ShitWeb

ShitWeb

    12 Horas

  • Usuários
  • 147 posts
  • Sexo:Não informado
  • Localidade:Araucária - PR

Posted 26/01/2003, 00:23

esse codigo aqui é pra verificar email tambem, a diferença que a verificação é real, ele verifica se existe esse email msm...

   '**************************************
   ' Name: A+ Email Verification
   ' Description:Will call a webservice tha
   '     t will verify an email address down to s
   '     erver level. This service is provided fo
   '     r FREE! No costs involved. Try it out!
   ' By: Christopher Michael Chenoweth
   '
   ' Inputs:email address
   '
   ' Returns:A code that tells how good the
   '     address is
   '
   ' Assumes:This calls a web service that
   '     is free to use if you only check 1000 or
   '     less addresses
   '
   ' Side Effects:Must have MSXML3.0 instal
   '     led from MSDN on the server you are usin
   '     g ASP on.
   '
   'This code is copyrighted and has    ' limited warranties.Please see http://w
   '     ww.Planet-Source-Code.com/xq/ASP/txtCode
   '     Id.7300/lngWId.4/qx/vb/scripts/ShowCode.
   '     htm    'for details.    '**************************************
   
   <HTML>
   <%@LANGUAGE="VBScript"%>
   <%
   Dim email
   Dim status
   Dim emaildata
   if Request.Form.Count > 0 Then
    ' Requires Microsoft XML SDK 3.0 available at msdn.microsoft.com.
    ' fill data
    email = Request.Form("email")
   
    ' Call Webservice at CDYNE
     Dim oXMLHTTP
     
     ' Call the web service To Get an XML document
     Set oXMLHTTP = server.CreateObject("Msxml2.ServerXMLHTTP")
     oXMLHTTP.Open "POST", _
    "http://ws.cdyne.com/...mx/VerifyEmail", _
    False
     oXMLHTTP.setRequestHeader "Content-Type", _
     "application/x-www-form-urlencoded"
     oXMLHTTP.send "email=" & server.URLEncode(email)
     Response.Write oxmlhttp.status
     if oXMLHTTP.Status = 200 Then
      Dim oDOM
      Set oDOM = oXMLHTTP.responseXML
      Dim oNL
      Dim oCN
      Dim oCC
      Set oNL = oDOM.getElementsByTagName("ReturnIndicator")
      For Each oCN In oNL
      For Each oCC In oCN.childNodes
     Select Case LCase(oCC.nodeName)
      Case "responsetext"
     emaildata = emaildata & "CodeTxt: " & occ.text & "<BR>"
      Case "responsecode"
     emaildata = emaildata & "Code: " & occ.text & "<BR>"
     End Select
      Next
      Next
      if status = "" Then status = "OK"
      Set oCC = Nothing
      Set oCN = Nothing
      Set oNL = Nothing
      Set oDOM = Nothing
     
     
     
     
     Else
     Status = "Service Unavailable. Try again later"
     End if
     Set oXMLHTTP = Nothing
   
   End if
   %>
   <HEAD>
   <BODY><FORM method="POST" action="">
   <P>Email Address Checker<BR>
   <INPUT type="text" name="email" size="40" value="<%=email%>"></P><%=status %>
   <P><INPUT type="submit" value="Check Email" name="B1"></P>
   <P><%=emaildata%></P>
   </FORM></BODY>
   </HTML>


o único problema é que precisa ter o MSXML3.0 instalado, pre qm tem é uma boa....

Flw

#14 Tarkan

Tarkan

    Powered by Linux - Que inglês! ;)

  • Ex-Admins
  • 651 posts
  • Sexo:Masculino
  • Localidade:Copacabana - RJ

Posted 20/02/2003, 21:43

Aí galera...
Fiz este código hoje para um amigo que me pediu...
Ele lista as tabelas, os campos existentes nela e os valores (se houverem...)

Vale a pena testar:

<%@Language="VBScript"%>
<%
Set Cn = CreateObject("ADODB.Connection")
ConnString = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("bd.mdb")
Cn.Open ConnString

Set cat = CreateObject("ADOX.Catalog")
cat.ActiveConnection = cn

for i = 0 to cat.tables.count - 1
	if lcase(cat.tables(i).type) = "table" Then

  set rs = server.createobject("adodb.recordset")
  rs.open "select * from " & cat.tables(i).name, cn, 1,3,1

  response.write "<br>" & "Tabela: " & cat.tables(i).name & "<br>"

  do until rs.eof
  for x = 0 to rs.fields.count - 1
 	 response.write "Campo: " & rs.fields(x).name & " / Valor: " & rs.fields(x).value & "<br>"
  next

  rs.movenext
  loop

	end if
next

rs.close
Cn.Close

Set rs = Nothing
Set Cn = Nothing
%>

:D
' nome: gustavo veiga
' profissão: ALOG Data Centers do Brasil (analista de sistemas)
' publicidade: ALOG Data Centers do Brasil

#15 Arley

Arley

    12 Horas

  • Usuários
  • 188 posts
  • Sexo:Não informado
  • Localidade:Brasilia
  • Interesses:ASP &lt;br&gt;banco de dados

Posted 28/02/2003, 12:34

Classica função de validar cpf:
function valida_cpf(num)
dim soma, soma2, cpf, cpf2, num, val

if len(num) <> 11 then
val = false
else

	for cpf = 1 to 9 
  soma = soma + (11 - cpf) * mid(num,cpf,1)
	next
	soma = soma mod 11
	soma = 11 - soma
  if (soma = 10) or (soma = 11)  then soma = 0
	
	if cstr(soma) <> cstr(mid(num,10,1)) then
	val= false

	else
  for cpf2 = 1 to 10
 	 soma2 = soma2 + (12-cpf2) * mid(num,cpf2,1)
  next
 	 soma2 = soma2 mod 11
 	 soma2 = 11 - soma2
  
  if (soma2 = 10) or (soma2 = 11) then soma2 = 0
    
  if cstr(soma2) <> cstr(mid(num,11,1)) then
 	 val = false
  else
 	 val = true
  end if
	end if
end if

valida_cpf = val
End function

ok ok!
Sem Imagens!




3 user(s) are reading this topic

0 membro(s), 3 visitante(s) e 0 membros anônimo(s)

IPB Skin By Virteq