以文本方式查看主题

-  Foxtable(狐表)  (http://www.foxtable.com/bbs/index.asp)
--  专家坐堂  (http://www.foxtable.com/bbs/list.asp?boardid=2)
----  FTPClient上传文件自动压缩  (http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=111267)
--  作者：cuicuibing
--  发布时间：2017/12/19 7:30:00
--  FTPClient上传文件自动压缩
请教，FTPClient上传文件自动压缩的代码
--  作者：cuicuibing
--  发布时间：2017/12/19 7:35:00
--  
我的意思是上传的图片，可以自动按照像素压缩。比如，宽度超过800，自动压缩为800.高度自动调整
--  作者：有点甜
--  发布时间：2017/12/19 8:41:00
--  

1、自动调整大小参考

 

http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&Id=89637

 

2、上传图片的功能你可以单独做一个按钮、实现upload的功能

 

http://www.foxtable.com/webhelp/scr/2638.htm

 

http://www.foxtable.com/webhelp/scr/1410.htm

 

3、或者是，你可以在服务器端那里，做一个foxtable项目，定时把文件夹没有压缩的图片压缩成符合规格的图片。

 
--  作者：cuicuibing
--  发布时间：2017/12/19 8:59:00
--  
谢谢版主
--  作者：cuicuibing
--  发布时间：2017/12/19 9:37:00
--  
版主，请帮忙在下面代码加入自动压缩，上传ftp的

Dim cmd2 As New SQLCommand
Dim dt2 As Date
cmd2.C
cmd2.CommandText = "Select GetDate()"
dt2 = cmd2.ExecuteScalar()


Dim ftp1 As New FtpClient
Ftp1.Host = "0"
Ftp1.Account = "0"
Ftp1.Password = "0"
If Tables("成品").Current.IsNull("图纸号") Then
    MessageBox.Show("必须输入图纸号!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
    Return
End If
Dim proDir As String = Tables("成品").Current("图纸号")
Dim dlg As New OpenFileDialog
dlg.Filter= "图形文件|*.bmp;*.jpg;*.gif"
dlg.MultiSelect = True
If dlg.ShowDialog = DialogResult.OK Then
    Dim fpath As String =  "/包装/" & prodir & "/"
    If ftp1.DirExists(fpath) = False Then ftp1.MakeDir(fpath)
    
    Dim str As String = ""
    For Each fl As String In dlg.FileNames
        Dim fileInfo As new FileInfo(fl)
        If Ftp1.Upload(fl,fpath & filesys.GetName(fl),True) = True Then
            str &= fpath & FileSys.GetName(fl) & vbcrlf
            
        End If
        
    Next

Tables("成品").Current("包装资料")= str
Tables("成品").Current("包装日期") = cmd2.ExecuteScalar()
Tables("成品").Current.Save()
Messagebox.show("上传完成!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)

End If
[此贴子已经被作者于2017/12/19 9:38:35编辑过]
--  作者：有点甜
--  发布时间：2017/12/19 9:44:00
--  

Dim file As String = fl
Dim img As image = getImage(file)
Dim bmp As bitmap
If img.width > 800 Then
    If 800 * (img.height / img.width) > 600 Then
        bmp = new bitmap(img, 800*(600/(800*(img.height/img.width))), 600)
    Else
        bmp = new bitmap(img, 800, 800 * (img.height / img.width))
    End If
End If
bmp.save("d:\\temp.jpg")
bmp.Dispose

 

If Ftp1.Upload("d:\\temp.jpg",fpath & filesys.GetName(fl),True) = True Then
--  作者：cuicuibing
--  发布时间：2017/12/19 10:36:00
--  
版主，我的意思是打开文件框，选择文件后，自动压缩，然后上传。
--  作者：有点甜
--  发布时间：2017/12/19 10:39:00
--  
看懂6楼代码，在红色代码前加入压缩的代码。
--  作者：cuicuibing
--  发布时间：2017/12/19 12:47:00
--  
明白了，谢谢版主