La Red de Conocimientos Pedagógicos - Currículum vitae - Código Vbs para leer registros de espacio QQ, ¡traiga comentarios!

Código Vbs para leer registros de espacio QQ, ¡traiga comentarios!

Es más difícil y más largo traer comentarios:

en caso de error, reanudar Siguiente

Dim qq

qq=Trim(InputBox ( "Solo mira el de otras personas"amp; chr(13)amp; chr(13)amp; chr(13)amp "Ingresa el número de QQ que deseas verificar", "Ingresa el número de QQ", ""))< / p>

Dim ie,doc:execute("Set ie=wscript.cr"&"eateobject(""inte"&"rne""amp;""texplorer.ap""amp;""pl" amp ; "ication"")")

es decir.navigate "ABOUT: BLANK": es decir.AddressBar=0: es decir.MenuBar=0: es decir.toolbar= 0: es decir.StatusBar=0: es decir. Resizable=1: es decir.FullScreen=0: es decir.visible=1: es decir.width=1200: es decir.Height=800

Hacer while(es decir.busy): bucle

set doc=ie.document

doc.open

doc.writeln "lt;headgt;lt;stylegt;BODY{SCROLLBAR-FACE-COLOR:#FFFF00;SCROLLBAR-HIGHLIGHT - COLOR: #999900; BARRA DE DESPLAZAMIENTO-COLOR DE SOMBRA: #999900; BARRA DE DESPLAZAMIENTO-COLOR DE PISTA: #999900; }lt;/stylegt;"

'doc.writeln "lt;script language='javascript'gt;function Click(){window.event.returnValue=false;}document.oncontextmenu=Click; ;/Scriptgt;lt;/headgt;"

doc.writeln "lt;body bgcolor='#C0C0C0'gt;"

doc.writeln "lt;H1gt;lt ; a href='/" amp; QQ amp; "' target='_blank'gt;lt;" amp; QQamp; "gt;lt;/agt; lista de registroslt;/H1gt;"

Dim strs

Dim id()

strs = GET_STR("/cgi-bin/blognew/blog_get_titlelist?property=GoREamp;numperpage=100amp;sorttype=0amp;arch= 0amp ;pos=0amp;direct=1amp;uin="amp;QQamp;"amp;vuin="amp; QQ)

'doc.writeln strsamp;"lt;hrgt;"

arryS = Split(strs, "{")

Para n=0 a UBound(arryS)

ReDim id(UBound(arryS))

id( n)=Midstr(arryS(n), "blogid"":", ",")

Si id(n) lt;gt "" Entonces

webwrite id( n), qq

Finalizar si

Siguiente

doc.writeln "lt;/bodygt;lt;/htmlgt;"

doc.close

Establecer ie=Nada

MsgBox "Listo"

wscript.quit

SUB webwrite(ID, QQ)

'En caso de error, reanudar siguiente

Dim strs

'doc.writeln ID&"lt;hrgt;"

strs = GET_STR( " /cgi-bin/blognew/blog_get_data?uin="amp; QQamp;"amp; blogid="amp; ID)

'doc.writeln strsamp; "hrgt;"

tie = Midstr(STRS, "title"": """, """, ")

dat = Midstr(STRS, "ver"": """, """, " )

pub = ubbcode(Midstr(STRS, "html"":""", ""","))

Si pub = "" Entonces

pub = ubbcode(Midstr(STRS, "content"":""", ""","))

End If

qid = Int(Midstr(STRS, "blogid"": ", ",""))

goy = Midstr(STRS, "category"": """, """,")

'Si pub lt;gt; "" Entonces

doc.writeln "lt;SPAN style='CURSOR:hand' onclick=""if (QQ"amp;qidamp;"a.style.display == ' ' ) {QQ"amp; qidamp; "a.style.display = 'none'; } else {QQ"amp; qidamp; "a.style.display = '' }""gt;lt; div style=' border :1px;color de fondo:#FF8000 amp;goyamp;"//Fecha:"amp;datamp;"lt;div style='background-color:#C0C0C0;overflow:auto;'gt;"amp;pubamp;" lt;/divgt;lt;/divgt ;lt;/di

vgt;lt;/SPANgt;lt;HRgt;"

'End If

End Sub

Función Get_Str(GetUrl) En caso de error al reanudar Siguiente: Dim oSend :execute("Set oSend = CreateO"&bject(""Micro"amp;"s""amp;""oft.XM""amp;""LH"amp;"TTP"")") :oSend .open " GET", GetUrl, False: oSend.send(): Get_Str=Bytes2Bstr(oSend.responsebody): Establecer oSend = Nothing: Función final

Función amidr(str, estrellas, extremos) en reanudación de error Siguiente: Dim temp1, temp2, temp3, temp4, msg: temp1=InStr(str, estrellas): temp2=InStr(temp1, str, termina): temp3=temp1 Len(stars): temp4=temp2-temp3: amidr= Mid(str , temp3, temp4): Función final

Función Ubbcode(str)

Ubbcode = Reemplazar(Reemplazar(str, "[em]", "lt; IMG SRC= '/qzone /em/"), "[/em]", ".gif'gt;")

Ubbcode = Reemplazar(Reemplazar(Ubbcode, "[M]", "lt;Pgt; "), "[/M]", "lt;/Pgt;")

Ubbcode = Reemplazar(Reemplazar(Ubbcode, "[img]", "lt;IMG SRC="""), "[/ img]", """gt;")

Ubbcode = Reemplazar(Reemplazar(Ubbcode, "[", "lt;"), "]", "gt;")

Ubbcode = Reemplazar(Reemplazar(Ubbcode, "\n", "lt;brgt;"), "\""", """")

Finalizar función

Función Bytes2Bstr(vIn)

strReturn = ""

Para i = 1 a LenB(vIn)

ThisCharCode = AscB(MidB(vIn, i, 1 ))

Si ThisCharCode lt; H80 Entonces

strReturn = strReturn amp Chr(ThisCharCode)

De lo contrario

NextCharCode = AscB( MidB(vIn, i 1, 1))

strReturn = strReturn amp;

amp; H100 CInt(NextCharCode))

i = i 1

Finalizar si

Siguiente

Bytes2Bstr = strReturn

Función final