Link to home
Create AccountLog in
Avatar of RobertNZana
RobertNZanaFlag for United States of America

asked on

How dynamically put path in DECLARE

At the top of my code I am referencing a DLL like this...

Declare Function FilePageCount Lib "F:\work-related\websites\MyWebsite\bin\AmPageInfo.dll" Alias "AmFilePageCount" (ByVal lpBuffer As String) As Integer

This is on my dev machine.  When I move it to production I'm going to have a different DLL path.  How can I DYNAMICALLY create the path to the DLL, such as by referencing an appsetting in the web.config?

Thanks!
ASKER CERTIFIED SOLUTION
Avatar of nmarun
nmarun
Flag of India image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Avatar of RobertNZana

ASKER

I get the message "String constant expected." for DllFilePath in the Declare Function...


Dim DllFilePath As String = System.Configuration.ConfigurationManager.AppSettings("DllFilePath")
 
Declare Function FilePageCount Lib DllFilePath Alias "AmFilePageCount" (ByVal lpBuffer As String) As Integer
 
Protected Sub cmdUpload_Click(.....

Open in new window

See if you can declare DLLFilePath as a const;

Const DllFilePath As String

Open in new window

SOLUTION
Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
I thought that just dropping it in the bin was enough, but I guess it's not huh?
Avatar of Ark
See my sample at http://www.freevbcode.com/ShowCode.asp?ID=1863
Regards
Ark
Can you paste the relavent code for me?  Thanks.
'===========module code=========
Option Explicit

Public Enum ARG_FLAG
   arg_Value
   arg_Pointer
End Enum

'Structure for passing parameters in remote API calls
Public Type API_DATA
   lpData       As Long      'Pointer to data or real data
   dwDataLength As Long      'Data length
   argType      As ARG_FLAG  'ByVal or ByRef?
   bOut         As Boolean   'Is this argument [OUT]? If True,
                             'lpData will be filled with [out] data
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Dim abAsm() As Byte 'buffer for assembly code
Dim lCP As Long     'used to keep track of latest byte added to assembly code

Public Function CallAPIByName(ByVal LibName As String, ByVal FuncName As String, _
                             ByVal nParams As Long, data() As API_DATA) As Long
   Dim hLib As Long, fnAddress As Long
   Dim bNeedUnload As Boolean
   Dim i As Long
   Dim codeStart As Long
     
   hLib = GetModuleHandle(LibName)
   If hLib = 0 Then
      hLib = LoadLibrary(LibName)
      If hLib = 0 Then
         MsgBox "Error loading library " & LibName & ".", vbCritical, "CallAPILocal"
         Exit Function
      End If
      bNeedUnload = True
   End If
   
   fnAddress = GetProcAddress(hLib, FuncName)
   If fnAddress Then
      ReDim abAsm(50 + 6 * nParams)
      codeStart = GetAlignedCodeStart(VarPtr(abAsm(0)))
      lCP = codeStart - VarPtr(abAsm(0))
      For i = 0 To lCP - 1
          abAsm(i) = &HCC
      Next
      PrepareStack 4
      For i = nParams To 1 Step -1
          AddByteToCode &H68 'push wwxxyyzz
          AddLongToCode data(i - 1).lpData
      Next
      AddCallToCode fnAddress, VarPtr(abAsm(lCP)) + 1
      AddByteToCode &HC3
      AddByteToCode &HCC
      CallAPIByName = CallWindowProc(codeStart, 0, 0, 0, 0)
   Else
      MsgBox "Can not find entry point for " & FuncName & " in " & LibName & ".", vbCritical, "CallAPILocal"
   End If
   If bNeedUnload Then Call FreeLibrary(hLib)
End Function

'============Private routines to prepare asm (op)code===========
Private Sub AddCallToCode(ByVal dwAddress As Long, ByVal BaseAddr As Long)
    AddByteToCode &HE8
    AddLongToCode dwAddress - BaseAddr - 5
End Sub

Private Sub AddLongToCode(ByVal lng As Long)
    Dim i As Integer
    Dim byt(3) As Byte
    CopyMemory byt(0), lng, 4
    For i = 0 To 3
        AddByteToCode byt(i)
    Next
End Sub

Private Sub AddByteToCode(ByVal byt As Byte)
    abAsm(lCP) = byt
    lCP = lCP + 1
End Sub

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

Private Sub PrepareStack(ByVal numParamsToRemove As Long)
    If numParamsToRemove = 0 Then Exit Sub
    Dim i As Long
    AddByteToCode &H58     'pop eax -  pop return address
    For i = 1 To numParamsToRemove
        AddByteToCode &H59 'pop ecx -  kill param
    Next i
    AddByteToCode &H50     'push eax - put return address back
End Sub

'========form code =======
'An example calling MessageBoxA API
Private Sub Command1_Click()
   Debug.Print CallMessageBoxA("Hello world!", "ApiByName", vbInformation)
End Sub

Private Function CallMessageBoxA(ByVal sPrompt As String, ByVal sTitle As String, ByVal msgBoxstyle As vbmsgBoxstyle) As VbMsgBoxResult
   Dim dt(3) As API_DATA 'this APi require 4 params
   Dim s As String
'Prepare parameters
'hWnd - first param
   With dt(0)
      .argType = arg_Value
      .lpData = 0
      .dwDataLength = 4
   End With
'Prompt - second param
   s = sPrompt & Chr(0)
   abString = StrConv(s, vbFromUnicode)
   With dt(1)
      .argType = arg_Pointer
      .lpData = VarPtr(abString(0))
      .dwDataLength = Len(s)
   End With
'Title third param
   s = sTitle & Chr(0)
   abString1 = StrConv(s, vbFromUnicode)
   With dt(2)
      .argType = arg_Pointer
      .lpData = VarPtr(abString1(0))
      .dwDataLength = Len(s)
   End With
'Style - forth pram
   With dt(3)
      .argType = arg_Value
      .lpData = msgBoxstyle
      .dwDataLength = 4
   End With
   If pid > 0 Then AppActivate pid
'Call function
   CallMessageBoxA = CallAPIByName("user32", "MessageBoxA", 4, dt)
End Function
SOLUTION
Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account