藍色、天空、貓: 【VB.NET 語言】上報練習

這篇就是前面分成八集，~~用來在天橋底下說書~~的程式完整內容。
請各位安心服用~~
小程式有史有末，端看完整程式碼也不一定看的出個所以然~
所以看看前面的介紹會幫助你懂得多一些!

底下就是這個~~連續劇~~程式分享的分段分享內容

1. 上報練習 _ 選擇資料夾
2. 上報練習 _ 寫一個 .XML 資料
3. 上報練習 _ 監控資料夾
4. 上報練習 _ 複製檔案
5. 上報練習 _ FTP Server 檔案上傳
6. 上報練習 _ 上傳錯誤紀錄
7. 上報練習 _ 使用 BackgroundWorker 再次上傳
8. 上報練習 _ Log 紀錄
9. 上報練習 _ 完整程式碼分享

以上就是全部的小程式分享文章!!!!

下面就是最重的的完整程式碼~
那裏面有一些重複然後或是被註解的地方，請大家見諒~
因為這個小程式是居裡貓自己寫的，不是一次到位的完整~

--------------------------------------------------------------------------------------------------------------------------

Imports System
Imports System.IO
Imports System.Xml.Serialization
Public Class UploadReport
#Region "Button Contorl Upload Report Folder"
'Select Local Folder
Private Sub Btn_Local_Click(sender As Object, e As EventArgs) Handles Btn_Local.Click
Dim Local_FolderBrowser As FolderBrowserDialog = New FolderBrowserDialog
Local_FolderBrowser.ShowDialog()
TxB_Local.Text = Local_FolderBrowser.SelectedPath
End Sub
'Select Remote Folder
Private Sub Btn_Remote_Click(sender As Object, e As EventArgs) Handles Btn_Remote.Click
Dim Remote_FolderBrowser As FolderBrowserDialog = New FolderBrowserDialog
Remote_FolderBrowser.ShowDialog()
TxB_Remote.Text = Remote_FolderBrowser.SelectedPath
End Sub
'Select NAS Folder
Private Sub Btn_NAS_Click(sender As Object, e As EventArgs) Handles Btn_NAS.Click
Dim NAS_FolderBrowser As FolderBrowserDialog = New FolderBrowserDialog
NAS_FolderBrowser.ShowDialog()
TxB_NAS.Text = NAS_FolderBrowser.SelectedPath
End Sub
'Select FTP Folder
Private Sub Btn_FTP_Click(sender As Object, e As EventArgs) Handles Btn_FTP.Click
Dim FTP_FolderBrowser As FolderBrowserDialog = New FolderBrowserDialog
FTP_FolderBrowser.ShowDialog()
TxB_FTP.Text = FTP_FolderBrowser.SelectedPath
End Sub
#End Region
'Button Contorl XML Write
Private Sub Btn_WriteXML_Click(sender As Object, e As EventArgs) Handles Btn_WriteXML.Click
'Check watch event was raising
If Watcher.watcher.EnableRaisingEvents = False Then
Watcher.watcher.EnableRaisingEvents = True
End If
Copy_Delete_File.GetPath(TxB_Local.Text, TxB_Remote.Text, TxB_NAS.Text, TxB_FTP.Text, ChB_UploadFTP.Checked)
FTPupload.Get_FTPinfo(TxB_FTPAddress.Text, TxB_FTPAccount.Text, Txb_FTPPassword.Text)
Dim wrXML As New XML
wrXML.LocalPath = TxB_Local.Text
wrXML.RemotePath = TxB_Remote.Text
wrXML.NASPath = TxB_NAS.Text
wrXML.FTPPath = TxB_FTP.Text
wrXML.Data = "This is a Programming Practices " & Now.ToString
wrXML.DateTime = Now.ToString
If ChB_UploadFTP.Checked Then
wrXML.CheckFTP = "Ture"
Else
wrXML.CheckFTP = "Flase"
End If
Dim objectStreamWriter As New StreamWriter(TxB_Local.Text + ("\Program Practices " & Now.ToString("_yyyyMMddHHmmss") & ".xml"))
Dim xmlserialize As New XmlSerializer(wrXML.GetType)
xmlserialize.Serialize(objectStreamWriter, wrXML)
objectStreamWriter.Dispose()
'Check backwork status
'If Not back.IsBusy = True Then
' back.RunWorkerAsync()
'End If
Backwork.main()
End Sub
Public Shared back As New System.ComponentModel.BackgroundWorker
Private Sub UploadReport_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'At program started to run monitor folder programming
Watcher.Main(TxB_Local.Text)
back.WorkerSupportsCancellation = True
back.WorkerReportsProgress = True
AddHandler back.DoWork, AddressOf back_DoWork
End Sub
Private Sub UploadReport_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
'When formclosed do log xml write
Dim log As New XML
log.Loginfo = ErrorList.LogList
Dim logstreamwriter As New StreamWriter(TxB_Remote.Text + ("\Log" & Now.ToString(" _yyyyMMddHHmmss") & ".xml"))
Dim logxmlserialize As New XmlSerializer(log.GetType)
logxmlserialize.Serialize(logstreamwriter, log)
logstreamwriter.Dispose()
End Sub
Private Sub back_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs)
Dim retry As Boolean = True
Dim retrytime As Integer = 0
'Check upload NAS ro FTP
If ChB_UploadFTP.Checked = False Then
While retry
'Do upload to NAS back ground work
For i As Integer = 0 To ErrorList.CountNas - 1
Try
File.Copy(Copy_Delete_File.copypath + "\" + ErrorList.NASList(i), Copy_Delete_File.uptonas + "\" + ErrorList.NASList(i), True)
If ErrorList.CountNas = 0 Then
'If NasList count eaual 0, retry end
retry = False
Else
'retry not end and remove NasList now data then re do for
retry = True
ErrorList.RemoveNAS(i)
Exit For
End If
Catch ex As Exception
'Retry failure add retry times and error log
retry = True
retrytime += 1
'Console.WriteLine("Error list upload to NAS retry failured, back do work times : " & retrytime)
ErrorList.AddLog(Now.ToString("yyyyMMddHHmmss _ ") + "Error list upload to NAS retry failured, back do work times : " & retrytime)
End Try
Next
'If NasList count eaual 0, retry end
If ErrorList.CountNas = 0 Then
retry = False
End If
End While
Else
While retry
For i As Integer = 0 To ErrorList.CountFtp - 1
Try
File.Copy(Copy_Delete_File.copypath + "\" + ErrorList.FTPList(i), Copy_Delete_File.uptoftp + "\" + ErrorList.FTPList(i), True)
System.Threading.Thread.Sleep(100)
FTPupload.uploadtoftp()
System.Threading.Thread.Sleep(100)
If ErrorList.CountFtp = 0 Then
'If NasList count eaual 0, retry end
retry = False
Else
'retry not end and remove NasList now data then re do for
retry = True
ErrorList.RemoveFTP(i)
Exit For
End If
Catch ex As Exception
'Retry failure add retry times and error log
retry = True
retrytime += 1
'Console.WriteLine("Error list upload to FTP retry failured, back do work times : " & retrytime)
ErrorList.AddLog(Now.ToString("yyyyMMddHHmmss _ ") + "Error list upload to FTP retry failured, back do work times : " & retrytime)
End Try
Next
'If NasList count eaual 0, retry end
If ErrorList.CountFtp = 0 Then
retry = False
End If
End While
End If
End Sub
Private Sub back_Completes(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs)
'If ErrorList.CountNas = 0 Then
' back.CancelAsync()
'Else
' back.RunWorkerAsync()
'End If
End Sub
End Class
#Region "XML Class setting"
'About used XML setting info
Public Class XML
Private _LoaclPath As String
Public Property LocalPath() As String
Get
Return _LoaclPath
End Get
Set(value As String)
_LoaclPath = value
End Set
End Property
Private _RemotePath As String
Public Property RemotePath() As String
Get
Return _RemotePath
End Get
Set(value As String)
_RemotePath = value
End Set
End Property
Private _NASPath As String
Public Property NASPath() As String
Get
Return _NASPath
End Get
Set(value As String)
_NASPath = value
End Set
End Property
Private _FTPPath As String
Public Property FTPPath() As String
Get
Return _FTPPath
End Get
Set(value As String)
_FTPPath = value
End Set
End Property
Private _Data As String
Public Property Data() As String
Get
Return _Data
End Get
Set(value As String)
_Data = value
End Set
End Property
Private _DateTime As String
Public Property DateTime() As String
Get
Return _DateTime
End Get
Set(value As String)
_DateTime = value
End Set
End Property
Private _CheckFTP As String
Public Property CheckFTP() As String
Get
Return _CheckFTP
End Get
Set(value As String)
_CheckFTP = value
End Set
End Property
Private _Loginfo As List(Of String)
Public Property Loginfo() As List(Of String)
Get
Return _Loginfo
End Get
Set(value As List(Of String))
_Loginfo = value
End Set
End Property
End Class
#End Region
#Region "Monitor Folder, used FileSystemWatcher"
'About Monitor Foldaer
Public Class Watcher
Public Shared Sub Main(path As String)
'"path" was monitored folder file path
Run(path)
End Sub
Public Shared watcher As New FileSystemWatcher()
Private Shared Sub Run(p As String)
'Create new FileSystemWatcher and set path
watcher.Path = p
'Only watch XML files
watcher.Filter = "*.xml"
'AddHandler watcher.Changed, AddressOf OnChanged
AddHandler watcher.Created, AddressOf OnCreated
'AddHandler watcher.Deleted, AddressOf OnDeleted
'AddHandler watcher.Renamed, AddressOf OnRenamed
'Begin watching
watcher.EnableRaisingEvents = True
End Sub
Private Shared Sub OnCreated(source As Object, e As FileSystemEventArgs)
'When file was created
Console.WriteLine("File : " & e.FullPath & " _ " & e.ChangeType)
'When into here and then get now file name
Copy_Delete_File.GetFileName(e.Name)
System.Threading.Thread.Sleep(500)
'Wait few second then do copyfile work
Copy_Delete_File.copyfile()
End Sub
Private Shared Sub OnChanged(source As Object, e As FileSystemEventArgs)
'When file was changed
End Sub
Private Shared Sub OnDeleted(source As Object, e As FileSystemEventArgs)
'When file was deleted
End Sub
Private Shared Sub OnRenamed(source As Object, e As RenamedEventArgs)
'When file was renmaed
Console.WriteLine("File : {0} Renamed to {1}", e.OldFullPath, e.FullPath)
Copy_Delete_File.GetFileName(e.Name)
System.Threading.Thread.Sleep(100)
Copy_Delete_File.copyfile()
End Sub
End Class
#End Region
#Region "Copy and Delete file class"
'About Copy and Delete file
Public Class Copy_Delete_File
'Parameter use for down below work
Public Shared filename As String 'use get file name
Public Shared sourcepath As String 'use get soure file path
Public Shared copypath As String 'use get copy file path
Public Shared uptonas As String 'use get upload to nas path
Public Shared uptoftp As String 'use get upload to ftp path
Public Shared checkbox As Boolean 'use get checkbox condition
'Get now file name
Public Shared Sub GetFileName(Name As String)
Console.WriteLine(Name & " Get")
filename = Name
End Sub
'Get path to use copy file, delete file, upload file
Public Shared Sub GetPath(source As String, copyformpath As String, upNASpath As String, upFTPpath As String, check As Boolean)
Console.WriteLine(source & vbCr & copyformpath & vbCr & upNASpath & vbCr & upFTPpath)
sourcepath = source
copypath = copyformpath
uptonas = upNASpath
uptoftp = upFTPpath
checkbox = check
End Sub
'Do copy file to remote folder, upload file to NAS folder and FTP folder then deleted local file
Public Shared Sub copyfile()
Try
'Copy file to remote folder from local folder
File.Copy(sourcepath + "\" + filename, copypath + "\" + filename, True)
'Control retry parameter
Dim Retry As Boolean = True
Dim retrytimes As Integer = 0
'Check upload to NAS or FTP
If checkbox = False Then
While Retry
Try
'Upload to NAS, copy file from remote folder, upload done delete loacal file
File.Copy(copypath + "\" + filename, uptonas + "\" + filename, True)
System.Threading.Thread.Sleep(100)
Retry = False
Catch ex As Exception
'Upload to NAS Error, do retry upload file and count retry times
If retrytimes <= 10 Then
Retry = True
retrytimes += 1
'Console.WriteLine("Upload to NAS was Error, do retry upload, retry times : " & retrytimes)
ErrorList.AddLog(Now.ToString("yyyyMMddHHmmss _ ") + "Upload to NAS was Error, do retry upload, retry times : " & retrytimes)
System.Threading.Thread.Sleep(500)
Else
Retry = False
retrytimes = 0
'Console.WriteLine("Retry upload to NAS times was arrived")
'When retry arrived then add upload error filename into list and error log list
ErrorList.AddNas(filename)
ErrorList.AddLog(Now.ToString("yyyyMMddHHmmss _ ") + "Retry upload to NAS times was arrived")
End If
End Try
End While
File.Delete(sourcepath + "\" + filename)
Else
While Retry
Try
'Upload to FTP, copy file from remote folder, upload done delete loacal file
File.Copy(copypath + "\" + filename, uptoftp + "\" + filename, True)
System.Threading.Thread.Sleep(100)
FTPupload.uploadtoftp()
System.Threading.Thread.Sleep(100)
Retry = False
Catch ex As Exception
'Upload to FTP Error, do retry upload file and count retry times
If retrytimes <= 10 Then
Retry = True
retrytimes += 1
'Console.WriteLine("Upload to FTP was Error, do retry upload, retry times : " & retrytimes)
ErrorList.AddLog(Now.ToString("yyyyMMddHHmmss _ ") + "Upload to FTP was Error, do retry upload, do retry upload, retry times : " & retrytimes)
System.Threading.Thread.Sleep(500)
Else
Retry = False
retrytimes = 0
'Console.WriteLine("Retry upload to FTP times was arrived")
'When retry arrived then add upload error filename into list and error log list
ErrorList.AddFtp(filename)
ErrorList.AddLog(Now.ToString("yyyyMMddHHmmss _ ") + "Retry upload to FTP times was arrived")
End If
End Try
End While
File.Delete(sourcepath + "\" + filename)
End If
Catch ex As Exception
ErrorList.AddLog(Now.ToString("yyyyMMddHHmmss _ ") + "Copy to reomte folder failure")
End Try
End Sub
End Class
#End Region
#Region "Upload to FTP class"
'About upload to FTP
Public Class FTPupload
'Parameter usw for down below work
Public Shared FTP_IP As String 'use get IP
Public Shared FTP_Account As String 'use get account
Public Shared FTP_Password As String 'use get password
'Get FTP info, IP, account and password
Public Shared Sub Get_FTPinfo(ByVal ip As String, ByVal account As String, ByVal password As String)
FTP_IP = ip
FTP_Account = account
FTP_Password = password
End Sub
'Do upload work
Public Shared Sub uploadtoftp()
Dim ftpRequestStream As System.IO.Stream
Dim statusDescription As String
Dim retry As Boolean = True
Dim retrytimes As Integer = 0
While retry
'Create file
Try
'Create FTP IP and upload file name
Dim ftpRequest As System.Net.FtpWebRequest = System.Net.FtpWebRequest.Create("ftp://" + FTP_IP + "//" + Copy_Delete_File.filename)
ftpRequest.Credentials = New System.Net.NetworkCredential(FTP_Account, FTP_Password) 'Set account and password
ftpRequest.Method = System.Net.WebRequestMethods.Ftp.UploadFile 'Set method is uploadfile mathod
System.Threading.Thread.Sleep(500)
ftpRequest.KeepAlive = True
ftpRequestStream = ftpRequest.GetRequestStream
retry = False
Catch ex As Exception
If retrytimes <= 10 Then
'If retry times less than 10 do retry and add retry times, error loglist
statusDescription = ex.Message
retry = True
retrytimes += 1
'Console.WriteLine("***Upload to FTP was Error, do retry upload, retry times : " & retrytimes)
ErrorList.AddLog(Now.ToString("yyyyMMddHHmmss _ ") + "***Upload to FTP was Error, do retry upload, retry times : " & retrytimes)
System.Threading.Thread.Sleep(500)
Else
retry = False
retrytimes = 0
'Console.WriteLine("***Retry upload to FTP times was arrived")
'When retry arrived then add upload error filename into list and error log list
ErrorList.AddFtp(Copy_Delete_File.filename)
ErrorList.AddLog(Now.ToString("yyyyMMddHHmmss _ ") + "***Retry upload to FTP times was arrived")
End If
End Try
End While
'Open copy file and then read file data
Dim filestream As System.IO.FileStream
Try
filestream = System.IO.File.Open(Copy_Delete_File.copypath + "\" + Copy_Delete_File.filename, IO.FileMode.Open, IO.FileAccess.Read)
'filestream = System.IO.File.Open(Copy_Delete_File.sourcepath + "\" + Copy_Delete_File.filename, IO.FileMode.Open, IO.FileAccess.Read)
Catch ex As Exception
statusDescription = ex.Message
End Try
Dim buffer() As Byte = New Byte((filestream.Length) - 1) {}
Dim byteRead As Integer
'Do write data into FTP file
While True
byteRead = filestream.Read(buffer, 0, buffer.Length)
If byteRead = 0 Then Exit While
ftpRequestStream.Write(buffer, 0, byteRead)
End While
filestream.Close()
ftpRequestStream.Close()
End Sub
End Class
#End Region
#Region "Error List"
'About error list, NAS , FTP, log
Public Class ErrorList
Public Shared NASList As New List(Of String)
Public Shared FTPList As New List(Of String)
Public Shared LogList As New List(Of String)
Public Shared Sub AddNas(ByVal nList As String)
NASList.Add(nList)
End Sub
Public Shared Sub AddFtp(ByVal fList As String)
FTPList.Add(fList)
End Sub
Public Shared Sub AddLog(ByVal log As String)
LogList.Add(log)
End Sub
Public Shared Sub ClearNas()
NASList.Clear()
End Sub
Public Shared Sub ClearFtp()
FTPList.Clear()
End Sub
Public Shared Sub ClaerLog()
LogList.Clear()
End Sub
Public Shared Function CountNas()
Return NASList.Count
End Function
Public Shared Function CountFtp()
Return FTPList.Count
End Function
Public Shared Sub RemoveNAS(ByVal i As Integer)
Dim str As String = NASList(i)
NASList.Remove(str)
End Sub
Public Shared Sub RemoveFTP(ByVal i As Integer)
Dim str As String = FTPList(i)
FTPList.Remove(str)
End Sub
End Class
#End Region
Public Class Backwork
'Public WithEvents background As New System.ComponentModel.BackgroundWorker
Public Shared background As New System.ComponentModel.BackgroundWorker
Public Sub New()
background.WorkerReportsProgress = True
background.WorkerSupportsCancellation = True
background.RunWorkerAsync()
End Sub
Public Shared Sub main()
background.RunWorkerAsync()
AddHandler background.DoWork, AddressOf back_DoWork
End Sub
Private Shared Sub back_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs)
Dim retry As Boolean = True
Dim retrytime As Integer = 0
'Check upload NAS ro FTP
If Copy_Delete_File.checkbox = False Then
While retry
'Do upload to NAS back ground work
For i As Integer = 0 To ErrorList.CountNas - 1
Try
File.Copy(Copy_Delete_File.copypath + "\" + ErrorList.NASList(i), Copy_Delete_File.uptonas + "\" + ErrorList.NASList(i), True)
If ErrorList.CountNas = 0 Then
'If NasList count eaual 0, retry end
retry = False
Else
'retry not end and remove NasList now data then re do for
retry = True
ErrorList.RemoveNAS(i)
Exit For
End If
Catch ex As Exception
'Retry failure add retry times and error log
retry = True
retrytime += 1
'Console.WriteLine("Error list upload to NAS retry failured, back do work times : " & retrytime)
ErrorList.AddLog(Now.ToString("yyyyMMddHHmmss _ ") + "Error list upload to NAS retry failured, back do work times : " & retrytime)
End Try
Next
'If NasList count eaual 0, retry end
If ErrorList.CountNas = 0 Then
retry = False
End If
End While
Else
While retry
For i As Integer = 0 To ErrorList.CountFtp - 1
Try
File.Copy(Copy_Delete_File.copypath + "\" + ErrorList.FTPList(i), Copy_Delete_File.uptoftp + "\" + ErrorList.FTPList(i), True)
System.Threading.Thread.Sleep(100)
FTPupload.uploadtoftp()
System.Threading.Thread.Sleep(100)
If ErrorList.CountFtp = 0 Then
'If NasList count eaual 0, retry end
retry = False
Else
'retry not end and remove NasList now data then re do for
retry = True
ErrorList.RemoveFTP(i)
Exit For
End If
Catch ex As Exception
'Retry failure add retry times and error log
retry = True
retrytime += 1
'Console.WriteLine("Error list upload to FTP retry failured, back do work times : " & retrytime)
ErrorList.AddLog(Now.ToString("yyyyMMddHHmmss _ ") + "Error list upload to FTP retry failured, back do work times : " & retrytime)
End Try
Next
'If NasList count eaual 0, retry end
If ErrorList.CountFtp = 0 Then
retry = False
End If
End While
End If
End Sub
End Class

----------------------------------------------------------------------------------------------------------------------

分享就真的到這邊告一段落了!!!!
完結篇!!!!沒有下集了~

謝謝大家收看，謝謝先進的教學文章!!!

藍色、天空、貓

關於我自己

2016年7月30日星期六

【VB.NET 語言】上報練習 _ 完整程式碼分享

沒有留言:

張貼留言

分享至 Facebook 臉書

分享至 Plurk 噗浪

阿榮福利味

重灌狂人

海芋小站