Solved

OCX running only in some PC, why?

Posted on 2009-05-07
6
784 Views
Last Modified: 2013-12-08
I constructed an OCX file using VB6, and then I wrote a simple webpage to trigger the OCX with a button click (by javascript).

The OCX works on some PC, but not all. I need to sort this out. At this stage I only focus on IE6, and provide that the security level is set to Low. Would any of you gimme some advice?
This is my webpage
 

<html>

<HEAD>
 

<TITLE>Get Hardware</TITLE>

<script type="text/javascript" FOR="window">

function fn()

{

	Ctrl1.myocx; // activex method is called test

}
 

</script>

</HEAD>
 

<body bgcolor=lightblue LANGUAGE = VBScript>

<!--	If any of the controls on this page require licensing, you must

	create a license package file. Run LPK_TOOL.EXE to create the

	required LPK file. LPK_TOOL.EXE can be found on the ActiveX SDK,

	http://www.microsoft.com/intdev/sdk/sdk.htm. If you have the Visual

	Basic 6.0 CD, it can also be found in the \Tools\LPK_TOOL directory.

	The following is an example of the Object tag:

<OBJECT CLASSID="clsid:5220cb21-c88d-11cf-b347-00aa00a28331">

	<PARAM NAME="LPKPath" VALUE="LPKfilename.LPK">

</OBJECT>

-->

<TABLE BORDER WIDTH = "515" HEIGHT = "600">

<TR>

<TD><OBJECT

	CLASSID="CLSID:7BA13F4A-EA26-4753-B3B8-7DC17CE574B6"

	CODEBASE="gethardware.CAB#version=1,0,0,0"

ID="Ctrl1"

name="Ctrl1">

</OBJECT>

</TD>

</TR>
 

<TR>

<TD ALIGN="CENTER">

<INPUT TYPE=BUTTON VALUE="Get Hardware" onclick="fn()" >

</TD>

</TR>

</TABLE>

</body>

</html>
 
 

====================================================================

====================================================================
 

My OCX source code
 

'======bas module code=======

Public Const DEVICE_CLASS_DISK As String = "{4d36e967-e325-11ce-bfc1-08002be10318}"

Public Const DEVICE_CLASS_COMPACT_DISC As String = "{4d36e965-e325-11ce-bfc1-08002be10318}"

Public Const DEVICE_CLASS_TAPE As String = "{6d807884-7d21-11cf-801c-08002be10318}"

Public Const DEVICE_INTERFACE_DISK As String = "{53f56307-b6bf-11d0-94f2-00a0c91efb8b}"

Public Const DEVICE_INTERFACE_COMPACT_DISC As String = "{53f56308-b6bf-11d0-94f2-00a0c91efb8b}"

Public Const DEVICE_INTERFACE_TAPE As String = "{53f5630b-b6bf-11d0-94f2-00a0c91efb8b}"
 

Public Const DIGCF_DEFAULT As Integer = &H1

Public Const DIGCF_DEVICEINTERFACE As Integer = &H10

Public Const DIGCF_PRESENT As Integer = &H2

Public Const DIGCF_ALLCLASSES As Integer = &H4

Public Const DIGCF_PROFILE As Integer = &H8
 

Private Type Guid

    Data1 As Long

    Data2 As Integer

    Data3 As Integer

    Data4(0 To 7) As Byte

End Type
 

Private Type SP_DEVICE_INTERFACE_DATA

    cbSize As Long

    InterfaceGuid As Guid

    Flag As Long

    Reserved As Long

End Type
 

Private Type SP_DEVINFO_DATA

    cbSize As Long

    ClassGuid As Guid

    DevInstance As Long

    Reserved As Long

End Type
 

Private Type SP_DEVICE_INTERFACE_DETAIL_DATA

    cbSize As Long

    DevicePath As String

End Type
 

Private Type SP_DEVINFO_LIST_DETAIL_DATA

    cbSize As Long

    Id As Guid

    Handle As Long

    DevName As String

End Type
 

Private Declare Function SetupDiCreateDeviceInfoList Lib "setupapi.dll" _

        (ByRef Class As Any, ByVal Handle As Long) As Long
 

Private Declare Function SetupDiCreateDeviceInfoListEx Lib "setupapi.dll" _

        Alias "SetupDiCreateDeviceInfoListExW" _

        (ByRef Class As Any, ByVal Handle As Long, ByVal Machine As String, _

        ByVal Reserved As Long) As Long
 

Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" _

        (ByVal List As Long) As Boolean
 

Private Declare Function SetupDiGetClassDevs Lib "setupapi.dll" _

        Alias "SetupDiGetClassDevsW" _

        (ByRef Class As Any, ByVal Enumerator As String, _

        ByVal Parent As Long, ByVal Flag As Long) As Long
 

Private Declare Function SetupDiGetClassDevsEx Lib "setupapi.dll" _

        Alias "SetupDiGetClassDevsExW" _

        (ByRef Class As Any, ByVal Enumerator As String, _

        ByVal Parent As Long, ByVal Code As Long, _

        ByVal List As Long, ByVal Machine As String, ByVal Reserved As Long) As Long
 

Private Declare Function SetupDiEnumDeviceInfo Lib "setupapi.dll" _

        (ByVal List As Long, ByVal Index As Long, _

        ByRef Device As SP_DEVINFO_DATA) As Boolean
 

Private Declare Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" _

        (ByVal List As Long, _

        ByRef Device As SP_DEVICE_INTERFACE_DATA, ByRef Class As Guid, _

        ByVal Index As Long, _

        ByRef Interface As SP_DEVICE_INTERFACE_DATA) As Boolean
 

Private Declare Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" _

        Alias "SetupDiGetDeviceInterfaceDetailW" _

        (ByVal List As Long, _

        ByRef Interface As SP_DEVICE_INTERFACE_DATA, _

        ByRef Detail As Long, _

        ByVal Size As Long, _

        ByRef Length As Long, _

        ByRef Device As SP_DEVICE_INTERFACE_DATA) As Boolean
 

Public Declare Function SetupDiGetDeviceRegistryProperty Lib "setupapi.dll" _

  Alias "SetupDiGetDeviceRegistryPropertyA" ( _

  ByVal DeviceInfoSet As Long, _

  ByRef DeviceInfoData As SP_DEVINFO_DATA, _

  ByVal Property As DEVICEPROPERTYINDEX, _

  ByRef PropertyRegDataType As REGPROPERTYTYPES, _

  ByVal PropertyBuffer As String, _

  ByVal PropertyBufferSize As Long, _

  ByRef RequiredSize As Long) As Long
 

Private Declare Function QueryDosDevice Lib "KERNEL32.DLL" _

        Alias "QueryDosDeviceW" _

        (ByVal Device As String, ByVal Path As String, ByVal Length As Long) As Long

   

Private Type DeviceStructure

    Result As Long

    List As Long

    Class As Guid

    Flag As Long

    Machine As String

End Type
 

Public Enum DEVICEPROPERTYINDEX

  SPDRP_ADDRESS = (&H1C)

  SPDRP_BUSNUMBER = (&H15)

  SPDRP_BUSTYPEGUID = (&H13)

  SPDRP_CAPABILITIES = (&HF)

  SPDRP_CHARACTERISTICS = (&H1B)

  SPDRP_CLASS = (&H7)

  SPDRP_CLASSGUID = (&H8)

  SPDRP_COMPATIBLEIDS = (&H2)

  SPDRP_CONFIGFLAGS = (&HA)

  SPDRP_DEVICEDESC = &H0

  SPDRP_DEVTYPE = (&H19)

  SPDRP_DRIVER = (&H9)

  SPDRP_ENUMERATOR_NAME = (&H16)

  SPDRP_EXCLUSIVE = (&H1A)

  SPDRP_FRIENDLYNAME = (&HC)

  SPDRP_HARDWAREID = (&H1)

  SPDRP_LEGACYBUSTYPE = (&H14)

  SPDRP_LOCATION_INFORMATION = (&HD)

  SPDRP_LOWERFILTERS = (&H12)

  SPDRP_MFG = (&HB)

  SPDRP_PHYSICAL_DEVICE_OBJECT_NAME = (&HE)

  SPDRP_SECURITY = (&H17)

  SPDRP_SECURITY_SDS = (&H18)

  SPDRP_SERVICE = (&H4)

  SPDRP_UI_NUMBER = (&H10)

  SPDRP_UPPERFILTERS = (&H11)

End Enum
 

Public Enum REGPROPERTYTYPES

  REG_BINARY = 3

  REG_DWORD = 4

  REG_DWORD_BIG_ENDIAN = 5

  REG_DWORD_LITTLE_ENDIAN = 4

  REG_EXPAND_SZ = 2

  REG_MULTI_SZ = 7

  REG_SZ = 1

End Enum

Public Enum SetupErrors

  ERROR_INSUFFICIENT_BUFFER = 122

  ERROR_INVALID_DATA = 13&

  ERROR_NO_MORE_ITEMS = 259&

End Enum
 

Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As String, pclsid As Guid) As Long

Private Declare Function IsEqualGUID Lib "ole32" (rguid1 As Guid, rguid2 As Guid) As Boolean

Private Const INVALID_HANDLE_VALUE = -1

Private Const INTERFACE_DETAIL_SIZE = 1024
 

Public Function EnumAllDevices(tv As TreeView, txt As TextBox)

   Dim hDevInfo As Long

   Dim gd As Guid

   Dim devinfo As SP_DEVINFO_DATA

   Dim nCount As Long, n As Long

   Dim bResult As Boolean

   Dim sClass As String, sGUID, sDevice As String

   

   hDevInfo = SetupDiGetClassDevs(ByVal 0&, vbNullString, 0, DIGCF_PRESENT Or DIGCF_PROFILE Or DIGCF_ALLCLASSES)

   tv.Nodes.Add , , "Root", Environ$("COMPUTERNAME")

   

   'Edit by Aaron

   txt.Text = Environ$("COMPUTERNAME") & vbNewLine

   

   If hDevInfo = INVALID_HANDLE_VALUE Then Exit Function

   nCount = 0: bResult = True

   devinfo.cbSize = Len(devinfo)
 

   Do While bResult

      n = SetupDiEnumDeviceInfo(hDevInfo, nCount, devinfo)

      bResult = CBool(n)

      If bResult Then

         sGUID = GetSetupRegSetting(hDevInfo, devinfo, SPDRP_CLASSGUID)

         If Not NodeExists(tv, sGUID) Then

            sClass = GetSetupRegSetting(hDevInfo, devinfo, SPDRP_CLASS)

            tv.Nodes.Add tv.Nodes("Root"), tvwChild, sGUID, sClass

                

                'Edit by Aaron

                txt.Text = txt.Text & sClass & ": " & sGUID & vbNewLine

            

         Else

            sDevice = GetSetupRegSetting(hDevInfo, devinfo, SPDRP_FRIENDLYNAME)

            If sDevice = "" Then sDevice = GetSetupRegSetting(hDevInfo, devinfo, SPDRP_DEVICEDESC)

            tv.Nodes.Add tv.Nodes(sGUID), tvwChild, "", sDevice

         

                'Edit by Aaron

                txt.Text = txt.Text & sDevice & vbNewLine

         

         End If

      End If

      nCount = nCount + 1

   Loop

   Call SetupDiDestroyDeviceInfoList(hDevInfo)

   tv.Nodes("Root").Expanded = True

   EnumAllDevices = nCount

End Function
 

Public Function GetSetupRegSetting(ByVal hDevInfo As Long, _

  DID As SP_DEVINFO_DATA, ByVal RegSetting As DEVICEPROPERTYINDEX) As String

 

  Dim BuffStr As String

  Dim BuffLng As Long

  Dim BufferLen As Long

  Dim RegType As REGPROPERTYTYPES

  Dim SE As SetupErrors

  Dim Retval As Long

     

   Retval = SetupDiGetDeviceRegistryProperty(hDevInfo, DID, RegSetting, RegType, "", 0&, BufferLen)

   If Retval = 0 Then

     SE = Err.LastDllError

         

     If SE = ERROR_INSUFFICIENT_BUFFER Then

       Select Case RegType

         Case REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ, REG_BINARY

           BuffStr = Space$(BufferLen)

           Retval = SetupDiGetDeviceRegistryProperty(hDevInfo, DID, RegSetting, _

             RegType, BuffStr, Len(BuffStr), BufferLen)

                   

         Case REG_DWORD, REG_DWORD_BIG_ENDIAN, REG_DWORD_LITTLE_ENDIAN

           Retval = SetupDiGetDeviceRegistryProperty(hDevInfo, DID, RegSetting, RegType, _

             BuffLng, Len(BuffLng), BufferLen)

           BuffStr = CStr(BuffLng)

           BuffLng = BuffLng + 1

       End Select

               

       If Retval <> 0 Then

         GetSetupRegSetting = Left$(BuffStr, BufferLen - 1)

       Else

         MsgBox "Error while dermitting Regestryproperty"

       End If

               

    ElseIf SE <> ERROR_INVALID_DATA Then

      MsgBox "Error, can't get Regestryproperty"

    End If

  End If

End Function
 

Private Function NodeExists(tv As TreeView, ByVal sKey As String) As Boolean

   Dim nd As Node

   On Error Resume Next

   Set nd = tv.Nodes(sKey)

   NodeExists = (Err = 0)

   Set nd = Nothing

End Function
 

Option Explicit

 

Public Function getInfo() As String

    Dim output As String

    

    output = ""

    output = output & wmiVideoControllerInfo

    getInfo = output

End Function
 

Private Function wmiVideoControllerInfo() As String

    Dim wmiObjSet As SWbemObjectSet

    Dim obj As SWbemObject

    

    wmiVideoControllerInfo = ""

    Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_VideoController")

    On Local Error Resume Next

    For Each obj In wmiObjSet

          wmiVideoControllerInfo = obj.VideoProcessor

          Exit Function

    Next

End Function

Open in new window

Not-working.jpg
Working.jpg
0
Comment
Question by:mishelper
  • 3
  • 2
6 Comments
 
LVL 7

Accepted Solution

by:
ycTIN earned 500 total points
ID: 24334309
This is security problem, different os , browser , version will have are different security rules.
especially the microsoft product ,many different  in IE 6, 7 ,8

i suggest you use Java
0
 
LVL 10

Expert Comment

by:bugada
ID: 24334666
VB6 runtime are installed on all pc?
0
 

Author Comment

by:mishelper
ID: 24349010
Hi Bugada,
I am not sure about this. How to get VB6 runtime to be installed? does this come with Windows XP SP2?
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 

Author Comment

by:mishelper
ID: 24349019
ycTIN:
Would you give me further information if we assume all users are using Windows XP + IE6?
0
 
LVL 10

Expert Comment

by:bugada
ID: 24396679
You can donwload vb6 runtime from here:

http://www.microsoft.com/downloads/details.aspx?FamilyId=7B9BA261-7A9C-43E7-9117-F673077FFB3C&displaylang=en

But honestly I don't know if they are needed. Try to install them on a pc where you get the error, reboot it and retry. If the error disappears (or changes) this is the solution otherwise I can't help you further.
0
 

Author Closing Comment

by:mishelper
ID: 31579294
No example or further information given.
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

I had to do a bit of research to find the answer to this question so I thought I'd share my results.  Due to our outdated mainframe systems, we need to downgrade IE9 to IE8 in order to stay compatible.  We also needed to downgrade Java.  In order to…
SSL stands for “Secure Sockets Layer” and an SSL certificate is a critical component to keeping your website safe, secured, and compliant. Any ecommerce website must have an SSL certificate to ensure the safe handling of sensitive information like…
The purpose of this video is to demonstrate how to set up the WordPress backend so that each page automatically generates a Mailchimp signup form in the sidebar. This will be demonstrated using a Windows 8 PC. Tools Used are Photoshop, Awesome…
How to create a custom search shortcut to site-search Experts Exchange using Google in the Firefox browser. This eliminates the need to type out site:experts-exchange.com whenever you want to search the site. Launch your Bookmark Menu: Press 'Ctrl +…

705 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

19 Experts available now in Live!

Get 1:1 Help Now