PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

PB3.94 conversion help

https://www.purebasic.fr/english/viewtopic.php?t=27020

Page 1 of 1

Posted: Tue May 15, 2007 9:35 am
by Trond
It's not the asm, it's the way procedures are stored. This compiles and in theory it should work the same as 3.94 version:

Code: Select all

Procedure Error(message$)
  wError = GetLastError_()
  If wError
    *ErrorBuffer = AllocateMemory(1024)
    FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, wError, 0, *ErrorBuffer, 1024, 0)
    message$+Chr(10)+PeekS(*ErrorBuffer)
    FreeMemory(*ErrorBuffer)
  EndIf
  MessageRequester("Error", message$)
EndProcedure

Structure ClassFactoryObject
  lpVtbl.l
  nRefCount.l
  nLockCount.l
EndStructure

Global m_pDataObj.IDataObject, cmd, hModule
Global i_Unk.IUnknown, i_SEI.IShellExtInit, i_QCM.IContextMenu
Global *p_Unk.ClassFactoryObject
Global File$

Procedure Ansi2Uni(*st, *Buffer, blen)
  If Len(PeekS(*st))<blen
    ProcedureReturn MultiByteToWideChar_(#CP_ACP, 0, *st, -1, *Buffer, blen)
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure IUnknown_QueryInterface(*ti_unk.IUnknown, *riid.GUID, *ppvObject.LONG)
  If *ppvObject
    If CompareMemory(*riid, ?IID_IUnknown, SizeOf(GUID))
      MessageRequester("", "iunknown")
      *ppvObject\l = i_Unk
    ElseIf CompareMemory(*riid, ?IID_IShellExtInit, SizeOf(GUID))
      *ppvObject\l = i_SEI
    ElseIf CompareMemory(*riid, ?IID_IContextMenu, SizeOf(GUID))
      *ppvObject\l = i_QCM
    Else
      ProcedureReturn #E_NOINTERFACE
    EndIf
  Else
    ProcedureReturn #S_FALSE
  EndIf
  i_Unk\AddRef()
  ProcedureReturn #S_OK
EndProcedure

Procedure IUnknown_AddRef(*ti_unk.IUnknown):*p_Unk\nRefCount+1:ProcedureReturn *p_Unk\nRefCount:EndProcedure

Procedure IUnknown_Release(*ti_unk.IUnknown):*p_Unk\nRefCount-1:ProcedureReturn *p_Unk\nRefCount:EndProcedure

Procedure IClassFactory_CreateInstance(*ti_cf.IClassFactory, *pUnkOuter.IUnknown, *riid.GUID, *ppvObject)
  If *pUnkOuter
    ProcedureReturn #CLASS_E_NOAGGREGATION
  Else
    If i_SEI=#Null
      ProcedureReturn #E_OUTOFMEMORY
    Else
      hr = i_SEI\QueryInterface(*riid, *ppvObject)
    EndIf
  EndIf
  ProcedureReturn hr
EndProcedure

Procedure IClassFactory_LockServer(*ti_cf.IClassFactory, fLock)
  ProcedureReturn #E_FAIL
EndProcedure

#CF_HDROP = $0f
#DVASPECT_CONTENT = 1
#TYMED_HGLOBAL = 1
#TYMED_FILE = 2

Procedure IShellExtInit_Initialize(*ti_sei.IShellExtInit, *pidlFolder.ITEMIDLIST, *pdtobj.IDataObject, hkeyProgID)
  If m_pDataObj
    m_pDataObj\Release()
  EndIf
  If *pdtobj
    m_pDataObj = *pdtobj
    *pdtobj\AddRef()
    fe.FORMATETC\cfFormat = #CF_HDROP
    fe\ptd = #Null
    fe\dwAspect = #DVASPECT_CONTENT
    fe\lindex = -1
    fe\tymed = #TYMED_HGLOBAL
    If *pdtobj\GetData(@fe, @medium.STGMEDIUM)=#S_OK
      uCount = DragQueryFile_(medium\hGlobal, -1, #Null, 0)
      If uCount=1
        *m_szFile = AllocateMemory(#MAX_PATH)
        DragQueryFile_(medium\hGlobal, 0, *m_szFile, #MAX_PATH)
        If Len(PeekS(*m_szFile))=0
          uCount = 0
        Else
          File$ = PeekS(*m_szFile)
        EndIf
        FreeMemory(*m_szFile)
      EndIf
      ReleaseStgMedium_(@medium)
      If uCount=1
        ProcedureReturn #S_OK
      EndIf
    EndIf
  EndIf
  ProcedureReturn #S_FALSE
EndProcedure

#MIIM_ID = 2
#MIIM_STRING = $40
#MF_STRING = 0
#MFT_STRING = #MF_STRING
#CMF_DEFAULTONLY = 1

Procedure IContextMenu_QueryContextMenu(*i_icm.IContextMenu, hmenu, indexMenu, idCmdFirst, idCmdLast, uFlags)
  If #CMF_DEFAULTONLY&uFlags:ProcedureReturn 0:EndIf
  cmd = indexMenu
  mii.MENUITEMINFO
  mii\cbSize = SizeOf(MENUITEMINFO)
  mii\fMask = #MIIM_STRING|#MIIM_ID
  mii\fType = #MFT_STRING
  mii\wID = idCmdFirst
  mii\dwTypeData = ?CommandString
  If InsertMenuItem_(hmenu, 0, #True, @mii)=#False
    ProcedureReturn 1<<31
  EndIf
  ProcedureReturn 1
EndProcedure

Enumeration
  #GCS_VERBA
  #GCS_HELPTEXTA
  #GCS_VALIDATEA
  #GCS_VERBW
  #GCS_HELPTEXTW
  #GCS_VALIDATEW
EndEnumeration
#GCS_UNICODE = 4
#GCS_VERB = #GCS_VERBA
#GCS_HELPTEXT = #GCS_HELPTEXTA
#GCS_VALIDATE = #GCS_VALIDATEA

Procedure IContextMenu_GetCommandString(*ti_icm.IContextMenu, idCmd, uFlags, pwReserved, pszName, cchMax)
  If idCmd=cmd
    Select uFlags
      Case #GCS_HELPTEXTA ; Sets pszName To an ANSI string containing the Help text For the command.
        CopyMemory(?CommandHelpLine, pszName, Len(PeekS(?CommandHelpLine)))
      Case #GCS_HELPTEXTW ; Sets pszName To a Unicode string containing the Help text For the command.
        If Ansi2Uni(?CommandHelpLine, pszName, cchMax)=0
          ProcedureReturn #S_FALSE
        EndIf
      Case #GCS_VALIDATEA ; Returns S_OK If the menu item exists, Or S_FALSE otherwise.
        ProcedureReturn #S_OK
      Case #GCS_VALIDATEW ; Returns S_OK If the menu item exists, Or S_FALSE otherwise.
        ProcedureReturn #S_OK
      Case #GCS_VERBA ; Sets pszName To an ANSI string containing the language-independent command name For the menu item.
        PokeS(pszName, PeekS(?CommandString))
      Case #GCS_VERBW ; Sets pszName To a Unicode string containing the language-independent command name For the menu item.
        If Ansi2Uni(?CommandString, pszName, cchMax)=0
          ProcedureReturn #S_FALSE
        EndIf
      Default
        ProcedureReturn #S_FALSE
    EndSelect
  Else
    ProcedureReturn #S_FALSE
  EndIf
  ProcedureReturn #S_OK
EndProcedure

Structure CMINVOKECOMMANDINFO
 cbSize.l
 fMask.l
 hwnd.l
 lpVerb.l
 lpParameters.l
 lpDirectory.l
 nShow.l
 dwHotKey.l
 hIcon.l
EndStructure

Structure CMINVOKECOMMANDINFOEX Extends CMINVOKECOMMANDINFO
 lpTitle.l
 lpVerbW.l
 lpParametersW.l
 lpDirectoryW.l
 lpTitleW.l
 ptInvoke.POINT
EndStructure

#SEE_MASK_UNICODE = $4000
#CMIC_MASK_UNICODE = #SEE_MASK_UNICODE

Procedure IContextMenu_InvokeCommand(*ti_icm.IContextMenu, *pici.CMINVOKECOMMANDINFOEX)
  If *pici\cbSize=SizeOf(CMINVOKECOMMANDINFOEX)
    If *pici\fMask&#CMIC_MASK_UNICODE
      If (*pici\lpVerbW&$ffff)=cmd
        MessageRequester("Show file name", File$)
        ProcedureReturn #NOERROR
      EndIf
    EndIf
  ElseIf *pici\cbSize=SizeOf(CMINVOKECOMMANDINFO)
    If (*pici\lpVerb&$ffff)=cmd
      MessageRequester("Show file name", File$)
      ProcedureReturn #NOERROR
    EndIf
  Else
    ProcedureReturn #S_FALSE
  EndIf
EndProcedure

#SELFREG_E_FIRST = $80009E40
#SELFREG_E_CLASS = #SELFREG_E_FIRST+1

#GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS = 4

ProcedureDLL DllRegisterServer()
  InDLL:
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "*\shellex\ContextMenuHandlers\FastView.Image", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  RegSetValueEx_(hKey1, "", 0, #REG_SZ, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 38)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "FastView.Image\shellex\ContextMenuHandlers", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  RegSetValueEx_(hKey1, "", 0, #REG_SZ, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 38)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegCreateKeyEx_(#HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  RegSetValueEx_(hKey1, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 0, #REG_SZ, "FastView.Image", 15)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  *szBuffer = AllocateMemory(#MAX_PATH)
  If *szBuffer And GetModuleFileName_(?InDLL&$FFFF0000, *szBuffer, #MAX_PATH)
    If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
    RegSetValueEx_(hKey1, "", 0, #REG_SZ, "FastView.Image", 15)
    If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
    If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{851aab5c-2008-4157-9c5d-a28dfa7b2660}\InProcServer32", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
    RegSetValueEx_(hKey1, "", 0, #REG_SZ, *szBuffer, Len(PeekS(*szBuffer))+1)
    RegSetValueEx_(hKey1, "ThreadingModel", 0, #REG_SZ, "Apartment", 10)
    If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  Else
    ProcedureReturn #SELFREG_E_CLASS
  EndIf
  FreeMemory(*szBuffer)
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL DllUnregisterServer()
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "*\shellex\ContextMenuHandlers\FastView.Image")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "FastView.Image\shellex\ContextMenuHandlers")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "FastView.Image\shellex")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "FastView.Image")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If RegOpenKeyEx_(#HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved", 0, #KEY_ALL_ACCESS, @hKey1)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteValue_(hKey1, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 0, #KEY_ALL_ACCESS, @hKey1)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteKey_(hKey1, "InProcServer32")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "CLSID", 0, #KEY_ALL_ACCESS, @hKey1)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteKey_(hKey1, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL AttachProcess(Instance)
  DisableThreadLibraryCalls_(Instance)
  hModule = Instance
  i_QCM = ?lpVT_IContextMenu
  i_SEI = ?lpVT_IShellExtInit
  i_Unk = ?lpVT_IUnknown
  *p_Unk = ?lpVT_IUnknown
  ProcedureReturn #True
EndProcedure

ProcedureDLL DllGetClassObject(*rclsid.GUID, *riid.GUID, *ppv.LONG)
  If *ppv
    If CompareMemory(*rclsid, ?CLSID_ContextMenuHandler, SizeOf(GUID))
      If CompareMemory(*riid, ?IID_IClassFactory, SizeOf(GUID))
        *ppv\l = ?lpVT_IClassFactory
      Else
        *ppv\l = 0
        ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
      EndIf
    Else
      *ppv\l = 0
      ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
    EndIf
  Else
    *ppv\l = 0
    ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
  EndIf
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL DllCanUnloadNow()
  If *p_Unk\nRefCount<=0 And *p_Unk\nLockCount<=0
    ProcedureReturn #S_OK
  Else
    ProcedureReturn #S_FALSE
  EndIf
EndProcedure

DataSection
  lpVT_IUnknown:
    Data.l ?VT_IUnknown, 0, 0
  VT_IUnknown:
    Data.l @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release()
  lpVT_IClassFactory:
    Data.l ?VT_IClassFactory
  VT_IClassFactory:
    Data.l @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release()
    Data.l @IClassFactory_CreateInstance(), @IClassFactory_LockServer()
  lpVT_IShellExtInit:
    Data.l ?VT_IShellExtInit
  VT_IShellExtInit:
    Data.l @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release()
    Data.l @IShellExtInit_Initialize()
  lpVT_IContextMenu:
    Data.l ?VT_IContextMenu
  VT_IContextMenu:
    Data.l @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release()
    Data.l @IContextMenu_QueryContextMenu()
    Data.l @IContextMenu_InvokeCommand()
    Data.l @IContextMenu_GetCommandString()
EndDataSection

DataSection ;
  CLSID_ContextMenuHandler: ; {851aab5c-2008-4157-9c5d-a28dfa7b2660}
  Data.l $851aab5c
  Data.w $2008, $4157
  Data.b $9c, $5d, $a2, $8d, $fa, $7b, $26, $60
  IID_IUnknown:
  Data.l $00000000
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  IID_IClassFactory:
  Data.l $00000001
  Data.w $0, $0
  Data.b $C0, $0, $0, $0, $0, $0, $0, $46
  IID_IShellExtInit:
  Data.l $000214E8
  Data.w 0, 0
  Data.b $C0, 0, 0, 0, 0, 0, 0, $46
  IID_IContextMenu:
  Data.l $000214E4
  Data.w 0, 0
  Data.b $C0, 0, 0, 0, 0, 0, 0, $46
  CommandString:
  Data.s "Show file name"
  CommandHelpLine:
  Data.s "Shows the file name"
EndDataSection

Posted: Tue May 15, 2007 9:56 am
by Inf0Byt3
Yes, you are right :). It works perfectly now. I have to study the code a bit and see how you made it work. Thank you!

Posted: Tue May 15, 2007 10:37 am
by Trond
It's a difference on how procedures are treated. In PB 4 they are placed at the end of the asm file, but only if they are referenced from somewhere in the PB code. Thus the 3.94 approach of placing a label just before them is doubly flawed: First, the procedures themselves aren't referenced, so they aren't included, second, if the procedures ARE included they are placed at the end of the file, so the labels (which are not moved) points to the wrong place.

Posted: Tue May 15, 2007 10:47 am
by Inf0Byt3
Oh.... I see... When I first tried to convert it, I thought of the DataSection stuff too, but I simply couldn't get it to work. The error I was getting suggested uninitialized code (exactly as you say, it was at the wrong location) but I thought that if I execute Vtable() it would work. If you weren't here to help me, it would have taken me probably years to make it work :).

[Edit]
This should definately go to the CodeArchiv

Posted: Wed Dec 19, 2007 3:20 pm
by kinglestat
excuse me, how does this work?
ie what should i call ? and/or change to adapt it for me?
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited