'''
'/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
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
Next
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)
Next
End With
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/>")
Next
End If
End Select
e.WriteString(wb.Build) '生成网页
End If
加好友 
发短信
Post By：2017/12/24 20:59:00 [只看该作者]
