Option Explicit
'-------------------------------- main ------------------------------------------
Function ExeLoop()
Dim timerID
ClearTimeOut(TimerID)
' 実行ボタンの連打を防ぐためボタンを無効にする。
document.getElementById("EXE_BUTTON").disabled = true
document.getElementById("JOUTAI").innerHTML= "Sataid Data Get start"
Call DataGet()
document.getElementById("JOUTAI").innerHTML= "Sataid Data Get Finsh"
document.getElementById("FILE_STATUS").innerHTML= " "
document.getElementById("JOUTAI").innerHTML= "Sataid Data Resize start"
Call SataidDataCut()
document.getElementById("JOUTAI").innerHTML= "Sataid Data Resaze Finsh"
document.getElementById("JOUTAI").innerHTML= "Atc File Make"
Call AtcMake()
Call DelData()
' 実行ボタンを有効にする。
document.getElementById("EXE_BUTTON").disabled = false
Call AutoProcess()
End Function
'-------------------------------- AutoProcess main ------------------------------------------
'
Function AutoProcess()
Dim timerID,intInterval
ClearTimeOut(TimerID)
intInterval = CInt( loopform.interval_min.options( loopform.interval_min.selectedIndex ).text )
' チェックがついていて、ボタンが押されていない場合にタイマーを動かす
If (loopform.AUTO_RELOAD.checked = True) and (document.getElementById("EXE_BUTTON").disabled = False) then
' タイマーは動画間隔とする
TIMERID = SetTimeOut("ExeLoop()",(intInterval)*60*1000) ' run program minutes
end if
End Function
'-------------------------------- main ------------------------------------------
'
' 自動更新がクリックされた場合の動作
'
Function auto_reload_clicked()
Dim timerID
If loopform.AUTO_RELOAD.checked then
' タイマーを初期化しプログラムを起動する。
ClearTimeOut(TimerID)
Call exeLoop()
End If
End Function
'-------------------------------- data get main ------------------------------------------
Function DataGet()
Dim oFS,oShell
Dim strCommand
Dim strSrcPath(10),strDestPath(10)
Dim strDestFile0,strDestFile1,strSrcFile
Dim strDestGashu(20),strDestData(20)
Dim strSrcFileName,strDestFileName,strArea,strSataid,strObs
Dim strOptin,strUser,strPass
Dim strCurPath
Dim intPreHour,intAjtHour,intMAX
Dim i,j,k,defaultLoopNum,LoopNum
Dim strOption,oArg
'----------------------------------- initial setting -------------------------------------------
set oFS = CreateObject("Scripting.FileSystemObject")
set oShell = CreateObject("WScript.Shell")
strCurPath = getScriptPath() & "\"
document.getElementById("FILE_STATUS").innerHTML= "DATA GET MAIN" & strCurPath & ""
defaultLoopNum = 13
intMAX = 48
intPreHour = 12 'download the past xx hours
intAjtHour = 9 'time-difference between UTC and local time
strArea = "nw"
' wget procedures (e.g. allow no duplications, timeout is second)
strOptin = "-nc -nd --no-check-certificate --tries=1 --timeout=10 --wait=1"
'-------------------------------- image setting --------------------------------
' select imagery types: add "'" at head of lines if not necessary
If document.getElementbyID( "ir1" ).Checked then strDestGashu(0) = "IR"
If document.getElementbyID( "ir2" ).Checked then strDestGashu(1) = "I2"
If document.getElementbyID( "vis" ).Checked then strDestGashu(2) = "VS"
If document.getElementbyID( "wv" ).Checked then strDestGashu(3) = "WV"
If document.getElementbyID( "ir4" ).Checked then strDestGashu(4) = "I4"
If document.getElementbyID( "gsm" ).Checked then strDestGashu(5) = "GS"
If document.getElementbyID( "synop" ).Checked then strDestData(0) = "SYNOP"
If document.getElementbyID( "ship " ).Checked then strDestData(1) = "SHIP"
If document.getElementbyID( "metar" ).Checked then strDestData(2) = "METAR"
If document.getElementbyID( "temp " ).Checked then strDestData(3) = "TEMP_A"
If document.getElementbyID( "temp " ).Checked then strDestData(4) = "TEMP_B"
If document.getElementbyID( "scat " ).Checked then strDestData(5) = "SCAT_A"
If document.getElementbyID( "scat " ).Checked then strDestData(6) = "SCAT_B"
If document.getElementbyID( "sst" ).Checked then strDestData(7) = "SST"
'--------------------------------- read wis setting ------------------------------
'
Dim oFSText,strData,sIni,intInterval
Dim sUserID,sPassword,sHttps_proxy
sIni = "WIS.INI"
Set oFSText = oFS.OpenTextFile(sIni)
Do While Not oFSText.AtEndOfStream
strData = oFSText.ReadLine
Select Case strData
Case "Time":
strData = oFSText.ReadLine
intAjtHour = strData
Case "Area":
strData = oFSText.ReadLine
strArea = strData
Case "UserID":
strData = oFSText.ReadLine
sUserID = strData
Case "Password":
strData = oFSText.ReadLine
sPassword = strData
Case "Https_proxy":
strData = oFSText.ReadLine
sHttps_proxy = strData
End Select
Loop
if sHttps_proxy<>"" then strOptin = "-e https_proxy=" & sHttps_proxy & " " & strOptin
'----------------------------------- get data setting ---------------------------------
' WIS address
strSrcPath(1) = "https://www.wis-jma.go.jp/sataid/" & strArea & "/"
'strSrcPath(1) = "https://www.wis-jma.go.jp/sataid/" & strArea & "_test/"
strSrcPath(2) = "https://www.wis-jma.go.jp/sataid/OBS/"
'strSrcPath(2) = "https://www.wis-jma.go.jp/sataid/OBS_TEST/"
' save the original data in the following folder
strDestPath(1) = "sataid_data_org"
strDestPath(2) = "obsdata"
if oFS.FolderExists(strDestPath(1))=false then oFS.CreateFolder(strDestPath(1))
if oFS.FolderExists(strDestPath(2))=false then oFS.CreateFolder(strDestPath(2))
' 動画時間設定
intPreHour = CInt( loopform.looplen.options( loopform.looplen.selectedIndex ).text )
' 動画間隔設定
intInterval = CInt( loopform.interval_min.options( loopform.interval_min.selectedIndex ).text )
' sataid data get
For j=0 to intPreHour*(60/intInterval)
For i=0 to UBound(strDestGashu)
if strDestGashu(i)<>"" then
strSrcFileName = MakeFileDate(strDestGashu(i),j/(60/intInterval)+intAjtHour-1)
strSrcFile = strSrcPath(1) & strSrcFileName
strDestFile0 = strCurPath & strSrcFileName
strDestFile1 = strDestPath(1) & "\" & strSrcFileName
if (i < 5 ) then
if (Left(strSrcFileName, 2)<>"VS") or ((CInt(Mid(strSrcFileName, 13, 2)) < 11 ) or (CInt(Mid(strSrcFileName, 13, 2)) > 20 )) then
if (oFS.FileExists(strDestFile1)=FALSE) then
strCommand = "cmd /c " & strCurPath & "wget\bin\wget.exe " & strOptin & " --http-user=" & sUserID & " --http-passwd=" & sPassword & " " & strSrcFile
document.getElementById("FILE_STATUS").innerHTML= "Get SATAID data " & strSrcFileName & ""
oShell.Run strCommand,0,TRUE
if (oFS.FileExists(strDestFile0)=TRUE) then
oFS.MoveFile strDestFile0,strDestFile1
End if
End if
End if
ElseIf ((CInt(Mid(strSrcFileName, 11, 2)) Mod 3) = 0) and (Int(j/(60/intInterval))=j/(60/intInterval)) then
For k=1 to 3
strSrcFileName = MakeFileDate(strDestGashu(i),j/(60/intInterval)+intAjtHour-1+(k*3))
strSrcFile = strSrcPath(1) & strSrcFileName
strDestFile0 = strCurPath & strSrcFileName
strDestFile1 = strDestPath(1) & "\" & strSrcFileName
if ((oFS.FileExists(strDestFile1)=FALSE) and (CInt(Mid(strSrcFileName, 11, 2)) Mod 6) = 0) then
strCommand = "cmd /c " & strCurPath & "wget\bin\wget.exe " & strOptin & " --http-user=" & sUserID & " --http-passwd=" & sPassword & " " & strSrcFile
document.getElementById("FILE_STATUS").innerHTML= "Get SATAID data " & strSrcFileName & ""
oShell.Run strCommand,0,TRUE
if (oFS.FileExists(strDestFile0)=TRUE) then
oFS.MoveFile strDestFile0,strDestFile1
End if
End if
Next 'k
End if
End if
Next 'i
Next 'j
'obsdata get
For i=0 to 4 'synop ship metar tempa tempb
For j=0 to intPreHour
strSrcFileName = MakeFileDate1(strDestData(i),j+intAjtHour)
strSrcFile = strSrcPath(2) & strDestData(i) & "/" & strSrcFileName
strDestFile0 = strCurPath & strSrcFileName
strDestFile1 = strDestPath(2) & "\" & strSrcFileName
if (oFS.FileExists(strDestFile1)=FALSE) or ( j < intPreHour ) then '遡り時間(動画時間以内)
strCommand = "cmd /c " & strCurPath & "wget\bin\wget.exe " & strOptin & " --http-user=" & sUserID & " --http-passwd=" & sPassword & " " & strSrcFile
document.getElementById("FILE_STATUS").innerHTML= "Get Obs data " & strSrcFileName & ""
oShell.Run strCommand,0,TRUE
if (oFS.FileExists(strDestFile0)=TRUE) then
strCommand = "cmd /c move /y " & strDestFile0 & " " & strDestFile1
oShell.Run strCommand,0,TRUE
End if
End if
Next 'j
Next 'i
For i=5 to 6 'metop-a metop-b
For j=0 to 1 '2day
strSrcFileName = MakeFileDate1(strDestData(i),j*24)
strSrcFile = strSrcPath(2) & Left(strDestData(i),4) & "/" & strSrcFileName
strDestFile0 = strCurPath & strSrcFileName
strDestFile1 = strDestPath(2) & "\" & strSrcFileName
strCommand = "cmd /c " & strCurPath & "wget\bin\wget.exe " & strOptin & " --http-user=" & sUserID & " --http-passwd=" & sPassword & " " & strSrcFile
document.getElementById("FILE_STATUS").innerHTML= "Get Obs data " & strSrcFileName & ""
oShell.Run strCommand,0,TRUE
if (oFS.FileExists(strDestFile0)=TRUE) then
strCommand = "cmd /c move /y " & strDestFile0 & " " & strDestFile1
oShell.Run strCommand,0,TRUE
End if
Next 'j
Next 'i
i=7 'sst
For j=0 to 1 '2day
strSrcFileName = MakeFileDate1(strDestData(i),j*24)
strSrcFile = strSrcPath(1) & strSrcFileName
strDestFile0 = strCurPath & strSrcFileName
strDestFile1 = strDestPath(2) & "\" & strSrcFileName
strCommand = "cmd /c " & strCurPath & "wget\bin\wget.exe " & strOptin & " --http-user=" & sUserID & " --http-passwd=" & sPassword & " " & strSrcFile
document.getElementById("FILE_STATUS").innerHTML= "Get Obs data " & strSrcFileName & ""
oShell.Run strCommand,0,TRUE
if (oFS.FileExists(strDestFile0)=TRUE) then
strCommand = "cmd /c move /y " & strDestFile0 & " " & strDestFile1
oShell.Run strCommand,0,TRUE
End if
Next 'j
set oFS = Nothing
set oShell = Nothing
End Function
'-------------------------------- sataid cut main ------------------------------------------
Function SataidDataCut()
Dim oFS,oShell
Dim strCommand
Dim strDestPath,strSrcPath
Dim strDestFile,strSrcFile
Dim strGashu(5),strFileName
Dim strCurPath
Dim intPreHour,intAjtHour,intInterval
Dim i,j
Dim strOption,oArg
Dim fEAST,fWEST,fNORTH,fSOUTH,fReso
Dim sOption,lPixel,lLine,iInterval
strGashu(0) = "IR"
strGashu(1) = "I2"
strGashu(2) = "VS"
strGashu(3) = "WV"
strGashu(4) = "I4"
set oFS = CreateObject("Scripting.FileSystemObject")
set oShell = CreateObject("WScript.Shell")
'strCurPath = oFS.GetParentFolderName(WScript.ScriptFullName) & "\"
strCurPath = getScriptPath() & "\"
strSrcPath = "sataid_data_org" 'large area (origincal data)
strDestPath = "sataid_data_cut" 'small area (cut data)
if oFS.FolderExists(strDestPath)=false then oFS.CreateFolder(strDestPath)
if oFS.FileExists(".\s2s.exe")=False then WScript.Quit(99)
if oFS.FolderExists(strSrcPath) = False then WScript.Quit(99)
'----------------------------------------------------------------------------------
' designation of cutout area (e.g. 20S=-20, 160W=-160 or 200)
' initial setting
fEAST = 120
fWEST = 80
fSOUTH = 00
fNORTH = 40
intAjtHour= 9 'time-difference between UTC and local time
' resolution
fReso = 0.04
'----------------------------------------------------------------------------------
' read argument 時間読み込み
intPreHour = CInt( loopform.looplen.options( loopform.looplen.selectedIndex ).text )
intInterval = CInt( loopform.interval_min.options( loopform.interval_min.selectedIndex ).text )
'----------------------------------------------------------------------------------
' read wis setting
Dim oFSText,strData,sEast,sWest,sSouth,sNorth,sIni
sIni = "WIS.INI"
Set oFSText = oFS.OpenTextFile(sIni)
Do While Not oFSText.AtEndOfStream
strData = oFSText.ReadLine
Select Case strData
Case "Time":
strData = oFSText.ReadLine
intAjtHour = strData
Case "East":
strData = oFSText.ReadLine
fEAST= strData
Case "West":
strData = oFSText.ReadLine
fWEST = strData
Case "South":
strData = oFSText.ReadLine
fSOUTH = strData
Case "North":
strData = oFSText.ReadLine
fNORTH = strData
End Select
Loop
'-------------------------------------------------------------------------------------
if fEAST<0 then fEAST=fEAST+360
lPixel = -(fWEST-fEAST)/fReso+1
lLine = (fNORTH-fSOUTH)/fReso+1
sOption = "-C=99 -D=0 -E=" & fEAST & " -W=" & fWEST & " -S=" & fSOUTH & " -N=" & fNORTH & " -P=" & lPixel & " -L=" & lLine
For j=0 to intPreHour*(60/intInterval)+1
For i=0 to UBound(strGashu)
'File name
strFileName = MakeFileDate(strGashu(i),j/(60/intInterval)+intAjtHour-1)
strSrcFile = strSrcPath & "\" & strFileName
strDestFile = strDestPath & "\" & strFileName
if (oFS.FileExists(strSrcFile)=TRUE) AND (oFS.FileExists(strDestFile)=FALSE) then
strCommand = "cmd /c s2s.exe " & sOption & " -F=" & strSrcFile & " -O=" & strDestFile
oShell.Run strCommand,0,TRUE
End if
Next 'i
Next 'j
set oFS = Nothing
set oShell = Nothing
End Function
'-------------------------------- atc make main ------------------------------------------
Function AtcMake()
Dim vDate,vStartDate,vEndDate,intInterval
Dim sKoteiData(20,3)
Dim sAtcFileName,sIniName,sIntFile
Dim i,j,k
Dim oFS,oFolder,oRE,oArg,strSataid
Dim sDDE,sGMSLP,oShell,sCommand,lRet,sAppName
Dim intMAX,LoopNum,defaultLoopNum,intAjtHour
set oFS = CreateObject("Scripting.FileSystemObject")
set oRE = new RegExp
set oShell = CreateObject("WScript.Shell")
'#####################################################################################
' initial setting
intAjtHour = 9 'time-difference between UTC and local time
intInterval = CInt( loopform.interval_min.options( loopform.interval_min.selectedIndex ).text )
LoopNum = CInt( loopform.looplen.options( loopform.looplen.selectedIndex ).text ) + intInterval/60
' SATAID Type 32bit/64/bit
If CInt( loopform.sataid_type.options( loopform.sataid_type.selectedIndex ).text ) = 64 then
sGMSLP = "GMSLPD\GMSLPD64.EXE"
Else
sGMSLP = "GMSLPD\GMSLPD.EXE"
End if
sAtcFileName = "sataid.atc"
' fixed data name
' 0:name of imagery 1:offset(hour) 2:file path
' add "'" at head of lines if not necessary
If document.getElementbyID( "ir1" ).Checked then sKoteiData(0,0) = "ir[YYYY][MM][DD].Z[HH][mm]"
If document.getElementbyID( "ir2" ).Checked then sKoteiData(1,0) = "i2[YYYY][MM][DD].Z[HH][mm]"
If document.getElementbyID( "vis" ).Checked then sKoteiData(2,0) = "vs[YYYY][MM][DD].Z[HH][mm]"
If document.getElementbyID( "wv" ).Checked then sKoteiData(3,0) = "wv[YYYY][MM][DD].Z[HH][mm]"
If document.getElementbyID( "ir4" ).Checked then sKoteiData(4,0) = "i4[YYYY][MM][DD].Z[HH][mm]"
If document.getElementbyID( "gsm" ).Checked then sKoteiData(5,0) = "GS[YY][MM][DD].Z[HH]"
sKoteiData(0,1) = 0
sKoteiData(1,1) = 0
sKoteiData(2,1) = 0
sKoteiData(3,1) = 0
sKoteiData(4,1) = 0
sKoteiData(5,1) = 6*(60/intInterval)
' folders in which SATAID imagery is saved
sKoteiData(0,2) = "sataid_data_cut"
sKoteiData(1,2) = "sataid_data_cut"
sKoteiData(2,2) = "sataid_data_cut"
sKoteiData(3,2) = "sataid_data_cut"
sKoteiData(4,2) = "sataid_data_cut"
sKoteiData(5,2) = "sataid_data_org"
sKoteiData(6,2) = "Obsdata"
'#####################################################################################
'-------------------------------------------------------------------------------
' read wis setting
Dim oFSText,strData,sIni
sIni = "WIS.INI"
Set oFSText = oFS.OpenTextFile(sIni)
Do While Not oFSText.AtEndOfStream
strData = oFSText.ReadLine
Select Case strData
Case "Time":
strData = oFSText.ReadLine
intAjtHour = strData
End Select
Loop
'------------------------------------------------------------------------------------------------
vEndDate = Date+TimeSerial(Hour(Time)-intAjtHour,0,0)+1/24
vStartDate = vEndDate-(LoopNum)/24.0-1/24
sAppName = oFS.GetBASEName(sGMSLP)
if LoopNum<=4 then
sIniName = "-ini=gmslpd03.ini"
sIntFile = "FILE=GMSLPD\gmslpd03.ini"
ElseIf LoopNum<=7 then
sIniName = "-ini=gmslpd06.ini"
sIntFile = "FILE=GMSLPD\gmslpd06.ini"
ElseIf LoopNum<=13 then
sIniName = "-ini=gmslpd12.ini"
sIntFile = "FILE=GMSLPD\gmslpd12.ini"
ElseIf LoopNum<=25 then
sIniName = "-ini=gmslpd24.ini"
sIntFile = "FILE=GMSLPD\gmslpd24.ini"
ElseIf LoopNum<=37 then
sIniName = "-ini=gmslpd36.ini"
sIntFile = "FILE=GMSLPD\gmslpd36.ini"
ElseIf LoopNum<=49 then
sIniName = "-ini=gmslpd48.ini"
sIntFile = "FILE=GMSLPD\gmslpd48.ini"
Else
sIniName = "-ini=gmslpd12.ini"
sIntFile = "FILE=GMSLPD\gmslpd12.ini"
End if
Dim fso,MyDir,curDir
set fso = CreateObject("Scripting.FileSystemObject")
Set MyDir = fso.GetFolder(".")
curDir = MyDir.path
Call MakeAtc(vStartDate,vEndDate,intInterval,sAtcFileName,sKoteiData,sIntFile)
document.getElementById("JOUTAI").innerHTML= "Sataid Running"
sCommand = "cmd /c " & sGMSLP & " " & sIniName & " " & curDir & "\" & sAtcFileName
oShell.Run sCommand,0,False
set oShell = Nothing
set oFS = Nothing
set oRE = Nothing
End Function
'---------------------------------------------------------------------
' ATC file making function
Function MakeAtc(vStartDate,vEndDate,intInterval,sAtcFileName,sKoteiData,sIntFile)
Dim i,j,k
Dim vDate
Dim sHEAD,sINIT,sSubDir,oFolder
Dim oFS,oFile
Dim sGMSNames(600),sFile
Dim sKoteiNames(600)
Dim sLine
Dim iLoopNum,sWriteData
Dim iOffset
Dim bRepet
Dim sHiduke(6)
iOffset = 200
set oFS = CreateObject("Scripting.FileSystemobject")
' Check subdirectory
for i=0 to Ubound(sKoteiData,1)
if oFS.FolderExists(sKoteiData(i,2)) then
set oFolder = oFS.GetFolder(sKoteiData(i,2))
if InStr(sSubDir,UCase(oFolder.Name))=0 then
sSubDir = sSubDir & UCase(oFolder.Name) & ";"
End if
End if
next 'i
set oFolder = Nothing
sHEAD = "[TITLE]" & vbCRLF & "[SUBDIR]" & vbCRLF & sSubDir & vbCRLF & "[NOTE]" & vbCRLF & "atcnote.dat" & vbCRLF & "[IMAGE]" & vbCRLF
' fixed name loop
for i=0 to Ubound(sKoteiData,1)
j=0
vDate = vStartDate
Do While vDate<=vEndDate
vDate = vStartDate + (intInterval/60)*(j-sKoteiData(i,1))/24.0 'Set time with offset
if sKoteiData(i,0)<>"" then
sFile = MakeOKIKAE(sKoteiData(i,0),vDate)
if oFS.FileExists(sKoteiData(i,2) & "\" & sFile) then
' check duplication
bRepet = TRUE 'TRUE if no duplication
k=0
if (j-sKoteiData(i,1)+iOffset)>2.0/(intInterval/60) then k=(j-sKoteiData(i,1)+iOffset)-2.0/(intInterval/60)
Do while k0 then bRepet=False:Exit Do
k=k+1
Loop
if bRepet then
if (j-sKoteiData(i,1)+iOffset)>=0 then
sKoteiNames(j-sKoteiData(i,1)+iOffset) = sKoteiNames(j-sKoteiData(i,1)+iOffset) & " "& sFile
End if
Else
End if
End if
End if
j=j+1
Loop
next 'i
' Final write
Call MakeHiduke(sHiduke,vStartDate)
sINIT = "[INIT]" & vbCRLF & "IMAGE=IR" & vbCRLF & "TERM=" & sHiduke(0) & "." & sHiduke(2) & "." & sHiduke(3) & "." & sHiduke(4) & "." & sHiduke(5) & "Z "
Call MakeHiduke(sHiduke,vEndDate)
sINIT = sINIT & sHiduke(0) & "." & sHiduke(2) & "." & sHiduke(3) & "." & sHiduke(4) & "." & sHiduke(5) & "Z"
sINIT = sINIT & vbCRLF & "FONT=24" & vbCRLF & "SUMRY=ON" & vbCRLF & sIntFile
sINIT = sINIT & vbCRLF &"[TEXT]" & vbCRLF& vbCRLF
sINIT = sINIT & vbCRLF & "<>"
' Write
iLoopNum=1
' for i=0 to CInt((vEndDate-vStartDate)/(intInterval/60)*24.0)
for i=0 to UBound(sKoteiNames)
sLine = sKoteiNames(i)
if TRIM(sLine)<>"" then
sWriteData = sWriteData& MakeTimeHead(vStartDate+(intInterval/60)*(i-iOffset)/24.0) & sLine & vbCRLF
iLoopNum=iLoopNum+1
End if
next 'i
set oFile = oFS.CreateTextFile(sAtcFileName,TRUE)
oFile.Write(sHEAD & iLoopNum & vbCRLF & sWriteData & sINIT)
oFile.Close
set oFS = Nothing
End Function
'---------------------------------------------------------------------
' replacement function
Function MakeOKIKAE(sData,vDate)
Dim sHiduke(10)
Dim sFileName
Call MakeHiduke(sHiduke,vDate)
sFileName = sData
sFileName = Replace(sFileName,"[YYYY]",sHiduke(0))
sFileName = Replace(sFileName,"[YY]",sHiduke(1))
sFileName = Replace(sFileName,"[MM]",sHiduke(2))
sFileName = Replace(sFileName,"[DD]",sHiduke(3))
sFileName = Replace(sFileName,"[HH]",sHiduke(4))
sFileName = Replace(sFileName,"[mm]",sHiduke(5))
MakeOKIKAE = sFileName
End Function
'---------------------------------------------------------------------
' return start time of animation (ATC)
Function MakeTimeHead(vDate)
Dim sHiduke(10)
Call MakeHiduke(sHiduke,vDate)
MakeTimeHead = sHiduke(1) & "." & sHiduke(2) & "." & sHiduke(3) & "." & sHiduke(4) & sHiduke(5) & "Z"
End Function
'-------------------------------- deldata main ------------------------------------------
Function DelData()
Dim oFS
Dim strPath(10)
Dim intDayDiff(10)
Dim i,j
Dim sCurPath
' start processing
set oFS = CreateObject("Scripting.FileSystemObject")
' initial setting
strPath(0) = "sataid_data_org"
strPath(1) = "sataid_data_cut"
strPath(2) = "obsdata"
intDayDiff(0) = 31
intDayDiff(1) = 31
intDayDiff(2) = 31
' read wis setting
Dim oFSText,strData,sIni
sIni = "WIS.INI"
Set oFSText = oFS.OpenTextFile(sIni)
Do While Not oFSText.AtEndOfStream
strData = oFSText.ReadLine
Select Case strData
Case "Org":
strData = oFSText.ReadLine
intDayDiff(0) = strData
Case "Cut":
strData = oFSText.ReadLine
intDayDiff(1) = strData
Case "Obs":
strData = oFSText.ReadLine
intDayDiff(2) = strData
End Select
Loop
for i=0 to UBound(strPath)
if strPath(i)<>"" then
Call DelOldFile(strPath(i),intDayDiff(i))
End if
next 'i
set oFS = Nothing
End Function
'--------------------------------------------------------------------
' delete function
Function DelOldFile(strDir,lDayNum)
Dim oFolder,oFile,oSubFolder,oFS
Dim lInterval
set oFS = CreateObject("Scripting.FileSystemObject")
if oFS.FolderExists(strDir)=False then Exit Function
set oFolder = oFS.GetFolder(strDir)
For Each oFile in oFolder.Files
lInterval = DateDiff("d",oFile.DateLastModified,Now)
if Int(lInterval)>Int(lDayNum) then
oFile.Delete
End if
Next
for Each oSubFolder in oFolder.SubFolders
Call DelOldFile(oSubFolder.Path,lDayNum)
next
set oFolder = Nothing
set oFile = Nothing
set oSubFolder = Nothing
End Function
'----------------------------------
Function MakeHiduke(strHiduke,vntDate)
Dim i
strHiduke(0) = Year(vntDate)
strHiduke(1) = Right(strHiduke(0),2)
strHiduke(2) = Month(vntDate)
strHiduke(3) = Day(vntDate)
strHiduke(4) = Hour(vntDate)
strHiduke(5) = Minute(vntDate)
for i=2 to 5
if CInt(strHiduke(i))<10 then strHiduke(i) = "0" & strHiduke(i)
next 'i
End Function
'-------------------------------------
Function MakeHiduke1(strHiduke,dblDiff)
Dim i
Dim vntDate
vntDate = Date + TimeSerial(Hour(Now),0,0) - dblDiff/24.0
strHiduke(0) = Year(vntDate)
strHiduke(1) = Right(strHiduke(0),2)
strHiduke(2) = Month(vntDate)
strHiduke(3) = Day(vntDate)
strHiduke(4) = Hour(vntDate)
strHiduke(5) = Minute(vntDate)
for i=2 to 5
if CInt(strHiduke(i))<10 then strHiduke(i) = "0" & strHiduke(i)
next 'i
End Function
'-------------------------------------
Function MakeFileDate(strKind,dblDiff)
Dim i
Dim strJikan(10)
Dim strMinFlag
Call MakeHiduke1(strJikan,dblDiff)
if Left(strKind,2)<>"GS" then
MakeFileDate = strKind & strJikan(0) & strJikan(2) & strJikan(3) & ".Z" & strJikan(4) & strJikan(5)
Else
MakeFileDate = strKind & strJikan(1) & strJikan(2) & strJikan(3) & ".Z" & strJikan(4)
End if
End Function
'---------------------------------------
Function MakeFileDate1(strKind,dblDiff)
Dim i
Dim strJikan(10)
Dim strMinFlag
Call MakeHiduke1(strJikan,dblDiff)
if Left(strKind,5)="SYNOP" then MakeFileDate1 = "SY_" & strJikan(0) & strJikan(2) & strJikan(3) & strJikan(4) & ".TXT"
if Left(strKind,4)="SHIP" then MakeFileDate1 = "SH_" & strJikan(0) & strJikan(2) & strJikan(3) & strJikan(4) & ".TXT"
if Left(strKind,5)="METAR" then MakeFileDate1 = "METAR" & strJikan(0) & strJikan(2) & strJikan(3) & strJikan(4) & ".TXT"
if Left(strKind,6)="TEMP_A" then MakeFileDate1 = "UA_" & strJikan(0) & strJikan(2) & strJikan(3) & strJikan(4) & ".TXT"
if Left(strKind,6)="TEMP_B" then MakeFileDate1 = "UB_" & strJikan(0) & strJikan(2) & strJikan(3) & strJikan(4) & ".TXT"
if Left(strKind,6)="SCAT_A" then MakeFileDate1 = "WINX" & strJikan(2) & strJikan(3) & ".TXT"
if Left(strKind,6)="SCAT_B" then MakeFileDate1 = "WINE" & strJikan(2) & strJikan(3) & ".TXT"
if Left(strKind,3)="SST" then MakeFileDate1 = "sst" & strJikan(0) & strJikan(2) & strJikan(3) & ".f32"
End Function
'----------------------------------------
' スクリプトのパスを得る。
Function getScriptPath()
Dim oFS
Dim sRet
set oFS = CreateObject("Scripting.FileSystemObject")
sRet = location.href
sRet = replace( sRet, "file:///", "" )
sRet = replace( sRet, "/", "\" )
getScriptPath = oFS.getParentFolderName( sRet )
set oFS = Nothing
End Function
'----------------------------------------
Function Ending()
Dim oShell,sCommand,check
set oShell = CreateObject("WScript.Shell")
check = MsgBox(" Program Ending ok?",vbYesNo)
if check <> 7 then
sCommand = "cmd /c Ending.bat"
oShell.Run sCommand,0,False
Window.Close
set oShell = Nothing
else Exit Function
end if
End Function
'----------------------------------------
Function WgetEnd()
Dim oShell,sCommand,check
set oShell = CreateObject("WScript.Shell")
check = MsgBox(" Wget Cancel ok?",vbYesNo)
if check <> 7 then
sCommand = "cmd /c WgetEnd.bat"
oShell.Run sCommand,0,False
set oShell = Nothing
else Exit Function
end if
End Function