'Download MPC Comet Data
'V1.0 彗星下载工具，适用于 Stellarium/The sky6/skyX/Starry Night/SkyMAP/sky Chart(sky safari)/sky Tools

'-----------------------------定义下载地址------------------------------
Dim sSource(6)   'Set this to the number of MPC files to be retrieved
Dim sTarget(6)   'see above.


sSource(0) = "http://www.minorplanetcenter.net/iau/Ephemerides/Comets/Soft00Cmt.txt"
sTarget(0) = "Stellarium_Soft00Cmt.txt"
sSource(1) = "http://www.minorplanetcenter.net/iau/Ephemerides/Comets/Soft01Cmt.txt"
sTarget(1) = "Skymap_Soft01Cmt.txt"
sSource(2) = "http://www.minorplanetcenter.net/iau/Ephemerides/Comets/Soft06Cmt.txt"
sTarget(2) = "Thesky_Soft06Cmt.txt"
sSource(3) = "http://www.minorplanetcenter.net/iau/Ephemerides/Comets/Soft07Cmt.txt"
sTarget(3) = "Starrynight_Soft07Cmt.txt"
sSource(4) = "http://www.minorplanetcenter.net/iau/Ephemerides/Comets/Soft13Cmt.txt"
sTarget(4) = "Skychart_Soft13Cmt.txt"
sSource(5) = "http://www.minorplanetcenter.net/iau/Ephemerides/Comets/Soft15Cmt.txt"
sTarget(5) = "Skytools_Soft15Cmt.txt"
'--------------------------开始---------------------------------
Dim Url
Dim MPC_File_Name
Dim Low_Index
Dim High_Index

Data_Type=inputbox("现在时间是:"&Now()& CHR(10) &CHR(10)&"请选择需要下载的MPC彗星文件格式:"&CHR(10) &CHR(10)& " 1 : Stellarium"&CHR(10) &CHR(10)&" 2 : Skymap"&CHR(10) &CHR(10)&" 3 : The sky6/skyX"&CHR(10) &CHR(10)&" 4 : Starry Night"&CHR(10) &CHR(10)&" 5 : Sky Chart(Sky Safari)"&CHR(10) &CHR(10)&" 6 : Sky Tools"&CHR(10) &CHR(10)&" 7 : 以上全部"&CHR(10) &CHR(10),"彗星MPC文件下载工具")
If IsEmpty(Data_Type) Then
MsgBox "程序退出!"
WScript.Quit
End If
If CInt(Data_Type)>7 Or CInt(Data_Type)<0 Then
	WScript.Echo "彗星类型输入错误，程序退出!"
	WScript.Quit
End If
If CInt(Data_Type) = 7 Then
	Low_Index =LBound(sSource)
	High_Index = UBound(sSource)-1
Else
	Low_Index = Data_Type-1
	High_Index = Data_Type-1
End If



'--------------获得当前路径----------------
Set fso=CreateObject("Scripting.FileSystemObject")
Cur_Path = fso.GetFolder(".").Path&"\"
File_Name = MPC_File_Name
MPC_File_Name = Cur_Path&MPC_File_Name

'--------------下载文件-------------
Dim obj1,obj2
Set obj1 = CreateObject("msxml2.xmlhttp")
Set obj2 = CreateObject("adodb.stream")


For i = Low_Index To High_Index
start = Timer
Url = sSource(i)
obj1.open "get",Url,False
obj1.send
temp = obj1.responseBody
obj2.Type = 1
obj2.Mode = 3
obj2.Open()
obj2.Write(temp)

MPC_File_Name = sTarget(i)
File_Name = MPC_File_Name
MPC_File_Name = Cur_Path&MPC_File_Name

obj2.SaveToFile MPC_File_Name,2  '这里写保存的路径和名字，后缀名要跟你文件后缀名一样哦。2的意思是已有则覆盖之
obj2.Close
endd = Timer
take = formatnumber(endd-start,1)
MsgBox File_Name&" 下载成功！" & "共花费 " & take & " 秒！",0, "彗星MPC文件下载工具"
Next

Set obj1 = Nothing
Set obj2 = Nothing

If CInt(Data_Type) = 7 Then
MsgBox "全部文件下载成功!",0, "彗星MPC文件下载工具"
End If


'--------------拷贝当前路径--------------
Dim Form, TextBox
Set Form = CreateObject("Forms.Form.1")
Set TextBox = Form.Controls.Add("Forms.TextBox.1").Object
TextBox.MultiLine = True
TextBox.Text = Cur_Path
TextBox.SelStart = 0
TextBox.SelLength = TextBox.TextLength
TextBox.Copy
'----------------------------------End---------------------------------