作成csv

最新推荐文章于 2022-11-11 09:16:44 发布

转载最新推荐文章于 2022-11-11 09:16:44 发布 · 904 阅读

文章标签：

#csv #string #exception #dataset #upload #integer

'******************************************************************************
'*                                                                            *
'*                      Comma Separated Value Data Class                      *
'*                                                                            *
'*                             By John Priestley                              *
'*                                                                            *
'******************************************************************************
'
' History
' ~~~~~~~
' 31 May 2005  1.02 - Update: Now correctly identifies the last field if it is blank.
' 31 May 2005  1.01 - Update: Changed LoadCSV's optional parameter to overloaded function
' 27 May 2005  1.00 - First Release
'
Imports System.Data.SqlClient
Imports System.Data
Imports System.IO
Imports System.Text.RegularExpressions

Public Class CSVData
    Implements IDisposable

    Dim dsCSV As DataSet
    Dim mSeparator As Char = ","
    Dim mTextQualifier As Char = """"
    Dim mData() As String
    Dim mHeader As Boolean

    Private regQuote As New Regex("^(")(.*)(")(s*,)(.*)$", RegexOptions.IgnoreCase + RegexOptions.RightToLeft)
    Private regNormal As New Regex("^([^,]*)(s*,)(.*)$", RegexOptions.IgnoreCase + RegexOptions.RightToLeft)
    Private regQuoteLast As New Regex("^(")(["*]{2,})(")$", RegexOptions.IgnoreCase)
    Private regNormalLast As New Regex("^.*$", RegexOptions.IgnoreCase)

    Protected Disposed As Boolean

#Region " Load CSV "
    '
    ' Load CSV
    '
    Public Sub LoadCSV(ByVal CSVFile As String)
        LoadCSV(CSVFile, False)
    End Sub

    '
    ' Load CSV - Has Header
    '
    Public Sub LoadCSV(ByVal CSVFile As String, ByVal HasHeader As Boolean)
        mHeader = HasHeader
        SetupRegEx()

        If File.Exists(CSVFile) = False Then
            Throw New Exception(CSVFile & " does not exist.")
        End If

        If Not dsCSV Is Nothing Then
            dsCSV.Clear()
            dsCSV.Tables.Clear()
            dsCSV.Dispose()
            dsCSV = Nothing
        End If

        dsCSV = New DataSet("CSV")
        dsCSV.Tables.Add("CSVData")

        Dim sr As New StreamReader(CSVFile)
        Dim idx As Integer
        Dim bFirstLine As Boolean = True
        Dim dr As DataRow

        Do While sr.Peek > -1
            ProcessLine(sr.ReadLine())

            '
            ' Create Columns
            '
            If bFirstLine = True Then
                For idx = 0 To mData.GetUpperBound(0)
                    If mHeader = True Then
                        dsCSV.Tables("CSVData").Columns.Add(mData(idx), GetType(String))
                    Else
                        dsCSV.Tables("CSVData").Columns.Add("Column" & idx, GetType(String))
                    End If
                Next
            End If

            '
            ' Add Data
            '
            If Not (bFirstLine = True And mHeader = True) Then
                dr = dsCSV.Tables("CSVData").NewRow()

                For idx = 0 To mData.GetUpperBound(0)
                    dr(idx) = mData(idx)
                Next

                dsCSV.Tables("CSVData").Rows.Add(dr)
                dsCSV.AcceptChanges()
            End If

            bFirstLine = False
        Loop

        sr.Close()
    End Sub

    '
    ' Load CSV - Custom Separator
    '
    Public Sub LoadCSV(ByVal CSVFile As String, ByVal Separator As Char)
        LoadCSV(CSVFile, Separator, False)
    End Sub

    '
    ' Load CSV - Custom Separator and Has Header
    '
    Public Sub LoadCSV(ByVal CSVFile As String, ByVal Separator As Char, ByVal HasHeader As Boolean)
        mSeparator = Separator
        Try
            LoadCSV(CSVFile, HasHeader)
        Catch ex As Exception
            Throw New Exception("CSV Error", ex)
        End Try
    End Sub

    '
    ' Load CSV - Custom Separator, Text Qualifier and Has Header
    '
    Public Sub LoadCSV(ByVal CSVFile As String, ByVal Separator As Char, ByVal TxtQualifier As Char)
        LoadCSV(CSVFile, Separator, TxtQualifier, False)
    End Sub

    '
    ' Load CSV - Custom Separator, Text Qualifier and Has Header
    '
    Public Sub LoadCSV(ByVal CSVFile As String, ByVal Separator As Char, ByVal TxtQualifier As Char, ByVal HasHeader As Boolean)
        mSeparator = Separator
        mTextQualifier = TxtQualifier
        Try
            LoadCSV(CSVFile, HasHeader)
        Catch ex As Exception
            Throw New Exception("CSV Error", ex)
        End Try
    End Sub
#End Region
#Region " Process Line "
    '
    ' Process Line
    '
    Private Sub ProcessLine(ByVal sLine As String)
        Dim sData As String
        Dim iSep As Integer
        Dim iQuote As String
        Dim m As Match
        Dim idx As Integer
        Dim mc As MatchCollection
        Dim bLastField As Boolean = False

        Erase mData
        sLine = sLine.Replace(ControlChars.Tab, "    ") 'Replace tab with 4 spaces
        sLine = sLine.Trim

        Do While bLastField = False
            sData = ""

            If regQuote.IsMatch(sLine) Then
                mc = regQuote.Matches(sLine)
                '
                ' "text",<rest of the line>
                '
                m = regQuote.Match(sLine)
                sData = m.Groups(2).Value
                sLine = m.Groups(5).Value
            ElseIf regQuoteLast.IsMatch(sLine) Then
                '
                ' "text"
                '
                m = regQuoteLast.Match(sLine)
                sData = m.Groups(2).Value
                sLine = ""
                bLastField = True
            ElseIf regNormal.IsMatch(sLine) Then
                '
                ' text,<rest of the line>
                '
                m = regNormal.Match(sLine)
                sData = m.Groups(1).Value
                sLine = m.Groups(3).Value
            ElseIf regNormalLast.IsMatch(sLine) Then
                '
                ' text
                '
                m = regNormalLast.Match(sLine)
                sData = m.Groups(0).Value
                sLine = ""
                bLastField = True
            Else
                '
                ' ERROR!!!!!
                '
                sData = ""
                sLine = ""
                bLastField = True
            End If

            sData = sData.Trim
            sLine = sLine.Trim

            If mData Is Nothing Then
                ReDim mData(0)
                idx = 0
            Else
                idx = mData.GetUpperBound(0) + 1
                ReDim Preserve mData(idx)
            End If

            mData(idx) = sData
        Loop
    End Sub
#End Region
#Region " Regular Expressions "
    '
    ' Set up Regular Expressions
    '
    Private Sub SetupRegEx()
        Dim sQuote As String = "^(%Q)(.*)(%Q)(s*%S)(.*)$"
        Dim sNormal As String = "^([^%S]*)(s*%S)(.*)$"
        Dim sQuoteLast As String = "^(%Q)(.*)(%Q$)"
        Dim sNormalLast As String = "^.*$"
        Dim sSep As String
        Dim sQual As String

        If Not regQuote Is Nothing Then regQuote = Nothing
        If Not regNormal Is Nothing Then regNormal = Nothing
        If Not regQuoteLast Is Nothing Then regQuoteLast = Nothing
        If Not regNormalLast Is Nothing Then regNormalLast = Nothing

        sSep = mSeparator
        sQual = mTextQualifier

        If InStr(".$^{[(|)]}*+?", sSep) > 0 Then sSep = "" & sSep
        If InStr(".$^{[(|)]}*+?", sQual) > 0 Then sQual = "" & sQual

        sQuote = sQuote.Replace("%S", sSep)
        sQuote = sQuote.Replace("%Q", sQual)
        sNormal = sNormal.Replace("%S", sSep)
        sQuoteLast = sQuoteLast.Replace("%Q", sQual)

        regQuote = New Regex(sQuote, RegexOptions.IgnoreCase + RegexOptions.RightToLeft)
        regNormal = New Regex(sNormal, RegexOptions.IgnoreCase + RegexOptions.RightToLeft)
        regQuoteLast = New Regex(sQuoteLast, RegexOptions.IgnoreCase + RegexOptions.RightToLeft)
        regNormalLast = New Regex(sNormalLast, RegexOptions.IgnoreCase + RegexOptions.RightToLeft)
    End Sub
#End Region
#Region " Save As "
    '
    ' Save data as XML
    '
    Public Sub SaveAsXML(ByVal sXMLFile As String)
        If dsCSV Is Nothing Then Exit Sub
        dsCSV.WriteXml(sXMLFile)
    End Sub

    '
    ' Save data as CSV
    '
    Public Sub SaveAsCSV(ByVal sCSVFile As String)
        If dsCSV Is Nothing Then Exit Sub

        Dim dr As DataRow
        Dim sLine As String
        Dim sw As New StreamWriter(sCSVFile)
        Dim iCol As Integer

        For Each dr In dsCSV.Tables("CSVData").Rows
            sLine = ""
            For iCol = 0 To dsCSV.Tables("CSVData").Columns.Count - 1
                If sLine.Length > 0 Then sLine &= mSeparator
                If Not dr(iCol) Is DBNull.Value Then
                    If InStr(dr(iCol), mSeparator) > 0 Then
                        sLine &= mTextQualifier & dr(iCol) & mTextQualifier
                    Else
                        sLine &= dr(iCol)
                    End If
                End If
            Next

            sw.WriteLine(sLine)
        Next

        sw.Flush()
        sw.Close()
        sw = Nothing
    End Sub
#End Region
#Region " Properties "
    '
    ' Separator Property
    '
    Public Property Separator() As Char
        Get
            Return mSeparator
        End Get
        Set(ByVal Value As Char)
            mSeparator = Value
            SetupRegEx()
        End Set
    End Property

    '
    ' Qualifier Property
    '
    Public Property TextQualifier() As Char
        Get
            Return mTextQualifier
        End Get
        Set(ByVal Value As Char)
            mTextQualifier = Value
            SetupRegEx()
        End Set
    End Property

    '
    ' Dataset Property
    '
    Public ReadOnly Property CSVDataSet() As DataSet
        Get
            Return dsCSV
        End Get
    End Property
#End Region
#Region " Dispose and Finalize "
    '
    ' Dispose
    '
    Public Sub Dispose() Implements System.IDisposable.Dispose
        Dispose(True)
    End Sub

    Protected Overridable Sub Dispose(ByVal disposing As Boolean)
        If Disposed Then Exit Sub

        If disposing Then
            Disposed = True

            GC.SuppressFinalize(Me)
        End If

        If Not dsCSV Is Nothing Then
            dsCSV.Clear()
            dsCSV.Tables.Clear()
            dsCSV.Dispose()
            dsCSV = Nothing
        End If
    End Sub

    '
    ' Finalize
    '
    Protected Overrides Sub Finalize()
        Dispose(False)
        MyBase.Finalize()
    End Sub
#End Region
End Class

操作CSV

Imports System.IO
Public Class Get_all_data_csv
    Inherits System.Web.UI.Page
    Dim dsCSV As DataSet
    Dim mSeparator As Char = ","
    Dim mTextQualifier As Char = """"
    Dim mData() As String
    Dim mHeader As Boolean
    Dim dsCSV_upload As DataSet
    Dim mSeparator_upload As Char = ","
    Dim mTextQualifier_upload As Char = """"
#Region " Web Form 設計工具產生的程式碼 "

'此為 Web Form 設計工具所需的呼叫。
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()

End Sub

    '注意: 下列預留位置宣告是 Web Form 設計工具需要的項目。
    '請勿刪除或移動它。
    Private designerPlaceholderDeclaration As System.Object

    Private Sub Page_Init(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Init
        'CODEGEN: 此為 Web Form 設計工具所需的方法呼叫
        '請勿使用程式碼編輯器進行修改。
        InitializeComponent()
    End Sub

#End Region

    Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        If Session("session_site") = "" Then
            Response.Redirect("session.aspx")
        Else
            Dim num As Integer
            num = 1
            Dim last_vendor, last_mawb, last_org, str_sql As String
            Dim sCSVFile As String
            Dim file As String = "input_download.csv"
            sCSVFile = Server.MapPath("./") + "Upload/"
            Dim now_date = DateTime.Now.ToString("yyyyMMddHHmmss")
            sCSVFile = sCSVFile & now_date & file
            str_sql = Session("str_sql")
            Dim iCol As Integer
            dsCSV_upload = GetDataSet(str_sql)
            If dsCSV_upload Is Nothing Then Exit Sub
            Dim dr As DataRow
            Dim sLine As String
            Dim sw As New StreamWriter(sCSVFile)
            sLine = "NO,DF Site,BU,DF_Status,Screen Down,FA Code,Model,PartNo,SN,DF Test Date,DF Input Date,Failure Symptom,Fail Station,Chasis SN,Root Cause,QE approve,PM approve,QE Approve Date,SA#,STO#,STO#&SA# DATE,Tracking,Tracking Date,LH Date,Complete Date,Week,DFSite Owner,LH Owner,Packing,Packing_date,"
            sw.WriteLine(sLine)
            For Each dr In dsCSV_upload.Tables(0).Rows
                sLine = ""
                For iCol = 0 To dsCSV_upload.Tables(0).Columns.Count - 1
                    If sLine.Length > 0 Then sLine &= mSeparator_upload
                    If Not dr(iCol) Is DBNull.Value Then
                        If InStr(dr(iCol), mSeparator_upload) > 0 Then
                            If iCol = 0 Then
                                sLine &= num
                                num = num + 1
                            ElseIf iCol > 0 Then
                                If iCol = 4 Then
                                    If dr(iCol) = "" Then
                                        sLine &= "N"
                                    Else
                                        sLine &= "Y"
                                    End If
                                Else
                                    If iCol <= 29 Then
                                        sLine &= mTextQualifier & dr(iCol) & mTextQualifier
                                    End If
                                End If

End If
Else

                            If iCol = 0 Then
                                sLine &= num
                                num = num + 1
                            ElseIf iCol > 0 Then
                                If iCol = 4 Then
                                    If dr(iCol) = "" Then
                                        sLine &= "N"
                                    Else
                                        sLine &= "Y"
                                    End If
                                Else
                                    If iCol <= 29 Then
                                        sLine &= dr(iCol)
                                    End If
                                End If
                            End If
                        End If
                    End If
                Next
                sw.WriteLine(sLine)
            Next
            sw.Flush()
            sw.Close()
            sw = Nothing
            Response.Redirect("upload/" & now_date & file)
        End If
    End Sub
End Class

上傳csv

Imports System.IO
Public Class upload_input
    Inherits System.Web.UI.Page
    Dim dsCSV As DataSet
    Dim mSeparator As Char = ","
    Dim mTextQualifier As Char = """"
    Dim mData() As String
    Dim mHeader As Boolean
    Dim sLine As String
    Dim mCSV As New CSVData
    Dim dsCSV_upload As DataSet
    Dim mSeparator_upload As Char = ","
    Protected WithEvents IBtnSubmit As System.Web.UI.WebControls.ImageButton
    Protected WithEvents TD2 As System.Web.UI.HtmlControls.HtmlTableCell
    Protected WithEvents FilePath As System.Web.UI.HtmlControls.HtmlInputFile
    Dim mTextQualifier_upload As Char = """"

#Region " Web Form 設計工具產生的程式碼 "

'此為 Web Form 設計工具所需的呼叫。
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()

    End Sub


    '注意: 下列預留位置宣告是 Web Form 設計工具需要的項目。
    '請勿刪除或移動它。
    Private designerPlaceholderDeclaration As System.Object

#End Region

    Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        '在這裡放置使用者程式碼以初始化網頁
        If Session("session_site") = "" Then
            Response.Redirect("session.aspx")
        End If
    End Sub

    Private Sub Read_csv(ByVal strPath As String)
        mCSV.Separator = ","
        mCSV.TextQualifier = """"
        mCSV.LoadCSV(Server.MapPath("./") + strPath, True)
        Dim dc As DataColumn
        Dim dr As DataRow
        Dim str_insert As String
        Dim arraylist1 As New ArrayList
        Dim arraylist2 As New ArrayList
        Dim idx, get_workorderqty As Integer
        For Each dc In mCSV.CSVDataSet.Tables(0).Columns
            arraylist1.Add(dc.ColumnName)
        Next
        For Each dr In mCSV.CSVDataSet.Tables(0).Rows
            sLine = ""
            For idx = 1 To mCSV.CSVDataSet.Tables(0).Columns.Count - 1
                arraylist2.Add(dr(idx))
            Next
            dr(1) = Convert.ToString(dr(1)).ToUpper
            If dr(1) = Session("session_site") Then
                Dim du As DataView
                Dim dv As DataView
                Dim str_sql As String
                Dim count1 As Integer
                Dim sql_str, rohs_status As String
                Try

                    sql_str = "select rohs_value from rma_sn_rohs where charIndex(pre_part_no,'" & dr(5) & "')>0 and sn_start<'" & dr(7) & "' and ((len(sn_end)-len('" & dr(7) & "') <0) or ((len(sn_end)-len('" & dr(7) & "') =0 and sn_end>'" & dr(7) & "') or ((len(sn_end)-len('" & dr(7) & "') =0 and sn_end like '9999')))) "
                    dv = adodata_view(sql_str)
                    If dv.Count > 0 Then
                        rohs_status = dv.Item(0).Row(0)
                    Else
                        rohs_status = "NON-ROHS"
                    End If
                Catch ex As Exception
                    rohs_status = "NON-ROHS"
                End Try

                Dim strSQL As String
                Dim dp As DataView
                str_sql = "select model,bu from pn_model where '" & dr(5) & "' like p_n +'%' "
                Try
                    dp = adodata_view(str_sql)
                    If dp.Count <> 0 Then
                        dr(4) = dp.Item(0).Item("model")
                        dr(2) = dp.Item(0).Item("bu")
                    End If
                Catch ex As Exception
                    Response.Write(ex.Message)
                End Try

                str_sql = "select s_n from Production_List where s_n='" & dr(7) & "' and foxconn_states<>'shipped' and DF_Input_Date>getdate()-14 "
                Try
                    du = adodata_view(str_sql)
                    If du.Count = 0 Then
                        If dr(7).Length = 11 Or dr(7).Length = 8 Then
                            If dr(3) = "VD" Or dr(3) = "VD-HUB" Or dr(3) = "VD-PD (Production)" Or dr(3) = "VD-Undispatch" Or dr(3) = "VVD-WH (Warehouse)" Or dr(3) = "FD" Then
                                dr(16) = "Pending LH Enginner Approval"
                            End If
                            If dr(3) = "NDF" Then
                                dr(16) = "NDF"
                            End If
                            If dr(3) = "DF-Scrap" Then
                                dr(16) = "DF-Scrap"
                            End If
                            If dr(16) = "" Then
                                dr(16) = "Pending LH Enginner Approval"
                            End If

                            If dr(12) = "" Then
                                dr(12) = Right("000" + CStr(DatePart("WW", Now)), 2)
                            Else
                                Try
                                    dr(12) = Convert.ToInt32(dr(12))
                                Catch ex As Exception
                                    RegisterStartupScript(" ", "<script>alert('The Input week arise error!pls check it')</script>")
                                    Exit Sub
                                End Try
                            End If
                            Try
                                dr(11) = Convert.ToDateTime(dr(11)).ToString("yyyy/MM/dd")
                            Catch ex As Exception
                                RegisterStartupScript(" ", "<script>alert('The DF TEST Date arise error!pls check it,Format is yyyy/MM/dd')</script>")
                                Exit Sub
                            End Try
                            dr(1) = change_data(dr(1))
                            dr(2) = change_data(dr(2))
                            dr(2) = Convert.ToString(dr(2)).ToUpper
                            dr(16) = change_data(dr(16))
                            dr(15) = change_data(dr(15))
                            dr(3) = change_data(dr(3))
                            dr(4) = change_data(dr(4))
                            dr(5) = change_data(dr(5))

                            dr(7) = change_data(dr(7))
                            rohs_status = change_data(rohs_status)
                            dr(9) = change_data(dr(9))
                            dr(10) = change_data(dr(10))
                            dr(13) = change_data(dr(13))
                            dr(14) = change_data(dr(14))

                            str_insert = "insert into Production_List (DF_Site,BU,DF_Status,Root_Cause,pr_an,Model, PartNo, S_N,Rohs_status,chasis_sn,defect_location,DF_Test_Date,Failure_Symptom, Fail_Station, Week_input) "
                            str_insert = str_insert + "values ('" & dr(1) & "','" & dr(2) & "','" & dr(16) & "','" & dr(15) & "','" & dr(3) & "','" & dr(4) & "','" & dr(5) & "','" & dr(7) & "','" & rohs_status & "','" & dr(9) & "','" & dr(10) & "','" & dr(11) & "','" & dr(13) & "','" & dr(14) & "','" & dr(12) & "')"
                            execsql(str_insert)
                            RegisterStartupScript(" ", "<script>alert('upload success!!')</script>")
                            HIS("ACCOUNT:[" & Session("username") & " " & Trim(dr(10)) & "]insert successful!", 0, Me.Page)
                        Else
                            RegisterStartupScript(" ", "<script>alert('Pls make sure the length of the s_n!')</script>")
                            Exit Sub
                        End If
                    Else
                        RegisterStartupScript(" ", "<script>alert('The s/n have exist!!')</script>")
                        Exit Sub
                    End If
                Catch ex As Exception
                    RegisterStartupScript(" ", "<script>alert('Add fail!!')</script>")
                End Try
            Else
                RegisterStartupScript(" ", "<script>alert('You have no right to upload this data!!')</script>")
            End If
        Next
    End Sub

    Public Function change_data(ByVal str As String) As String
        str = Server.UrlEncode(str)
        str = Replace(str, "%0d%0", " ")
        str = Replace(str, ",", " ;")
        str = Replace(str, "''", "'")
        change_data = Server.UrlDecode(str)
    End Function

    Private Sub IBtnSubmit_Click(ByVal sender As System.Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles IBtnSubmit.Click
        Dim CREATE_BY As String = Session("UserId")
        Dim COMMITMPS As String = "COMMITMPS"
        Dim EMP_NO, EMP_NAME, SEX, EDU_LEVEL, GRADING, GRADING_TYPE, POSITION, CONTROL_TYPE, JOIN_DATE, DPT, ENTERPRISE_ID, TOP_ENTERPRISE_ID As String
        Dim StrSql, strPath, strName, strLen, File_path, IFUPLOAD As String
        strPath = "Upload/"
        IFUPLOAD = "Y"
        Dim get_file = Path.GetExtension(FilePath.Value)
        If get_file = ".csv" Then
            If Not FilePath.PostedFile.ContentLength > 0 Then
                RegisterStartupScript(" ", "<script>alert('The File is not found,please checked!!')</script>")
                Exit Sub
            End If
            If Not Directory.Exists(Server.MapPath(strPath)) Then
                RegisterStartupScript(" ", "<script>alert('SavePath is not exists,Please checked.!!')</script>")
                Exit Sub
            End If
            strName = Path.GetFileName(FilePath.PostedFile.FileName)
            strLen = Format(CLng(FilePath.PostedFile.ContentLength / 1024), "##,###,###,###") & "K"
            strPath = strPath & COMMITMPS & DateTime.Now.ToString("yyyyMMddHHmmss") & Path.GetExtension(FilePath.PostedFile.FileName)
            If File.Exists(strPath) Then
                RegisterStartupScript(" ", "<script>alert('File is exists,Please Rename.!!')</script>")
                Exit Sub
            End If
            FilePath.PostedFile.SaveAs(Server.MapPath(strPath))
            Call Read_csv(strPath)
        Else
            RegisterStartupScript(" ", "<script>alert('Please make sure the file is csv format.!!')</script>")
        End If
    End Sub
End Class