以文本方式查看主题 -  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp) --  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2) ----  压缩图片后系统卡顿  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=142685)

--  作者：刘林 --  发布时间：2019/11/3 21:04:00 --  压缩图片后系统卡顿 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 老师请问上面的代码是想用打开文件压缩上传并以身份证号命名文件，但只要传两张后，系统就卡，死机，有时会自动关了，我估这种方式是不是占用内存过大或内存溢出，请问该怎么改才行

--  作者：有点蓝 --  发布时间：2019/11/3 21:32:00 --   图片处理本身就很费资源的,特别是大图片.何况还压缩了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