Clique abaixo para nos ajudar
Login

Esqueci minha senha

Estamos no Facebook
Buscar
 
 

Resultados por:
 


Rechercher Busca avançada

Quem está conectado
13 usuários online :: Nenhum usuário registrado, Nenhum Invisível e 13 Visitantes :: 1 Motor de busca

Nenhum

[ Ver toda a lista ]


O recorde de usuários online foi de 468 em 1/3/2012, 10:43
Últimos assuntos
» Ajuda a direcionar
Hoje à(s) 01:17 por miiiih

» Alterar uma palavra num arquivo de texto
5/12/2016, 12:02 por Teseu

» Buscar endereço por CEP
3/12/2016, 19:59 por pedrossian

» USAR WEBSERVICE NO VFP9
2/12/2016, 09:50 por AJC

» BANIMENTO DE USUARIO
17/11/2016, 08:31 por FAF

» Impressora Ticket
15/11/2016, 09:20 por clima238

» Gráfico
9/11/2016, 10:43 por hidroluz

» TRANSPOR TABELA
9/11/2016, 10:34 por hidroluz

» MUDANÇA DO .DBF PARA POTSGREE
9/11/2016, 09:12 por AJC

» Website com videoaulas sobre linguagens de programação
8/11/2016, 09:56 por JLDR

» Parceria para desenvolvimento de template em Wordpress
7/11/2016, 19:15 por mindix

» Data fica invertida na planilha que é gerada via programa.
27/10/2016, 11:00 por Linghston

» Maximizar report direto do menu
21/10/2016, 20:48 por Rosangela Pires

» Fechar form com tempo
21/10/2016, 10:15 por Rosangela Pires

» URGENTE: Ajuda com impressora ELGIN-L42
14/10/2016, 09:53 por megasoft

» Opções para gerar NF-e
10/10/2016, 09:07 por mavsinfo

» Google Maps
8/10/2016, 15:08 por Rosangela Pires

» Mysql
5/10/2016, 11:22 por Marcos Guedes

» Acessando Banco em MYSQL de um projeto WORDPRESS
3/10/2016, 10:58 por Marcos Guedes

» OPTION SELECT MOSTRAR CAMPOS QUASE PRONTO
26/9/2016, 21:09 por BobKuspe

Alterar uma palavra num arquivo de texto

5/12/2016, 12:02 por Teseu

Olá prezados colegas de programação!

Este é eu primeiro post no fórum e gostaria de poder …

Comentários: 0

Buscar endereço por CEP

3/12/2016, 19:59 por pedrossian

Caros amigos, meu código para buscar endereço pelo CEP não funciona mais.
Alguém pode me …

Comentários: 0

USAR WEBSERVICE NO VFP9

2/12/2016, 09:50 por AJC

Pessoal, preciso de um material ou livro que me traga instruções como
usar a consumação de …

Comentários: 0

BANIMENTO DE USUARIO

13/11/2016, 16:21 por FAF

A usuária ROSANGELA PIRES ao tentar acessar o Forum obtem sempre a mensagem de BANIMENTO.
A mesma …

Comentários: 3

Impressora Ticket

15/11/2016, 09:20 por clima238

Bom dia,
Por favor alguém me explique porque o código abaixo imprime no ecrã em vez do printer: …

Comentários: 0

Estatísticas
Temos 6963 usuários registrados
O último usuário registrado atende pelo nome de miiiih

Os nossos membros postaram um total de 17119 mensagens em 2577 assuntos

[Tópico Único] - Funções Interessantes

Página 3 de 4 Anterior  1, 2, 3, 4  Seguinte

Ver o tópico anterior Ver o tópico seguinte Ir em baixo

[Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 2/4/2009, 01:17

Relembrando a primeira mensagem :

Conferindo CEP
Clique aqui para acessar o site oficial e/ou consultar o exemplo em outras linguagens...

Código:
* ########################################################################################
* #######        Desenvolvido por Leandro Sbrissa                                  ####### 
* #######        MSN: [Você precisa estar registrado e conectado para ver este link.]                                        #######
* ########################################################################################

* EXEMPLO FEITO PELO COLEGA ACIMA E CONVERTIDO PARA O VFP POR PABLO SOLLAR
******************************************************************************************

* Cria objeto e realiza consulta no "[Você precisa estar registrado e conectado para ver este link.] (XML)


lc_cep_a_ser_procurado="50920180"

lc_url_procura ="http://www.buscarcep.com.br/?cep="+lc_cep_a_ser_procurado+"&formato=xml"

srvXMLHttp = CreateObject("MSXML2.ServerXMLHTTP.4.0")
srvXMLHttp.open("GET",lc_url_procura,.f.)
srvXMLHttp.Send()
*!*MESSAGEBOX(srvXMLHttp.responseText)
STORE "" TO cep, uf, cidade, bairro, t_logradouro, logradouro, resultado, resultado_txt

*Cria objeto e Adquiri resultado da busca em formato XML
xmlResult  = CreateObject("MSXML2.DomDocument")
xmlResult.loadXML(srvXMLHttp.ResponseText)

* Recupera valores do resultado da busca
* ********************** Observação 
*     O servidor [Você precisa estar registrado e conectado para ver este link.] retorna apenas 1 resultado para cada CEP
*    por esta razão o método ".item(0)" foi usado, ou seja, se existisse, mais de 1 resultado
*    seria necessario realizar um LOOP de "0" à "xmlResult.length" para recuperar
*    todos os items de cada resultado retornado com o nome de cada nó do XML
   

resultado    = xmlResult.SelectNodes("//resultado"      ).item(0).Text
resultado_txt= xmlResult.SelectNodes("//resultado_txt"  ).item(0).Text
cep          = xmlResult.SelectNodes("//cep"            ).item(0).Text

*     Caso ocorra alguma irregularidade os nós abaixo não vão existir
*    portanto para evitar erros pegaremos os valore apenas se o resultado for positivo 

IF INT(VAL(resultado)) > 0
  uf          = xmlResult.SelectNodes("//uf"            ).item(0).Text
  cidade      = xmlResult.SelectNodes("//cidade"        ).item(0).Text
  bairro      = xmlResult.SelectNodes("//bairro"        ).item(0).Text
  t_logradouro = xmlResult.SelectNodes("//tipo_logradouro").item(0).Text
  logradouro  = xmlResult.SelectNodes("//logradouro"    ).item(0).Text
ENDIF

CLEAR
?cep
?uf
?cidade
?bairro
?t_logradouro
?logradouro


Última edição por Marcos Guedes em 3/5/2010, 11:09, editado 6 vez(es)

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo


Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 3/10/2009, 09:54

Lendo tamanho de arquivo:
Código:
CLEAR
?tamanhoarquivo(GETFILE())

FUNCTION tamanhoarquivo
    LPARAMETERS caminhoarquivo AS STRING

    *!* Devolve o tamanho do arquivo em Bytes *!*

    IF (VARTYPE(m.caminhoarquivo)!="C") OR EMPTY(m.caminhoarquivo) THEN
        RETURN 0
    ENDIF

    *!* Armazena o total de arquivos
    *!* contidos no diretório fitrado
    LOCAL totalarquivos AS INTEGER

    LOCAL set_default
    LOCAL tamanhoarquivo && Em Bytes
    LOCAL contador AS INTEGER

    *!* Pega o caminho default em que a aplicação se encontra
    m.set_default = SET("Default")+CURDIR()

    TRY
        SET DEFAULT TO (JUSTPATH(m.caminhoarquivo))

        m.totalarquivos = ADIR(arrayarquivos)

        FOR m.contador = 1 TO m.totalarquivos
            *!* Procura pelo arquivo
            IF UPPER(ALLTRIM(arrayarquivos[m.contador,1])) == ;
                    UPPER(ALLTRIM(JUSTFNAME(m.caminhoarquivo))) THEN
                *!* Tamanho do arquivo selecionado (Em Bytes)
                m.tamanhoarquivo = arrayarquivos[m.contador,2]
                EXIT
            ENDIF
        ENDFOR
    CATCH
        m.tamanhoarquivo = 0
    FINALLY
    ENDTRY

    *!* Retorna ao caminho default em que a aplicação se encontrava
    SET DEFAULT TO (m.set_default)

    RETURN m.tamanhoarquivo
ENDFUNC

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 24/10/2009, 22:11

Verifica se um número pertence a operadora Claro:
Código:
?verificarclaro("00", "00000000")
FUNCTION verificarclaro AS logical
    LPARAMETERS ddd AS STRING, telefone AS STRING
    *!*
    *!* Autor: Marcos Guedes
    *!* Data: 24/10/2009
    *!*
    IF (VARTYPE(m.ddd)!="C") THEN
        m.ddd = ""
    ENDIF
    IF (VARTYPE(m.telefone)!="C") THEN
        m.telefone = ""
    ENDIF
    *!*
    LOCAL loxmlhttp AS OBJECT
    LOCAL resultado AS logical
    *!*
    m.loxmlhttp = CREATEOBJECT("MSXML2.XMLHTTP")
    m.parametros = "msisdn="+m.ddd+m.telefone
    *!* Consulta o número do telefone nos servicos da claro
    m.loxmlhttp.OPEN("POST","http://www.claroideias.com.br/portal/site/CIdeias/ClaroClubeServices?service=consultarClienteClaro",.F.)
    m.loxmlhttp.setrequestheader("content-type", "application/x-www-form-urlencoded")
    m.loxmlhttp.SEND(m.parametros)
    m.resultado = !"não é"$m.loxmlhttp.responsetext
    m.loxmlhttp = NULL
    *!*
    RETURN m.resultado
ENDFUNC
Obs: Até onde testei, funciona perfeitamente! Deixei a data incluída na função pois talvez haja mudanças na operadora, futuramente.

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 10/11/2009, 16:41

Retirando acentos das palavras:
Código:
CLEAR
?retirar_acento("á é í ó ú à è ì ò ù")
?retirar_acento("Á É Í Ó Ú À È Ì Ò Ù")
*!*
FUNCTION retirar_acento AS STRING
   LPARAMETERS centrada AS STRING
   *!*
   LOCAL cfiltroentrada AS STRING
   LOCAL cfiltrosaida AS STRING
   LOCAL csaida AS STRING
   *!*
   m.cfiltroentrada = "áéíóúàèìòùâêîôûäëïöüãõçñºÁÉÍÓÚÀÈÌÒÙÂÊÎÔÛÄËÏÖÜÃÕÇÑ"
   *!*
   m.cfiltrosaida = "aeiouaeiouaeiouaeiouaocnoAEIOUAEIOUAEIOUAEIOUAOCNO"
   *!*
   m.csaida = CHRTRAN(m.centrada, m.cfiltroentrada, m.cfiltrosaida)
   *!*
   RETURN m.csaida
ENDFUNC

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 11/11/2009, 14:33

Download de arquivos via HTTP:
Código:
CLEAR
?baixar_arquivo_http("http://www.news2news.com/vfp/downloads/w32data.zip", "f:\lixo\teste.zip")
*!*
FUNCTION baixar_arquivo_http AS logical
   LPARAMETERS urlArquivoHTTP as String, caminhoArquivoLocal as String
   
   DECLARE INTEGER URLDownloadToFile IN urlmon.DLL;
      INTEGER pCaller, STRING szURL,;
      STRING szFileName, INTEGER dwReserved,;
      INTEGER lpfnCB

   LOCAL cremotefile, clocalfile, nresult
   cremotefile = m.urlArquivoHTTP
   clocalfile = m.caminhoArquivoLocal

   WAIT WINDOW NOWAIT "Downloading file..."
      nresult = urldownloadtofile(0, cremotefile, clocalfile, 0,0)
   WAIT CLEAR

   RETURN (nresult = 0)
ENDFUNC

Adaptada do link abaixo:
[Você precisa estar registrado e conectado para ver este link.]

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 13/11/2009, 16:17

Reindexando tabelas:

Como utilizar:
Código:
CLEAR
*!*
LOCAL caminhodb as Logical
m.caminhodb = "C:\Program Files\Microsoft Visual FoxPro 9\Samples\Data\testdata.DBC"
*!*
?reindexar(m.caminhodb, "customer")
?reindexar(m.caminhodb, "employee")
?reindexar(m.caminhodb, "Orders")
?reindexar(m.caminhodb, "orditems")
?reindexar(m.caminhodb, "products")

A função:
Código:
FUNCTION reindexar AS logical
   LPARAMETERS caminhodb AS STRING, nometabela AS STRING
   *!*
   LOCAL continuar AS logical
   LOCAL ok AS logical
   *!*
   m.continuar = .T.
   m.ok = .T.
   *!*
   TRY
      OPEN DATABASE (m.caminhodb)

      IF USED(m.nometabela)
         m.continuar = RLOCK(m.nometabela)
      ENDIF

      USE (m.nometabela) IN SELECT(m.nometabela) EXCLUSIVE
      SELECT(m.nometabela)
      REINDEX

      UNLOCK IN (m.nometabela)

      USE IN SELECT(m.nometabela)

      SET DATABASE TO (m.caminhodb)
      CLOSE DATABASES
   CATCH
      m.ok = .F.
   FINALLY
   ENDTRY
   *!*
   RETURN m.ok
ENDFUNC

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por alceu11 em 15/11/2009, 10:08

Falta coloca aquela minha rotina ,aqui neste topico,pq mesmo sem saber as tabelas monta a rotina inteira de reindexacao, que voce melhorou, sera que dava pra voce Marcos Guedes postala aqui !!!!he he Laughing
porque na sua tem indentificar a base e as tabelas, ja a minha faz tudo sozinho e gera o prg de reindexacao!!!

alceu11
Usuário 5 Estrelas
Usuário 5 Estrelas


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 16/11/2009, 09:32

[Você precisa estar registrado e conectado para ver este link.] escreveu:Falta coloca aquela minha rotina ,aqui neste topico,pq mesmo sem saber as tabelas monta a rotina inteira de reindexacao, que voce melhorou, sera que dava pra voce Marcos Guedes postala aqui !!!!he he Laughing
porque na sua tem indentificar a base e as tabelas, ja a minha faz tudo sozinho e gera o prg de reindexacao!!!
Aí está, Alceu!
Com sua autorização.

Código:
CLOSE DATABASES ALL
CLOSE ALL
USE
CLOSE TABLES ALL

CREATE TABLE arquivos (dbf_nome c(18),acao c(40),reindexa c(15),banco c(15))
SELECT arquivos

CLEAR
SET CONSOLE OFF
SET NOTIFY OFF
SET SAFETY OFF
SET ALTERNATE TO testos.txt
SET ALTERNATE ON

sofazuma=.F.

gndbcnumber = ADIR(gadatabase, '*.DBC') && Create array
?
? '* Nome de database: '

wbanco=SPACE(20)
FOR ncount = 1 TO gndbcnumber && Loop for number of databases
    ? '* '+gadatabase(ncount,1) && Display database names
    wbanco=gadatabase(ncount,1)
ENDFOR

? '*Este o arquivo testo, de nome testos.txt que fiz com set alternate'
? '*Nome dos dbf: REINDEXACAO'
_arq=''
gntables = ADIR(gadataba, '*.Dbf') && Create array

FOR ncount = 1 TO gntables && Loop for number of databases

    ? '* '+ gadataba(ncount,1)
    IF !EMPTY(gadataba(ncount,1))
        IF  UPPER(gadataba(ncount,1)) <>UPPER('foxuser.dbf') OR TRIM(UPPER(gadataba(ncount,1)))<>UPPER('ARQUIVOS.DBF')
            SELECT arquivos
            APPEND BLANK
            REPLACE dbf_nome WITH gadataba(ncount,1)
            _arq=ALLTRIM(arquivos.dbf_nome)
            IF RIGHT(_arq,3)='DBF'
                _arq = LEFT(_arq,LEN(_arq)-4)
            ENDIF

            REPLACE acao WITH 'Use '+_arq +' Alias '+ALLTRIM(_arq) + ' IN 0  EXCLUS'
            REPLACE reindexa WITH 'reindex'
            IF !EMPTY(wbanco)
                REPLACE banco WITH wbanco
            ENDIF

            IF !EMPTY(wbanco)
                IF sofazuma=.F.
                    ? 'OPEN DATABASE '+wbanco
                ENDIF
            ENDIF

            ?[IF USED("]+ALLTRIM(_arq)+[")]
            ?[    m.continuar = RLOCK("]+ALLTRIM(_arq)+[")]
            ?[ENDIF]
            ?[]
            ?[USE ("]+ALLTRIM(_arq)+[") IN SELECT("]+ALLTRIM(_arq)+[") EXCLUSIVE]
            ?[SELECT("]+ALLTRIM(_arq)+[")]
            ?[REINDEX]
            ?[]
            ?[UNLOCK IN ("]+ALLTRIM(_arq)+[")]
            ? '*****************'
        ENDIF
    ENDIF
    sofazuma=.T.
ENDFOR
SET ALTERNATE TO
SET ALTERNATE OFF
SET CONSOLE ON
SELECT arquivos
GO TOP

BROWSE

MODIFY COMMAND testos.txt

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 1/12/2009, 12:07

Converte Hexadecimal para Decimal:
Código:
?Hex2Decimal("FB")

FUNCTION Hex2Decimal(tcHex)
  *-- remove the invalid characters
  tcHex = CHRTRAN(tcHex,CHRTRAN(tcHex,"0123456789ABCDEFabcdef",""),"")
  RETURN EVALUATE("0x"+tcHex)
ENDFUNC

Fonte:
[Você precisa estar registrado e conectado para ver este link.]

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 1/12/2009, 12:24

Converte Decimal para Hexadecimal:
Código:
CLEAR
?RIGHT(dectohex(32),2)
?RIGHT(dectohex(191),2)
?RIGHT(dectohex(251),2)

FUNCTION dectohex
   PARAMETERS lidecnumber
   lshexnumber = ""
   IF lidecnumber > 0 && It's not negative, so do a straight TRANSFORM.
      lshexnumber = TRANSFORM(lidecnumber, "@0")
   ELSE

      *-- The number is negative, so we'll have to do a little more work,
      *-- since it's not as straight forward as converting and adding a
      *-- minus sign.

      *-- Find the length of the resulting hex string.
      lshexnumber = TRANSFORM(ABS(lidecnumber), "@0")
      IF SUBSTR(lshexnumber, 3, 1) = "0" && The number has filled the
         && eight places of DWORD.
         lilength = LEN(SUBSTR(lshexnumber, notat("0", lshexnumber, 2)))
      ELSE
         *-- Subtract to account for "0x".
         lilength = LEN(TRANSFORM(ABS(lidecnumber), "@0")) - 2
      ENDIF

      lstemphex = 0xffffffff
      lshexnumber = TRANSFORM(lstemphex-ABS(lidecnumber) + 1, "@0")
   ENDIF
   RETURN lshexnumber
ENDFUNC

FUNCTION notat()
   PARAMETERS lsnotstring, lssearchstring, lioccurrence

   llfound      = .F.  && Flag indicates if we've found a character that
   && is NOT lsNotString
   llendofstring = .F.  && Flag to indicate that we've reached the end
   && of the string.
   lncounter    = 0    && Tracks position during the search.
   lnlength      = LEN(lssearchstring)
   lioccurcount  = 0    && Tracks how many occurrences have been found.

   *-- Loop until the desired character is found or the end of
   *-- the string is reached.
   DO WHILE NOT llfound AND NOT llendofstring
      lncounter = lncounter + 1
      lscompare = SUBSTR(lssearchstring, lncounter, 1)
      IF lscompare <> lsnotstring
         lioccurcount = lioccurcount + 1

         *-- Have we found the occurrence we want?
         IF lioccurcount = lioccurrence
            llfound = .T.
         ENDIF
      ENDIF
      IF lncounter = lnlength
         llendofstring = .T.
      ENDIF

   ENDDO
   RETURN lncounter
ENDFUNC
Fonte:
[Você precisa estar registrado e conectado para ver este link.]

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 1/12/2009, 12:31

Obtendo informações da máquina (IP Address, Mac Address, Máscara de Rede, etc...) :
Código:
#DEFINE error_success               0
#DEFINE error_not_supported         50
#DEFINE error_invalid_parameter      87
#DEFINE error_buffer_overflow       111
#DEFINE error_no_data               232
#DEFINE max_adapter_name_length      256
#DEFINE max_adapter_description_length 128
#DEFINE max_adapter_address_length    8

CLEAR
LOCAL obj AS OBJECT
m.obj = NEWOBJECT("pcinfo")

? "IP Address: "
?? m.obj.get_ip_address()

? "Adapter Name: "
?? m.obj.get_adapter_name()

? "Description: "
?? m.obj.get_description()

? "Net Mask: "
?? m.obj.get_net_mask()

? "Gateway: "
?? m.obj.get_gateway()

? "DHCP Enabled: "
?? m.obj.get_dhcp_enabled()

? "DHCP Server: "
?? m.obj.get_dhcp_server()

? "Wins Server: "
?? m.obj.get_wins_server()

? "Mac Address (Decimal): "
?? m.obj.get_mac_address_dec()

? "Mac Address (Hexadecimal): "
?? m.obj.get_mac_address_hex()

m.obj = NULL

DEFINE CLASS pcinfo AS CUSTOM

   HIDDEN ip_address AS STRING
   HIDDEN adapter_name AS STRING
   HIDDEN cdescription AS STRING
   HIDDEN net_mask AS STRING
   HIDDEN gateway AS STRING
   HIDDEN dhcp_enabled AS logical
   HIDDEN dhcp_server AS STRING
   HIDDEN wins_server AS STRING
   HIDDEN mac_address_dec AS STRING
   HIDDEN mac_address_hex AS STRING   

   FUNCTION get_ip_address AS STRING
      RETURN THIS.ip_address
   ENDFUNC

   FUNCTION get_adapter_name AS STRING
      RETURN THIS.adapter_name
   ENDFUNC

   FUNCTION get_description AS STRING
      RETURN THIS.cdescription
   ENDFUNC

   FUNCTION get_net_mask AS STRING
      RETURN THIS.net_mask
   ENDFUNC

   FUNCTION get_gateway AS STRING
      RETURN THIS.gateway
   ENDFUNC

   FUNCTION get_dhcp_enabled AS logical
      RETURN THIS.dhcp_enabled
   ENDFUNC

   FUNCTION get_dhcp_server AS STRING
      RETURN THIS.dhcp_server
   ENDFUNC

   FUNCTION get_wins_server AS STRING
      RETURN THIS.wins_server
   ENDFUNC

   FUNCTION get_mac_address_dec AS STRING
      *!* Mac Address em formato decimal
      RETURN THIS.mac_address_dec
   ENDFUNC

   FUNCTION get_mac_address_hex AS STRING
      *!* Mac Address em formato hexadecimal
      RETURN THIS.mac_address_hex
   ENDFUNC

   HIDDEN PROCEDURE INIT AS void
      THIS.getinfoall()
   ENDPROC

   HIDDEN FUNCTION dectohex
      PARAMETERS lidecnumber
      lshexnumber = ""
      IF lidecnumber > 0 && It's not negative, so do a straight TRANSFORM.
         lshexnumber = TRANSFORM(lidecnumber, "@0")
      ELSE

         *-- The number is negative, so we'll have to do a little more work,
         *-- since it's not as straight forward as converting and adding a
         *-- minus sign.

         *-- Find the length of the resulting hex string.
         lshexnumber = TRANSFORM(ABS(lidecnumber), "@0")
         IF SUBSTR(lshexnumber, 3, 1) = "0" && The number has filled the
            && eight places of DWORD.
            lilength = LEN(SUBSTR(lshexnumber, THIS.notat("0", lshexnumber, 2)))
         ELSE
            *-- Subtract to account for "0x".
            lilength = LEN(TRANSFORM(ABS(lidecnumber), "@0")) - 2
         ENDIF

         lstemphex = 0xffffffff
         lshexnumber = TRANSFORM(lstemphex-ABS(lidecnumber) + 1, "@0")
      ENDIF
      RETURN lshexnumber
   ENDFUNC

   HIDDEN FUNCTION notat()
      PARAMETERS lsnotstring, lssearchstring, lioccurrence

      llfound      = .F.  && Flag indicates if we've found a character that
      && is NOT lsNotString
      llendofstring = .F.  && Flag to indicate that we've reached the end
      && of the string.
      lncounter    = 0    && Tracks position during the search.
      lnlength      = LEN(lssearchstring)
      lioccurcount  = 0    && Tracks how many occurrences have been found.

      *-- Loop until the desired character is found or the end of
      *-- the string is reached.
      DO WHILE NOT llfound AND NOT llendofstring
         lncounter = lncounter + 1
         lscompare = SUBSTR(lssearchstring, lncounter, 1)
         IF lscompare <> lsnotstring
            lioccurcount = lioccurcount + 1

            *-- Have we found the occurrence we want?
            IF lioccurcount = lioccurrence
               llfound = .T.
            ENDIF
         ENDIF
         IF lncounter = lnlength
            llendofstring = .T.
         ENDIF

      ENDDO
      RETURN lncounter
   ENDFUNC

   HIDDEN PROCEDURE getinfoall AS void
      LOCAL lcitem AS STRING
      m.lcitem = 'NONE'

      DECLARE INTEGER GetAdaptersInfo IN iphlpapi;
         STRING @pAdapterInfo, LONG @pOutBufLen

      LOCAL lcbuffer, lnbufsize
      lnbufsize = 0
      lcbuffer = ""

      * this call usually returns the ERROR_BUFFER_OVERFLOW
      * with lnBufsize set to the required amount of memory
      = getadaptersinfo(@lcbuffer, @lnbufsize)

      lcbuffer = REPLI(CHR(0), lnbufsize)
      IF getadaptersinfo(@lcbuffer, @lnbufsize) <> error_success
         * still something is wrong
         RETURN ""
      ENDIF



      DO CASE
         CASE lcitem='NONE'
            THIS.ip_address = STRTRAN(SUBSTR(lcbuffer, 433,15), CHR(0),"")
         CASE lcitem='IP'
            RETURN STRTRAN(SUBSTR(lcbuffer, 433,15), CHR(0),"")
      ENDCASE

      DO CASE
         CASE lcitem='NONE'
            THIS.adapter_name = STRTRAN(SUBSTR(lcbuffer, 9, 260), CHR(0), "")
         CASE lcitem='NAME'
            RETURN STRTRAN(SUBSTR(lcbuffer, 9, 260), CHR(0), "")
      ENDCASE
      DO CASE
         CASE lcitem='NONE'
            THIS.cdescription = STRTRAN(SUBSTR(lcbuffer, 269, 132), CHR(0), "")
         CASE lcitem='DESC'
            RETURN STRTRAN(SUBSTR(lcbuffer, 269, 132), CHR(0), "")
      ENDCASE
      DO CASE
         CASE lcitem='NONE'
            THIS.net_mask = STRTRAN(SUBSTR(lcbuffer, 449, 15), CHR(0), "")
         CASE lcitem='NETMASK'
            RETURN STRTRAN(SUBSTR(lcbuffer, 449, 15), CHR(0), "")
      ENDCASE
      DO CASE
         CASE lcitem='NONE'
            THIS.gateway = STRTRAN(SUBSTR(lcbuffer, 473, 15), CHR(0), "")
         CASE lcitem='GATEWAY'
            RETURN STRTRAN(SUBSTR(lcbuffer, 473, 15), CHR(0), "")
      ENDCASE
      DO CASE
         CASE lcitem='NONE'
            THIS.dhcp_enabled = ASC(SUBSTR(lcbuffer, 421, 1))<>0
         CASE lcitem='DHCPON'
            RETURN ASC(SUBSTR(lcbuffer, 421, 1))<>0
      ENDCASE
      DO CASE
         CASE lcitem='NONE'
            THIS.dhcp_server = STRTRAN(SUBSTR(lcbuffer, 513, 15), CHR(0), "")
         CASE lcitem='DHCPSERVER'
            RETURN STRTRAN(SUBSTR(lcbuffer, 513, 15), CHR(0), "")
      ENDCASE
      DO CASE
         CASE lcitem='NONE'
            THIS.wins_server = STRTRAN(SUBSTR(lcbuffer, 557, 15), CHR(0), "")
         CASE lcitem='WINSSERVER'
            RETURN STRTRAN(SUBSTR(lcbuffer, 557, 15), CHR(0), "")
      ENDCASE

      LOCAL lnaddrlen, lcaddress, ii, ch, lcmacaddr
      lnaddrlen = ASC(SUBSTR(lcbuffer, 401, 1))
      lcaddress = SUBSTR(lcbuffer, 405, lnaddrlen)

      DO CASE
         CASE lcitem='NONE'
            THIS.mac_address_dec = ""
            THIS.mac_address_hex = ""
            FOR ii=1 TO lnaddrlen
               THIS.mac_address_dec = THIS.mac_address_dec + ALLTRIM(STR(ASC(SUBSTR(lcaddress, ii,1)))) + " "
               THIS.mac_address_hex = THIS.mac_address_hex + RIGHT(THIS.dectohex(ASC(SUBSTR(lcaddress, ii,1))),2) + " "
            ENDFOR
         CASE lcitem='MAC'
            lcmacaddr = ''
            FOR ii=1 TO lnaddrlen
               lcmacaddr = lcmacaddr + PADL(int2hex(ASC(SUBSTR(lcaddress, ii,1))),2,'0')+ " "
            ENDFOR
            RETURN ALLTRIM(lcmacaddr)
      ENDCASE

   ENDPROC

ENDDEFINE

Obs: Adaptei esta rotina a partir de uma solução encontrada no seguinte link:
[Você precisa estar registrado e conectado para ver este link.]

Acesse o link do autor para mais detalhes!

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 6/1/2010, 17:50

Deletando um diretório:
Código:
deletardiretorio("caminho\do\diretorio")

PROCEDURE deletardiretorio AS void
   LPARAMETERS caminho as String
   LOCAL objdel AS "Scripting.FileSystemObject"
   m.objdel = NEWOBJECT("Scripting.FileSystemObject")
   m.objdel.deletefolder(m.caminho, .T.)
   m.objdel = NULL
ENDPROC

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 16/1/2010, 23:40

Deletando registros duplicados:

Código:
*!* Criação de um cursor para demonstração:
CREATE CURSOR teste (campo1 c(50), sequencia i(4) AUTOINC)
INSERT INTO teste (campo1) VALUES ("Marcos Guedes")
INSERT INTO teste (campo1) VALUES ("Marcos Guedes")
INSERT INTO teste (campo1) VALUES ("Marcos Guedes")
INSERT INTO teste (campo1) VALUES ("Programação Brasil")
INSERT INTO teste (campo1) VALUES ("Programação Brasil")
INSERT INTO teste (campo1) VALUES ("http://www.programacaobrasil.com")
INSERT INTO teste (campo1) VALUES ("http://www.programacaobrasil.com")
INSERT INTO teste (campo1) VALUES ("http://www.programacaobrasil.com")
INSERT INTO teste (campo1) VALUES ("http://www.programacaobrasil.com")
INSERT INTO teste (campo1) VALUES ("http://www.programacaobrasil.com")

*!* Demonstração
SELECT teste
BROWSE

*!* Chamada à função
*!* Obs.: É necessário informar, no terceiro parâmetro,
*!* o nome de um campo do tipo inteiro
*!* Cujos valores são únicos. De preferência um campo AUTOINC
m.deletaduplicado("teste", "campo1", "sequencia")

*!* Demonstração
SELECT teste
BROWSE

*!* A função:
PROCEDURE deletaduplicado AS void
   LPARAMETERS ;
      nometabela AS STRING ,;
      nomecampodeletar AS STRING ,;
      nomecampoautoinc AS STRING
   *!* Deleta registros duplicados
   *!* Obs.: A tabela deverá está aberta e com permissões de alteração
   DELETE FROM (m.nometabela) WHERE &nomecampoautoinc NOT IN ;
      (SELECT MIN(&nomecampoautoinc) FROM (m.nometabela) GROUP BY &nomecampodeletar)
ENDPROC

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 17/1/2010, 01:37

[Você precisa estar registrado e conectado para ver este link.] escreveu:boa gostei

so ta faltando colocar aquela minhas funcoes aqui......vc esqueceu hehe

Pensei que fosse esta:
[Você precisa estar registrado e conectado para ver este link.]

Se não for, posta aí pois estou esquecido.
bounce

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Retirar caracteres de um texto, ou textbox

Mensagem por alceu11 em 18/1/2010, 08:23

Código:

*!*   Remover caracteres de uma cadeia de texto
*!*   Esta e uma  rotina básicas que sempre devemos ter en conta para validar
*!*   nossa cadeia de texto o extrair so os caracteres que necesitamos.
*!*   Neste exemplo quero extrair todos os caracteres exceto os asteriscos ( * )

? STRTRAN("8S3F292Q843*4567*0Q7S82MU-6","*")

*!*   De outra  *   forma

? CHRTRAN("8S3F292Q843*4567*0Q7S82MU-6", "*", "")

*!*   En caso que queira extrair os números que existan na cadeia

cCadEvalua = "7U.$W592?:0-*3DE4"
&& Cadeia a evaluar

cCaraExt = "1234567890" 
&& Caracteres a extrair

? CHRTRAN( cCadEvalua, CHRTRAN( cCadEvalua, cCaraExt, "" ), "" )



alceu11
Usuário 5 Estrelas
Usuário 5 Estrelas


Voltar ao Topo Ir em baixo

Dicas sobre reports

Mensagem por alceu11 em 18/1/2010, 08:34

*Suponhamos que temos um reporte de 20 paginas, eu posso mandar a imprimir de da pagina 10 a 15
*da seguinte maneira

Código:
REPORT FORM nomedoReport RANGE 10,15

Imagine que vc tem 200 registros, e so quer imprimir so o registro corrente
wrec=RECNO()
Código:
REPORT FORM nomedoreport FOR RECNO()=wrec

alceu11
Usuário 5 Estrelas
Usuário 5 Estrelas


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por alceu11 em 18/1/2010, 08:53

Marcos
o topico que queria que estivesse aqui tambem

[Você precisa estar registrado e conectado para ver este link.]

alceu11
Usuário 5 Estrelas
Usuário 5 Estrelas


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 18/1/2010, 09:57

Em breve moverei o tópico para cá também!


Estou fazendo uma análise geral no fórum, por isso não posso fazer modificação alguma agora.
Smile

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Nelson Arcas em 1/2/2010, 18:31

Validação de numero de pis
Coloquei um form utlizando um metodo como exemplo
validandopis.rar

Nelson Arcas
Participa Bastante
Participa Bastante


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por hugo em 1/2/2010, 19:04

muito bom arcas

valeu

_________________
"A tristeza é a falta de alegria, mais sem ela eu não poderia entender a alegria do fato de que a felicidade existe!"
Helio Leites - [Você precisa estar registrado e conectado para ver este link.]

hugo
Usuário 5 Estrelas
Usuário 5 Estrelas


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Nelson Arcas em 1/2/2010, 19:57

Validação de numero de renavam
Coloquei um form utlizando um metodo como exemplo
validandorenavam.rar

Nelson Arcas
Participa Bastante
Participa Bastante


Voltar ao Topo Ir em baixo

Retornar valor por extenso

Mensagem por Nelson Arcas em 7/2/2010, 09:59

Estou colocando essa função caso interesse pra alguem estar retornando um valor por extenso. Eu utilizo bastante para preencher cheque.

Código:
FUNCTION valor_extenso

PARAMETERS pvalor
local vextenso, flagbilhao, flagmilhao,flagcentavos
DIMENSION unidade[10], dez[10], dezena[10], centena[11]

STORE .F. TO flagbilhao,flagmilhao,flagcentavos

unidade[1] = ""
unidade[2] = "Um "
unidade[3] = "Dois "
unidade[4] = "Três "
unidade[5] = "Quatro "
unidade[6] = "Cinco "
unidade[7] = "Seis "
unidade[8] = "Sete "
unidade[9] = "Oito "
unidade[10] = "Nove "

dez[1]  = "Dez "
dez[2]  = "Onze "
dez[3]  = "Doze "
dez[4]  = "Treze "
dez[5]  = "Quatorze "
dez[6]  = "Quinze "
dez[7]  = "Dezesseis "
dez[8]  = "Dezessete "
dez[9]  = "Dezoito "
dez[10] = "Dezenove "

dezena[1] = ""
dezena[2] = "Dez "
dezena[3] = "Vinte "
dezena[4] = "Trinta "
dezena[5] = "Quarenta "
dezena[6] = "Cinqüenta "
dezena[7] = "Sessenta "
dezena[8] = "Setenta "
dezena[9] = "Oitenta "
dezena[10] = "Noventa "

centena[1] = ""
centena[2] = "Cento "
centena[3] = "Duzentos "
centena[4] = "Trezentos "
centena[5] = "Quatrocentos "
centena[6] = "Quinhentos "
centena[7] = "Seiscentos "
centena[8] = "Setecentos "
centena[9] = "Oitocentos "
centena[10] = "Novecentos "
centena[11] = "Cem "

valorstr = STR(INT(pvalor * 100),14,0)
vextenso = " "
FOR i=1 TO 14
   IF SUBSTR(valorstr,i,1) != " "
      num = VAL(SUBSTR(valorstr,i,1))
      DO CASE
         * --- Bilhao
      CASE i = 1
         IF num = 1 .AND. VAL(SUBSTR(valorstr,i+1,2)) = 0
            vextenso = centena[11]
         ELSE
            vextenso = centena[Num+1] + IIF(SUBSTR(valorstr,i+1,2) = "00" OR num=0, "", "e ")
         ENDIF
         flagbilhao = .T.
      CASE i = 2
         IF num != 1
            vextenso = vextenso + dezena[Num+1] + IIF(SUBSTR(valorstr,i+1,1) = "0" .OR. num=0, "", "e ")
            flagbilhao = .T.
         ELSE
            i=i+1
            num = VAL(SUBSTR(valorstr,i,1))
            vextenso = vextenso + dez[Num+1] + "Bilhões" + IIF(VAL(SUBSTR(valorstr,4))>0,", "," ")
         ENDIF
      CASE i = 3
         IF !(flagbilhao)
            flagbilhao = IIF(num>1,.T.,.F.)
         ENDIF
         vextenso = vextenso + unidade[Num+1] + IIF(flagbilhao,"Bilhões","Bilhão") + IIF(VAL(SUBSTR(valorstr,4))>0,", "," ")

         *---- Milhao
      CASE i = 4
         IF num = 1 .AND. VAL(SUBSTR(valorstr,i+1,2)) = 0
            vextenso = vextenso + centena[11]
         ELSE
            vextenso = vextenso + centena[Num+1] + IIF(SUBSTR(valorstr,i+1,2) = "00" OR num=0, "", "e ")
         ENDIF
         flagmilhao = .T.
      CASE i = 5
         IF num != 1
            vextenso = vextenso + dezena[Num+1] + IIF(SUBSTR(valorstr,i+1,1) = "0" .OR. num=0, "", "e ")
            flagmilhao = .T.
         ELSE
            i=i+1
            num = VAL(SUBSTR(valorstr,i,1))
            vextenso = vextenso + dez[Num+1] + "Milhões" + IIF(VAL(SUBSTR(valorstr,7))>0,", "," ")
         ENDIF
      CASE i = 6
         IF !(flagmilhao)
            flagmilhao = IIF(num>1,.T.,.F.)
         ENDIF
         vextenso = vextenso + unidade[Num+1] + IIF(flagmilhao,"Milhões","Milhão") + IIF(VAL(SUBSTR(valorstr,7))>0,", "," ")

         *--- MILHAR
      CASE i = 7
         IF num = 1 .AND. VAL(SUBSTR(valorstr,i+1,2)) = 0
            vextenso = vextenso +  centena[11]
         ELSE
            vextenso = vextenso +  centena[Num+1] + IIF(SUBSTR(valorstr,i+1,2) = "00" OR num=0, "", "e ")
         ENDIF
      CASE i = 8
         IF num != 1
            vextenso = vextenso + dezena[Num+1] + IIF(SUBSTR(valorstr,i+1,1) = "0" .OR. num=0, "", "e ")
         ELSE
            i=i+1
            num = VAL(SUBSTR(valorstr,i,1))
            vextenso = vextenso + dez[Num+1] + "Mil" + IIF(VAL(SUBSTR(valorstr,10))>0,", "," ")
         ENDIF
      CASE i = 9
         vextenso = vextenso + unidade[Num+1] + "Mil" + IIF(VAL(SUBSTR(valorstr,10))>0,", "," ")

         *--- Reais
      CASE i = 10
         IF num = 1 .AND. VAL(SUBSTR(valorstr,i+1,2)) = 0
            vextenso = vextenso +  centena[11]
         ELSE
            vextenso = vextenso +  centena[Num+1] + IIF(SUBSTR(valorstr,i+1,2) = "00" OR num=0, "", "e ")
         ENDIF
      CASE i = 11
         IF num != 1
            vextenso = vextenso + dezena[Num+1] + IIF(SUBSTR(valorstr,i+1,1) = "0" .OR. num=0, "", "e ")
         ELSE
            i=i+1
            num = VAL(SUBSTR(valorstr,i,1))
            vextenso = vextenso + dez[Num+1] + "Reais" + IIF(VAL(SUBSTR(valorstr,13))>0," e "," ")
         ENDIF
      CASE i = 12
         vextenso=vextenso+unidade[Num+1]+ IIF(EMPTY(vextenso) AND num=1,"Real","Reais") +IIF(VAL(SUBSTR(valorstr,13))>0," e "," ")

         *---- CENTAVOS
      CASE i = 13
         IF num != 1
            vextenso = vextenso + dezena[Num+1]
            flagcentavos = IIF(num>1,.T.,.F.)
         ELSE
            i=i+1
            num = VAL(SUBSTR(valorstr,i,1))
            vextenso = vextenso + dez[Num+1] + "Centavos"
            flagcentavos = .T.
         ENDIF
      CASE i = 14
         IF !(flagcentavos)
            flagcentavos = IIF(num>1,.T.,.F.)
         ENDIF
         IF flagcentavos
            vextenso = vextenso + unidade[Num+1] + IIF(flagcentavos,"Centavos","")
         ELSE
            IF num>0
               vextenso = vextenso + unidade[Num+1] + "Centavo"
            ENDIF
         ENDIF
      ENDCASE
   ENDIF
ENDFOR

RETURN ALLTRIM(vextenso)

Nelson Arcas
Participa Bastante
Participa Bastante


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 7/2/2010, 10:13

Obrigado por cooperar, Nelson!
Very Happy

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por hugo em 7/2/2010, 14:51

boa

_________________
"A tristeza é a falta de alegria, mais sem ela eu não poderia entender a alegria do fato de que a felicidade existe!"
Helio Leites - [Você precisa estar registrado e conectado para ver este link.]

hugo
Usuário 5 Estrelas
Usuário 5 Estrelas


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 11/3/2010, 12:09

Remove TAG's HTML de um conteúdo:
Código:
CLEAR
*!*
?"Exemplo 1:"
?ALLTRIM(removetaghtml("<html>Programação Brasil</html><br>Para programadores em Geral"))
*!*
?
?"Exemplo 2:"
?removetaghtml("<html>Programação Brasil</html><br>Para programadores em Geral",CHR(13))
*!*
FUNCTION removetaghtml AS STRING
   LPARAMETERS conteudo AS STRING, separador as String

   LOCAL objregexp AS OBJECT
   LOCAL resultado AS STRING

   *!* Instancia o objeto responsável por manipular a expressão regular
   m.objregexp = NEWOBJECT("VBScript.RegExp")

   *!* Define a expressão regular
   m.objregexp.PATTERN = "<[^>]*>"

   m.objregexp.ignorecase = .T.    && Ignora "case sensitivity"
   m.objregexp.GLOBAL = .T.  && && Procura por todas as ocorrências

   *!* Remove as tags HTML, com base na expressão regular
   m.resultado = m.objregexp.REPLACE(;
   IIF(VARTYPE(m.conteudo)=="C",m.conteudo,""),IIF(VARTYPE(m.separador)=="C",m.separador," "))
   
   *!* Destrói o objeto
   m.objregexp = null

   RETURN m.resultado
ENDFUNC

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Marcos Guedes em 16/3/2010, 15:56

Valida emails (com expressão regular)
Código:
CLEAR
*!*
?"Exemplo 1:"
?validaEmail("http://www.programacaobrasil.com")
*!*
?
?"Exemplo 2:"
?validaEmail("programacaobrasil@programacaobrasil.com")
*!*
FUNCTION validaEmail AS VOID
  LPARAMETERS email AS STRING

  LOCAL objregexp AS OBJECT
  LOCAL resultado AS STRING

  *!* Instancia o objeto responsável por manipular a expressão regular
  m.objregexp = NEWOBJECT("VBScript.RegExp")

  *!* Define a expressão regular
  m.objregexp.PATTERN = "^([0-9,a-z,A-Z]+)([.,_]([0-9,a-z,A-Z]+))*[@]([0-9,a-z,A-Z]+)([.,_,-]([0-9,a-z,A-Z]+))*[.]([0-9,a-z,A-Z]){2}([0-9,a-z,A-Z])?$"

  m.objregexp.ignorecase = .T.    && Ignora "case sensitivity"
  m.objregexp.GLOBAL = .T.  && && Procura por todas as ocorrências

  *!* Verifica se o email está em formato válido
  m.resultado = m.objregexp.Test(m.email)
 
  *!* Destrói o objeto
  m.objregexp = null

  RETURN m.resultado
ENDFUNC

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Re: [Tópico Único] - Funções Interessantes

Mensagem por Conteúdo patrocinado Hoje à(s) 18:58


Conteúdo patrocinado


Voltar ao Topo Ir em baixo

Página 3 de 4 Anterior  1, 2, 3, 4  Seguinte

Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo


 
Permissão deste fórum:
Você não pode responder aos tópicos neste fórum