图片处理本身就很费资源的,特别是大图片.何况还压缩了2次
Dim ftp1 As New FtpClient
ftp1.Host=""
ftp1.Account = ""
ftp1.Password = ""
Dim r As Row = Tables("人员花名_table1").Current
Dim t11 As String = e.Form.Controls("textbox11").text
If T11>""
If ValidPIN(r("身份证号码"))= False
messagebox.show("请正确填写身份证号码后才能上传其相片")
Return
Else
Dim ifo As new FileInfo(t11)
If Ifo.Length>40960 '大于40k才压缩
Dim img1 As image = getImage(t11)
Dim bmp1 As bitmap
If img1.width > 400 Then
If 400 * (img1.height / img1.width) > 300 Then
bmp1 = new bitmap(img1, 400*(300/(400*(img1.height/img1.width))), 300)
Else
bmp1 = new bitmap(img1, 300, 300 * (img1.height / img1.width))
End If
bmp1.save(slt, img.RawFormat)
bmp1.Dispose
End If
If ftp1.Upload(slt,"\xp\" & FileSys.GetName(T11 & Ifo.extension),True) = True Then
r("相片")="\xp\" & FileSys.GetName(T11 & Ifo.extension)
r.save
' messagebox.show(ProjectPath & "\RemoteFiles\xp\T11" & Ifo.extension)
' bmp1.save(ProjectPath & "RemoteFiles\xp\" & T11 & Ifo.extension)
e.Form.Controls("textbox11").text=""
Else
Messagebox.show("上传失败,请重新上传该文件!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
End If
Else
'If ftp1.Upload(t11,"\xp\" & FileSys.GetName(T11 & Ifo.extension),True) = True Then
'r("相片")="\xp\" & FileSys.GetName(T11 & Ifo.extension)
'r.save
'e.Form.Controls("textbox11").text=""
If ftp1.Upload(t11,"\xp\" & T11 & Ifo.extension,True) = True Then
r("相片")="\xp\" & T11 & Ifo.extension
r.save
e.Form.Controls("textbox11").text=""
Else
Messagebox.show("上传失败,请重新上传该文件!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
End If
End If
End If
Else
messagebox.show("你没打开相片")
End If
加好友 
发短信
Post By：2019/11/3 21:32:00 [显示全部帖子]
