frmwinpoc.vb

来自「对ima、imz压缩文件修改」· VB 代码 · 共 579 行 · 第 1/2 页

            txtInformation.Text = NumberofFiles.ToString() & " files - extracted to D:\Howler"
        End If

        DeleteIma(Ima)

        btnBrowse.Enabled = True

        btnReadImage.Enabled = True
        btnWriteImage.Enabled = True
        btnExtractFiles.Enabled = True
        btnExtractXmlFiles.Enabled = True
        btnViewXmlFiles.Enabled = True
        'InfoTextBox.Text = "Done"



    End Sub
    
#End Region


#Region "Function 'ReadImage'"

    Function ReadImage(ByVal strFilename As String) As IntPtr

        Dim blnFileCompressed As Boolean
        Dim blnReadFile As Boolean
        Dim Ima As IntPtr
        Dim strFileExt As String
        Dim strFileExt4 As String
        Dim dwNbPartFound As Integer
        Dim dwNbFat32Found As Integer
        Dim dwRetMakeList As Integer

        strFilename = txtFilename.Text
        txtFilename.Enabled = False
        btnBrowse.Enabled = False
        btnReadImage.Enabled = False
        btnWriteImage.Enabled = False

        ' Checking for the existance of file
        If Not FileExist(strFilename) Then
            txtInformation.Text = "File does not Exists "
            Exit Function
        End If

        strFileExt = (Mid(strFilename, Len(strFilename) - 3))
        strFileExt = strFileExt.ToLower
        strFileExt4 = (Mid(strFilename, Len(strFilename) - 4))
        strFileExt4 = strFileExt4.ToLower


        If (strFileExt = ".vhd") Or (strFileExt = ".pfr") Or (strFileExt4 = ".vmdk") Then
            Dim PartList As PARTDESCArray
            ReDim PartList.diItem(MAXPARTITION)



            'Dim ooo As Integer
            'ooo = MakePartitionList("n:\\demoimage\\16GB_vhd.vhd", "", dwNbPartFound, dwNbFat32Found, MAXPARTITION, PartList)
            'Dim dwsize1 As Integer
            'Dim dwsizehigh1 As Integer
            'Dim fIsBigFat As Boolean
            'Dim dwPosInFile1 As Integer
            'Dim retget As Boolean
            'retget = GetFatImaSizeFileName("n:\demoimage\usb128_fix-flat.vmdk", dwsize1, dwsizehigh1, fIsBigFat, dwPosInFile1)


            dwRetMakeList = MakePartitionList(strFilename, "", dwNbPartFound, dwNbFat32Found, MAXPARTITION, PartList)
            MsgBox("dwRetMakeList=" & dwRetMakeList & "part found=" & dwNbPartFound)

            Dim i As Integer

            i = 0
            Ima = 0

            While (Ima = 0) And (i < dwRetMakeList)
                Dim dwPosInFileLow As Integer
                Dim dwPosInFileHigh As Integer
                Dim dwPosPartition As Integer
                dwPosPartition = PartList.diItem(i).dwPosPartition
                dwPosInFileLow = dwPosPartition * 512
                dwPosInFileHigh = dwPosPartition / (&H1000000 / 2)
                Ima = OpenLargeImageFile(0, strFilename, dwPosInFileLow, dwPosInFileHigh, True)
                blnReadFile = (Ima <> 0)
                If (Ima <> 0) Then
                    MsgBox("partition :number :" & i & " : opened successfully")
                Else
                    MsgBox("OpenLargeImageFile fail")
                End If
                i = i + 1
            End While

        ElseIf (strFileExt = ".iso") Then
            Ima = CreateCDIsoIma(strFilename)
            blnReadFile = (Ima <> 0)
        Else
            Ima = CreateMemFatHima()
            blnFileCompressed = True
            blnReadFile = ReadImaFile(Ima, 0, strFilename, blnFileCompressed, 0)
        End If


        ' Reading image files 

        If (blnReadFile) Then
            Return Ima
        Else
            Return 0
        End If

    End Function
#End Region


    Private Sub btnExtractXmlFiles_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExtractXmlFiles.Click

        Dim strFilename As String
        Dim NumberofFiles As Integer
        Dim NumberofFilesExtracted As Integer
        Dim blnFileExtracted As Boolean
        Dim Ima As IntPtr


        btnReadImage.Enabled = False
        btnWriteImage.Enabled = False
        btnExtractFiles.Enabled = False
        btnExtractXmlFiles.Enabled = False
        btnViewXmlFiles.Enabled = False


        strFilename = txtFilename.Text
        Ima = ReadImage(strFilename)

        ' Checking for the existance of file
        If Not FileExist("D:\Howler") Then
            Directory.CreateDirectory("D:\Howler")
        End If

        ' Getting number of files in image
        NumberofFiles = GetNbEntryCurDir(Ima)
        Dim j As Integer
        Dim diItem As New DIRINFO
        Dim dwNbDiItem As Integer
        NumberofFilesExtracted = 0

        If (RefreshInternalBufferDirInfo(Ima, SORT_NAME, dwNbDiItem)) Then
            ' Extracting the files 
            For j = 0 To dwNbDiItem - 1
                GetBufferDirInfoItem(Ima, diItem, j)
                Dim strFileExtrExt As String
                If Len(diItem.longname) > 3 Then
                    strFileExtrExt = (Mid(diItem.longname, Len(diItem.longname) - 3))
                Else
                    strFileExtrExt = ""
                End If
                strFileExtrExt = strFileExtrExt.ToLower

                If strFileExtrExt = ".xml" Then
                    blnFileExtracted = ExtractFile(Ima, diItem.uiPosInDir, "D:\Howler", "")
                    If (blnFileExtracted) Then NumberofFilesExtracted = NumberofFilesExtracted + 1
                End If
            Next
        End If
        If (NumberofFiles = 0) Then
            txtInformation.Text = "Image file Contains :   " & NumberofFiles.ToString() & " files "
        Else
            txtInformation.Text = NumberofFilesExtracted.ToString() & " files - extracted to D:\Howler"
        End If

        DeleteIma(Ima)

        btnBrowse.Enabled = True

        btnReadImage.Enabled = True
        btnWriteImage.Enabled = True
        btnExtractFiles.Enabled = True
        btnExtractXmlFiles.Enabled = True
        btnViewXmlFiles.Enabled = True
    End Sub

    Dim strextrGlobal As String

    Private Function WimWrCBDemo(ByRef Buf As byteArrayBuf, _
                                   ByVal dwDataSize As Integer, _
                                   ByVal dwUserValue As IntPtr) As Boolean
        '        Dim i As Integer
        Dim strlocal As String

        If (dwDataSize > 0) Then
            strlocal = System.Text.Encoding.Default.GetString(Buf.bItem)
            If (dwDataSize < MAXSIZEBYTEARRAY) Then
                strlocal = strlocal.Remove(dwDataSize, MAXSIZEBYTEARRAY - dwDataSize)
            End If

            strextrGlobal = strextrGlobal & strlocal
        End If
        WimWrCBDemo = True

    End Function

    Private Sub btnViewXmlFiles_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnViewXmlFiles.Click
        Dim strFilename As String
        Dim NumberofFiles As Integer
        Dim NumberofFilesExtracted As Integer
        Dim blnFileExtracted As Boolean
        Dim Ima As IntPtr
        'Dim DataBuf As byteArrayBuf


        btnReadImage.Enabled = False
        btnWriteImage.Enabled = False
        btnExtractFiles.Enabled = False
        btnExtractXmlFiles.Enabled = False
        btnViewXmlFiles.Enabled = False


        strFilename = txtFilename.Text
        Ima = ReadImage(strFilename)
        txtInformation.Text = ""

        ' Checking for the existance of file

        ' Getting number of files in image
        NumberofFiles = GetNbEntryCurDir(Ima)
        Dim j As Integer
        Dim diItem As New DIRINFO
        Dim dwNbDiItem As Integer
        NumberofFilesExtracted = 0
        Dim dispString As String
        dispString = ""

        If (RefreshInternalBufferDirInfo(Ima, SORT_NAME, dwNbDiItem)) Then
            ' Extracting the files 
            For j = 0 To dwNbDiItem - 1
                GetBufferDirInfoItem(Ima, diItem, j)
                Dim strFileExtrExt As String
                Dim uiPosDirCurrent As Integer
                If Len(diItem.longname) > 3 Then
                    strFileExtrExt = (Mid(diItem.longname, Len(diItem.longname) - 3))
                Else
                    strFileExtrExt = ""
                End If
                strFileExtrExt = strFileExtrExt.ToLower

                'If strFileExtrExt = ".xml" Then
                If (strFileExtrExt = ".xml") Or (strFileExtrExt = ".txt") Or (strFileExtrExt = ".inf") Then
                    uiPosDirCurrent = diItem.uiPosInDir
                    Dim cbExtrfunc As WimWrCB
                    cbExtrfunc = AddressOf WimWrCBDemo
                    strextrGlobal = ""
                    blnFileExtracted = ExtractFileVirtual(Ima, _
                                           cbExtrfunc, MAXSIZEBYTEARRAY, 666, _
                                               uiPosDirCurrent, "D:\Howler", "")
                    If (blnFileExtracted) Then
                        NumberofFilesExtracted = NumberofFilesExtracted + 1
                        'dispString = dispString & "content of '" & diItem.longname & "'" & vbCrLf & strextrGlobal & vbCrLf & vbCrLf
                        dispString = dispString & "content of '" & diItem.longname & "'" & vbCrLf & strextrGlobal & _
                                    vbCrLf & "Length of '" & diItem.longname & "' is " & strextrGlobal.Length & " bytes " & vbCrLf
                    End If

                End If
            Next
        End If
        If (NumberofFilesExtracted = 0) Then
            txtInformation.Text = txtInformation.Text & "Image file Contains :   " & NumberofFiles.ToString() & " files "
        Else
            dispString = dispString & _
                           NumberofFilesExtracted.ToString() & " files - extracted to D:\Howler"
            txtInformation.Text = dispString
        End If

        txtInformation.Text = dispString

        DeleteIma(Ima)

        btnBrowse.Enabled = True

        btnReadImage.Enabled = True
        btnWriteImage.Enabled = True
        btnExtractFiles.Enabled = True
        btnExtractXmlFiles.Enabled = True
        btnViewXmlFiles.Enabled = True

    End Sub

End Class