Dim ftp1 As New FtpClient
ftp1.Host="
ftp1.Account =
ftp1.Password =
Dim wjm As String=""
If Tables("拍户口_table1").Rows.Count>0
Dim r As Row = Tables("拍户口_table1").Current
If ValidPIN(r("身份证件号"))= True
wjm = r("身份证件号") & ".jpg"
ElseIf r("学籍号")>""
wjm= r("学籍号") & ".jpg"
Else
messagebox.show("该学生的身份证号和学籍号中至少有一个要正确完整")
Return
End If
If wjm>""
Dim pic As WinForm.PictureBox = e.Form.Controls("PicView2")
Dim img As Image
If pic.Image IsNot Nothing
Dim buffer() As Byte = Functions.Execute("GetImageToBytes",pic.Image)
Dim result As Integer = Functions.Execute("SaveBytesToFile",buffer,wjm)
Dim fl As String=ProjectPath & "RemoteFiles\xp\" & FileSys.GetName(wjm)
pic.image.save(fl)
Dim fileInfo As new FileInfo(fl)
Dim file As String = fl
img = getImage(file)
Dim bmp As bitmap
bmp = new bitmap(img, 100, 100 * (img.height / img.width))
bmp.save(ProjectPath & "RemoteFiles\xp\" & FileSys.GetName(wjm), ImageFormat.Jpeg)
bmp.Dispose
Dim ifo As new FileInfo(wjm)
If ftp1.Upload(wjm,"\xp\" & FileSys.GetName(wjm),True) = True Then
r("相片")="\xp\" & FileSys.GetName(wjm)
r.save
With Tables("拍户口_table1")
If .Position = .Rows.Count - 1
.Position = .Position - 1
.Position = .Position + 1
Else
.Position = .Position + 1
.Position = .Position - 1
End If
End With
Else
Messagebox.show("上传失败,请重新上传该文件!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
End If
Else
MessageBox.Show("保存失败","失败")
End If
Else
MessageBox.Show("请先拍照!","错误")
End If
End If
老师：你好，之前我也做过压缩，这个地方没做压缩，发现用户上读的图片很大,现在才发现，又很急越急越晕，增加压缩这样好像没压缩起，请老师帮改下压缩文件大小，谢谢!
加好友 
发短信
Post By：2020/4/23 10:02:00 [只看该作者]
