Option Strict Off Imports System.IO Imports System.Net Public Class 鞋型圖片資料庫 Public Property Credentials As ICredentials Private ReadOnly ds, ds1 As New DataSet Dim aa1 As MsgBoxResult Dim TT As String Private Sub Set_圖片清單() 主表單_dgv.DataSource = Nothing : ds.Clear() 主表單_dgv.ColumnHeadersHeightSizeMode = DataGridViewColumnHeadersHeightSizeMode.EnableResizing 主表單_dgv.ColumnHeadersHeight = 25 主表單_dgv.AllowUserToAddRows = False SQL_鞋型圖片資料庫表單() da.Fill(ds) : 主表單_dgv.DataSource = ds.Tables(0) : conn.Close() 主表單_dgv.Columns(0).Width = 90 : 主表單_dgv.Columns(1).Width = 110 : 主表單_dgv.Columns(2).Width = 110 : 主表單_dgv.Columns(3).Width = 90 : 主表單_dgv.Columns(4).Width = 50 主表單_dgv.Columns(5).Width = 50 : 主表單_dgv.Columns(6).Visible = False End Sub Private Sub 鞋型圖片資料庫_Load(sender As Object, e As EventArgs) Handles MyBase.Load WINPROFIT_ERP_SYS.WindowState = 2 : Me.MdiParent = WINPROFIT_ERP_SYS : Me.WindowState = 2 : Me.AutoScroll = True 圖片編號_tb.Visible = False 全部資料_ch.Checked = True : 檔案名稱1_tb.Visible = False 客戶_tb.Enabled = False : 形體號碼_tb.Enabled = False : 形體名稱_tb.Enabled = False : Color_tb.Enabled = False Set_圖片清單() If FolderBrowserDialog1.ShowDialog = DialogResult.OK Then WebBrowser2.Navigate(FolderBrowserDialog1.SelectedPath) End If Target1 = Target & AA(1) & "/" WebBrowser1.Url = New Uri(Target1) If CC(12) = False Then : 刪除_bt.Enabled = False : End If End Sub Private Sub DataGridView1_CellClick(ByVal sender As Object, ByVal e As DataGridViewCellEventArgs) Handles 主表單_dgv.CellClick If e.RowIndex = -1 Then : Else 客戶_tb.Text = 主表單_dgv(0, e.RowIndex).Value.ToString : 形體號碼_tb.Text = 主表單_dgv(1, e.RowIndex).Value.ToString 形體名稱_tb.Text = 主表單_dgv(2, e.RowIndex).Value.ToString : Color_tb.Text = 主表單_dgv(3, e.RowIndex).Value.ToString Category_cb.Text = 主表單_dgv(4, e.RowIndex).Value.ToString : 圖片編號_tb.Text = 主表單_dgv(6, e.RowIndex).Value.ToString SQL_鞋型圖片資料庫6() PictureBox1.Image = Nothing While dr.Read() = True Dim unused As Byte() = New Byte(-1) {} Dim bytes As Byte() = DirectCast(dr.Item("圖片"), Byte()) Dim oStream As New MemoryStream(bytes) PictureBox1.Image = Bitmap.FromStream(oStream) End While conn.Close() PictureBox1.SizeMode = 4 End If End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles 更新清單_bt.Click Set_圖片清單() End Sub Private Sub Button6_Click(sender As Object, e As EventArgs) Handles 查詢_bt.Click PA = InputBox("請輸入要查詢的關鍵字") : Set_圖片清單() : PA = "" End Sub Private Sub CheckBox4_CheckedChanged(sender As Object, e As EventArgs) Handles 全部資料_ch.Click 全部資料_ch.Checked = True : 彩圖_ch.Checked = False : 設計圖_ch.Checked = False PA = "" : Set_圖片清單() : PA = "" End Sub Private Sub CheckBox3_CheckedChanged(sender As Object, e As EventArgs) Handles 彩圖_ch.Click 全部資料_ch.Checked = False : 彩圖_ch.Checked = True : 設計圖_ch.Checked = False PA = "彩圖" : Set_圖片清單() : PA = "" End Sub Private Sub CheckBox2_CheckedChanged(sender As Object, e As EventArgs) Handles 設計圖_ch.Click 全部資料_ch.Checked = False : 彩圖_ch.Checked = False : 設計圖_ch.Checked = True PA = "設計圖" : Set_圖片清單() : PA = "" End Sub Private Sub Button3_Click(sender As Object, e As EventArgs) Handles 下載圖片_bt.Click If 圖片編號_tb.Text = "" Then MsgBox("選擇要下載的圖片") Else With SaveFileDialog1 : .Filter = "所有文件(*.*)|*.*" : End With TT = Category_cb.Text SaveFileDialog1.FileName = 客戶_tb.Text & " - " & TT & " - " & 形體名稱_tb.Text & " - " & 形體號碼_tb.Text & " - " & Color_tb.Text & ".jpg" SaveFileDialog1.ShowDialog() : 檔案名稱_tb.Text = SaveFileDialog1.FileName ds1.Clear() SQL_鞋型圖片資料庫7() da.Fill(ds1) : conn.Close() If ds1.Tables(0).Rows.Count > 0 Then Dim imgData() As Byte imgData = ds1.Tables(0).Rows(0).Item("圖片") Dim fs As FileStream fs = File.Create(檔案名稱_tb.Text, imgData.Length - 1) fs.Write(imgData, 0, imgData.Length - 1) fs.Close() End If 檔案名稱_tb.Text = "" : 圖片編號_tb.Text = "" MsgBox("下載完成") End If End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles 刪除_bt.Click aa1 = MsgBox("確定要刪除該筆資料?", MsgBoxStyle.OkCancel) If aa1 = MsgBoxResult.Ok Then SQL_刪除鞋型圖片資料庫() : conn.Close() MsgBox("刪除完成") End If Set_圖片清單() End Sub Private Sub Button4_Click(sender As Object, e As EventArgs) Handles 讀取料夾路徑_bt.Click If FolderBrowserDialog1.ShowDialog = DialogResult.OK Then WebBrowser2.Navigate(FolderBrowserDialog1.SelectedPath) End If End Sub Private Sub TextBox4_DragEnter(sender As Object, e As DragEventArgs) Handles 檔案名稱_tb.DragEnter If e.Data.GetDataPresent(DataFormats.FileDrop) Then Dim files As String() Try files = CType(e.Data.GetData(DataFormats.FileDrop), String()) 檔案名稱_tb.Text = files(files.Length - 1) Catch ex As Exception MessageBox.Show(ex.Message) Return End Try End If Dim STR2 As Integer = 0 檔案名稱1_tb.Text = 檔案名稱_tb.Text If 檔案名稱_tb.Text = "" Then Else For i As Integer = 0 To 9999 Dim STR1 As Integer = Strings.Len(檔案名稱1_tb.Text) If Strings.Right((檔案名稱1_tb.Text), 1) <> "\" Then STR1 -= 1 : STR2 += 1 If STR1 = 0 Then 檔案名稱1_tb.Text = "" 檔案名稱_tb.Text = "" i = 9999 Else 檔案名稱1_tb.Text = Strings.Left((檔案名稱1_tb.Text), STR1) End If Else 檔案名稱1_tb.Text = Strings.Right((檔案名稱_tb.Text), STR2) 檔案名稱_tb.Text = 檔案名稱1_tb.Text i = 9999 End If Next End If End Sub Private Sub TextBox4_DragDrop(ByVal sender As Object, ByVal e As DragEventArgs) Handles 檔案名稱_tb.DragDrop Dim files As Array = e.Data.GetData(DataFormats.FileDrop) For Each file As String In files 檔案名稱_tb.AppendText(file + Environment.NewLine) Next End Sub Private Sub Button24_Click(sender As Object, e As EventArgs) Handles 圖片修改存檔_bt.Click conn.Close() ConnOpen() If 修改前確認_ch.Checked = False Then Else Dim 驗證 As String = "" : Dim 取變數 As String 取變數 = Strings.StrReverse(檔案名稱_tb.Text) For i As Integer = 1 To 10 If i = 1 Then 驗證 = Strings.Left(取變數, i) Else If Strings.Mid(取變數, i, 1) = "." Then 驗證 = Strings.StrReverse(驗證) : Exit For Else 驗證 &= Strings.Mid(取變數, i, 1) End If End If Next If 驗證 = "PNG" Or 驗證 = "png" Or 驗證 = "GIF" Or 驗證 = "gif" Or 驗證 = "BMP" Or 驗證 = "bmp" Or 驗證 = "JPG" Or 驗證 = "jpg" Or 驗證 = "JPEG" Or 驗證 = "jpeg" Then SQL_更改鞋型圖片資料庫() : conn.Close() MsgBox("修改完成") '---FTP方式刪除檔案---------------------------------------------------------------------------------------------------------------- Dim frq As FtpWebRequest, frp As FtpWebResponse, fcr As NetworkCredential frq = CType(WebRequest.Create(New Uri(Target1 & 檔案名稱_tb.Text)), FtpWebRequest) fcr = New NetworkCredential(FTP帳號, FTP密碼) frq.Credentials = fcr frq.Method = WebRequestMethods.Ftp.DeleteFile frq.UseBinary = True frp = CType(frq.GetResponse, FtpWebResponse) frp.Close() WebBrowser1.Refresh() '----------------------------------------------------------------------------------------------------------------------------------- 檔案名稱_tb.Text = "" : 圖片編號_tb.Text = "" Else '---FTP方式刪除檔案---------------------------------------------------------------------------------------------------------------- Dim frq As FtpWebRequest, frp As FtpWebResponse, fcr As NetworkCredential frq = CType(WebRequest.Create(New Uri(Target1 & 檔案名稱_tb.Text)), FtpWebRequest) fcr = New NetworkCredential(FTP帳號, FTP密碼) frq.Credentials = fcr frq.Method = WebRequestMethods.Ftp.DeleteFile frq.UseBinary = True frp = CType(frq.GetResponse, FtpWebResponse) frp.Close() WebBrowser1.Refresh() '----------------------------------------------------------------------------------------------------------------------------------- 檔案名稱_tb.Text = "" : 圖片編號_tb.Text = "" MsgBox("上傳文件並非常用圖片格式，文件已自動刪除，請專換成常用圖片檔案再行操作。") End If End If End Sub End Class