Hvordan hente verdier fra dll-filer?

[Blaster2k]

Hei

Jeg vet ikke hvordan jeg kan skrive dette mer utfyllende. Men er det noen som kan si meg hvordan man henter/leser verdier fra dll-filer i VB 6? Kan ikke legge til henvisning til dll-filen: "Can't add reference to the specified file."

Endret 3. juli 2006 av Blaster2k

[GeirGrusom]

Det kan være fordi det ikke er en COM/ActiveX dll

Da må du bruke Declare Function/Sub eller bruke LoadLibrary (men LoadLibrary fungerer ikke i VB6 så det er bare å glemme, og jeg tror ikke det fungerer i VB.NET heller)

[aadnk]

(men LoadLibrary fungerer ikke i VB6 så det er bare å glemme, og jeg tror ikke det fungerer i VB.NET heller)

6456104[/snapback]

Det er faktisk mulig i VB6 - du får da sågar benytte ulike calling conventions. Legg følgende i en klassemodul:

Skjult tekst: (Marker innholdet i feltet for å se teksten):

Option Explicit

 

' Nødvendige API-funksjoner

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName 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

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)

 

Public Enum DECLSPEC

    eStdCall

    eCDecl

End Enum

 

Private m_lParameters() As Long   ' List of parameters

Private m_lpFn As Long           ' Address of function to call

Private m_abCode() As Byte       ' Buffer for assembly code

Private m_lCP As Long             ' Used to keep track of latest byte added to code

Private m_hLib As Long

Private m_CallType As DECLSPEC

 

Public Property Let LibraryName(ByVal sData As String)

 

    If m_hLib Then

        FreeLibrary m_hLib

    End If

   

    m_hLib = LoadLibrary(CStr(sData))

   

    If m_hLib = 0 Then

        MsgBox "Can not find library " & Chr(34) & sData & Chr(34), _

        vbCritical, "Function call error"

    End If

 

End Property

 

Public Property Let FunctionName(ByVal sData As String)

 

    Dim sMsg As String

   

    m_lpFn = GetProcAddress(m_hLib, CStr(sData))

   

    If m_lpFn = 0 Then

        sMsg = "Can not find function entry point for " & Chr(34) & sData & Chr(34)

        sMsg = sMsg & vbCrLf & "Note: function names are case sensitive, check out you function spelling!"

        MsgBox sMsg, vbCritical, "Function call error"

    End If

 

End Property

 

Public Property Let CallType(ByVal lData As DECLSPEC)

   

    m_CallType = lData

 

End Property

 

Public Function CallFunction(ParamArray FuncParams() As Variant) As Long

 

    Dim i As Long

   

    If m_lpFn = 0 Then

        MsgBox "Function not defined!", vbCritical, "Call function error"

        Exit Function

    End If

   

    ReDim m_abCode(0)

    ReDim m_lParameters(UBound(FuncParams) + 1)

    ReDim m_abCode(18 + 32 + 6 * UBound(m_lParameters))

   

    For i = 1 To UBound(m_lParameters)

   

        Select Case VarType(FuncParams(i - 1))

            Case vbString

                m_lParameters(i) = StrPtr(FuncParams(i - 1))

            Case vbObject

                m_lParameters(i) = ObjPtr(FuncParams(i - 1))

            Case Else

                m_lParameters(i) = CLng(FuncParams(i - 1))

        End Select

       

    Next

   

    CallFunction = CallWindowProc(PrepareCode, 0, 0, 0, 0)

 

End Function

 

Private Function PrepareCode() As Long

 

    Dim i As Long, codeStart As Long

   

    codeStart = GetAlignedCodeStart(VarPtr(m_abCode(0)))

    m_lCP = codeStart - VarPtr(m_abCode(0))

   

    For i = 0 To m_lCP - 1

    m_abCode(i) = &HCC

    Next

   

    PrepareStack

   

    For i = UBound(m_lParameters) To 1 Step -1

    AddByteToCode &H68 'push wwxxyyzz

    AddLongToCode m_lParameters(i)

    Next

   

    AddCallToCode m_lpFn

    If m_CallType = eCDecl Then ClearStack

   

    AddByteToCode &HC3

    AddByteToCode &HCC

    PrepareCode = codeStart

 

End Function

 

Private Sub AddCallToCode(ByVal dwAddress As Long)

 

    AddByteToCode &HE8

    AddLongToCode dwAddress - VarPtr(m_abCode(m_lCP)) - 4

 

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)

   

    m_abCode(m_lCP) = byt

    m_lCP = m_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 If

 

End Function

 

Private Sub PrepareStack()

 

    AddByteToCode &H58 'pop eax -  pop return address "first"

    AddByteToCode &H59 'pop ecx -  kill hwnd

    AddByteToCode &H59 'pop ecx -  kill wmsg

    AddByteToCode &H59 'pop ecx -  kill wParam

    AddByteToCode &H59 'pop ecx -  kill lParam

    AddByteToCode &H50 'push eax - put return address back "out"

 

End Sub

 

Private Sub ClearStack()

 

    Dim i As Long

   

    For i = 1 To UBound(m_lParameters)

        AddByteToCode &H59 'pop ecx - remove params from stack

    Next

 

End Sub

 

Private Sub Class_Initialize()

 

    m_CallType = eStdCall

 

End Sub

 

Private Sub Class_Terminate()

 

    If m_hLib Then

        FreeLibrary m_hLib

    End If

 

End Sub

Dernest kan en benytte klassemodulen således:

    ' Deklarer nødvendig klassemodul

    Dim cFunc As New cFuncCall

   

    ' Endre dette dersom CDecl ikke går/er inkorrekt

    cFunc.CallType = eCDecl

 

    ' Skriv inn navnet på DLL-filen (bør være plassert i en kjent mappe)

    cFunc.LibraryName = "din_fil.dll"

   

    ' Navnet på funksjonen du ønsker å kalle

    cFunc.FunctionName = "funksjonsnavn"

   

    ' Kaller funksjon her (bruk riktig antall paramenter med de riktige typer)

    cFunc.CallFunction "en paramenter", "en annen", 42

 

Men såklart, dersom funksjonen du ønsker å kalle anvender StdCall, er det ikke nødvendig med all den koden ovenfor. Da kan du nok bare deklarere den med den innebyggede API-funksjonaliteten i VB.