[VB.NET] แจกโค้ดฟรีการอัพโหลดไฟล์ขึ้นสู่ Web Hosting ด้วย Component มาตรฐานของ MS
http://www.g2gnet.com/webboard/images/vbnet/ftpclientnet.pngโค้ดชุดนี้เป็นการใช้ขีดความสามารถของ VB.NET ล้วนๆ ซึ่งแอดมินเตรียมไว้ในโปรเจคตัวใหม่ในการติดต่อกับฐานข้อมูลในแบบ Remote MySQL Server ... โดยแอดมินเลือกใช้ฟรีโฮสติ้ง HelioHost.org ซึ่งให้บริการพื้นที่ขนาด 1 GB. และฐานข้อมูล MySQL ขนาด 1 GB. โดยไม่จำกัดจำนวนฐานข้อมูล ดูวิธีการจัดการ User ได้จากที่นี่ ...
มาดูโค้ดกันเถอะ ...
Imports System.Net
Imports System.IO
Public Class frmFTPClientNet
'// Get only Filename + Extension
Dim sFileName As String
Dim RemoteDir As String = "ftp://ftp.YOUR_DNS.heliohost.org//upload/"
Dim UName As String = "USERNAME@YOUR_DNS.heliohost.org"
Dim Pwd As String = "PASSWORD"
Private Sub btnBrowse_Click(sender As System.Object, e As System.EventArgs) Handles btnBrowse.Click
' Declare Open File Dialog Control - Run Time
Dim dlgImage As OpenFileDialog = New OpenFileDialog()
Dim strPath As String = MyPath(Application.StartupPath) & "Images\"
' / Initialize Open File Dialog
With dlgImage
.InitialDirectory = strPath & "Images\"
.Title = "Choose images - Images File Format"
.Filter = "Images (*.jpg;*.png;*.gif;*.bmp)|*.jpg;*.png;*.gif;*.bmp"
.FilterIndex = 1
.RestoreDirectory = True
End With
' Select OK
If dlgImage.ShowDialog() = DialogResult.OK Then
' Get file size less than 1,024 KB.
Dim info As New FileInfo(dlgImage.FileName)
If (info.Length / 1024) > 1024 Then
MessageBox.Show("Picture file size has " & Format((info.Length / 1024), "#,##0") & " KB. too large 1,024 KB.", "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Exit Sub
End If
'//
txtFileName.Text = dlgImage.FileName
'// Put the current image file into PictureBox Control
picData.Image = Image.FromFile(dlgImage.FileName)
'// Get only Filename + Extension. Ex. thongkorn.png
sFileName = dlgImage.SafeFileName
End If
End Sub
Private Sub btnUploadFile1_Click(sender As System.Object, e As System.EventArgs) Handles btnUploadFile1.Click
If txtFileName.Text.Trim.Length = 0 Then Return
Me.Cursor = Cursors.WaitCursor
Try
'/ Create Request To Upload File
Dim wrUpload As FtpWebRequest = DirectCast(WebRequest.Create(RemoteDir & sFileName), FtpWebRequest)
'/ Specify UName & Pwd
wrUpload.Credentials = New NetworkCredential(UName, Pwd)
'/ Start Upload Process
wrUpload.Method = WebRequestMethods.Ftp.UploadFile
'/ Locate File And Store It In Byte Array
Dim BitFile() As Byte = File.ReadAllBytes(txtFileName.Text)
'/ Get File'
Dim strFile As Stream = wrUpload.GetRequestStream()
'/ Upload Each Byte
strFile.Write(BitFile, 0, BitFile.Length)
'/ Close
strFile.Close()
'/ Free Memory
strFile.Dispose()
MessageBox.Show("File " & sFileName & " Uploaded Complete.", "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Information)
Catch ex As Exception
MessageBox.Show(ex.Message)
Finally
txtFileName.Clear()
picData.Image = Nothing
End Try
Me.Cursor = Cursors.Default
End Sub
Private Sub btnUploadFile2_Click(sender As System.Object, e As System.EventArgs) Handles btnUploadFile2.Click
If txtFileName.Text.Trim.Length = 0 Then Return
Me.Cursor = Cursors.WaitCursor
Try
Dim Request As FtpWebRequest = WebRequest.Create(RemoteDir & sFileName)
'// Login
Request.Credentials = New NetworkCredential(UName, Pwd)
Request.Method = WebRequestMethods.Ftp.UploadFile
Using FileStream As Stream = File.OpenRead(txtFileName.Text),
ftpStream As Stream = Request.GetRequestStream()
Dim read As Integer
Do
Dim Buffer() As Byte = New Byte(10240) {}
read = FileStream.Read(Buffer, 0, Buffer.Length)
If read > 0 Then
ftpStream.Write(Buffer, 0, read)
Console.WriteLine("Uploaded {0} bytes", FileStream.Position)
End If
Loop While read > 0
End Using
MessageBox.Show("File " & sFileName & " Uploaded Complete.", "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Information)
'//
Catch ex As Exception
MessageBox.Show(ex.Message)
Finally
txtFileName.Clear()
picData.Image = Nothing
End Try
Me.Cursor = Cursors.Default
End Sub
Private Sub txtFileName_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtFileName.KeyPress
e.Handled = True
End Sub
' / --------------------------------------------------------------------------------
' / Get my project path
' / AppPath = C:\My Project\bin\debug
' / Replace "\bin\debug" with "\"
' / Return : C:\My Project\
Function MyPath(AppPath As String) As String
'/ MessageBox.Show(AppPath);
AppPath = AppPath.ToLower()
'/ Return Value
MyPath = AppPath.Replace("\bin\debug", "\").Replace("\bin\release", "\").Replace("\bin\x86\debug", "\")
'// If not found folder then put the \ (BackSlash ASCII Code = 92) at the end.
If Microsoft.VisualBasic.Right(MyPath, 1) <> Chr(92) Then MyPath = MyPath & Chr(92)
End Function
End Class
ดาวน์โหลดโค้ดชุดต้นฉบับ VB.NET (2010) ได้ที่นี่ ...
ขอบคุณคับ ขอบคุณครับอาจารย์ :D ขอบคุณครับ
หน้า:
[1]