总结vb activex制作、打包、签名、发布

 订阅

制作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=[e-mail],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，不过这样要等上几分钟，这是客户不愿意看到的。