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 img As image = getimage(t11)
Dim bmp As 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, 200) ' 质量级别 0 对应于最大压缩,而质量级别 100 对应于最小压缩
myEncoderParameters.Param(0) = myEncoderParameter
Dim slt As String = ifo.path & T11 & ifo.Extension
bmp.Save(slt,jpgEncoder, myEncoderParameters)
bmp.dispose
g.dispose
Dim img1 As image = getImage(slt)
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, ImageFormat.Jpeg)
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:04:00 [只看该作者]
