Dll

[noc_Trix]

Hi

Does anyone have any ideas on how to retrieve the exe path & name of a calling executable from within a .dll file. I want to be able to identify what exe file called a dll procedure...

Thanks

[yrwyddfa]

The following will give you a tree structure of all the processes on your system, and what process spawned what process. It may still need some interpretation in order to get what you need:

Option Explicit
 
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Private Type PROCESS_INFORMATION
   hProcess As Long
   hThread As Long
   dwProcessId As Long
   dwThreadId As Long
End Type
 
Private Type PROCESS_TREE
    ProcessId As Long
    ParentProcessId As Long
End Type
 
Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szexeFile As String * 6400
End Type
 
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const WINAPI_TRUE = 1
 
Private Sub Form_Load()
 
    Dim ProcessTree() As PROCESS_TREE
    Dim n As Long
    
    ProcessTree = GetProcessList()
    
End Sub
 
Private Function GetProcessList() As PROCESS_TREE()
 
    On Error GoTo ERR_GetProcessTree
 
    Dim hSnapShot As Long
    Dim hProcess As Long
    Dim uProcessEntry As PROCESSENTRY32
    Dim lSuccess As Long
    Dim ProcessTree() As PROCESS_TREE
    Dim lCtr As Long
    
    '************************************************************
    '* Get a snapshot of all of the processes in the system . . .
    '************************************************************
    hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    
    '***********************************************
    '* If we don't have a snapshot then finish . . .
    '***********************************************
    If hSnapShot = INVALID_HANDLE_VALUE Then
        Err.Raise vbObjectError + 512, , "Unable To Get Process Snapshot"
    Else
    
        '*********************************
        '* Get first process in list . . .
        '*********************************
        uProcessEntry.dwSize = Len(uProcessEntry)
        lSuccess = ProcessFirst(hSnapShot, uProcessEntry)
        
        If lSuccess = WINAPI_TRUE Then
        
            lCtr = 0
            
            '**********************************
            '* Loop through all processes . . .
            '**********************************
            Do Until lSuccess <> WINAPI_TRUE
            
                ReDim Preserve ProcessTree(lCtr)
                With ProcessTree(lCtr)
                    .ParentProcessId = uProcessEntry.th32ParentProcessID
                    .ProcessId = uProcessEntry.th32ProcessID
                    
                    Debug.Print .ParentProcessId, .ProcessId, Replace(uProcessEntry.szexeFile, Chr(0), vbNullString)
                    
                End With
                
                
                
                lCtr = lCtr + 1
                lSuccess = ProcessNext(hSnapShot, uProcessEntry)
                
            Loop
        
        Else
            Err.Raise vbObjectError + 512, , "Unable To Get First Process In Snapshot"
        End If
    
    End If
    
    '********************************
    '* Release handle resources . . .
    '********************************
    CloseHandle (hSnapShot)
    
    GetProcessList = ProcessTree
    Exit Function
    
ERR_GetProcessTree:
 
    CloseHandle (hSnapShot)
    Err.Raise Err.Number, Err.Source, Err.Description
    
End Function