Foxtable(狐表) → 用户栏目 → 专家坐堂 → 能不能帮我看看这个代码是否有问题，有时会闪退


  共有2392人关注过本帖树形打印复制链接

主题：能不能帮我看看这个代码是否有问题，有时会闪退
帅哥哟，离线，有人找我吗？
hongye
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：一尾狐 帖子：437 积分：2949 威望：0 精华：0 注册：2011/3/15 12:49:00 		能不能帮我看看这个代码是否有问题，有时会闪退  发帖心情 Post By：2019/12/12 15:35:00 [只看该作者]

Dim ftp1 As New FtpClient
ftp1.Host=Tables("FTPIP").Current("FTPhost")
ftp1.Account = Tables("FTPIP").Current("FTPAccount")
ftp1.Password = Tables("FTPIP").Current("FTPpassword")
Dim r As Row = Tables("员工信息_员工信息").current
Dim l As String = "/身份证/"& r("证件号码") + r("员工姓名")
Dim dlg As New FolderBrowserDialog '选择目录对话框
dlg.Description = "选择文件夹" '对话框的说明
dlg.ShowNewFolderButton = False '不显示"新建文件夹"按钮
If dlg.ShowDialog = DialogResult.Ok Then '如果单击确定
    MessageBox.Show("你选择的目录是:" & dlg.SelectedPath ,"提示")
    Dim f As String = dlg.SelectedPath & "\" & r("员工姓名")  & "1.jpg"
    Dim f1 As String = dlg.SelectedPath & "\" & r("员工姓名")  & "2.jpg"
    Dim sf As String =  r("证件图1")
    Dim sf1 As String = r("证件图2")
    If FileSys.DirectoryExists(dlg.SelectedPath ) Then '如果指定的文件目录存在
        If  ftp1.DirExists(l)  Then
            Messagebox.Show("服务器文件目录已经存在!","提示")
            If FileSys.FileExists(f) Then
                If  ftp1.Upload(f,sf) = True Then
                    Messagebox.show("" &r("员工姓名")&" 身份证正面上传完成!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
                Else
                    Messagebox.show("" &r("员工姓名")&" 身份证正面上传失败!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
                End If
            Else
                Messagebox.show("没有找到 " &r("员工姓名")&" 的身份证(正面)图片!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
            End If
            If FileSys.FileExists(f1) Then
                If  ftp1.Upload(f1,sf1) = True Then
                    Messagebox.show("" &r("员工姓名")&" 身份证反面上传完成!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
                Else
                    Messagebox.show("" &r("员工姓名")&" 身份证反面上传失败!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
                End If
            Else
                Messagebox.show("没有找到 " &r("员工姓名")&" 的身份证(反面)图片!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
            End If
            If DataTables("员工信息_员工信息").HasChanges Then
                DataTables("员工信息_员工信息").Save
            End If
        Else
            If ftp1.MakeDir(l) Then
                Messagebox.Show("创建目录成功!")
                If FileSys.FileExists(f) Then
                    If  ftp1.Upload(f,sf) = True Then
                        Messagebox.show("" &r("员工姓名")&" 身份证正面上传完成!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
                    Else
                        Messagebox.show("" &r("员工姓名")&" 身份证正面上传失败!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
                    End If
                Else
                    Messagebox.show("没有找到 " &r("员工姓名")&" 的身份证(正面)图片!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
                End If
                If FileSys.FileExists(f1) Then
                    If  ftp1.Upload(f1,sf1) = True Then
                        Messagebox.show("" &r("员工姓名")&" 身份证反面上传完成!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
                    Else
                        Messagebox.show("" &r("员工姓名")&" 身份证反面上传失败!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
                    End If
                Else
                    Messagebox.show("没有找到 " &r("员工姓名")&" 的身份证(反面)图片!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
                End If
                If DataTables("员工信息_员工信息").HasChanges Then
                    DataTables("员工信息_员工信息").Save
                End If
            Else
                Messagebox.Show("创建目录失败,请联系管理员!")
            End If
        End If
    Else
        Messagebox.Show("源文件目录不存在!","提示")
    End If
    Dim idx As Integer = Tables("员工信息_员工信息").position
    If idx <> 0 Then
        Tables("员工信息_员工信息").position = 0
        Tables("员工信息_员工信息").position = idx
    Else
        Tables("员工信息_员工信息").position += 1
        Tables("员工信息_员工信息").position = idx
    End If
End If
 回到顶部
帅哥，在线噢！
有点蓝
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109680 积分：558098 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2019/12/12 15:57:00 [只看该作者]

看不出什么问题，不过可以优化一下

Dim ftp1 As New FtpClient
ftp1.Host=Tables("FTPIP").Current("FTPhost")
ftp1.Account = Tables("FTPIP").Current("FTPAccount")
ftp1.Password = Tables("FTPIP").Current("FTPpassword")
Dim r As Row = Tables("员工信息_员工信息").current
Dim l As String = "/身份证/"& r("证件号码") + r("员工姓名")
msgbox(l)
Dim dlg As New FolderBrowserDialog '选择目录对话框
dlg.Description = "选择文件夹" '对话框的说明
dlg.ShowNewFolderButton = False '不显示"新建文件夹"按钮
If dlg.ShowDialog = DialogResult.Ok Then '如果单击确定
    MessageBox.Show("你选择的目录是:" & dlg.SelectedPath ,"提示")
    Dim f As String = dlg.SelectedPath & "\" & r("员工姓名")  & "1.jpg"
    Dim f1 As String = dlg.SelectedPath & "\" & r("员工姓名")  & "2.jpg"
    Dim sf As String =  r("证件图1")
msgbox(sf) '这里弹出的值是否正确
    Dim sf1 As String = r("证件图2")
msgbox(sf1)
    If  ftp1.DirExists(l) = False  Then
        If ftp1.MakeDir(l) = False Then
            Messagebox.Show("创建目录失败,请联系管理员!")
            Return
        End If
    End If
    If FileSys.FileExists(f) Then
        If  ftp1.Upload(f,sf) = True Then
            Messagebox.show("" &r("员工姓名")&" 身份证正面上传完成!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
        Else
            Messagebox.show("" &r("员工姓名")&" 身份证正面上传失败!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
        End If
    Else
        Messagebox.show("没有找到 " &r("员工姓名")&" 的身份证(正面)图片!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
    End If
    If FileSys.FileExists(f1) Then
        If  ftp1.Upload(f1,sf1) = True Then
            Messagebox.show("" &r("员工姓名")&" 身份证反面上传完成!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
        Else
            Messagebox.show("" &r("员工姓名")&" 身份证反面上传失败!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
        End If
    Else
        Messagebox.show("没有找到 " &r("员工姓名")&" 的身份证(反面)图片!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
    End If
    If DataTables("员工信息_员工信息").HasChanges Then
        DataTables("员工信息_员工信息").Save
    End If
    Tables("员工信息_员工信息").RaisePositionChanged()
End If
 回到顶部
帅哥哟，离线，有人找我吗？
hongye
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：一尾狐 帖子：437 积分：2949 威望：0 精华：0 注册：2011/3/15 12:49:00 		  发帖心情 Post By：2019/12/12 18:20:00 [只看该作者]

不知道为什么，在点击前面FTP上传按钮后，再点击OCR识别证件时会弹出
OCR识别证件按钮代码如下：
Dim sffo As String
sffo = ProjectPath & "Attachments\sdb.cfg"
Dim txt As WinForm.Label = e.Form.Controls("Label1")
If FileSys.FileExists(sffo) Then
    Dim Info As String
    Info = FileSys.ReadAllText(sffo) '读取生成的文本文件
    info = info.Replace(vbcrlf,vblf) '将回车换行替换为换行
    Dim pars() As String = Info.Split(vblf) '将读取的信息拆分为数组
    Dim tsq1 As String
    Dim tsq2 As String
    Dim tsq3 As String
    Dim jzf1 As String = pars(0).SubString(6)
    Dim jzf3 As String = pars(1).SubString(7)
    Dim jzf5 As String = pars(2).SubString(10)
    tsq1 = jzf1.Trim()
    tsq2 = jzf3.Trim()
    tsq3 = jzf5.Trim()
    Vars.Add("AppID",Gettype(String),tsq1)
    Vars.Add("APIKey",Gettype(String),tsq2)
    Vars.Add("SecretKey",Gettype(String),tsq3)
    Dim File As String = "d:\Temp.jpg"
    Dim pic1 As WinForm.PictureBox = e.Form.Controls("证件图1")
    pic1.Image.Save(File)
    Dim r As Row = Tables("员工信息_员工信息").Current
    try
        Dim client As new Baidu.Aip.Ocr.Ocr(Vars("APIKey"), Vars("SecretKey")) '初始化接口类,传入创建的应用的API Key,Secret Key
        client.Timeout = 60000 '设置超时时间
        Dim data() As Byte = System.IO.File.ReadAllBytes(File)'dlg.FileName) '把图片文件字节流加载进来,
        Dim options As new Dictionary(of String, object) '使用字典传递参数
        'options.Add("detect_direction","true") '是否检测图像朝向,默认不检测
        options.Add("detect_risk","true")
        Dim jo = client.Idcard(data,"front", options) '调用接口开始识别,返回值为JObject对象
        If jo("error_code") IsNot Nothing AndAlso jo("error_code") <> 0 Then
            txt.text = "识别失败: " & vbcrlf & jo("error_msg").Tostring
        Else
            Dim sbu As new StringBuilder
            sbu.AppendLine( "--------************-----------")
            sbu.AppendLine( "状态:" & jo("image_status").Tostring)
            If jo("risk_type") IsNot Nothing Then sbu.AppendLine("风险类型:" & jo("risk_type").Tostring)
            If jo("edit_tool") IsNot Nothing Then sbu.AppendLine("编辑状态:" & jo("edit_tool").Tostring)
            sbu.AppendLine( "--------************-----------")
            sbu.AppendLine( "识别出" & jo("words_result_num").Tostring & "条信息:")
            If jo("words_result")("公民身份号码") IsNot Nothing Then sbu.AppendLine( "--公民身份号码:" & jo("words_result")("公民身份号码")("words").ToString)
            If jo("words_result")("出生") IsNot Nothing Then sbu.AppendLine( "--出生日期:" & jo("words_result")("出生")("words").ToString)
            If jo("words_result")("姓名") IsNot Nothing Then sbu.AppendLine( "--姓名:" & jo("words_result")("姓名")("words").ToString)
            If jo("words_result")("性别") IsNot Nothing Then sbu.AppendLine( "--性别:" & jo("words_result")("性别")("words").ToString)
            If jo("words_result")("民族") IsNot Nothing Then sbu.AppendLine( "--民族:" & jo("words_result")("民族")("words").ToString)
            If jo("words_result")("住址") IsNot Nothing Then sbu.AppendLine( "--住址:" & jo("words_result")("住址")("words").ToString)
            r("原籍地址") = jo("words_result")("住址")("words").ToString
            If FileSys.FileExists(File) Then '如果指定的文件存在
                FileSys.DeleteFile(File,2,2) '则彻底删除之
            End If
        End If
    catch ex As exception
        txt.Visible = True
        txt.text = txt.text & vbcrlf & "识别接口调用失败,错误描述: " &  vbcrlf & ex.message
        txt.ForeColor = Color.Red
    End try
Else
    Dim frm As WinForm.Form
    frm = Forms("百度AI开发接口数据配置")
    frm.Open()
End If
[此贴子已经被作者于2019/12/12 18:21:50编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
hongye
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：一尾狐 帖子：437 积分：2949 威望：0 精华：0 注册：2011/3/15 12:49:00 		  发帖心情 Post By：2019/12/12 18:28:00 [只看该作者]

 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:员工编辑.rar
这是窗口文件，帮我看一下吧
 回到顶部
帅哥，在线噢！
有点蓝
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109680 积分：558098 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2019/12/13 8:43:00 [只看该作者]

看不出什么问题。做个完整可以测试的项目发上来

 回到顶部
帅哥哟，离线，有人找我吗？
hongye
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：一尾狐 帖子：437 积分：2949 威望：0 精华：0 注册：2011/3/15 12:49:00 		  发帖心情 Post By：2019/12/13 10:29:00 [只看该作者]

不知道老师QQ有吗，文件太大，无法上传

 回到顶部
帅哥，在线噢！
有点蓝
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109680 积分：558098 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2019/12/13 10:31:00 [只看该作者]

联系客服QQ：800014337

 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.05078 秒, 5 次数据查询