微信　获取用户地理位置和拍照 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

老师，您好。

咨询如下问题：

1.无法将"scan2"拍摄的照片，存入到“照片”中；

2.“照片”能否锁定，只能通过"scan2"获取，不能手动添加；

3.“纬度”、“经度”能正常获取，如何获得地理位置。

下面的代码能获取地理位置，而且测试位置很准确。但不知道怎么写代码，使其填入到“位置”中。

Dim 纬度 As Double = 30.799173

Dim 经度 As Double = 120.781265

Dim ur As String = "http://api.map.baidu.com/geocoder/v2/?ak=hAaa2NLELKdAIfMhMjnuEgi1&output=json&location=" & 纬度 & "," & 经度

Dim hc As new HttpClient(ur)

Dim jo = JObject.Parse(hc.GetData)

output.show(jo.Tostring)

If jo("status") = 0 Then

'msgbox(jo("result")("addressComponent")("province")) '省份

'msgbox(jo("result")("addressComponent")("city")) '城市

'msgbox(jo("result")("addressComponent")("district")) '区域

msgbox(jo("result")("formatted_address")) '地理位置

End If

4.运行下面的代码，能向表中添加“类型”、“照片”，但不能添加“纬度”、"经度”(单精度小数)，用字符型，运行时网页卡住不动，退出网页foxtable会提示：由于线程退出或应用程序请求，已中止 I/O 操作。

５.整个界面很丑，是否可以隐藏掉“获取经度纬度”、“纬度”、“经度”，这样比较简洁，或者“纬度”、“经度”不要保存了，我只要地理位置数据就可以了。

一.程序代码

Case "hhh.htm" '首页

If e.PostValues.Count = 0 Then

wb.AddForm("","form1","hhh.htm")

wb.AppendHTML("<script src='http://res.wx.qq.com/open/js/jweixin-1.2.0.js'></script>",True) '引入JS-SDK库

wb.AppendHTML("<script src='./lib/jssdk2.js'></script>") '引入脚本文件

'在页面注入权限验证配置

Dim st As New Date(1970,1,1,8,0,0)

Dim appid As String = "wx4718459301f2db8f" '开发者ID

Dim timestamp As Integer = CInt((Date.Now - st).TotalSeconds()) '时间戳

Dim noncestr As String = Rand.NextString(16) '随机字符

Dim url As String = e.Request.URL.ToString '当前页面地址

Dim signature As String = Functions.Execute("GetJsSignature", noncestr, timestamp, url) '生成权限验证签名

Dim cfg As String = "wx.config({appId:'{0}',timestamp:{1},nonceStr:'{2}',signature:'{3}',jsApiList:['chooseImage']});"

wb.AppendHTML("<script>" & CExp(cfg,appid,timestamp,noncestr,signature) & "</script>",True)

'开始正常生成网页内容

With wb.AddInputGroup("form1","ipg1","打卡")

.AddSelect("类型","类型","|出发|抵达|离开|返厂")

.AddUploader("照片","照片",False) 'False表示,只允许上传一张照片

End With

With wb.AddButtonGroup("form1","btg1",False) '垂直排列

.Add("scan2","拍摄照片","button")

End With

wb.AppendHTML("<script src='./lib/jssdk1.js'></script>") '引入脚本文件

'在页面注入权限验证配置

Dim cfg2 As String = "wx.config({appId:'{0}',timestamp:{1},nonceStr:'{2}',signature:'{3}',jsApiList:['scanQRCode']});"

wb.AppendHTML("<script>" & CExp(cfg,appid,timestamp,noncestr,signature) & "</script>",True)

With wb.AddButtonGroup("form1","btg2",False) '垂直排列

.Add("scan1","获取经度纬度","button")

.Add("scan3","获取地址位置","button")

End With

With wb.AddInputGroup("form1","ipg2","地址位置")

.AddInput("纬度","纬度","text").Enabled = False

.AddInput("经度","经度","text").Enabled = False

With wb.AddInputGroup("form1","ipg3","位置")

.AddTextArea("wz",3).Enabled = False

End With

With wb.AddButtonGroup("form1","btg3",True)

.Add("btn1", "确定", "submit")

End With

e.WriteString(wb.Build)

Else

Dim nms() As String = {"类型","照片","纬度","经度","位置"}

Dim dr As DataRow = DataTables("服务打卡").AddNew()

For Each nm As String In nms

dr(nm) = e.PostValues(nm)

For Each key As String In e.Files.Keys

If key = "照片" Then

For Each fln As String In e.Files(key)

e.SaveFile(key, fln, ProjectPath & "Attachments\" & fln)

dr.Lines("照片") = e.Files(key)

End If

'保存并生成增加成功提示页面

e.WriteString(wb.Build)

End If

二.JS代码

二.1：jssdk1代码

wx.ready(function () {

document.getElementById('scan1').onclick = function () {

wx.getLocation({

type: 'wgs84', // 默认为wgs84的gps坐标，如果要返回直接给openLocation用的火星坐标，可传入'gcj02'

success: function (res) {

document.getElementById('纬度').value = res.latitude; // 纬度，浮点数，范围为90 ~ -90

document.getElementById('经度').value = res.longitude; // 经度，浮点数，范围为180 ~ -180。

}

});

};

});

wx.error(function (res) {

//alert(res.errMsg);

});

二.2：jssdk1代码

wx.ready(function () {

document.getElementById('scan2').onclick = function () {

wx.chooseImage({

count: 1, // 默认9

sizeType: ['compressed'], // 可以指定是原图['original']还是压缩图['compressed']，默认二者都有

sourceType: ['album','camera'], // 可以指定来源是相册['album']还是相机['camera']，默认二者都有

success: function (res) {

document.getElementById('照片').value = res.localIds;

}

});

};

});

wx.error(function (res) {

//alert(res.errMsg);

});

此主题相关图片如下：1231.png

[此贴子已经被作者于2017/6/6 18:38:17编辑过]

老师，请您指教：我用微信JS-SDK获取的经度/纬度，怎么是空值？能处理能可用值吗？

If e.PostValues.Count = 0 Then　

......

With wb.AddButtonGroup("form1","btg1",False) '垂直排列

.Add("scan1","获取坐标","button")

End With

With wb.AddInputGroup("form1","ipg2","坐标")

.AddInput("纬度","纬度","text").Enabled = False

.AddInput("经度","经度","text").Enabled = False

End With

With wb.AddButtonGroup("form1","btg3",True)

.Add("btn1", "确定", "submit")

End With

e.WriteString(wb.Build)

Else

Dim 纬度 As Double = e.PostValues("纬度")

Dim 经度 As Double = e.PostValues("经度")

Dim ur As String = "http://api.map.baidu.com/geocoder/v2/?ak=hAaa2NLELKdAIfMhMjnuEgi1&output=json&location=" & 纬度 & "," & 经度

Dim hc As new HttpClient(ur)

Dim jo = JObject.Parse(hc.GetData)

output.show(jo.Tostring)

If jo("status") = 0 Then

'msgbox(jo("result")("addressComponent")("province"))

'msgbox(jo("result")("addressComponent")("city"))

'msgbox(jo("result")("addressComponent")("district"))

msgbox(jo("result")("formatted_address"))

End If

.....

end if

老师，您好。

经测试，当将文本框禁止编辑时（.Enabled = False），无法获得数据。允许编辑就可以获得地理位置了。

但坐标是用jssdk获取的，不允许手动再修改，那要如何控制输入权限(禁止再编辑)？

Case "hhh.htm" '首页

If e.PostValues.Count = 0 Then

wb.AddForm("","form1","hhh.htm")

wb.AppendHTML("<script src='http://res.wx.qq.com/open/js/jweixin-1.2.0.js'></script>",True) '引入JS-SDK库

wb.AppendHTML("<script src='./lib/jssdk1.js'></script>") '引入脚本文件...微信,获取地理位置(纬度/经度).

'在页面注入权限验证配置

Dim st As New Date(1970,1,1,8,0,0)

Dim appid As String = "wx4718459301f2db8f" '开发者ID

Dim timestamp As Integer = CInt((Date.Now - st).TotalSeconds()) '时间戳

Dim noncestr As String = Rand.NextString(16) '随机字符

Dim url As String = e.Request.URL.ToString '当前页面地址

Dim signature As String = Functions.Execute("GetJsSignature", noncestr, timestamp, url) '生成权限验证签名

Dim cfg As String = "wx.config({appId:'{0}',timestamp:{1},nonceStr:'{2}',signature:'{3}',jsApiList:['scanQRCode']});"

wb.AppendHTML("<script>" & CExp(cfg,appid,timestamp,noncestr,signature) & "</script>",True)

'开始正常生成网页内容

With wb.AddInputGroup("form1","ipg1","打卡")

.AddSelect("类型","类型","|出发|抵达|离开|返厂")

.AddUploader("照片","照片",False) 'False表示,只允许上传一张照片

End With

With wb.AddButtonGroup("form1","btg1",False) '垂直排列

.Add("scan","获取坐标","button")

End With

With wb.AddInputGroup("form1","ipg2","地理位置")

.AddInput("纬度","纬度","text").Enabled = False

.AddInput("经度","经度","text").Enabled = False

End With

With wb.AddButtonGroup("form1","btg3",True)

.Add("btn1", "确定", "submit")

End With

e.WriteString(wb.Build)

Else

Dim 纬度 As Double = e.PostValues("纬度")

Dim 经度 As Double = e.PostValues("经度")

Dim ur As String = "http://api.map.baidu.com/geocoder/v2/?ak=hAaa2NLELKdAIfMhMjnuEgi1&output=json&location=" & 纬度 & "," & 经度

Dim hc As new HttpClient(ur)

Dim jo = JObject.Parse(hc.GetData)

output.show(jo.Tostring)

If jo("status") = 0 Then

'msgbox(jo("result")("addressComponent")("province"))

'msgbox(jo("result")("addressComponent")("city"))

'msgbox(jo("result")("addressComponent")("district"))

msgbox(jo("result")("formatted_address"))

End If

jssdk代码

wx.ready(function () {

document.getElementById('scan').onclick = function () {

wx.getLocation({

type: 'wgs84', // 默认为wgs84的gps坐标，如果要返回直接给openLocation用的火星坐标，可传入'gcj02'

success: function (res) {

document.getElementById('纬度').value = res.latitude; // 纬度，浮点数，范围为90 ~ -90

document.getElementById('经度').value = res.longitude; // 经度，浮点数，范围为180 ~ -180。

}

});

};

});

wx.error(function (res) {

//alert(res.errMsg);

});

老师，微信获取地理位置，试用精度很差，误差在：1公里 ~ 6公里，这个是否可以设置？

按目前的误差，感觉效果不理想。

获取地理位置接口:

wx.getLocation({

type: 'wgs84', // 默认为wgs84的gps坐标，如果要返回直接给openLocation用的火星坐标，可传入'gcj02'

success: function (res) {

var latitude = res.latitude; // 纬度，浮点数，范围为90 ~ -90

var longitude = res.longitude; // 经度，浮点数，范围为180 ~ -180。

var speed = res.speed; // 速度，以米/每秒计

var accuracy = res.accuracy; // 位置精度.....js是否可以使用此代码来控制精度？要怎么写？

}

});

js代码:

wx.ready(function () {

document.getElementById('scan1').onclick = function () {

wx.getLocation({

type: 'wgs84', // 默认为wgs84的gps坐标，如果要返回直接给openLocation用的火星坐标，可传入'gcj02'

success: function (res) {

document.getElementById('纬度').value = res.latitude; // 纬度，浮点数，范围为90 ~ -90

document.getElementById('经度').value = res.longitude; // 经度，浮点数，范围为180 ~ -180。

}

});

};

});

wx.error(function (res) {

//alert(res.errMsg);

});

老师，您好。

你给的网址我看不懂，是否可以用百度提供的功能来作业：http://lbsyun.baidu.com/index.php?title=webapi/guide/changeposition

操作想法：先将wgs84转代为bd09ll(百度坐标系)，再将获得的坐标放到原来的代码运行，获取精准地理位置。

json 示例：

http://api.map.baidu.com/geoconv/v1/?coords=114.21892734521,29.575429778924;114.21892734521,29.575429778924&from=1&to=5&ak=你的密钥

代码没有返回值，应该是哪里要调整：

Dim 纬度 As Double = e.PostValues("纬度")

Dim 经度 As Double = e.PostValues("经度")

Dim ur1 As String = "http://api.map.baidu.com/geoconv/v1/?coords=" & 纬度 & "," & 经度 &"&from=1&to=5&output=json&ak=VuoyLhIgEFg3ptz4GfhQhPtjyOlTEjHb"

Dim hc1 As new HttpClient(ur1)

Dim jo1 = JObject.Parse(hc1.GetData)

output.show(jo1.Tostring)

msgbox(2)

If jo1("status") = 0 Then

msgbox(1)

End If

[此贴子已经被作者于2017/6/9 15:22:11编辑过]

老师，是纬度、经度，代入的问题。

我改成数字测试，就可以取得值。

Dim ur1 As String = "http://api.map.baidu.com/geoconv/v1/?coords=" & 纬度 & "," & 经度 &"&from=1&to=5&output=json&ak=VuoyLhIgEFg3ptz4GfhQhPtjyOlTEjHb"

老师，这个错误，代码要怎么改？

Dim 纬度 As Double = e.PostValues("纬度")

Dim 经度 As Double = e.PostValues("经度")

Dim ur1 As String = "http://api.map.baidu.com/geoconv/v1/?ak=VuoyLhIgEFg3ptz4GfhQhPtjyOlTEjHb&from=1&to=5&output=json&coords=" & 纬度 & "," & 经度

Dim hc1 As new HttpClient(ur1)

Dim jo1 = JObject.Parse(hc1.GetData)

output.show(jo1.Tostring)

If jo1("status") = 0 Then

msgbox(jo1("result")("x"))

msgbox(jo1("result")("y"))

End If

{

"status": 0,

"result": [

{

"x": 120.79228431775,

"y": 30.802926586494

}

]

}

此主题相关图片如下：123.jpg

[此贴子已经被作者于2017/6/9 15:57:41编辑过]

老师，您好!

下面的代码使用一直都是正常的：1.获取坐标 -->2.打卡．

现在想简化作业流程：只要"打卡"，"坐标"由系统自动获取．

"坐标"自动获取的想法是：在登录此页面时直接获取，或者在按"打卡"时先获取坐标再进行下面的操作，是否可行？

此主题相关图片如下：111.jpg

Dim e As RequestEventArgs = args(0)

Dim wb As New WeUI

wb.AddPageTitle("","ka","打卡")

If e.PostValues.Count = 0 Then

wb.AddTopTips("","toptip1","类型/坐标不能为空!") '用于显示动态错误提示

wb.AddForm("","form1","x10121_ka.htm").Attribute="" '使用js脚本文件,判断是否按要求输入数据

wb.AppendHTML("<script src='http://res.wx.qq.com/open/js/jweixin-1.2.0.js'></script>",True) '引入JS-SDK库

wb.AppendHTML("<script src='./lib/jssdk1.js'></script>") '引入脚本文件...微信,获取地理位置(纬度/经度).

wb.AppendHTML("<script src='./lib/ajaxform.js'></script>") '引入脚本文件...未按要求输入数据,产生错误提示.

'在页面注入权限验证配置

Dim st As New Date(1970,1,1,8,0,0)

Dim appid As String = "wx4718459301f2db8f" '开发者ID

Dim timestamp As Integer = CInt((Date.Now - st).TotalSeconds()) '时间戳

Dim noncestr As String = Rand.NextString(16) '随机字符

Dim url As String = e.Request.URL.ToString '当前页面地址

Dim signature As String = Functions.Execute("GetJsSignature", noncestr, timestamp, url) '生成权限验证签名

Dim cfg1 As String = "wx.config({appId:'{0}',timestamp:{1},nonceStr:'{2}',signature:'{3}',jsApiList:['scanQRCode']});"

wb.AppendHTML("<script>" & CExp(cfg1,appid,timestamp,noncestr,signature) & "</script>",True)

'开始正常生成网页内容

With wb.AddInputGroup("form1","ipg1")

.AddSelect("类型","类型","|上班|下班|出发|抵达|离开|返厂")

End With

With wb.AddInputGroup("form1","ipg2")

.AddInput("纬度","纬度","password").Readonly = True

.AddInput("经度","经度","password").Readonly = True

End With

With wb.AddButtonGroup("form1","btg3",False)

.Add("scan1","坐标","button")

.Add("btn1", "打卡", "submit").Kind = 2

.Add("btn2", "返回","","./x10100_jls.htm")

End With

Else

Dim 纬度 As Double = e.PostValues("纬度")

Dim 经度 As Double = e.PostValues("经度")

......

[此贴子已经被作者于2017/7/25 20:56:51编辑过]

老师，您好。

现在经纬度坐标都有了，需要计算2个坐标点间距离。

参考论坛文章：http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=83701&authorid=0&page=0&star=1

x1、y1 是纬度、经度

Dim x1 As Double = 37.856862
Dim y1 As Double = 112.525760
Dim x2 As Double = 37.857587
Dim y2 As Double = 112.525683

Dim rad As Double = 6371
Dim p1X As Double = X1 / 180 * Math.PI
Dim p1Y As Double = Y2 / 180 * Math.PI
Dim p2X As Double = X2 / 180 * Math.PI
Dim p2Y As Double = Y2 / 180 * Math.PI

Dim a As Double = p1X - p2X
Dim b As Double = p1Y - p2Y
Dim s As Double = 2 * Math.Asin(Math.Sqrt(Math.Pow(Math.Sin(a/2),2) + Math.Cos(p1X)*Math.Cos(p2X)*Math.Pow(Math.Sin(b/2),2))) * rad
output.show(s)

有如下请教：

1.代码中使用的经纬度是微信获取的gps坐标，还是转换后的百度坐标bd09ll，或者只要是相同坐标系就可以计算？

2.百度地图开放平台是否有提供相应的<Web服务API>，我没有找到？

[此贴子已经被作者于2017/9/7 9:52:15编辑过]

老师，您好。

js方式调用我不会用，我用公式计算和百度地图测距计算，两者都是直线距离，结果相差不是很大。

查看<百度地图>导航的常规路线，比对上面算出来的直线距离，有很大差异。

所以直线距离仅仅只能作参考，我先用公式来计算，比较好处理。

老师，我现在想使用百度地图开放平台的<静态图API>：http://lbsyun.baidu.com/index.php?title=static

参考论坛文章：http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=103519&skin=0

现在ak、坐标都有，不知如何获取返回的png图片，并显示到手机中。

Select Case e.Path

Case "test.htm"

wb.AppendHTML("<script src='http://cdn.static.runoob.com/libs/jquery/1.10.2/jquery.min.js'></script>",True)

wb.AppendHTML("<script src='http://echarts.baidu.com/gallery/vendors/echarts-stat/ecStat.min.js'></script>",True)

wb.AppendHTML("<script src='http://echarts.baidu.com/gallery/vendors/echarts/echarts-all-3.js'></script>",True)

wb.AppendHTML("<script src='http://echarts.baidu.com/gallery/vendors/echarts/map/js/china.js'></script>",True)

With wb.AddArticle("","ar1")

.AddTitle("h1","ECharts测试")

.AddTitle("h2","1. 条形图")

.AddContent("<div id=""main1"" style=""width: 600px;height:400px;""></div>")

.AddTitle("h2","2. 地图")

.AddContent("<div id=""main2"" style=""width: 600px;height:400px;""></div>")

End With

wb.AppendHTML("<script src='./lib/map.js'></script>")

e.WriteString(wb.Build)

Case "getdata.htm" '获取数据，这里通过文件返回json数据，实际应用可以结合数据库查询和JObject返回json数据

Dim json As String

If e.GetValues("type") = "1" Then

json = FileSys.ReadAllText("d:\web\lib\data1.txt")

Else

json = FileSys.ReadAllText("d:\web\lib\data2.txt")

End If

e.WriteString(json)

End Select

[此贴子已经被作者于2017/9/7 11:04:38编辑过]

主题：微信 获取用户地理位置和拍照

主题：微信　获取用户地理位置和拍照