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

以文本方式查看主题

-  Foxtable(狐表)  (http://www.foxtable.com/bbs/index.asp)
--  专家坐堂  (http://www.foxtable.com/bbs/list.asp?boardid=2)
----  微信　获取用户地理位置和拍照  (http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=101759)

--  作者：qwz405
--  发布时间：2017/6/6 18:33:00
--  微信　获取用户地理位置和拍照

老师，您好。
咨询如下问题：
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
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)
Next
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)
Next
dr.Lines("照片") = e.Files(key)
End If
Next
\'保存并生成增加成功提示页面
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编辑过]

--  作者：有点蓝
--  发布时间：2017/6/6 20:54:00
--
1、调用jssdk拍照的用法参考：http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=100473&authorid=0&page=0&star=1

2、无法锁定，参考1的用法，不用Uploader

3、4、5、获取位置参考：http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=101097&authorid=0&page=0&star=1

--  作者：qwz405
--  发布时间：2017/6/7 19:45:00
--

老师，请您指教：我用微信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

--  作者：有点色
--  发布时间：2017/6/7 20:33:00
--

回复3楼，没看懂你写了什么。

如果用的是jssdk，参考这个帖子

http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=100204&authorid=0&page=0&star=2

如果直接用浏览器的，参考这个帖子

http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=101097&authorid=0&page=0&star=1

--  作者：qwz405
--  发布时间：2017/6/8 8:21:00
--

老师，您好。
经测试，当将文本框禁止编辑时（.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
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);
});

--  作者：有点蓝
--  发布时间：2017/6/8 9:26:00
--
用Readonly，http://www.foxtable.com/mobilehelp/scr/0045.htm

.AddInput("纬度","纬度","text").Readonly= True
.AddInput("经度","经度","text").Readonly= True

--  作者：qwz405
--  发布时间：2017/6/9 10:53:00
--
老师，微信获取地理位置，试用精度很差，误差在：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);
});

--  作者：有点色
--  发布时间：2017/6/9 11:09:00
--

不同的标准，坐标需要转换的

http://www.oschina.net/code/snippet_260395_39205

--  作者：qwz405
--  发布时间：2017/6/9 15:22:00
--
老师，您好。
你给的网址我看不懂，是否可以用百度提供的功能来作业：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编辑过]

--  作者：qwz405
--  发布时间：2017/6/9 15:35:00
--

老师，是纬度、经度，代入的问题。
我改成数字测试，就可以取得值。

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