专家坐堂-移动开发问题请教：初学Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

\'\'\'

\'/1/--------通过SQLJoinTableBuilder形式得到登录者是否存在于数据库，如果不存在予提示并返回

Dim bm As String = "查询表1"

Dim jb As New SQLJoinTableBuilder(bm,"数据表")

jb.C

jb.AddCols("*")

jb.Filter = "编号=\'20170211001\'"

Dim dt As DataTable = jb.Build(True)

Dim dr As DataRow = dt.DataRows(0) \'/1/

If dr IsNot Nothing

Dim 目标目录路径 As String = "e:\\web\\images\\图片\\" & dr("号码")

\'/2/--------判断当前是否存在患者“号码”的目录，如果不存在则创建

If FileSys.DirectoryExists(目标目录路径) = False

FileSys.CreateDirectory(目标目录路径) \'如果当前目录不存在则予创建

End If \'/2/

\'/3/--------声明并得到“目标目录路径”的所有文件名集合，便于与ftp中的文件名比较

Dim 目标目录文件名集 As new List(of String)

For Each File As String In FileSys.GetFiles(目标目录路径)

目标目录文件名集.Add(FileSys.GetName(File))

Next \'/3/

\'/4/--------判断ftp是否可以连接，如果未连接重新连接，重新连接后如果不通予提示并返回

Dim nhftp As New FtpClient

nhftp.host = "*.*.*.*" \'隐藏

nhftp.Port = "****"

nhftp.Account = "****"

nhftp.password = "****"

nhftp.RootDir = "\\图片\\" \'设置nhftp根目录

If nhftp.Connected = False \'如果FTP没有连接

If nhftp.Connect = False \'如果FTP连接失败

Messagebox.show("连接FTP失败!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)

Return

End If

End If \'/4/

\'/5/--------比较ftp和目标目前文件名情况，如果目标目录不存在则下载，下载后期处理

Dim ftp目录文件名集 As List(of String) = nhftp.GetFileList(nhftp.RootDir & "/" & dr("号码")) \'得到ftp所有文件名集合

For Each ftp目录文件名 As String In ftp目录文件名集

Dim ftp文件路径 As String = nhftp.RootDir & dr("号码") & "/" & ftp目录文件名

Dim 目标文件路径 As String = 目标目录路径 & "\\" & ftp目录文件名

If 目标目录文件名集.Contains(ftp目录文件名) = False

nhftp.Download(ftp文件路径,目标文件路径)

Dim ifo As new FileInfo(目标文件路径)

Dim img As image = getImage(目标文件路径)

Dim bmp As bitmap

If img.width > 500 Then \'如果照片宽度大于500

If 500 * (img.height / img.width) > 300 Then \'如果照片的高度大于500

bmp = new bitmap(img, 500*(300/(500*(img.height/img.width))), 300)

Else

bmp = new bitmap(img, 500, 500 * (img.height / img.width))

End If

bmp.save(目标文件路径)

bmp.Dispose

\'以上缩放图片大小,以下压缩图片提高质量

img = getimage(目标文件路径)

bmp = new bitmap(img.width, img.height)

Dim g = graphics.fromimage(bmp)

g.DrawImage(img, 0, 0, img.Width, img.Height)

Dim jpgEncoder As ImageCodecInfo

Dim codecs() As ImageCodecInfo = ImageCodecInfo.GetImageDecoders

For Each codec As ImageCodecInfo In codecs

If (codec.FormatID = ImageFormat.Jpeg.Guid) Then

jpgEncoder = codec

Exit For

End If

Dim myEncoder As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Quality

Dim myEncoderParameters As EncoderParameters = New EncoderParameters(1)

Dim myEncoderParameter As EncoderParameter = New EncoderParameter(myEncoder, 100) \' 质量级别 0 对应于最大压缩,而质量级别 100 对应于最小压缩

myEncoderParameters.Param(0) = myEncoderParameter

bmp.Save(目标文件路径, jpgEncoder, myEncoderParameters)

bmp.dispose

g.dispose

End If

Next \'/5/

\'通用事件头,用于发送已经存在的常见文件

Dim e As RequestEventArgs = args(0)

Dim fl As String = "e:\\web\\" & e.path

If filesys.FileExists(fl)

Dim idx As Integer = fl.LastIndexOf(".")

Dim ext As String = fl.SubString(idx)

Select Case ext

Case ".jpg",".gif",".png",".bmp",".wmf",".js",".css" ,".html",".htm",".zip",".rar"

e.WriteFile(fl)

Return \'这里必须返回

End Select

End If

\'以下是动态生成网页的代码

Dim wb As New WeUI \'定义一个基于weui框架的网页生成器

Select Case e.Path

Case "test.htm"

If e.PostValues.Count = 0 Then

wb.AddToast("","提示1", "正在下载图片",1) \'定义提示

wb.AddForm("","表单1","test.htm")

wb.AddForm("","表单1","test.htm").attribute= """

With wb.AddInputGroup("表单1","输入框分组1","文件上传") \'文件上传

.AddUploader("文件上传1","")

End With

With wb.AddInputGroup("表单1","输入框分组2","浏览式文件上传") \'带图片浏览的文件上传

With .AddUploader("文件上传2","图片",True) \'True表示允许一次上传多个文件

.AllowAdd = False \'关闭文件上传功能

For Each fl As String In FileSys.GetFiles(目标目录路径)

Dim ifo As new FileInfo(fl)

.AddImage("./images/图片/" & dr("号码") & "/" & ifo.Name)

End With

With wb.AddButtonGroup("表单1","按钮分组1",True)

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

End With

Else

wb.InsertHTML("接收到的数据有:<br/>") \'这个用于测试结果

For Each key As String In e.PostValues.Keys

wb.InsertHTML(key & ":" & e.PostValues(key) & "<br/>")

End If

End Select

e.WriteString(wb.Build) \'生成网页

End If