?? frmwinpoc.vb
字號:
' 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -