Solved

Activex controls and VB modules

Posted on 2002-03-03
9
660 Views
Last Modified: 2013-11-13
Hi all

I'm writing a module that I intend to be portable.  However I want to call a activex control -  winsock (mswinsck.ocx) but I don't know how to declare it in a module with out having a form and placing the control in it.

My aim is to have one module that contains all the code.  At the moment I have a module that contains most of the code and a form that contains the activex control, winsock and the Winsock1_DataArriva subroutine,  is there anyway to have it all in one module?
0
Comment
Question by:philipw
  • 4
  • 2
  • 2
  • +1
9 Comments
 

Expert Comment

by:grafe
ID: 6838409
Have you tried using the CreateObject method as in the ff example:

Dim xlApp As Object   ' Declare variable to hold the reference.
   
Set xlApp = CreateObject("excel.application")
   ' You may have to set Visible property to True
   ' if you want to see the application.
xlApp.Visible = True
   ' Use xlApp to access Microsoft Excel's
   ' other objects.
xlApp.Quit   ' When you finish, use the Quit method to close
Set xlApp = Nothing   ' the application, then release the reference.

Just make sure you include the OCX in your Project/References.

0
 
LVL 17

Expert Comment

by:inthedark
ID: 6838745
You can achiev this using dummy forms within your class module.

Here is an example of how to use a control from a form in a class module.

http://www.freevbcode.com/ShowCode.Asp?ID=109

The above example sends emails.

In this example in the class module decs. a Winsok control is delcared:

Private WithEvents sckMail      As Winsock

The actual winsock control (WinSck) which is located on a form (frmSck) within the project of the class module that is never displayed.

In the Class_Initialize event the sckMail is linked to a Winsock control on the form.

Private Sub Class_Initialize()
    ' instantiate the Winsock Control
    Set sckMail = frmSck.WinSck

etc...


So in summary the key thing are:

1)

Private WithEvents sckMail      As Winsock

2)

Private Sub Class_Initialize()
    ' instantiate the Winsock Control
    Set sckMail = frmSck.WinSck
End Sub


Now in you class the control behaves as if it is located on a form; you get evnts and control its properties and methods as normal.  But try to avoid controls that interact with the user.

If you need any more info please ask...

0
 
LVL 17

Expert Comment

by:inthedark
ID: 6838759
But if you want to create the Winsock in thin air you may find that there is a better way to do this.

In this case I use the Sockets directly.  But the sockets example in the vbSendMail is no good because it may cause you application to crash as the sockets are used in a blocking mode - here it gets a bit complicated.

But you may also know that all Classes have hidden undocumented Internet features, like Async downloads, etc.

So depending on your application, before investigating thin air Winsock controls what do you need to do?


0
 

Expert Comment

by:kolip
ID: 6838932
you could place the Winsock control on a form, make the form hidden and from the module load the form and access the control
say the form is named form1, and the control's name is Sock1,
then within the module, the following code

dim WinSck as Winsock

Sub Loader
load form1
set WinSck =  form1.Sock1
with WinSck
'' then you can access the conrol
''
''
end With
end sub




0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Expert Comment

by:kolip
ID: 6838977
if you don't want to make use of a form at all, you could try loading the WinSock control from within your module

dim WinSck as WinSock

Sub Loader
load WinSck

With  WinSck
' Access the loaded control

end With


end sub
0
 

Author Comment

by:philipw
ID: 6839919
inthedark,
If I read your comment correctly you still need a form.  If I am wrong could you please explain some more


kolip,
I tried your comment, but was unable to get it to work can you offer any more assistance




Does this question need points?
0
 
LVL 17

Accepted Solution

by:
inthedark earned 50 total points
ID: 6840895
philipw, in the sample application vbSendMail, it shows how use a winsock control using a form, which is not what you want, despite that the form is only in your class and transparent to your application. But also the sample shows how to use Windows Sockets, which don't need a form.

See the subroutine MXQuery, there were some bugs in the code as the code used Blocking Sockets, which could cause your system to hang.  I converted these to use non-blocking sockets as follows:

(I added a Logit subroutine to help find where the code was failing.)


So in summary:


    ' Initialize the Winsock, request v1.1
    WSAStartup - Initialize the Winsock
       
    ' find IP address
    IpAddr = GetHostByNameAlias
   
    ' Setup the connnection parameters
    SocketBuffer.sin_family = AF_INET
    SocketBuffer.sin_port = htons(53)
    SocketBuffer.sin_addr = IpAddr
    SocketBuffer.sin_zero = String$(8, 0)
   
    connect - conected to a host
    iSock = socket(AF_INET, SOCK_DGRAM, 0) ' open un reliable datagram protocol
  '  iSock = socket(AF_INET, SOCK_STREAM, 0) ' stream protocol
       
    sendto - send data to a host
    ioctlsocket - Set no blocking mode
    recvfrom - wait for a response
    recv ' listen for data from a connection
    send ' send data to a connection
    closesocket - close one socket
    WSACleanup - close sockets session


here is the full code:


Public Function MX_Query(ByVal ms_Domain As String) As String
   
    ' Performs the actual IP work to contact the DNS server,
    ' calls the other functions to parse and return the
    ' best server to send email through
   
    Dim StartupData     As WSADATA
    Dim SocketBuffer    As SOCKADDR
    Dim IpAddr          As Long
    Dim iRC             As Integer
    Dim dnsHead         As DNS_HEADER
    Dim iSock           As Integer
    Dim dnsQuery()      As Byte
    Dim sQName          As String
    Dim dnsQueryNdx     As Integer
    Dim iTemp           As Integer
    Dim iNdx            As Integer
    Dim dnsReply(2048)  As Byte
    Dim iAnCount        As Integer
    Dim dwFlags         As Long
    Dim starting As Date
    Dim STARTER As Long
    Dim linger As LINGER_STRUCT
    Dim lResult2 As Long
    Dim rcv As Long

    MX.Count = 0
    MX.Best = vbNullString
    ReDim MX.List(0)

    ' if DNSInfo hasn't been called, call it now
    If DNS.Count = 0 Then GetDNSInfo
   
    ' check to see that we found a dns server
    If DNS.Count = 0 Then
        ' problem
        Err.Raise 20000, "MXQuery", "No DNS entries found, MX Query cannot contine."
        Exit Function
    End If
   
    ' if null was passed in then use the local domain name
   
    If Len(ms_Domain) = 0 Then ms_Domain = DNS.LocalDomain
   
    ' validate domain name
    If Len(ms_Domain) < 5 Then
        Err.Raise 20000, "MXQuery", "No Valid Domain Specified"
        Exit Function
    End If
   
    MX.Domain = ms_Domain
   
    ' Initialize the Winsock, request v1.1
    If WSAStartup(&H101, StartupData) <> ERROR_SUCCESS Then
        iRC = WSACleanup
        Exit Function
    End If
   
    ' Create a socket
    iSock = socket(AF_INET, SOCK_DGRAM, 0)
  '  iSock = socket(AF_INET, SOCK_STREAM, 0)
    If iSock = SOCKET_ERROR Then
        iRC = WSACleanup
        Exit Function
    End If
    ' convert the IP address string to a network ordered long
    IpAddr = GetHostByNameAlias(DNS.Servers(0))
    If IpAddr = -1 Then
        iRC = closesocket(iSock)
        iRC = WSACleanup
        Exit Function
    End If
   
   
    ' Setup the connnection parameters
    SocketBuffer.sin_family = AF_INET
    SocketBuffer.sin_port = htons(53)
    SocketBuffer.sin_addr = IpAddr
    SocketBuffer.sin_zero = String$(8, 0)
   
    ' Set the DNS parameters
    dnsHead.qryID = htons(&H11DF)
    dnsHead.options = DNS_RECURSION
    dnsHead.qdcount = htons(1)
    dnsHead.ancount = 0
    dnsHead.nscount = 0
    dnsHead.arcount = 0
   
    dnsQueryNdx = 0
   
    ReDim dnsQuery(4000)
   
    ' Setup the dns structure to send the query in
    ' First goes the DNS header information
    CopyMemory dnsQuery(dnsQueryNdx), dnsHead, 12
    dnsQueryNdx = dnsQueryNdx + 12
   
    ' Then the domain name (as a QNAME)
    sQName = MakeQName(MX.Domain)
    iNdx = 0
    While (iNdx < Len(sQName))
        dnsQuery(dnsQueryNdx + iNdx) = Asc(Mid(sQName, iNdx + 1, 1))
        iNdx = iNdx + 1
    Wend

    dnsQueryNdx = dnsQueryNdx + Len(sQName)
   
    ' Null terminate the string
    dnsQuery(dnsQueryNdx) = &H0
    dnsQueryNdx = dnsQueryNdx + 1
   
    ' The type of query (15 means MX query)
    iTemp = htons(15)
    CopyMemory dnsQuery(dnsQueryNdx), iTemp, Len(iTemp)
    dnsQueryNdx = dnsQueryNdx + Len(iTemp)
   
    ' The class of query (1 means INET)
    iTemp = htons(1)
    CopyMemory dnsQuery(dnsQueryNdx), iTemp, Len(iTemp)
    dnsQueryNdx = dnsQueryNdx + Len(iTemp)
   
    ReDim Preserve dnsQuery(dnsQueryNdx - 1)
   
    rcv = connect(iSock, SocketBuffer, Len(SocketBuffer))
    If rcv <> 0 Then
        Logit "No connection to name server at: " + ms_Domain
        iRC = closesocket(iSock)
        iRC = WSACleanup
        Exit Function
    End If
   
   
    iRC = closesocket(iSock)
   
    iSock = socket(AF_INET, SOCK_DGRAM, 0)
  '  iSock = socket(AF_INET, SOCK_STREAM, 0)
    If iSock = SOCKET_ERROR Then
        iRC = closesocket(iSock)
        iRC = WSACleanup
        Exit Function
    End If

    ' Send the query to the DNS server
    Logit "4700"
   
       
    Dim SETNONBLOCKING As Long
    SETNONBLOCKING = 1
   
   
   
    iRC = sendto(iSock, dnsQuery(0), dnsQueryNdx + 1, 0, SocketBuffer, Len(SocketBuffer))

    Logit "4710"
    If (iRC = SOCKET_ERROR) Or (iRC = 0) Then
        Logit "4720"
        Err.Raise 20000, "MXQuery", "Problem sending MX query"
       
        iRC = closesocket(iSock)
        iRC = WSACleanup
        Exit Function
    End If
   
     ' Wait for answer from the DNS server
    Logit "4750"
   
    starting = Now

    STARTER = 0
   
    ' Set no blocking
   
    rcv = ioctlsocket(iSock, FIONBIO, SETNONBLOCKING)
     
    Do
        rcv = recvfrom(iSock, dnsReply(STARTER), 2048, 0, SocketBuffer, Len(SocketBuffer))
        If rcv = SOCKET_ERROR And STARTER > 0 Then Exit Do
        If rcv = 0 And STARTER > 0 Then Exit Do
       
        If rcv > 0 Then
            STARTER = STARTER + rcv
            'reply = reply + Left(buffer, rcv)
        End If
       
        If DateDiff("S", starting, Now) > 4 Then
    '        Logit "4760"
            rcv = SOCKET_ERROR
            Exit Do
        End If
        DoEvents
    Loop
    If STARTER = 0 Then
        Logit "4789"
   
        iRC = closesocket(iSock)
        iRC = WSACleanup
        Exit Function
    End If
   
    ' Get the number of answers
    CopyMemory iAnCount, dnsReply(6), 2
    iAnCount = ntohs(iAnCount)
   
    Logit "4790"
   
    iRC = closesocket(iSock)
    iRC = WSACleanup
    Logit "4799"
    If iAnCount Then
        ' Parse the answer buffer
        Logit "4800"
        MX_Query = GetMXName(dnsReply(), 12, iAnCount)
        Logit "4810"
    Else
        Logit "4900 No MX Records"
        ' if we didn't find anything and we are part of
        ' a sub domain, go up one level and try again
        ' the last pass is at the root domain level
        If InStr(MX.Domain, DNS.RootDomain) > 1 Then
            MX.Domain = Mid$(MX.Domain, InStr(MX.Domain, ".") + 1)
            Logit "4910 Up Domain"
            MX_Query = MX_Query(MX.Domain)
            Logit "4920 Up Domain Return"
        End If
    End If
   
End Function




0
 
LVL 17

Expert Comment

by:inthedark
ID: 6841105
I would be tempted to use the Class example, wich uese a silent form,  as you will save loads of time.

VB6 supports windowless controls.  I am not sure if winsock is among them.  But I have generated a winsock class, similar to the vbSendMain and I dont have any trouble running the DLL on other system.  I created an install for the DLL.  The only problem I had was making sure the dll was installed in a location which allowed user access.

I have found a few bugs in the winsock control.  You get error 40006 in the data arrival event if a server sends you a message then terminates the connection.  Hence my desire to move towards a lower level use of Sockets.
0
 

Author Comment

by:philipw
ID: 6842825
inthedark, I think I might head in your exapmles direction.
Thanks for everyones help
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

How to remove superseded packages in windows w60 or w61 installation media (.wim) or online system to prevent unnecessary space. w60 means Windows Vista or Windows Server 2008. w61 means Windows 7 or Windows Server 2008 R2. There are various …
This article is meant to give a basic understanding of how to use R Sweave as a way to merge LaTeX and R code seamlessly into one presentable document.
The goal of the video will be to teach the user the concept of local variables and scope. An example of a locally defined variable will be given as well as an explanation of what scope is in C++. The local variable and concept of scope will be relat…
The goal of the video will be to teach the user the difference and consequence of passing data by value vs passing data by reference in C++. An example of passing data by value as well as an example of passing data by reference will be be given. Bot…

910 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now