Um pedaço de código para capturar o endereço de e-mail do Fórum Dongwang
/**
Autor: Ci Qinqiang
E-mail: [email protected]
**/
Recentemente, estive pensando em como promover nosso novo site, http://www.up114.com .
A otimização de mecanismos de pesquisa é naturalmente a primeira escolha, mas você não pode abandonar a correspondência em massa. Embora a correspondência em massa seja desprezada,
contanto que você selecione o alvo da correspondência em massa e envie menos, tudo bem, :=——. .
Então encontrei alguns fóruns sobre tópicos relacionados, muitos dos quais são fóruns Dongwang. Agora preciso
coletar os endereços de e-mail dos usuários do fórum. Também existem ferramentas especiais vendidas online, mas hoje escreveremos nós mesmos uma pequena ferramenta, que também pode ser alcançada. o mesmo objetivo.
O código é o seguinte. Use ferramentas de edição de texto como o Bloco de Notas para salvá-lo como dv.vbs.
Antes de usá-lo, você precisa ir ao fórum, registrar-se como usuário e fazer login.
Uso: c:cscript dv.vbs está bem.
'O local de armazenamento dos endereços de e-mail coletados
strFile = "d:email.txt"
srtUrl = " http://bbs.aaa.com "
iStart = 1 'Valor mínimo do ID do usuário
iEnd = 1000 'Valor máximo do ID do usuárioFor
i = iStart para iEnd
strUrl1 = strUrl & "/dispuser.asp?id=" & cstr(i)
strRet = OpenUrl(strurl1)
strRet = getMid(strRet,"mailto:",">") 'Este local pode precisar ser alterado de forma flexível.
Se eu mod 100=0 então.
chamar WriteToFile(strArquivo,strA)
strA = ""
outro
se strRet<>"" então strA = strA & strRet & vbCrLf
terminar se
Wscript.Echo i & vbTab & strRet
Próximo
Sub WriteToFile(strArquivo,str)
Dim fso, f
Definir fso = CreateObject("Scripting.FileSystemObject")
Definir f = fso.OpenTextFile(strfile, 8, True)
f.Escrever str
definir f = nada
definir fso = nada
Finalizar sub
Função bytes2BSTR(vIn)
Escureça eu
strReturn = ""
Para i = 1 para LenB(vIn)
EsteCharCode = AscB(MidB(vIn,i,1))
Se ThisCharCode <&H80 Então
strReturn = strReturn & Chr(ThisCharCode)
Outro
PróximoCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
eu = eu + 1
Terminar se
Próximo
bytes2BSTR = strReturn
Função final
Função OpenUrl(strUrl)
em caso de erro, retomar próximo
conjunto xmlhttp = CreateObject("Microsoft.XMLHTTP")
xmlhttp.open "GET",(strUrl),falso
xmlhttp.send
OpenUrl=bytes2BSTR(xmlhttp.ResponseBody)
Definir xmlhttp = Nada
Função final
Função getMid(str, str1, str2)
Escureça eu
j
str11 = ""
i = InStr(str, str1)
Se eu > 0 Então
j = InStr(i,str,str2)
Se j > 0 Então
str11 = Médio(str, i + Len(str1), j - i - Len(str1))
Terminar se
Terminar se
getMid=str11
Função final