frmwinpoc.vb

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

' WinPOC: Tool for reading ,writing, Extracting image files
Imports System.IO
Imports System.Runtime.InteropServices


Public Class frmWinPOC




#Region "btnBrowse"
    Private Sub btnBrowse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBrowse.Click
        Dim strFilename, strFileExt, strFileExt4 As String
        btnReadImage.Enabled = False
        btnExtractFiles.Enabled = False
        btnExtractXmlFiles.Enabled = False
        btnViewXmlFiles.Enabled = False
        btnWriteImage.Enabled = False

        dlgFileOpen.ShowDialog()

        'string manipulation for taking the extension of files
        If (txtFilename.Text = "") Then
            Exit Sub
        Else
            strFilename = txtFilename.Text
            strFileExt = (Mid(strFilename, Len(strFilename) - 3))
            strFileExt = strFileExt.ToLower
            strFileExt4 = (Mid(strFilename, Len(strFilename) - 4))
            strFileExt4 = strFileExt4.ToLower

            If (strFileExt = ".vhd") Or (strFileExt4 = ".vmdk") Or (strFileExt = ".pfr") Or (strFileExt = ".iso") Or (strFileExt = ".vfd") Or (strFileExt = ".ima") Or (strFileExt = ".imz") Then
                btnReadImage.Enabled = True
                btnExtractFiles.Enabled = True
                btnExtractXmlFiles.Enabled = True
                btnViewXmlFiles.Enabled = True
                btnWriteImage.Enabled = True
                'By selecting XML file we can only do write function
            ElseIf (strFileExt = ".xml") Then
                btnWriteImage.Enabled = True
            End If
        End If
    End Sub

#End Region

#Region "FormLoad"
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        dlgFileOpen.Filter = "All files|*.*"
        btnWriteImage.Enabled = False
        btnReadImage.Enabled = False
        btnExtractFiles.Enabled = False
        btnExtractXmlFiles.Enabled = False
        btnViewXmlFiles.Enabled = False
    End Sub
#End Region

#Region "Fileopen-OK"

    Private Sub dlgFileOpen_FileOk(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles dlgFileOpen.FileOk

        txtFilename.Text = dlgFileOpen.FileName

    End Sub
#End Region

#Region "FileExists"
    'Function to check the existance of files

    Function FileExist(ByRef File As String) As Boolean
        Dim Exist As Boolean
        Dim FileNumber As Short

        FileNumber = FreeFile()

        Exist = True
        On Error GoTo FileError
        FileOpen(FileNumber, File, OpenMode.Input)
        If Exist Then

            FileExist = True
            FileClose(FileNumber)
            Exit Function
        Else
            FileExist = False
        End If
        Exit Function
FileError:

        Select Case Err.Number ' Evaluate error number.
            Case 53 ' "File not Exist" error.
                Exist = False
            Case Else
                ' Handle other situations here...
        End Select
        Resume Next
    End Function
#End Region

#Region "btnWriteImage"

    'For creating iso, ima, imz,vhd files

    Private Sub btnWriteImage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnWriteImage.Click

        Dim blnFileCompressed As Boolean
        Dim blnFileInjected As Boolean
        Dim blnFileWrite As Boolean
        Dim blnCurDir As Boolean
        Dim blnEmptImg As Boolean
        Dim strFilename As String
        Dim strCurDir As String
        Dim dwPos As Integer
        Dim Ima As IntPtr

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

        strCurDir = ""
        'Creating an image
        Ima = CreateMemFatHima()
        blnEmptImg = MakeEmptyImage(Ima, 6 + (2 * 1))
        SetLabel(Ima, "BasicSdk")

        If (txtFilename.Text = "") Then
            txtInformation.Text = " Please select file"
            txtInformation.Focus()
        End If
        strFilename = txtFilename.Text

        'Injecting files in image.
        blnFileInjected = InjectFile(Ima, strFilename, dwPos, blnFileCompressed, "Injected.xml")

        'Creating  iso files
        blnFileWrite = WriteImaFile(Ima, 0, "D:\HowlerScoring.vfd", False, False, 5, 0, "Howler.ima")
        blnCurDir = GetCurDir(Ima, strCurDir, 1000)

        If (blnFileWrite) Then
            txtInformation.Text = " File has been created in  D:\HowlerScoring.vfd.... "
        Else
            txtInformation.Text = "Error!!! File Not created....."
        End If
        DeleteIma(Ima)

        txtFilename.Text = ""
        btnBrowse.Enabled = True

    End Sub
#End Region

#Region "btnReadImage"

    ' For Reading Image files
    Private Sub CountSubDir(ByVal Ima As IntPtr, ByVal uiPosInDir As Integer, ByRef dwNbFile As Integer, ByRef dwTotalSize As Integer)

        If (ChDirPos(Ima, CDM_ENTRY, uiPosInDir)) Then
            Dim dwNbDiItemSubDir As Integer
            Dim diItemSubDir As New DIRINFO
            Dim l As Integer
            RefreshInternalBufferDirInfo(Ima, SORT_NAME, dwNbDiItemSubDir)
            For l = 0 To dwNbDiItemSubDir - 1
                GetBufferDirInfoItem(Ima, diItemSubDir, l)
                If diItemSubDir.longname <> "." And diItemSubDir.longname <> ".." Then
                    If diItemSubDir.fIsSubDir Then
                        CountSubDir(Ima, diItemSubDir.uiPosInDir, dwNbFile, dwTotalSize)
                        RefreshInternalBufferDirInfo(Ima, SORT_NAME, dwNbDiItemSubDir)
                    Else
                        dwNbFile = dwNbFile + 1
                        dwTotalSize = dwTotalSize + diItemSubDir.dwSize
                    End If
                End If
            Next
            ChDir_Renamed(Ima, CDM_UPPER)
        End If
    End Sub


    Private Sub btnReadImage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnReadImage.Click

        Dim strFilename As String
        Dim NumberofFiles As Integer
        Dim Ima As IntPtr

        strFilename = txtFilename.Text
        'Calling the Readimage function
        Ima = ReadImage(strFilename)
        'Getting the number of files fromt he directory
        NumberofFiles = GetNbEntryCurDir(Ima)

        If (NumberofFiles = 0) Then
            txtInformation.Text = "Image file Contains :   " & NumberofFiles.ToString() & " files "
        Else
            txtInformation.Text = "Image file Contains :   " & NumberofFiles.ToString() & " files "
        End If


        Dim j As Integer

        Dim diItem As New DIRINFO
        Dim dwNbDiItem As Integer


        If (RefreshInternalBufferDirInfo(Ima, SORT_NAME, dwNbDiItem)) Then
            txtInformation.Text = txtInformation.Text & vbCrLf
            For j = 0 To dwNbDiItem - 1
                GetBufferDirInfoItem(Ima, diItem, j)
                'dwTrueSiz = diroot(j).dwTrueSize
                Dim strnameinima As String
                strnameinima = diItem.longname
                txtInformation.Text = txtInformation.Text & (j + 1) & ":" & strnameinima
                If (diItem.fIsSubDir) Then
                    Dim dwNbFile As Integer
                    Dim dwTotalSize As Integer
                    dwNbFile = 0
                    dwTotalSize = 0
                    CountSubDir(Ima, diItem.uiPosInDir, dwNbFile, dwTotalSize)
                    RefreshInternalBufferDirInfo(Ima, SORT_NAME, dwNbDiItem)
                    txtInformation.Text = txtInformation.Text & " contain " & dwNbFile & " files, " & dwTotalSize & " bytes"
                End If

                txtInformation.Text = txtInformation.Text & vbCrLf
            Next
        End If

        ' txtFilename.Text = ""
        btnBrowse.Enabled = True
        DeleteIma(Ima)

    End Sub
#End Region

#Region "btnExtract"

    Function WimaCallBackProc(ByVal dwEvent As Integer, _
                  ByVal dwEventParam As Integer, _
                  ByVal dwWin32Err As Integer, _
                  ByVal lpParam As IntPtr, _
                  ByVal lpUserParam As IntPtr) As Integer

        WimaCallBackProc = 0

        If (dwEvent = DWEV_PROGRESSPERCENT) Then
            If lpParam <> 0 Then
                Dim pfsi As PROGRESSFILE_SUPINFO
                pfsi = Marshal.PtrToStructure(lpParam, GetType(PROGRESSFILE_SUPINFO))
                If ((Int(dwEventParam / 5)) * 5) = dwEventParam Then
                    InfoTextBox.Text = "Extracting file " & pfsi.lpszFullName & " " & dwEventParam & "%"
                End If
            End If
        End If
    End Function

    Private Sub btnExtractFiles_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExtractFiles.Click

        Dim strFilename As String
        Dim NumberofFiles 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

        ' Extracting the files 
        For j = 0 To NumberofFiles - 1
            'blnFileExtracted = ExtractFile(Ima, j, "D:\Howler", "")
            blnFileExtracted = ExtractFileCB(Ima, AddressOf WimaCallBackProc, 0, j, "D:\Howler", "")
        Next
        If (NumberofFiles = 0) Then
            txtInformation.Text = "Image file Contains :   " & NumberofFiles.ToString() & " files "
        Else