Attribute VB_Name = "mod_DASMPlugin"
' Modul for Visual Basic 6
' Copyright (C) 2007 Jan Vorel
'
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' This is a shared modul, class modul, usercontrol or form. It is also
' published under the GNU General Public License.

' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues


Private Declare Sub RtlMoveMemory Lib "kernel32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Type CallInfoType
  PtrData As Long
  ptrCloseLib As Long
  ptrLoadLib As Long
  ptrGPA As Long
  hKernel As Long
  Reserved3 As Long
  Reserved2 As Long
  Reserved1 As Long
  End Type
Private Const CallInfoSize As Long = &H20
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private xCallInfo As CallInfoType

Public Sub DASMPlugin_Init()
  With xCallInfo
    If .hKernel = 0& Then
      .hKernel = LoadLibraryA("kernel32.dll")
      If .hKernel Then
        .ptrGPA = GetProcAddress(.hKernel, "GetProcAddress")
        .ptrLoadLib = GetProcAddress(.hKernel, "LoadLibraryA")
        .ptrCloseLib = GetProcAddress(.hKernel, "FreeLibrary")
        End If
      End If
    End With
  End Sub

Public Sub DASMPlugin_Close()
  With xCallInfo
    If Not .hKernel = 0& Then
      FreeLibrary (.hKernel)
      .hKernel = 0&
      End If
    End With
  End Sub

Public Function DASMPlugin_Use(ByVal xBinData As String, ByVal IdentifyStr As String, ByVal xParam As String) As String
  Dim xCodeSize As Long
  Dim xDataSize As Long
  Dim xPreFix As String
  Dim xPreSize As Long
  Dim xPostCode As String
  Dim xPostSize As Long
  Dim xVersion As Long
  Dim MemRequExtra As Long
  Dim hMem As Long
  Dim MemTotal As Long
  Dim AlignSpace As Long
  Dim xLong1 As Long
  Dim xChar1 As String
  
'  Stop
  If Left(xBinData, 4&) = "DASM" And Mid(xBinData, 17&, 16&) = IdentifyStr Then
    xPreFix = LoadDASM("CALLWINDOWPROCPREFIX")
    xPreSize = Len(xPreFix)
    xChar1 = Mid(xBinData, 5&, 4&)
    Call RtlMoveMemory(ByVal VarPtr(xVersion), ByVal xChar1, 4&)
'    Stop
    xPostCode = LoadDASM(Right("000" + CStr(xVersion), 4&))
    xPostSize = Len(xPostCode)
    MemRequExtra = Choose(xVersion + 1&, &H400&)
    If Not (MemRequExtra = 0& Or xPreSize = 0& Or xPostSize = 0& Or xCallInfo.hKernel = 0&) Then
      xChar1 = Mid(xBinData, 9&, 4&)
      Call RtlMoveMemory(ByVal VarPtr(xCodeSize), ByVal xChar1, 4&)
      'xCodeSize = LenCharToLong(xBinData, 9&)
      xChar1 = Mid(xBinData, 13&, 4&)
      Call RtlMoveMemory(ByVal VarPtr(xDataSize), ByVal xChar1, 4&)
      'xDataSize = LenCharToLong(xBinData, 13&)
      MemTotal = 16& + xDataSize + CallInfoSize + xPreSize + xCodeSize + xPostSize + MemRequExtra
      hMem = VirtualAlloc(0&, MemTotal, &H1000&, &H40&)
      If hMem Then
        AlignSpace = hMem + xDataSize + CallInfoSize
        AlignSpace = GetAlignedCodeStart(AlignSpace) - AlignSpace
        xLong1 = hMem + AlignSpace
        xCallInfo.PtrData = xLong1
        xChar1 = Mid(xBinData, 33& + xCodeSize, xDataSize)
        Call RtlMoveMemory(ByVal xLong1, ByVal xChar1, xDataSize)
        xLong1 = xLong1 + xDataSize
        Call RtlMoveMemory(ByVal xLong1, ByVal xPreFix, xPreSize)
        xLong1 = xLong1 + xPreSize
        xChar1 = Mid(xBinData, 33&, xCodeSize)
        Call RtlMoveMemory(ByVal xLong1, ByVal xChar1, xCodeSize)
        xLong1 = xLong1 + xCodeSize
        Call RtlMoveMemory(ByVal xLong1, ByVal xPostCode, xPostSize)
        xLong1 = xLong1 + xPostSize
        Call RtlMoveMemory(ByVal xLong1, xCallInfo, CallInfoSize)
        xLong1 = xLong1 + CallInfoSize + &H50&
        Call RtlMoveMemory(ByVal xLong1, ByVal xParam, Len(xParam))
        xLong1 = xLong1 - &H50&
        'Stop
'        Stop
        xPostSize = 0&
        On Error Resume Next
        xPostSize = CallWindowProcA(hMem + AlignSpace + xDataSize, xLong1, 0&, 0&, 0&)
        On Error GoTo 0
        'Stop
        Select Case xPostSize
          Case 1&
            'DASMPlugin_Use=PeekSAnsi(xLong1
            Call RtlMoveMemory(ByVal VarPtr(xPostSize), xLong1, 4&)
          Case Is > 3&
            DASMPlugin_Use = PeekSAnsi(xLong1 + xPostSize)
          End Select
        
'        DASMPlugin_Use = String(MemTotal, Chr(&HFF&))
 '       Call RtlMoveMemory(ByVal DASMPlugin_Use, ByVal hMem, MemTotal)
        
        
        Call VirtualFree(hMem, MemTotal, &H8000&)
        End If
      End If
    End If
  End Function






Private Function GetAlignedCodeStart(ByVal lngAddress As Long) As Long
  GetAlignedCodeStart = lngAddress + (15& - (lngAddress - 1&) Mod 16&)
  If (15& - (lngAddress - 1&) Mod 16&) = 0& Then GetAlignedCodeStart = GetAlignedCodeStart + 16&
  End Function

Private Function LoadDASM(ByVal ResID As String) As String
  Dim xByteA1() As Byte
  Dim xLong1 As Long
  
  On Error GoTo Er1
  xByteA1() = LoadResData(ResID, "DASM")
  xLong1 = UBound(xByteA1()) + 1&
  If Not xLong1 = 0& Then
    LoadDASM = String(xLong1, vbNullChar)
    Call RtlMoveMemory(ByVal LoadDASM, xByteA1(0), xLong1)
    End If

Rs1:
  On Error GoTo 0
  Exit Function

Er1:
  Resume Rs1
  End Function

