制作vb activex：

修改版本

'write by pengzhenglin
'2009-03-26
'功能：bs中导入等操作之前要选择客户端文件夹，此控件就完成此功能，并返回文件夹名称、文件夹所有文件名字和文件总数

Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (LpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDlist Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Type BROWSEINFO
  hOwner As Long
  pidlroot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lparam As Long
  iImage As Long
End Type

Dim rootpath As String  '选择文件夹
Dim cnt As Long '文件总数
Dim files() As String   '所有文件名

Private Function GetFolder(ByVal hWnd As Long, Optional Title As String) As String
    Dim bi As BROWSEINFO
    Dim pidl As Long
    Dim folder As String
    folder = Space(255)
With bi
   If IsNumeric(hWnd) Then .hOwner = hWnd
   .ulFlags = 1
   .pidlroot = 0
   If Title <> "" Then
      .lpszTitle = Title & Chr$(0)
   Else
      .lpszTitle = "选择目录" & Chr$(0)
    End If
End With

pidl = SHBrowseForFolder(bi)
If SHGetPathFromIDlist(ByVal pidl, ByVal folder) Then
    GetFolder = Left(folder, InStr(folder, Chr$(0)) - 1)
Else
    GetFolder = ""
End If
End Function

 
Private Function TreeSearch(ByVal sPath As String, ByVal sFileSpec As String, sFiles() As String) As Long
    Static lngFiles As Long '文件数目
    Dim sDir As String
    Dim sSubDirs() As String '存放子目录名称
    Dim lngIndex As Long
    Dim lngTemp&
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    sDir = Dir(sPath & sFileSpec)
   '获得当前目录下文件名和数目
    Do While Len(sDir)
      lngFiles = lngFiles + 1
      ReDim Preserve sFiles(1 To lngFiles)
      sFiles(lngFiles) = sPath & sDir
      sDir = Dir
    Loop
   '获得当前目录下的子目录名称
    lngIndex = 0
    sDir = Dir(sPath & "*.*", vbDirectory)
    Do While Len(sDir)
      If Left(sDir, 1) <> "." And Left(sDir, 1) <> ".." Then '' 跳过当前的目录及上层目录
     '找出子目录名
        If GetAttr(sPath & sDir) And vbDirectory Then
          lngIndex = lngIndex + 1
         '保存子目录名
          ReDim Preserve sSubDirs(1 To lngIndex)
          sSubDirs(lngIndex) = sPath & sDir & "\"
        End If
      End If
      sDir = Dir
    Loop
    For lngTemp = 1 To lngIndex
      '查找每一个子目录下文件，这里利用了递归
      Call TreeSearch(sSubDirs(lngTemp), sFileSpec, sFiles())
    Next lngTemp
    TreeSearch = lngFiles
  End Function
 
'弹出对话框
'返回选择文件夹路径
Public Function showDlg() As String
    showDlg = ""
    Dim str() As String
    rootpath = ""
    cnt = 0
   
    rootpath = GetFolder(0, "请选择上传文件夹：")
   
    If rootpath <> "" Then
        Call TreeSearch(rootpath, "*.*", str)
       
        Dim i As Integer
        Dim j As Integer
        j = 0
        Dim strall As String
        For i = 1 To UBound(str)
            If str(i) <> "" Then
                'MsgBox str(i)
                j = j + 1
            End If
        Next
       
        cnt = j '记录文件总数
       
        ReDim Preserve files(1 To cnt)  '重新分配空间
       
        j = 0
        For i = 1 To UBound(str)
            If str(i) <> "" Then
                'MsgBox str(i)
                j = j + 1
                files(j) = str(i)
            End If
        Next
       
        showDlg = rootpath
    Else
        showDlg = ""
    End If
   
End Function

'得到文件夹下文件总数
Public Function getFilesCount() As Long
    getFilesCount = cnt
End Function

'得到选择的文件夹路径
Public Function getSelectedPath() As String
    getSelectedPath = rootpath
End Function

'得到所有文件名
Public Function getAllFiles() As String()
    getAllFiles = files
End Function

'得到第i个文件名
Public Function getFile(i As Long) As String
    If i > 0 And i <= cnt Then
        getFile = files(i)
    Else
        getFile = ""
    End If
End Function

''示例或测试代码
'Private Sub Command1_Click()
'    Dim root As String
'    root = showDlg()
'
'    Dim count As Long
'    count = getFilesCount()
'    Dim s() As String
'    ReDim Preserve s(1 To count)
'    s = getAllFiles()
'    Dim i As Long
'    For i = 1 To count
'        MsgBox s(i)
'    Next
'End Sub

生成dll，builed outputs：

 

 

 

 第二步，打包：

利用vb6自带的打包工具PDCMDLN.EXE

选择activex工程

 点package

 点next

 选择Internet Package，点next

选择存放位置，点next

勾选你的activex，其他的不要勾选，点next

选择include in this cab，点next

选择两个yes，点next，finish。

这样就打好包了,生成了几个文件如下：

  

这种方式打包和自己使用命令【在运行中输入iexpress.exe，可以打包cab】打包一样的，但后者要自己书写inf文件，有点麻烦。

我们可以查看自动生成的inf文件

另外一个自动生成的网页文件是帮助我们在网页中使用这个activex控件。

<HTML>
<HEAD>
<TITLE>dirselectx.CAB</TITLE>
</HEAD>
<BODY>
<OBJECT ID="dirselectclass"
CLASSID="CLSID:0C5B1166-FEFB-42D3-B517-C579A7A2BB42"
CODEBASE="dirselectx.CAB#version=1,0,0,0">
</OBJECT>
</BODY>
</HTML>

 

数字签名：

利用几个工具对我们的activex签名：

给 .cab 文件签名

在命令行输入：

1. setreg 1 true
2. makecert newCert.cer -sv privatekey.pvk -n CN=CSUGISLink,E=pengzhenglin@163.com,O=Link"
生成 newCert.cer 和 privatekey.pvk 两个文件
3. Cert2Spc newCert.cer newCert.spc
4. signtool signwizard
有图形界面的签名向导，按提示指定有关文件路径即可，其中的描述是控件的描述。

浏览我们的cab文件，下一步：

选择典型，这样可以选择自己的证书等，点下一步：

从文件中选择你上几步生成的证书，点下一步：

浏览上几步生成的私钥文件，点下一步：

输入key【在生成密钥时使用的key】

选择算法md5，点下一步：

点下一步，下一步，一直到完成。

这样我们就得到了签了名的activex了。

 

 

最后一步，发布：

我们在asp.net上发布，用vs2005新建一个asp.net应用程序。

修改项目属性中的生成到iis，创建虚拟路径，这样在iis上发布。

修改default.aspx代码：

<%@ Page Language="C#" AutoEventWireup="true" CodeBehind="Default.aspx.cs" Inherits="dirselectxtestweb._Default" %>

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html xmlns="http://www.w3.org/1999/xhtml" >
<head runat="server">
    <title>dirselectx测试网页</title>
</head>
<body>
        <font face = arial size = 1><OBJECT id = "dirselect1" name = "dirselect1"  CLASSID="CLSID:0C5B1166-FEFB-42D3-B517-C579A7A2BB42" CODEBASE="dirselectx.CAB#version=1,0,0,0">
        </OBJECT>
        </font> 
    <form name = "frm" id = "frm" runat=server>
        <input type=text id="backserverstr" name="backserverstr" value=""  runat=server style="display:none;">   
        <input type =submit value = "选择文件夹" onClick ="doScript(); ">
        <asp:Label ID="Label1" runat="server" Text=""></asp:Label>
       
    </form>
</body>

<script language = "javascript">
function doScript()
{
    //调用对话框，返回选择文件夹路径，或者空值
 var t = dirselect1.showDlg();
 //alert(t);
 if(t!="")
 {
  var i=1;
  //该文件夹下总共有文件数
  var cnt = dirselect1.GetFilesCount();
  alert(cnt);  
  
  //var array = new Array(cnt);

        var allstr = "";
  for(i;i<=cnt;i++)
  {
      //得到第i个文件名
   var str = dirselect1.GetFile(i);
   //alert(str);
   if(i==1)
   {
       allstr = str;
   }
   else
   {
       allstr = allstr + "*" + str;
   }
  }
  
  //通过表单回传到服务器
  document.all.backserverstr.value = allstr;
  //alert("OK");
 } 

}
</script>
</html>

在后台加入如下代码，测试选择文件夹后回传到服务器处理了：

protected void Page_Load(object sender, EventArgs e)
        {
            if (IsPostBack)
            {
                Label1.Text = backserverstr.Value;
            }
        }

 

然后将签名后的cab文件放到我们的虚拟路径下面，这样做是因为我们在html中写了一段代码，codebase属性，如果客户端没有安装activex控件，则在这个地址下载安装。

生成。

这样就发布了。

 

在客户端访问的时候可能会遇到页面阻止了安装activex的情况，主要是我们的签名只是个测试签名。

有几个办法解决：

修改internet选项中安全级别，自定义安全级别中将下载未签名的activex等项选择“提示”；

将这个站点设置为信任站点；

 

测试后，可以运行。前几天用C#写的activex控件在客户端要安装.net framework，当下载安装组件的时候，其会自动安装.net framework，不过这样要等上几分钟，这是客户不愿意看到的。

 出处： https://www.cnblogs.com/penglink/archive/2009/03/27/1423275.html