Solved

Activex controls and VB modules

Posted on 2002-03-03
9
654 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
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

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.
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
The viewer will be introduced to the technique of using vectors in C++. The video will cover how to define a vector, store values in the vector and retrieve data from the values stored in the vector.
The viewer will be introduced to the member functions push_back and pop_back of the vector class. The video will teach the difference between the two as well as how to use each one along with its functionality.

757 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

18 Experts available now in Live!

Get 1:1 Help Now