2,718
社区成员
发帖
与我相关
我的任务
分享
DECLARE LONG URLDownloadToFileA IN Urlmon LONG, STRING@, STRING@, LONG, LONG
DECLARE LONG DeleteUrlCacheEntry IN Wininet STRING@
LOCAL oxhttp AS Microsoft.xmlhttp
oxhttp=CREATEOBJECT("Microsoft.xmlhttp")
oxhttp.OPEN("GET",'http://www.ifrog.cc/course/28',.F.)
oxhttp.SEND()
SourceCode=oxhttp.responseBody
RELEASE oxhttp
&&SourceCode = STRCONV(SourceCode,11)
lclength = LEN(SourceCode)
FOR a=1 TO lclength
lcString=SUBSTR(SourceCode,a,31)
IF lcString == '<i class="icon-course-chapter">'
lnstart = a
a = lclength
ENDIF
ENDFOR
FOR a=lnstart TO lclength
lcString=SUBSTR(SourceCode,a,52)
IF lcString == '<form action="/comment/course/28" id="comment-form">'
lnend = a
a = lclength
ENDIF
ENDFOR
SourceCode = SUBSTR(SourceCode,lnstart,lnend - lnstart)
FOR a=1 TO 49
lcnum = STREXTRACT(SourceCode,'<a href="/section/','" target="_blank">',a)
lcurl = 'http://www.ifrog.cc/section/'+lcnum
LOCAL oxhttp
lndelay = 0
lcstatus = 'ok'
oxhttp=CREATEOBJECT("InternetExplorer.Application")
oxhttp.Navigate(lcurl)
oxhttp.visible = .T.
Do While oxhttp.ReadyState != 4 AND lcstatus == 'ok'
INKEY(1,'H')
lndelay = lndelay + 1
IF lndelay = 5
lcstatus = 'fail'
ENDIF
ENDDO
IF lcstatus = 'ok'
SourceCode1 = oxhttp.Document.body.innerhtml
oxhttp.Quit
RELEASE oxhttp
lctarget = STREXTRACT(SourceCode1,"file:'/uploads/2016/","'",1)
lcdownurl = 'http://www.ifrog.cc/uploads/2016/'+lctarget &&if error?
IF DownloadFile(lcdownurl,'.\'+STRTRAN(STRTRAN(lctarget,':',''),'/','')) = .F.
MESSAGEBOX(lctarget+' failed',48,'Tips',800)
ELSE
MESSAGEBOX(lctarget+' ok',48,'Tips',800)
ENDIF
ELSE
oxhttp.Quit
RELEASE oxhttp
a = a - 1
ENDIF
ENDFOR
***********************Function DownloadFile***********************
FUNCTION DownloadFile(cURL, cLocalFileName)
IF URLDownloadToFileA(0, @cURL, @cLocalFileName, 0, 0) == 0
DeleteUrlCacheEntry(@cURL)
RETURN .T.
ENDIF
RETURN .F.
ENDFUNC
***************************Function End*****************************
*************************Function urlencode*************************
FUNCTION urlencode(lcUrl)
LOCAL r, i
r = ''
FOR i=1 TO LEN(lcUrl)
r = r + '%' + RIGHT(TRANSFORM(ASC(SUBSTR(lcUrl, i, 1)), '@0'), 2)
ENDFOR
RETURN r
ENDFUNC
***************************Function End*****************************
Function URLEncode2(tcUrl)
Local cRet, cc, c2, ii, jj
tcUrl = Strconv(tcUrl,12)
cRet = ''
For ii = 1 to Len(tcUrl) step 2
cc = Substr(tcUrl, ii, 2)
If Asc(Right(cc,1)) == 0 and Asc(Left(cc,1)) < 128
cRet = cRet + Left(cc, 1)
Else
cc = Strconv(Strconv(cc,10), 15)
c2 = ''
For jj = 1 to Len(cc) step 2
c2 = c2 + '%' + Substr(cc,jj,2)
EndFor
cRet = cRet + c2
EndIf
EndFor
Return cRet
EndFunc
...
SourceCode = Substr(SourceCode,lnstart,lnend - lnstart)
For a = 1 To 49
lcnum = Strextract(SourceCode,'<a href="/section/','" target="_blank">',a)
lcurl = 'http://www.ifrog.cc/section/'+lcnum
Local oxhttp
lndelay = 0
lcstatus = 'ok'
oxhttp=Createobject("InternetExplorer.Application")
oxhttp.Navigate(lcurl)
oxhttp.Visible = .T.
Do While oxhttp.ReadyState != 4 And lcstatus == 'ok'
Inkey(1,'H')
lndelay = lndelay + 1
If lndelay = 5
lcstatus = 'fail'
Endif
Enddo
If lcstatus = 'ok'
Sys(3101,65001) && 重要: 定义 vfp 与 COM 对象间用 utf-8 编码交换数据
SourceCode1 = oxhttp.Document.body.innerhtml && 现在 SourceCode1 是 utf-8 编码
Sys(3101,0)
try
oxhttp.Quit
Catch
EndTry
Release oxhttp
Local c1, c2
c1 = Strconv([file:'/uploads/2016/],9)
c2 = Strconv(['],9)
lctarget = Strextract(SourceCode1,c1,c2,1)
lcdownurl = Strconv([http://www.ifrog.cc/uploads/2016/],9)+lctarget
lcdownurl = URLEncode2(lcdownurl)
If DownloadFile(Strconv(lcdownurl+Chr(0),5),Strconv(lctarget+Chr(0),12)) = .F.
Messagebox(Strconv(lctarget,11)+' failed',48+4096,'Tips',800)
Else
Messagebox(Strconv(lctarget,11)+' ok',64+4096,'Tips',800)
Endif
Else
try
oxhttp.Quit
Catch
EndTry
Release oxhttp
a = a - 1
Endif
Endfor
DECLARE LONG URLDownloadToFileA IN Urlmon LONG, STRING@, STRING@, LONG, LONG
DECLARE LONG DeleteUrlCacheEntry IN Wininet STRING@
LOCAL oxhttp AS Microsoft.xmlhttp
oxhttp=CREATEOBJECT("Microsoft.xmlhttp")
oxhttp.OPEN("GET",'http://www.ifrog.cc/course/28',.F.)
oxhttp.SEND()
SourceCode=oxhttp.responseBody
RELEASE oxhttp
SourceCode = STRCONV(SourceCode,11)
lclength = LEN(SourceCode)
FOR a=1 TO lclength
lcString=SUBSTR(SourceCode,a,31)
IF lcString == '<i class="icon-course-chapter">'
lnstart = a
a = lclength
ENDIF
ENDFOR
FOR a=lnstart TO lclength
lcString=SUBSTR(SourceCode,a,52)
IF lcString == '<form action="/comment/course/28" id="comment-form">'
lnend = a
a = lclength
ENDIF
ENDFOR
SourceCode = SUBSTR(SourceCode,lnstart,lnend - lnstart)
FOR a = 1 TO 49
lcnum = STREXTRACT(SourceCode,'<a href="/section/','" target="_blank">',a)
lcurl = 'http://www.ifrog.cc/section/'+lcnum
LOCAL oxhttp
lndelay = 0
lcstatus = 'ok'
oxhttp=CREATEOBJECT("InternetExplorer.Application")
oxhttp.NAVIGATE(lcurl)
oxhttp.VISIBLE = .T.
DO WHILE oxhttp.ReadyState != 4 AND lcstatus == 'ok'
INKEY(1,'H')
lndelay = lndelay + 1
IF lndelay = 5
lcstatus = 'fail'
ENDIF
ENDDO
IF lcstatus = 'ok'
SYS(3101,65001) && 重要: 定义 vfp 与 COM 对象间用 utf-8 编码交换数据
SourceCode1 = oxhttp.DOCUMENT.body.innerhtml && 现在 SourceCode1 是 utf-8 编码
SYS(3101,0)
TRY
oxhttp.QUIT
CATCH
ENDTRY
RELEASE oxhttp
LOCAL c1, c2
c1 = STRCONV([file:'/uploads/2016/],9)
c2 = STRCONV(['],9)
lctarget = STREXTRACT(SourceCode1,c1,c2,1)
lcdownurl = STRCONV([http://www.ifrog.cc/uploads/2016/],9)+lctarget
lcdownurl = URLEncode2(lcdownurl)
IF DownloadFile(STRCONV(lcdownurl+CHR(0),5),STRCONV(lctarget+CHR(0),12)) = .F.
MESSAGEBOX(STRCONV(lctarget,11)+' failed',48+4096,'Tips',800)
ELSE
MESSAGEBOX(STRCONV(lctarget,11)+' ok',64+4096,'Tips',800)
ENDIF
ELSE
TRY
oxhttp.QUIT
CATCH
ENDTRY
RELEASE oxhttp
a = a - 1
ENDIF
ENDFOR
***********************Function DownloadFile***********************
FUNCTION DownloadFile(cURL, cLocalFileName)
IF URLDownloadToFileA(0, @cURL, @cLocalFileName, 0, 0) == 0
DeleteUrlCacheEntry(@cURL)
RETURN .T.
ENDIF
RETURN .F.
ENDFUNC
***************************Function End*****************************
*************************Function urlencode*************************
FUNCTION URLEncode2(lcurl)
LOCAL ReadyState, ii
ReadyState = ''
FOR ii=1 TO LEN(lcurl)
ReadyState = ReadyState + '%' + RIGHT(TRANSFORM(ASC(SUBSTR(lcurl, ii, 1)), '@0'), 2)
ENDFOR
RETURN ReadyState
ENDFUNC
***************************Function End*****************************
*************************Function urlencode2*************************
FUNCTION URLEncode2(tcUrl)
LOCAL cRet, cc, c2, ii, jj
tcUrl = STRCONV(tcUrl,12)
cRet = ''
FOR ii = 1 TO LEN(tcUrl) STEP 2
cc = SUBSTR(tcUrl, ii, 2)
IF ASC(RIGHT(cc,1)) == 0 AND ASC(LEFT(cc,1)) < 128
cRet = cRet + LEFT(cc, 1)
ELSE
cc = STRCONV(STRCONV(cc,10), 15)
c2 = ''
FOR jj = 1 TO LEN(cc) STEP 2
c2 = c2 + '%' + SUBSTR(cc,jj,2)
ENDFOR
cRet = cRet + c2
ENDIF
ENDFOR
RETURN cRet
ENDFUNC
***************************Function End******************************