ダウンローダーを作ってみよう - abwiki @ ウィキ (ActiveBasic非公式wiki)

ABでもちょっとくふうすれば簡単なダウンローダーがすぐにできる。
ここでは限定的な機能しか無いダウンローダを作る。
連番のファイル例えばhttp://○○001.mp4～http://○○999.mp4
こんなものを毎回右クリするのは地獄だ。
せっかくABがあるんだから、自動化してみようかな。

連番の部分を(*)と置き換えて桁数を入力すれば、内部で展開する。

Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA"(lpszCallerName As BytePtr,dwAccessType As Long,_
lpszProxyName As BytePtr,lpszProxyBypass As BytePtr,dwFlags As Long) As Long
Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA"(hHttpRequest As Long,dwInfoLevel As Long,_
lpvBuffer As BytePtr,ByRef lpdwBufferLength As Long,ByRef lpdwIndex As Long) As Long
Declare Function InternetCloseHandle Lib "wininet.dll"(hInternetHandle As Long) As Long
Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (hInternetSession As Long,_
sUrl As BytePtr,sHeaders As Long,lHeadersLength As Long,lFlags As Long,lContext As Long) As Long
Declare Function InternetReadFile Lib "wininet.dll" (hFile As Long, sBuffer As BytePtr,_
lNumBytesToRead As Long,lNumberOfBytesRead As Long) As Long

Const HTTP_QUERY_CONTENT_TYPE=1
Const HTTP_QUERY_CONTENT_LENGTH=5
Const HTTP_QUERY_LAST_MODIFIED=11

/***********************************************************
ダウンロード。
***********************************************************/
Sub Download(url As BytePtr, localfile As BytePtr)
Dim hOpen As HANDLE, hUrl As HANDLE,hFile As HANDLE
Dim buffer As BytePtr
Dim Size As Long
Dim a As Long
Dim dwReadSize As DWord, dwWriteSize As DWord
Dim TotalReadSize As DWord
Print "接続待ち -> ";MakeStr(url)
Size = 33333
buffer=calloc(Size)
hOpen=InternetOpen(0,0,0,0,0)
hUrl=InternetOpenUrl(hOpen,url,0,0,0,0)
HttpQueryInfo(url,HTTP_QUERY_CONTENT_LENGTH,buffer,Size,a)
Print "ファイルサイズ -> " ; MakeStr(buffer)
hFile = CreateFile(localfile, GENERIC_WRITE, 0, ByVal NULL, CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0)
If hFile = INVALID_HANDLE_VALUE Then
Print "CreateFile失敗"
Goto *goot
End If
Print "DL開始"
Do
InternetReadFile(hUrl, buffer, Size, VarPtr(dwReadSize))
WriteFile(hFile, buffer, dwReadSize,VarPtr(dwWriteSize), ByVal NULL)
If dwReadSize <> dwWriteSize Then Print "書き込みエラー？"
TotalReadSize += dwReadSize
Print TotalReadSize;"Byte"
Loop While (dwReadSize)
Print "完了"
*goot
CloseHandle(hFile)
InternetCloseHandle(hUrl)
InternetCloseHandle(hOpen)
free(buffer)
End Sub

/***********************************************************
strmatch.c -- 文字列照合
***********************************************************/
Function position(text As *Byte, pattern As *Byte) As Long
Dim i As Long, j As Long, k As Long, c As Long

c = pattern[0]: i = 0
while (text[i] <> 0)
if (text[i] = c) Then

k = i+1: j = 1
while (text[k] = pattern[j]) And (pattern[j] <> 0)
k++: j++
Wend

if (pattern[j] = 0) Then
position= k - j /* 見つかった */
Exit Function
End If
End If
i++
Wend
position = -1 /* 見つからなかった */
End Function

/* ワイルドカードの痴漢
(*)がワイルドカードとして機能。
返り血： 痴漢成功ならTRUE、0以外、失敗なら0
*/
Declare Function sprintf CDECL Lib"msvcrt"(s As *Byte, ...) As Long
Const WILD_II = "(*)"
Function wildcard(m1 As *Byte, des As *Byte, keta As Long, value As Long) As Long
Dim p1 As *Byte, p2 As *Byte
Dim internal_buffer[428] As Byte

lstrcpy(internal_buffer, m1)
'1. ワイルドカードを見つける
p1 = position(internal_buffer, WILD_II)
If p1 = -1 Then Exit Function

p2 = internal_buffer+p1+lstrlen(WILD_II)
SetByte(internal_buffer+p1, 0)
sprintf(des, "%s%0*d%s", internal_buffer, keta, value, p2)

wildcard = 1
End Function


#N88BASIC
Dim n As Long, min As Long, max As Long
Dim keta As Long
Dim base_url[428] As Byte, url[428] As Byte
Dim base_local[428] As Byte, local[428] As Byte

lstrcpy(base_url, "http://www.google.cn/(*).jpg")
lstrcpy(base_local, "downloadtest_(*).jpg")

Do
Input "桁数？"; keta
Loop While keta=0
n =0
min = 0
max = 10^keta-1

For n=min To max
wildcard(base_url, url, keta, n)
wildcard(base_local, local, keta, n)
Print MakeStr(url);"->"; MakeStr(local)'for check
' Download(url, local)
Next