' 發展單位：風禹科技驗證有限公司
' 撰寫人：鄭子璉(Tzu-Lien, Cheng, 璉璉) ，成大水博肄，微軟最有價值專家
' Web: http://tlcheng.twbbs.org/TLCheng/ E-Mail: qvb3377@ms5.hinet.net
' --------------------------------------------------------------------------------------

Imports System.IO
Imports System.Text

Module modFileTool
#Region "Windows API 宣告"
	<Runtime.InteropServices.DllImport("kernel32.dll")> _
	 Public Function GetVolumeInformation( _
	  ByVal lpRootPathName As String, _
	  ByVal lpVolumeNameBuffer As String, _
	  ByVal nVolumeNameSize As Integer, _
	  ByRef lpVolumeSerialNumber As Integer, _
	  ByRef lpMaximumComponentLength As Integer, _
	  ByRef lpFileSystemFlags As Integer, _
	  ByVal lpFileSystemNameBuffer As String, _
	  ByVal nFileSystemNameSize As Integer _
	 ) As Integer
	End Function

	Private Const MAX_PATH As Integer = 260
#End Region

   Public Enum enuNoGetData As Integer
      No_Default = 0
      No_Common = 1
      No_Null_Line = 2
      No_NotData = No_Common Or No_Null_Line
   End Enum

	Public Function MyGetSerialNumber(Optional ByVal strDriver As String = "C:\") As String
		Dim lpVolumeNameBuffer As String, lpFileSystemNameBuffer As String
		Dim lpVolumeSerialNumber As Integer
		Dim nVolumeNameSize, nFileSystemNameSize, lpMaximumComponentLength, lpFileSystemFlags, iReturn As Integer
		Dim strReturn As String

		If Len(strDriver) = 1 Then
			strDriver = strDriver + ":\"
		End If

		nVolumeNameSize = MAX_PATH + 1
		nFileSystemNameSize = MAX_PATH + 1
		lpVolumeNameBuffer = New String(CChar(" "), nVolumeNameSize)
		lpFileSystemNameBuffer = New String(CChar(" "), nFileSystemNameSize)

		iReturn = GetVolumeInformation(strDriver, lpVolumeNameBuffer, nVolumeNameSize, lpVolumeSerialNumber, lpMaximumComponentLength, lpFileSystemFlags, lpFileSystemNameBuffer, nFileSystemNameSize)
		strReturn = Hex(lpVolumeSerialNumber)
		strReturn = New String("0", 8 - strReturn.Length) & strReturn
		Return Left(strReturn, 4) & "-" & Right(strReturn, 4)
	End Function

	Public Function MyReadCSVFile(ByVal strFile As String, Optional ByVal srcCodePage As enuStandardCodePages = enuStandardCodePages.SCP_big5, Optional ByVal bChangeVariant As Boolean = False, Optional ByVal strNewLine As String = vbNewLine) As Object
		Dim strLine As String = MyGetFullTextFile(strFile, srcCodePage)
		Return MyReadCSVString(strLine, bChangeVariant, strNewLine)
	End Function

	Public Function MyWriteCSVString(ByVal arrData As Object, Optional ByVal strNewLine As String = vbNewLine, Optional ByVal bOutputAll As Boolean = False) As String
		Dim ibd, ubd, ibc, ubc As Integer
		ubd = UBound(arrData)
		Dim arrLine(ubd) As String
		For ibd = 0 To ubd
			ubc = UBound(arrData(ibd))
			Dim arrRow(ubc) As String
			For ibc = 0 To ubc
				Select Case VarType(arrData(ibd)(ibc))
					Case VariantType.Array, VariantType.DataObject, VariantType.Empty, VariantType.Error, VariantType.Null, VariantType.UserDefinedType
						If bOutputAll Then
							arrRow(ibc) = CType(VarType(arrData(ibd)(ibc)), VariantType).ToString
						Else
							arrRow(ibc) = ""
						End If
					Case VariantType.Object
						If bOutputAll Then
							If IsNothing(arrData(ibd)(ibc)) Then
								arrRow(ibc) = "Nothing"
							Else
								arrRow(ibc) = CType(VarType(arrData(ibd)(ibc)), VariantType).ToString
							End If
						Else
							arrRow(ibc) = ""
						End If
					Case VariantType.Char, VariantType.String
						arrRow(ibc) = """" & arrData(ibd)(ibc) & """"
					Case VariantType.Date
						arrRow(ibc) = CDate(arrData(ibd)(ibc)).ToString("yyyy/MM/dd HH:mm:ss")
					Case Else
						arrRow(ibc) = CStr(arrData(ibd)(ibc))
				End Select
			Next
			arrLine(ibd) = Join(arrRow, ",")
		Next
		Return Join(arrLine, strNewLine)
	End Function

	Public Function MyReadCSVString(ByVal strLine As String, Optional ByVal bChangeVariant As Boolean = False, Optional ByVal strNewLine As String = vbNewLine) As Object
		' Definition of the CSV Format : RFC4180 , 缺換行規則
		Dim arrLine() As String
		Dim ibl, ubl, ibc As Integer
		Dim arrReturn() As Object

		If Right(strLine, Len(strNewLine)) = strNewLine Then
			strLine = Left(strLine, Len(strLine) - Len(strNewLine))
		End If
		arrLine = Split(strLine, strNewLine)
		ubl = UBound(arrLine)
		ReDim arrReturn(ubl)

		For ibl = 0 To ubl
			arrReturn(ibl) = SplitMixDelimiterString(arrLine(ibl), ",", bChangeVariant)
		Next

		For ibl = 0 To ubl
			For ibc = 0 To UBound(arrReturn(ibl))
				If VarType(arrReturn(ibl)(ibc)) = VariantType.String Then
					arrReturn(ibl)(ibc) = CStr(arrReturn(ibl)(ibc)).Replace("""""", """")
					If Left(arrReturn(ibl)(ibc), 1) = """" Then arrReturn(ibl)(ibc) = Mid(arrReturn(ibl)(ibc), 2)
					If Right(arrReturn(ibl)(ibc), 1) = """" Then arrReturn(ibl)(ibc) = Left(arrReturn(ibl)(ibc), Len(arrReturn(ibl)(ibc)) - 1)
				End If
			Next
		Next

		Return arrReturn
	End Function

   Public Function MyGetAppPath() As String
      Return Application.StartupPath
   End Function

   Public Function MyGetTruePath(ByVal strFilename As String) As String
      Dim arrSource As String() = {"$(AppPath)"}
      Dim arrTarget As String() = {MyGetAppPath()}
      Dim ibs, nLoc As Integer

      strFilename = Replace(strFilename, "\", "/")

      For ibs = 0 To UBound(arrSource)
         nLoc = InStr(LCase(strFilename), LCase(arrSource(ibs)))

         If nLoc > 0 Then
            strFilename = Left(strFilename, nLoc - 1) & arrTarget(ibs) & Mid(strFilename, nLoc + Len(arrSource(ibs)))
         End If
      Next

      Return strFilename

   End Function

   Public Function MyGetPathName(ByVal strFilename As String) As String
      strFilename = Replace(strFilename, "/", "\")
      Dim nLoc As Integer = InStrRev(strFilename, "\")
      If nLoc > 0 Then
         Return Left(strFilename, nLoc - 1)
      Else
         Return ""
      End If
   End Function

   Public Function MyGetFileName(ByVal strFilename As String) As String
      Dim nLoc As Integer = InStrRev(strFilename, "\")
      If nLoc > 0 Then
         Return Mid(strFilename, nLoc + 1)
      Else
         Return strFilename
      End If
   End Function

   Public Function MyGetFileFirstName(ByVal strFilename As String) As String
      strFilename = MyGetFileName(strFilename)
      Dim nLoc As Integer = InStrRev(strFilename, ".")
      If nLoc > 0 Then
         Return Left(strFilename, nLoc - 1)
      Else
         Return strFilename
      End If
   End Function

   Public Function MyGetFileExtendName(ByVal strFilename As String) As String
      Dim nLoc As Integer = InStrRev(strFilename, ".")
      If nLoc > 0 Then
         Return Mid(strFilename, nLoc + 1)
      Else
         Return ""
      End If
   End Function

   Public Function MyCreateDirectory(ByVal strPath As String) As Boolean
      Try
         Directory.CreateDirectory(strPath)
      Catch
         Return False
      End Try
      Return True
   End Function

   Public Function MyFileCopy(ByVal sourceFileName As String, ByVal destFileName As String, Optional ByVal bOverWrite As Boolean = True) As Boolean
      Try
         MyCreateDirectory(MyGetPathName(destFileName))
         File.Copy(sourceFileName, destFileName, bOverWrite)
      Catch
         Return False
      End Try
      Return True
   End Function


   Public Function MyDir(ByVal strFilename As String, Optional ByVal Attributes As FileAttribute = FileAttribute.Normal Or FileAttribute.ReadOnly Or FileAttribute.Hidden Or FileAttribute.System Or FileAttribute.Directory Or FileAttribute.Archive, Optional ByVal bSearchSub As Boolean = False) As Object
      Dim tFile As String
      Dim sAllFile As String()
      Dim nFile As Integer = -1
      ReDim sAllFile(0)
      Dim ibf, ibs As Integer
      Dim objSub() As Object
      Dim strRootPath As String = MyGetPathName(strFilename)
      Dim strDirName As String = MyGetFileName(strFilename)

      If Right(strFilename, 1) = "\" Then
         strFilename = strFilename & "*.*"
      ElseIf InStrRev(strFilename, ".") > 0 Or InStrRev(strFilename, "*") > 0 Or InStrRev(strFilename, "?") > 0 Then
         ' 跳過不處理
      ElseIf GetAttr(strFilename) And FileAttribute.Directory Then
         strFilename = strFilename & "\*.*"
      End If

      tFile = Dir(strFilename, Attributes)
      If tFile <> "" Then
         Do Until tFile = ""
            nFile = nFile + 1
            ReDim Preserve sAllFile(nFile)

            sAllFile(nFile) = tFile
            tFile = Dir()
         Loop

         If bSearchSub Then
            ReDim objSub(nFile)
            For ibf = 0 To nFile
               If GetAttr(strRootPath & "\" & sAllFile(ibf)) And FileAttribute.Directory Then
                  objSub(ibf) = MyDir(strRootPath & "\" & sAllFile(ibf) & "\" & strDirName, Attributes, bSearchSub)
                  If Not IsNothing(objSub(ibf)) Then
                     For ibs = 0 To UBound(objSub(ibf))
                        objSub(ibf)(ibs) = sAllFile(ibf) & "\" & objSub(ibf)(ibs)
                     Next
                  End If
               End If
            Next

            For ibf = 0 To UBound(objSub)
               If Not IsNothing(objSub(ibf)) Then
                  For ibs = 0 To UBound(objSub(ibf))
                     nFile = nFile + 1
                     ReDim Preserve sAllFile(nFile)

                     sAllFile(nFile) = objSub(ibf)(ibs)
                  Next
               End If
            Next
         End If

         Return sAllFile
      Else
         Return Nothing
      End If

   End Function

   Public Function MyDeleteFile(ByVal strFilename As String) As Boolean
      Dim fi As New System.IO.FileInfo(strFilename)
      MyDeleteFile = False
      If fi.Exists Then
         fi.Delete()
      End If
   End Function

   Public Function IsFileExist(ByVal lpFilename As String) As Boolean
      Dim fi As New System.IO.FileInfo(lpFilename)
      Return fi.Exists
   End Function

   Public Function IsDirectoryExist(ByVal lpPathname As String) As Boolean
      Return IO.Directory.Exists(lpPathname)
   End Function

   Public Function MySaveFullTextFile(ByVal strText As String, ByVal lpFilename As String, Optional ByVal srcCodePage As enuStandardCodePages = enuStandardCodePages.SCP_big5) As Object
      Select Case srcCodePage
         Case modStrTools.enuStandardCodePages.SCP_CP_Big_Endian_Unicode, modStrTools.enuStandardCodePages.SCP_CP_Little_Endian_Unicode, modStrTools.enuStandardCodePages.SCP_CP_UTF7, modStrTools.enuStandardCodePages.SCP_CP_UTF8
            strText = ChrW(&HFEFF) & strText
      End Select

      Dim arrBytes As Byte() = StringToBytes(strText, srcCodePage)
      Return MySaveBinaryFile(arrBytes, lpFilename)
   End Function

	Public Function MySaveBinaryFile(ByVal arrBytes As Byte(), ByVal lpFilename As String, Optional ByVal hFileSeek As Long = 0, Optional ByVal nFileMode As System.IO.FileMode = IO.FileMode.Create) As Object
		Dim strPath As String = MyGetPathName(lpFilename)
		If Not IsDirectoryExist(strPath) Then
			MyCreateDirectory(strPath)
		End If
		If hFileSeek = -1 Then
			hFileSeek = FileLen(lpFilename)
		End If
		Dim fs As New System.IO.FileStream(lpFilename, nFileMode)
		If hFileSeek > 0 Then
			fs.Position = hFileSeek
		End If
		If IsNothing(arrBytes) Then
		Else
			fs.Write(arrBytes, 0, UBound(arrBytes) + 1)
		End If
		fs.Close()
		fs.Dispose()
	End Function

   Public Function MyGetBinaryFile(ByVal lpFilename As String, Optional ByVal hFileSeek As Long = 0, Optional ByVal GetLen As Long = 0) As Object

      Dim fi As New System.IO.FileInfo(lpFilename)
      Dim fs As System.IO.FileStream

      If Not fi.Exists Then
         Return Nothing
      Else
         Dim fLen As Long

         fLen = fi.Length
         If fLen = 0 Then
            Return Nothing
         End If

         If GetLen > 0 Then
            fLen = fLen - hFileSeek
            If fLen > GetLen Then
               fLen = GetLen
            End If
         End If

         fs = fi.Open(IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.ReadWrite)

         Dim FileBuffer(fLen - 1) As Byte
         Dim nBytesRead As Integer = fs.Read(FileBuffer, hFileSeek, fLen)

         fs.Close()

         Return FileBuffer
      End If

   End Function

   Public Function MyGetFullTextFile(ByVal lpFilename As String, Optional ByVal srcCodePage As enuStandardCodePages = enuStandardCodePages.SCP_big5) As String

      Return BytesToString(BytesChangeCodePages(MyGetBinaryFile(lpFilename), srcCodePage))

   End Function

   Public Function MyGetMultiLineFile(ByVal lpFilename As String, Optional ByVal wFlags As enuNoGetData = enuNoGetData.No_Default, Optional ByVal srcCodePage As enuStandardCodePages = enuStandardCodePages.SCP_big5) As String()

      Dim sBufLine() As String

      sBufLine = RemoveUnSelectLine(Split(MyGetFullTextFile(lpFilename, srcCodePage), vbNewLine), wFlags)

      Return sBufLine

   End Function

   Public Function RemoveUnSelectLine(ByVal arrMultiLine As String(), Optional ByVal wFlags As enuNoGetData = enuNoGetData.No_Default) As String()

      Dim sJoinLine As String
      Dim bAdd, bDel As Boolean
      Dim ibl, ubl, tLoc, nCount, tLen As Integer
      Dim tmpMultiLine As String()

      ubl = UBound(arrMultiLine)
      ReDim tmpMultiLine(ubl)

      nCount = -1
      For ibl = 0 To ubl
         bAdd = True
         If wFlags And enuNoGetData.No_Common Then
            bDel = False
            tLoc = InStr(arrMultiLine(ibl), "'")
            If tLoc > 0 Then
               bDel = True
               arrMultiLine(ibl) = Left(arrMultiLine(ibl), tLoc - 1)
            End If
            tLoc = InStr(LCase(arrMultiLine(ibl)), "rem ")
            If tLoc > 0 Then
               bDel = True
               arrMultiLine(ibl) = Left(arrMultiLine(ibl), tLoc - 1)
            End If

            If bDel And Len(Trim(arrMultiLine(ibl))) = 0 Then
               bAdd = False
            End If
         End If

         If wFlags And enuNoGetData.No_Null_Line Then
            If Len(Trim(Replace(arrMultiLine(ibl), Chr(0), ""))) = 0 Then
               bAdd = False
            End If
         End If

         If bAdd Then
            nCount += 1
            tmpMultiLine(nCount) = arrMultiLine(ibl)
         End If
      Next

      ReDim Preserve tmpMultiLine(nCount)
      Return tmpMultiLine

   End Function

End Module