以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  微信 获取用户地理位置和拍照  (http://foxtable.net/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 操作。
5.整个界面很丑,是否可以隐藏掉“获取经度纬度”、“纬度”、“经度”,这样比较简洁,或者“纬度”、“经度”不要保存了,我只要地理位置数据就可以了。



一.程序代码
 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




--  作者: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"