home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / EliteXp®_P21651610152009.psc / PeFile.cls < prev    next >
Text File  |  2009-10-14  |  7KB  |  211 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "PEFile"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. Private Type Props
  17.     hMapFile As Long
  18.     hFile As Long
  19.     dwFileSize As Long
  20.     FileName As String
  21. End Type
  22.  
  23. Private Type PESection
  24.     Section As IMAGE_SECTION_HEADER
  25.     Code() As Byte
  26. End Type
  27. Private Type PEStruct
  28.     DosHeader As IMAGE_DOS_HEADER
  29.     NTHeader As IMAGE_NT_HEADERS
  30.     OptHeader As IMAGE_OPTIONAL_HEADER
  31.     Sections() As PESection
  32.     DosStub() As Byte
  33. End Type
  34. Private Type MemoryPE
  35.     DosHeader As IMAGE_DOS_HEADER
  36.     DosStub() As Byte
  37.     NTHeader As IMAGE_NT_HEADERS
  38. End Type
  39. Dim Mem As Props    'Properties For this Class
  40.  
  41. Dim PE As PEStruct 'Stores PE Formats
  42.  
  43.  
  44. Property Get FileName() As String
  45. FileName = Mem.FileName
  46. End Property
  47. Property Get Base() As Long
  48. Base = Mem.hMapFile
  49. End Property
  50.  
  51. Function LoadFile(ByVal FileName As String) As Boolean
  52. On Error Resume Next
  53. Mem.hFile = CreateFile(FileName, GENERIC_READ, FILE_SHARE_READ, ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  54. If Mem.hFile = -1 Then
  55.     SetError "Error Opening File. Check if the File exists and is not locked."
  56.     Exit Function
  57. End If
  58. Mem.dwFileSize = GetFileSize(Mem.hFile, 0)
  59. If Mem.dwFileSize = 0 Then
  60.     SetError "FileSize Error. Check if the file is locked by other applications"
  61.     Exit Function
  62. End If
  63. Mem.hMapFile = GlobalAlloc(GMEM_FIXED Or GMEM_ZEROINIT, Mem.dwFileSize)
  64. If Mem.hMapFile = 0 Then
  65.     SetError "Error Allocating Memory Space."
  66.     Exit Function
  67. End If
  68. If ReadFile(Mem.hFile, ByVal Mem.hMapFile, Mem.dwFileSize, 0, ByVal 0) = 0 Then
  69.     SetError "Error in Reading File"
  70.     Exit Function
  71. End If
  72. '***********Close the File Handle
  73. 'CopyMemory PE.DosHeader, ByVal Base, Len(PE.DosHeader)
  74.  
  75.  
  76. If PE.DosHeader.e_magic <> IMAGE_DOS_SIGNATURE Then
  77.     SetError "Not a valid PE File. MZ Signature not found"
  78.     Exit Function
  79. End If
  80. CopyMemory PE.NTHeader, ByVal Base + PE.DosHeader.e_lfanew, Len(PE.NTHeader)
  81. If PE.NTHeader.Signature <> IMAGE_NT_SIGNATURE Then
  82.     SetError "Not a Valid PE File. PE Signature not found"
  83.     Exit Function
  84. End If
  85. 'Get the Dos Stub
  86. Dim dwStubSize As Long
  87. Dim bytes() As Byte, dwBytes As Long
  88. dwStubSize = PE.DosHeader.e_lfanew - Len(PE.DosHeader)
  89. ReDim bytes(dwStubSize)
  90. CopyMemory bytes(0), ByVal Base + Len(PE.DosHeader), dwStubSize
  91. PE.DosStub = bytes
  92. 'Deal with NT Header of PE File
  93. Dim idx As Long
  94. Dim dwFirstSectionOffset As Long
  95. dwFirstSectionOffset = PE.DosHeader.e_lfanew + Len(PE.NTHeader)
  96.  
  97. With PE.NTHeader
  98.     '************Populate Section Headers
  99.     Dim SectionHdr As IMAGE_SECTION_HEADER
  100.     Dim sctCount As Long
  101.     sctCount = PE.NTHeader.FileHeader.NumberOfSections
  102.     ReDim PE.Sections(1 To sctCount)
  103.     For idx = 1 To sctCount
  104.         CopyMemory SectionHdr, ByVal Base + dwFirstSectionOffset + (idx - 1) * Len(SectionHdr), Len(SectionHdr)
  105.         PE.Sections(idx).Section = SectionHdr
  106.         'dwBytes = PEAlign(SectionHdr.SizeOfRawData, PE.NTHeader.OptionalHeader.SectionAlignment)
  107.         dwBytes = SectionHdr.SizeOfRawData
  108.         ReDim bytes(dwBytes)
  109.         CopyMemory bytes(0), ByVal Base + SectionHdr.PointerToRawData, SectionHdr.SizeOfRawData
  110.         PE.Sections(idx).Code = bytes
  111.     Next
  112. End With
  113.  
  114.  
  115.  
  116.  
  117. CloseHandle Mem.hFile
  118. End Function
  119. Function SaveFile(ByVal FileName As String) As Boolean
  120. Mem.hFile = CreateFile(FileName, GENERIC_WRITE, FILE_SHARE_WRITE Or FILE_SHARE_READ, ByVal 0, CREATE_ALWAYS, 0, ByVal 0)
  121. If Mem.hFile = -1 Then
  122.     SetError "Error Creating File For Writing. Make sure the disk is ready."
  123.     Exit Function
  124. End If
  125. If IsBadCodePtr(Base) = False Then
  126.     Mem.hMapFile = 0
  127.     Mem.hMapFile = GlobalAlloc(GMEM_FIXED Or GMEM_ZEROINIT, Mem.dwFileSize)
  128. End If
  129.  
  130. If Mem.hMapFile = 0 Then
  131.     SetError "Error in Memory Allocation"
  132.     Exit Function
  133. End If
  134. FillMemory ByVal Base, GlobalSize(Base), 0
  135. AlignSections
  136. CopyMemory ByVal Base, PE.DosHeader, Len(PE.DosHeader)
  137. Dim bytes() As Byte
  138. bytes = PE.DosStub
  139. CopyMemory ByVal Base + Len(PE.DosHeader), bytes(0), UBound(PE.DosStub)
  140. CopyMemory ByVal Base + PE.DosHeader.e_lfanew, PE.NTHeader, Len(PE.NTHeader)
  141. Dim dwFirstSectionOffset As Long
  142. dwFirstSectionOffset = PE.DosHeader.e_lfanew + Len(PE.NTHeader)
  143. Dim sctNum As Long, idx As Long
  144. sctNum = UBound(PE.Sections)
  145. For idx = 1 To sctNum
  146.     CopyMemory ByVal Base + dwFirstSectionOffset + (idx - 1) * Len(PE.Sections(idx).Section), PE.Sections(idx).Section, Len(PE.Sections(idx).Section)
  147.     CopyMemory ByVal Base + PE.Sections(idx).Section.PointerToRawData, PE.Sections(idx).Code(0), PE.Sections(idx).Section.SizeOfRawData
  148. Next
  149. SetFilePointer hFile, 0, 0, FILE_BEGIN
  150.  
  151. WriteFile Mem.hFile, ByVal Base, GlobalSize(Base), 0, ByVal 0
  152. CloseHandle Mem.hFile
  153. SaveFile = True
  154. End Function
  155. '************************************************************************************
  156. 'Private Routines
  157. '************************************************************************************
  158. Private Sub AlignSections()
  159.  
  160.  
  161. End Sub
  162.  
  163. Private Sub SetError(ByVal Desc As String)
  164. Err.Description = Desc
  165. End Sub
  166. Private Function GetString(ByVal hMem As Long) As String
  167. Dim nLen As Long
  168. nLen = StrLenPtr(hMem)
  169. Dim st As String
  170. st = String(nLen, 0)
  171. StrCpyPtrToStr st, hMem
  172. GetString = st
  173. End Function
  174. Private Function GetLong(ByVal hMem As Long) As Long
  175. CopyMemory GetLong, ByVal hMem, 4
  176. End Function
  177. Private Function GetInt(ByVal hMem As Long) As Integer
  178. CopyMemory GetInt, ByVal hMem, 2
  179. End Function
  180. Private Function GetByte(ByVal hMem As Long) As Byte
  181. CopyMemory GetByte, ByVal hMem, 1
  182. End Function
  183. Function PEAlign(ByVal dwTarNum As Long, ByVal dwAlignTo As Long) As Long
  184. PEAlign = (((dwTarNum + dwAlignTo - 1) / dwAlignTo) * dwAlignTo)
  185. End Function
  186. Private Property Get NewBase() As Long
  187. NewBase = Mem.hMapFile
  188. End Property
  189.  
  190. '**************************************************************************************
  191. '**************************************************************************************
  192. 'Class Termiantion
  193. '**************************************************************************************
  194. '**************************************************************************************
  195. Private Sub Class_Terminate()
  196. If Mem.hMapFile <> 0 Then
  197.     GlobalFree Mem.hMapFile
  198. End If
  199. End Sub
  200. '**************************************************************************************
  201. 'Properties For PE
  202. '**************************************************************************************
  203. Property Get DosStub() As String
  204. DosStub = StrConv(PE.DosStub, vbUnicode)
  205. End Property
  206. Property Get EntryPoint() As Long
  207. EntryPoint = PE.NTHeader.OptionalHeader.AddressOfEntryPoint
  208. End Property
  209.  
  210.  
  211.