Solved

OCX running only in some PC, why?

Posted on 2009-05-07
6
794 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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

Increase your protection from Zero Day threats!

Running two Antivirus' is never a good idea.
Taking advantage of Multiple Security layers on the other hand can often save your hide.
See which top notch security software brands have been proven to happily coexist together.
Reduce your chances of becoming a statistic.

Question has a verified solution.

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

Nothing in an HTTP request can be trusted, including HTTP headers and form data.  A form token is a tool that can be used to guard against request forgeries (CSRF).  This article shows an improved approach to form tokens, making it more difficult to…
Today, the web development industry is booming, and many people consider it to be their vocation. The question you may be asking yourself is – how do I become a web developer?
The viewer will learn the basics of jQuery, including how to invoke it on a web page. Reference your jQuery libraries: (CODE) Include your new external js/jQuery file: (CODE) Write your first lines of code to setup your site for jQuery.: (CODE)
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 +…

739 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