|
| |
'テレモ株価放送から株価をデータベースに格納するスクリプト
NHKNo = 1
'------------------ テレモ株価の抽出＆格納
Set ChScan = WScript.CreateObject("ifchsam.ttapi")
Set General = WScript.CreateObject("ifchsam.gapi")
ChScan.OpenChScan("-i")
kbDate = CheckDate(NHKNo, 101, 2, 0) '日付を番組101から得る
if kbDate <> Empty Then
Call GetAndSetData(NHKNo, 101, 0, kbDate)
Call GetAndSetData(NHKNo, 102, 0, kbDate)
Call GetAndSetData(NHKNo, 103, 0, kbDate)
Call GetAndSetData(NHKNo, 104, 0, kbDate)
Call GetAndSetData(NHKNo, 105, 0, kbDate)
Call GetAndSetData(NHKNo, 106, 1, kbDate)
Call GetAndSetData(NHKNo, 107, 2, kbDate)
Call GetAndSetData(NHKNo, 111, 3, kbDate)
Call GetAndSetData(NHKNo, 112, 3, kbDate)
Set DBC = WScript.CreateObject("ADODB.Connection")
Set RS = WScript.CreateObject("ADODB.RecordSet")
DBC.Open "ttkabuka"
SQL = "SELECT * FROM ログ"
RS.Open SQL, DBC, 3, 3
RS.AddNew
RS.Fields("日付") = CDate(kbDate)
RS.Update
RS.Close
DBC.Close
end if
ChScan.CloseChScan(0)
Set ChScan = Nothing
Set General = Nothing
' WScript.Echo "終わり"
'-------------------------------------
'
' 日付の抽出＆チェック
'
Function CheckDate(Ch, Prog, Page, mode)
' Set ChScan = WScript.CreateObject("ifchsam.ttapi")
'ChScanからテキストを取り出す
' ChScan.OpenChScan("-i")
set ccc = ChScan.modeform
ccc.rectform = TRUE
ccc.repword = "×"
ChScan.modeform = ccc
bbb = ChScan.GetPageDataHandle (Ch,Prog,Page)
if bbb = 0 then
' ChScan.CloseChScan(0)
' Set ChScan = Nothing
CheckDate = Empty
Exit Function
end if
fff = ChScan.GetTTForm(bbb, onetext)
ChScan.DeletePageDataHandle (bbb)
' ChScan.CloseChScan(0)
' Set ChScan = Nothing
hi = GetStringForm(onetext, 1, 53, 10) ' "1 2 . 2 3 "
hi = Replace(hi, " ", "") ' "12.23"
hi = Replace(hi, ".", "/") ' "12/23"
hi = CStr(Year(Now))&"/"&hi ' "98/12/23"
revDate = CDate(hi) ' 送信日
if mode <> 3 then ' 東証１・２、大証、名証
hi = GetStringForm(onetext, 2, 1, 4) ' "2 2 "
else ' 店頭番組
hi = GetStringForm(onetext, 2, 4, 4) ' "2 2 "
end if
hi = Replace(hi, " ", "") ' "22"
if IsNumeric(hi) then
fi = CInt(hi) ' 確定日にち
else
CheckDate = Empty
Exit Function
end if
ei = Day(revDate)
if fi > ei then '月がかわっている
if Month(revDate) = 1 then
kbDate = DateSerial(Year(revDate)-1, 12, fi) 'しかも新年
else
kbDate = DateSerial(Year(revDate), Month(revDate)-1, fi)
end if
else
kbDate = DateSerial(Year(revDate), Month(revDate), fi)
end if
' ログのチェック
Set DBC = WScript.CreateObject("ADODB.Connection")
Set RS = WScript.CreateObject("ADODB.RecordSet")
DBC.Open "ttkabuka"
SQL = "SELECT * FROM ログ WHERE (日付 = #" & CStr(kbDate) & "#)"
RS.Open SQL, DBC, 3, 3
count = RS.RecordCount
RS.Close
if count > 0 then 'すでにこの日付のデータがある
CheckDate = Empty
else
CheckDate = kbDate
end if
DBC.Close
End Function
'
' データの取り出し＆日付のチェック
'
Sub GetAndSetData(Ch, Prog, mode, kbDate)
' Set ChScan = WScript.CreateObject("ifchsam.ttapi")
'ChScanからテキストを取り出す
' ChScan.OpenChScan("-i")
set ccc = ChScan.modeform
ccc.rectform = TRUE
ccc.repword = "×"
ChScan.modeform = ccc
onetext = ""
num=ChScan.GetPageNumber(Ch,Prog)
for j=1 to num
bbb = ChScan.GetPageDataHandle (Ch,Prog,j)
fff = ChScan.GetTTForm(bbb, onetext)
ChScan.DeletePageDataHandle (bbb)
if mode <> 3 then ' 東証１・２、大証、名証
kaku = GetStringForm(onetext, 6, 1, 2) ' 確
hi = GetStringForm(onetext, 2, 1, 4) ' "2 2 "
else ' 店頭番組
kaku = GetStringForm(onetext, 7, 1, 2) ' 確
hi = GetStringForm(onetext, 4, 1, 4) ' "2 2 "
end if
hi = Replace(hi, " ", "") ' "22"
if IsNumeric(hi) then
ihi = CInt(hi)
if kaku = "確" and Day(kbDate) = ihi then ' 確定して日付が正しい
pageIndex = (Prog*100+j)*10
Call SetDataBase(onetext, mode, kbDate, pageIndex)
end if
end if
next
' ChScan.CloseChScan(0)
' Set ChScan = Nothing
End Sub
'
' ９つの銘柄を格納
'
Sub SetDataBase(onetext, mode, dateIn, pageIndex)
bSpace = FALSE '前の欄が空いていない
Set DBC = WScript.CreateObject("ADODB.Connection")
Set RS = WScript.CreateObject("ADODB.RecordSet")
DBC.Open "ttkabuka"
for jj = 1 to 9 '各ページに９つの銘柄
name = GetKabuValue(onetext, jj, 0, FALSE)
if name <> "" then
Select Case mode
case 0
RS.Open "SELECT * FROM 東証１部", DBC, 3, 3
case 1
RS.Open "SELECT * FROM 大名証", DBC, 3, 3
case 2
RS.Open "SELECT * FROM 東証２部", DBC, 3, 3
case 3
RS.Open "SELECT * FROM 店頭", DBC, 3, 3
End Select
RS.AddNew
RS.Fields("名称") = GetKabuValue(onetext, jj, 0, FALSE)
RS.Fields("始値") = GetKabuValue(onetext, jj, 1, bSpace)
RS.Fields("高値") = GetKabuValue(onetext, jj, 2, bSpace)
RS.Fields("安値") = GetKabuValue(onetext, jj, 3, bSpace)
RS.Fields("終値") = GetKabuValue(onetext, jj, 4, bSpace)
RS.Fields("前日比") = GetKabuValue(onetext, jj, 5, bSpace)
RS.Fields("出来高") = GetKabuValue(onetext, jj, 6, bSpace)
RS.Fields("日付") = dateIn
' RS.Fields("市場") = market
' RS.Fields("コード") = code
RS.Fields("PageIndex") = pageIndex+jj '番組*10000+ページ*100+銘柄の位置
RS.Update
RS.Close
bSpace = FALSE '欄を利用
else
bSpace = TRUE '欄が空いた
end if
next
DBC.Close
End Sub
'
' val=0:銘柄, 1:始値, 2:高値, 3:安値, 4:終値, 5:比較, 6:出来高
' num=1〜9
'
Function GetKabuValue(str, num, val, bSpace)
Select Case num
Case 1
col = 3: start = 13
Case 2
col = 3: start = 25
Case 3
col = 3: start = 37
Case 4
col = 3: start = 49
Case 5
col = 11: start = 1
Case 6
col = 11: start = 13
Case 7
col = 11: start = 25
Case 8
col = 11: start = 37
Case 9
col = 11: start = 49
Case Else
GetKabuValue = 0
Exit Function
End Select
if val > 6 then
GetKabuValue = 0
Exit Function
end if
col = col + val
if bSpace then 'JT(101-23)などのように2つの欄を使う可能性がある
size = 24
if num <> 1 or num <> 5 then
start = start - 12
end if
else
size = 12
end if
tmp = GetStringForm(str, col, start, size)
if val = 0 then
'銘柄名
GetKabuValue = Replace(tmp, " ", "")
else
'株価
tmp1 = Replace(tmp, " ", "")
if IsNumeric(tmp1) then
GetKabuValue = CSng(tmp1)
else
i = InStr(1, tmp1, "▼", 0)
if i = 1 then
tmp2 = Right(tmp1, len(tmp1)-1)
if IsNumeric(tmp2) then
GetKabuValue = -1 * CSng(tmp2)
else
GetKabuValue = 0
end if
else
GetKabuValue = 0
end if
end if
end if
End Function
'
' 全角文字を２バイト、半角文字を１バイトとして
' 文字列を半角座標で取り出す
'
Function GetStringForm(str, col, start, length)
b = General.GetStringForm(str, col, start, length, strSelect)
GetStringForm = strSelect
End Function
'''''スクリプトバージョン
Function GetStringFormBak(str, col, start, length)
alen=len(str)
co = 1
k = 1
do
if col = co then
exit do
end if
ret = InStr(k,str, chr(13)&chr(10), 0)
k=ret+2
co = co+1
loop while k 0 then
co = co + 1 '半角
else
co = co + 2 '全角
end if
kk = kk + 1
ln = ln + 1
loop while co <> length
exit do
end if
if Asc(Mid(str, k, 1)) > 0 then
co = co + 1 '半角
else
co = co + 2 '全角
end if
k = k+1
loop while Asc(Mid(str, k, 1)) <> 13
GetStringForm = Mid( str, k, ln)
End Function
|