| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1353 人关注过本帖
标题:VBS计算指定经纬度地区当天日落时间
只看楼主 加入收藏
cwa9958
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:76
帖 子:270
专家分:1330
注 册:2006-6-25
收藏
得分:0 
回复 7楼 mrexcel
牵涉到地球的计算,圆周率用3.14就有问题了
2022-12-15 13:02
felix301
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2022-11-23
收藏
得分:0 
Sub 用网抓显示当前电脑所在地和IP和日出日落()  ' 不用人为指定经纬度,网抓经纬度实现
    Dim oHtml As Object
    Set oHtml = VBA.CreateObject("WinHttp.WinHttpRequest.5.1")
    Dim sUrl As String
    '指定要抓取的网站

    sUrl = "https://www.   '网抓地址
    Dim sCharset As String
    '指定要抓取的网站的字符编码
    sCharset = "utf-8"
    With oHtml
        .Open "GET", sUrl, False
        .Send
        '获取返回的字节数组
        bResult = .responsebody
        '按照指定的字符编码显示
        sResult = BByte2String(bResult, sCharset)
        Debug.Print sResult
        Dim STR As String
        经纬度 = Split(Split(sResult, "<span>经纬度</span>")(1), "</li>")(0)           
        IP地址 = Split(Split(sResult, "IP地址</span><a href=""/ip/")(1), ".html")(0)
        所在地址 = Split(Split(sResult, "位置信息</span>")(1), "</li>")(0)
        JD = Split(经纬度, ",")(1)
        WD = Split(经纬度, ",")(0)
    End With
    Set oHtml = Nothing
    MsgBox Suntime(JD, WD) & Chr(10) & "地址: " & 所在地址 & Chr(10) & "IP地址: " & IP地址
End Sub
Function BByte2String(bContent, ByVal sCharset As String)
Const adSaveCreateOverWrite = 2
Const adSaveCreateNotExist = 1
Const adTypeBinary = 1
Const adTypeText = 2
Const adModeRead = 1
Const adModeWrite = 2
Const adModeReadWrite = 3
Dim oStream As Object
'创建流对象
Set oStream = CreateObject("ADODB.Stream")
With oStream
    '打开流
    .Open
    '设置为字节模式
    .Type = adTypeBinary
    '写入字节
    .Write bContent
    '将位置定位在第一个字节
    .Position = 0
    '设置为文本模式
    .Type = adTypeText
    '设置编码的字符集
    .Charset = sCharset
    BByte2String = .ReadText
    .Close
End With
End Function
'
Function Suntime(ByVal lon As Single, ByVal lat As Single) As String
Dim Days&, X As Single, s(1)
Days = Date - DateSerial(Year(Date), 1, 0)
X = -Tan(-23.4 * Cos(8 * Atn(1) * (Days + 9) / 365) * Atn(1) / 45) * Tan(lat * Atn(1) / 45)
X = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)
s(0) = 4 * (300 - lon - X * 45 / Atn(1))
s(1) = 8 * (300 - lon) - s(0)
Suntime = "日出时间为:" & Format(TimeSerial(0, s(0), 0), "hh:MM") & ",日落时间为:" & Format(TimeSerial(0, s(1), 0), "hh:MM")
End Function

[此贴子已经被作者于2022-12-17 16:33编辑过]

2022-12-17 16:31
yuma
Rank: 11Rank: 11Rank: 11Rank: 11
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1921
专家分:2981
注 册:2009-12-22
收藏
得分:0 
回复 12楼 felix301
还可以,我主要用来算高德地图上收藏点的日出日落时间,方便出行。

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2022-12-18 08:37
yuma
Rank: 11Rank: 11Rank: 11Rank: 11
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1921
专家分:2981
注 册:2009-12-22
收藏
得分:0 
回复 4楼 mrexcel
计算这个日出日落时间,居然和一楼的程序得到的结果不一样。

Debug.Print Suntime(87.58512, 43.780072)      '格式:经度,纬度

为啥?

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2023-02-07 11:28
快速回复:VBS计算指定经纬度地区当天日落时间
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.015481 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved