DLL parametri UDT

MircoSoft

il 08 set 2022, 09:09

8 risposte

MircoSoft

Pochi posts

Iscritto da: apr, 2020

Messaggi:: 44

DLL parametri UDT

08 set 2022, 09:55

Salve

Vorrei creare una DLL Activex con VB6 che contenga una funzione che accetti come parametro in ingresso
una struttura dati personalizzata creata da un programma anch'esso da un programma VB6

Qualcuno può indicarmi la sintassi corretta
-per la definizione della funzione all'interno della DLL
-per il suo richiamo all'interno del programma VB6

P.S. Il caricamento della DLL all'interno del programma VB6 avverrà in maniera dinamica a RunTime
con CreateObject("nomeDll.nomeClasse")

8 Risposte

O
oregon
Super Famoso
Iscritto da
nov, 2011
Messaggi:
21791
Re: DLL parametri UDT
08 set 2022, 11:27
Hai già fatto qualcosa? Qualche prova? O attendi tutto il codice?
M
MircoSoft
Pochi posts
Iscritto da
apr, 2020
Messaggi:
44
Re: DLL parametri UDT
08 set 2022, 11:37
Ho già creato la DLL con funzioni e parametri semplici e riesco ad utilizzarle dal programma

Mi da errori di compilazione quando cerco di definire una funzione con parametro complesso (UDT)
O
oregon
Super Famoso
Iscritto da
nov, 2011
Messaggi:
21791
Re: DLL parametri UDT
08 set 2022, 12:12
Il tipo UDT mettilo in un modulo .BAS

Rendi Friend il metodo della DLL che accetta l'UDT

MircoSoft

Pochi posts

Iscritto da: apr, 2020

Messaggi:: 44

Re: DLL parametri UDT

08 set 2022, 13:52

Nel progetto DLL Activex nella Classe ho inserito il seguente codice:


Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Private Sub Class_Initialize()
    '//#
End Sub

Private Sub Class_Terminate()
    '//#
End Sub
'//###########################################################################################
'//# Debug Functions
'//###########################################################################################
Public Function ProvaRichiamo() As Boolean
    Call MsgBox("Prova Richiamo DLL", vbOKOnly)
    ProvaRichiamo = True
End Function

Public Function ProvaRichiamoConParametri(ByVal Par1 As Integer) As Boolean
    Call MsgBox("Prova Richiamo DLL Par1:" & Str(Par1), vbOKOnly)
    ProvaRichiamoConParametri = True
End Function

Friend Function ProvaRichiamoConParametriUDT(Par1 As STRUCT_PRODUCT_INFO) As Boolean
    Call MsgBox("Prova Richiamo DLL Par1:" & Str(Par1.ProductID), vbOKOnly)
    Call MsgBox("Prova Richiamo DLL Par2:" & Par1.ProductCode, vbOKOnly)
    Call MsgBox("Prova Richiamo DLL Par3:" & Par1.ProductDescription, vbOKOnly)
    ProvaRichiamoConParametriUDT = True
End Function

Public Function ProvaRichiamoConParametriPtrUDT(ByVal PointerPar1 As Long) As Boolean
    Dim stLocalProductInfo As STRUCT_PRODUCT_INFO
    Call CopyMemory(stLocalProductInfo, ByVal PointerPar1, LenB(stLocalProductInfo))
    Call MsgBox("Prova Richiamo DLL Par1:" & Str(stLocalProductInfo.ProductID), vbOKOnly)
    Call MsgBox("Prova Richiamo DLL Par2:" & StrConv(Trim(stLocalProductInfo.ProductCode), vbFromUnicode), vbOKOnly)
    Call MsgBox("Prova Richiamo DLL Par3:" & StrConv(Trim(stLocalProductInfo.ProductDescription), vbFromUnicode), vbOKOnly)
    ProvaRichiamoConParametriPtrUDT = True
End Function

Nel programma VB6 che Utilizzerà la DLL il seguente


    Set dllXgvMesInterface = Nothing
    Set dllXgvMesInterface = CreateObject("XgvMesInterface.clsXgvMesInterface")
    Call dllXgvMesInterface.ProvaRichiamo
    Call dllXgvMesInterface.ProvaRichiamoConParametri(5)
    stProductInfo.ProductID = 11
    stProductInfo.ProductCode = "11"
    stProductInfo.ProductDescription = "Descrizione Prodotto 11"
    Call dllXgvMesInterface.ProvaRichiamoConParametriUDT(stProductInfo)
    Call dllXgvMesInterface.ProvaRichiamoConParametriPtrUDT(VarPtr(stProductInfo))

mentre entrambi i progetti definiscono


'//#############################################################################################
'//# Struttura Info Prodotti (ridotta)
'//#############################################################################################
Public Type STRUCT_PRODUCT_INFO
    ProductID               As Integer
    ProductCode             As String
    ProductDescription      As String
End Type
'//#############################################################################################

LA DLL viene creata senza errori
Nel programma VB6 continuo ad avere l'errore:

Solo i tipi definiti dall'utente in moduli di oggetto pubblici possono essere assegnati a o una variabile Variant oppure passati a funzioni per cui è prevista l'associazione tardiva.

sul parametro della funzione ProvaRichiamoConParametriUDT

M
MircoSoft
Pochi posts
Iscritto da
apr, 2020
Messaggi:
44
Re: DLL parametri UDT
09 set 2022, 12:05
Continuando con i test utilizzando
Call dllXgvMesInterface.ProvaRichiamoConParametriPtrUDT(VarPtr(stProductInfo))
Riesco a passare la Struttura (anche se per le stringhe va eseguita una conversione)

Se però aggiungo un secondo parametro UDT in esecuzione mi da un RunTime Error "Automation Error"

Esiste un limite alla dimensione della struttura UDT?

MircoSoft

Pochi posts

Iscritto da: apr, 2020

Messaggi:: 44

Re: DLL parametri UDT

11 ott 2022, 15:20

Sto ancora Litigando con Gli UDT

In una Classe del Programma VB6 ho il seguente Codice


Private Sub Class_Initialize()
	Set dllXgvMesInterface = Nothing
	Set dllXgvMesInterface = CreateObject("XgvMesInterface.clsXgvMesInterface")
End Sub

Private Sub Class_Terminate()
	If (Not (dllXgvMesInterface Is Nothing)) Then
		Set dllXgvMesInterface = Nothing
	End If
End sub

Private Function ImpostaStatoParcheggio(EnableExport As Boolean) As Boolean
	Dim iIndex 					As Integer
	Dim strReturned				As String
	Dim stProductInfo           As STRUCT_PRODUCT_INFO
	
	For iIndex = 1 To Parcheggio(0).NumeroPiazza
		stProductInfo.ProductID = 1
		stProductInfo.ProductCode = "0001"
		stProductInfo.ProductDescription = "Prova Codice 0001"

		stParkInfoForMes = Parcheggio(iIndex)
		stProductInfoForMes = stProductInfo

		strReturned = dllXgvMesInterface.ImpostaStatoParcheggio_InsertQuery(VarPtr(stParkInfoForMes), _
                                                                            stProductInfo.ProductID, _
                                                                            stProductInfo.ProductCode, _
                                                                            stProductInfo.ProductDescription, _
                                                                            XGV_ParkStatesTable)
	Next iIndex
End Function

In un Modulo (.Bas) del programma VB6 Ho il Seguente Codice


Public Type STRUCT_PRODUCT_INFO
    ProductID               As Integer
    ProductCode             As String
    ProductDescription      As String
End Type
Public stProductInfoForMes As STRUCT_PRODUCT_INFO     '//# UDT Dettagli Prodotto per Passaggio a DLLMesInterface - '//#Mirco 2022_09_10
 
Public Type STRUCT_PARCHEGGIO
    IdZona 								As Integer                   
    NomeZona 							As String                  
    NumeroPiazza 						As Integer             
    Abilitazione 						As Boolean             
    TipoPiazza 							As String                
    PrelevaDa 							As Integer                
    TrasferisciA 						As Integer             
    PrelevaDopo 						As Integer              
    DepositaPrima 						As Integer            
    PuntoPrelievo 						As Integer            
    Piano        						As Integer             
    PuntoDeposito   					As Integer          
    QuotaPrelievo 						As Integer            
    QuotaDeposito 						As Integer            
    UltimoMovimentoPz 					As Date           
    IdSupporto 							As Integer               
    NomeSupporto 						As String              
    ColoreSupporto 						As Long              
    NumBox 								As Integer                   
    IdProdotto 							As Integer               
    CodiceProdotto 						As String            
    DescProdotto 						As String              
    ColoreProdotto 						As Long              
    IdFase 								As Integer                   
    DescrFase 							As String                 
    ColoreFase 							As Long                  
    CodiceTrasporto 					As String           
    UnitaMisura 						As String               
    Quantita 							As Long                    
    Altezza 							As Integer                  
    UltimoMovimentoBox 					As Date          
    Creazione 							As Date                   
    Prenotata 							As Boolean                
    SupportiAmmessi() 					As Integer        
    PiazzaNonAccessibile 				As Boolean
    IdMacchina 							As Integer               
    ContatoreTabella 					As Integer         
    IdFaseDefault 						As Integer            
    Ch_Prelievo 						As Integer              
    Mask_Prelievo 						As Integer            
    Value_Prelievo 						As Integer           
    Ch_Deposito 						As Integer              
    Mask_Deposito 						As Integer            
    Value_Deposito 						As Integer           
    Ch_ResetOp 							As Integer               
    Mask_ResetOp 						As Integer             
    Value_ResetOp 						As Integer            
    Ch_CambioProduzione 				As Integer      
    Mask_CambioProduzione 				As Integer    		
    Value_CambioProduzione 				As Integer   
    Ch_ResetProduzione 					As Integer       
    Mask_ResetProduzione 				As Integer     
    Value_ResetProduzione 				As Integer    
    Id_Programma          				As Integer    
    Precedenza_Op         				As Integer    
    Tipo_Cambio_Prod      				As Integer    
    ChiamataForzata 					As Boolean          
    OperDiStartCiclo 					As Long            
    Giracontenitore     				As Boolean
    Value_PermessoAccesso   			As Integer  
    Ch_Nr_PezziBox          			As Integer  
    Value_Nr_PezziBox       			As Long     
    MqPerBox                			As Single   
    PiazzaADx 							As Integer
    PiazzaASx 							As Integer
    PiazzeAdiacenti() 					As Integer
    Ch_Fine_Ciclo_Deposito 				As Integer                 
    Mask_Fine_Ciclo_Deposito 			As Long                  
    Value_Fine_Ciclo_Deposito 			As Integer              
    Ch_Fine_Ciclo_Prelievo 				As Integer                 
    Mask_Fine_Ciclo_Prelievo 			As Long                  
    Value_Fine_Ciclo_Prelievo 			As Integer
    Ch_Tipo_Supporto 					As Integer         
    Mask_Tipo_Supporto 					As Long          
    Value_Tipo_Supporto 				As Integer      
    Tag 								As String
    TempoEssiccazione 					As Integer                
    Ch_CaricoScarico982 				As Integer
    Mask_CaricoScarico982 				As Integer
    Value_CaricoScarico982 				As Integer
    Ch_LetturaPianiTecnoF 				As Integer             
    Mask_LetturaPianiTecnoF 			As Integer
    Value_LetturaPianiTecnoF 			As Integer
    Ch_ScritturaPianiTecnoF 			As Integer           
    Mask_ScritturaPianiTecnoF 			As Integer
    Value_ScritturaPianiTecnoF 			As Integer
    Incompleto      					As Boolean
    CodiceScelta    					As Integer
    TipoChiamata    					As Integer
End Type
Public Parcheggio() As STRUCT_PARCHEGGIO    	
Public stParkInfoForMes As STRUCT_PARCHEGGIO    '//# UDT Piazza per Passaggio a DLLMesInterface

Nella Classe della Dll Activex ho il seguente Codice


Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

'//###########################################################################################
'//# Aggiornamento Stato Parcheggio
'//###########################################################################################
Public Function ImpostaStatoParcheggio_InsertQuery(ByRef stParkPlacePtr As Long, _
                                                   ByVal ProductID As Integer, _
                                                   ByVal ProductCode As String, _
                                                   ByVal ProductDescription As String, _
                                                   ByVal XGV_ParkStatesTable As String) As String
    On Error GoTo gestErrore
    Dim stLocalParkInfo         As STRUCT_PARCHEGGIO
    
    Call CopyMemory(stLocalParkInfo, ByVal stParkPlacePtr, LenB(stLocalParkInfo))

        '*********************Log temporaneo per debug
    Dim n As Integer
    n = FreeFile
    Open "C:\Temp\TestImpostaStatoParcheggio_InsertQuery.txt" For Append As #n
        Print #n, "***********************"
        Print #n, "Piazza: "; Str(stLocalParkInfo.NumeroPiazza)
        Print #n, " -->"; "Zona di appartenenza ID:"; Str(stLocalParkInfo.IdZona)
        'Print #n, " -->"; "Zona di appartenenza Nome:"; stLocalParkInfo.NomeZona
        'Print #n, " -->"; "Abilitazione utilizzo della piazza:"; Str(CInt(stLocalParkInfo.Abilitazione))
        'Print #n, " -->"; "Tipo di piazza:"; stLocalParkInfo.TipoPiazza
        Print #n, " -->"; "PrelevaDa:"; Str(stLocalParkInfo.PrelevaDa)
        Print #n, " -->"; "TrasferisciA:"; Str(stLocalParkInfo.TrasferisciA)
        Print #n, " -->"; "PrelevaDopo:"; Str(stLocalParkInfo.PrelevaDopo)
        Print #n, " -->"; "DepositaPrima:"; Str(stLocalParkInfo.DepositaPrima)
        Print #n, " -->"; "PuntoPrelievo:"; Str(stLocalParkInfo.PuntoPrelievo)
        Print #n, " -->"; "Piano:"; Str(stLocalParkInfo.Piano)
        Print #n, " -->"; "PuntoDeposito:"; Str(stLocalParkInfo.PuntoDeposito)
        Print #n, " -->"; "QuotaPrelievo:"; Str(stLocalParkInfo.QuotaPrelievo)
        Print #n, " -->"; "QuotaDeposito:"; Str(stLocalParkInfo.QuotaDeposito)
    Close #n
    '***************************************
    ImpostaStatoParcheggio_InsertQuery = "Prova"
    Exit Function
gestErrore:
    ImpostaStatoParcheggio_InsertQuery = ""
    MsgBox ("Errore: " & Str(Err.Number) & "-" & Err.Description)
    '//#ToDo: Make Log
End Function

In un Modulo (.Bas) della Dll Activex VB6 Ho il Seguente Codice


Public Type STRUCT_PARCHEGGIO
    IdZona 								As Integer                   
    NomeZona 							As String                  
    NumeroPiazza 						As Integer             
    Abilitazione 						As Boolean             
    TipoPiazza 							As String                
    PrelevaDa 							As Integer                
    TrasferisciA 						As Integer             
    PrelevaDopo 						As Integer              
    DepositaPrima 						As Integer            
    PuntoPrelievo 						As Integer            
    Piano        						As Integer             
    PuntoDeposito   					As Integer          
    QuotaPrelievo 						As Integer            
    QuotaDeposito 						As Integer            
    UltimoMovimentoPz 					As Date           
    IdSupporto 							As Integer               
    NomeSupporto 						As String              
    ColoreSupporto 						As Long              
    NumBox 								As Integer                   
    IdProdotto 							As Integer               
    CodiceProdotto 						As String            
    DescProdotto 						As String              
    ColoreProdotto 						As Long              
    IdFase 								As Integer                   
    DescrFase 							As String                 
    ColoreFase 							As Long                  
    CodiceTrasporto 					As String           
    UnitaMisura 						As String               
    Quantita 							As Long                    
    Altezza 							As Integer                  
    UltimoMovimentoBox 					As Date          
    Creazione 							As Date                   
    Prenotata 							As Boolean                
    SupportiAmmessi() 					As Integer        
    PiazzaNonAccessibile 				As Boolean
    IdMacchina 							As Integer               
    ContatoreTabella 					As Integer         
    IdFaseDefault 						As Integer            
    Ch_Prelievo 						As Integer              
    Mask_Prelievo 						As Integer            
    Value_Prelievo 						As Integer           
    Ch_Deposito 						As Integer              
    Mask_Deposito 						As Integer            
    Value_Deposito 						As Integer           
    Ch_ResetOp 							As Integer               
    Mask_ResetOp 						As Integer             
    Value_ResetOp 						As Integer            
    Ch_CambioProduzione 				As Integer      
    Mask_CambioProduzione 				As Integer    		
    Value_CambioProduzione 				As Integer   
    Ch_ResetProduzione 					As Integer       
    Mask_ResetProduzione 				As Integer     
    Value_ResetProduzione 				As Integer    
    Id_Programma          				As Integer    
    Precedenza_Op         				As Integer    
    Tipo_Cambio_Prod      				As Integer    
    ChiamataForzata 					As Boolean          
    OperDiStartCiclo 					As Long            
    Giracontenitore     				As Boolean
    Value_PermessoAccesso   			As Integer  
    Ch_Nr_PezziBox          			As Integer  
    Value_Nr_PezziBox       			As Long     
    MqPerBox                			As Single   
    PiazzaADx 							As Integer
    PiazzaASx 							As Integer
    PiazzeAdiacenti() 					As Integer
    Ch_Fine_Ciclo_Deposito 				As Integer                 
    Mask_Fine_Ciclo_Deposito 			As Long                  
    Value_Fine_Ciclo_Deposito 			As Integer              
    Ch_Fine_Ciclo_Prelievo 				As Integer                 
    Mask_Fine_Ciclo_Prelievo 			As Long                  
    Value_Fine_Ciclo_Prelievo 			As Integer
    Ch_Tipo_Supporto 					As Integer         
    Mask_Tipo_Supporto 					As Long          
    Value_Tipo_Supporto 				As Integer      
    Tag 								As String
    TempoEssiccazione 					As Integer                
    Ch_CaricoScarico982 				As Integer
    Mask_CaricoScarico982 				As Integer
    Value_CaricoScarico982 				As Integer
    Ch_LetturaPianiTecnoF 				As Integer             
    Mask_LetturaPianiTecnoF 			As Integer
    Value_LetturaPianiTecnoF 			As Integer
    Ch_ScritturaPianiTecnoF 			As Integer           
    Mask_ScritturaPianiTecnoF 			As Integer
    Value_ScritturaPianiTecnoF 			As Integer
    Incompleto      					As Boolean
    CodiceScelta    					As Integer
    TipoChiamata    					As Integer
End Type

Se Eseguo il programma e Richiamo la funzione ImpostaStatoParcheggio della classe

Funziona per i primi 2 cicli e al terzo passaggio mi si chiude l'ambiente VB6 senza dare errori

Dimentico qualche passaggio tra una chiamata e l'altra?

O
oregon
Super Famoso
Iscritto da
nov, 2011
Messaggi:
21791
Re: DLL parametri UDT
22 ott 2022, 12:23
Usa una classe apposita con le proprietà che ti servono e non un UDT.

Crea un oggetto di questa classe da passare come parametro.
M
MircoSoft
Pochi posts
Iscritto da
apr, 2020
Messaggi:
44
Re: DLL parametri UDT
16 nov 2022, 13:59
Questa era la soluzione che volevo evitare...

Volevo evitare di riversare UNO per UNO i dati dall'UDT ad una classe di passaggio
prima di richiamare la funzione della DLL

Visto che la DLL verrebbe rifatta Cliente per Cliente sarebbe più conveniente creare
la funzione da richiamare con tutti i parametri per ospitare i dati dell' UDT...

Speravo in una soluzione che mi evitasse di dover creare una funzione con così tanti parametri

Devi accedere o registrarti per scrivere nel forum

8 risposte