VB6 混合应用程序架构

• 下载源码 - 313.4 Kb

引言

有很多应用程序是用 VB6 编写的。现在将整个应用程序重写为 VB.NET 对于小公司来说是一项耗时且有风险的任务。然而，随着 Microsoft Interop Toolkit 2.0 的发布，我们有了**部分迁移**的选项。我们可以在 VB.NET 中创建 Forms、Controls 和 Libraries，并使用 Microsoft Interop Toolkit 2.0 将它们与 VB6 应用程序粘合在一起。此选项为我们打开了许多可能性，例如调用 Web 服务、多线程等。本文将演示如何使用 Microsoft Interop Toolkit 2.0 和 VB.NET 向 VB6 应用程序添加高级功能，而无需更改现有代码。我们将添加的功能列表如下：

• 编写 VB.Net CRM 适配器，用于与 Sugar CRM 通信
  • Sugar CRM 通过 NuSoap PHP 库模块公开其对象
  • VB.NET 项目将使用 Web 服务
• 用于在 Sugar CRM 中创建事件的自定义屏幕
  • 用于创建事件的 VB.NET Forms
  • 事件创建屏幕将由 VB6 应用程序调用
• 多线程批量上传控件
  • 将使用 System.ComponentModel.BackgroundWorker 上传事件的 VB.NET UserControl
  • VB6 Form 将托管此控件。

注意：Sugar CRM 是一个基于 PHP 和 MySQL 的开源 CRM 包。

高级设计

在高级设计图中，第 1、2 和 3 部分是 VB6 Forms。第 4 部分是 VB.NET WinForm。第 5 部分是托管 VB.NET 用户控件的 VB6 Form。第 6 部分是 ToolKit 区域，它提供应用程序数据共享、事件框架服务等。第 7 部分是用 VB.NET 编写的 CRM 适配器，用于与 Sugar CRM SOAP 服务对话。应用程序包含以下项目：

1. Manager: Visual Basic 6.0 应用程序起始点，包含 forms
2. SugarCrmInteropForm: 包含事件相关 forms 的 .NET 程序集
3. HybridAppControls: 包含用于多线程批量上传的自定义用户控件的 .NET 程序集
4. SugarCrmAdapter: 包含 Sugar CRM 适配器的 .NET 程序集

背景

我们正在使用的应用程序是计费管理系统。它是一个基于 Windows 的应用程序，以 Access 数据库作为其后端。数据报表用于报告。它主要用于管理客户联系人（CRUD）、生成和维护账单信息、报告等。

使用代码

在 VB6 和 VB.NET 之间共享数据

**步骤 1.** 当 Visual Basic 6.0 应用程序加载时，使用以下代码初始化 Microsoft Interop Toolkit 2.0 Framework

' Instantiate the Toolbox
Set g_InteropToolbox = New InteropToolbox
g_InteropToolbox.Initialize
    
' Call Initialize method only when first creating the toolbox
' This aids in the debugging experience
g_InteropToolbox.Initialize

' Signal Application Startup
g_InteropToolbox.EventMessenger.RaiseApplicationStartedupEvent

**步骤 2.** 使用 Microsoft Interop Toolkit 2.0 Framework，将所有共享数据传递给 VB.NET

'1.Reading Config values from Access Database
'2.Sharing the values to VB.Net using ToolKit  
Dim rsSettings As ADODB.Recordset 
Set rsSettings = New ADODB.Recordset 
rsSettings.Open "select * from appsetting", db, _
    adOpenDynamic, adLockOptimistic 
While Not rsSettings.EOF 
    g_InteropToolbox.Globals.Add CStr(rsSettings!Name), _
        CStr(rsSettings!Value) 
    rsSettings.MoveNext 
Wend 
rsSettings.Close

**步骤 3.** 从 VB.NET 访问共享数据

SugarCrmSettings.crmUserId = My.InteropToolbox.Globals("crmUserId")
SugarCrmSettings.crmURL = My.InteropToolbox.Globals("crmURL")
SugarCrmSettings.crmPassword = My.InteropToolbox.Globals("crmPassword")
SugarCrmSettings.crmVer = My.InteropToolbox.Globals("crmVersion")  

VB.NET 中的多线程批量上传控件

**步骤 1. ** 从 Components ToolBox 中添加 BackgroundWorker 控件。

**步骤 2.** 在 DoWork 事件中，我们读取文件，然后调用适配器创建事件

Private Sub BulkImportWorker_DoWork(ByVal sender As System.Object, _
    ByVal e As System.ComponentModel.DoWorkEventArgs_
    ) Handles BulkImportWorker.DoWork
    Dim ReadFile As New System.IO.StreamReader(txtImportFileName.Text)
    Dim ImportedIncident As String
    Dim SugarCrmSettings As New SugarCrmAdapter.CrmHelper

    'Getting VB6 Configuration values
    SugarCrmSettings.crmUserId = _
        My.InteropToolbox.Globals("crmUserId").ToString()
    SugarCrmSettings.crmURL = _
        My.InteropToolbox.Globals("crmURL").ToString()
    SugarCrmSettings.crmPassword = _
        My.InteropToolbox.Globals("crmPassword").ToString()
    SugarCrmSettings.crmVer = _
        My.InteropToolbox.Globals("crmVersion").ToString()
    Dim lineno As Integer
    lineno = 1
    Dim importerror As Integer
    importerror = 0

    Try
        While Not ReadFile.EndOfStream
            ImportedIncident = ReadFile.ReadLine

            txtStatus.Text = "Processing Line  " + lineno.ToString()
            Dim IncidentRequest As New SugarCrmAdapter.Incident
            Dim IncidentResponse As New SugarCrmAdapter.GenericEntity

            IncidentResponse = 
                IncidentRequest.Create(SugarCrmSettings, _
                    ImportedIncident)
            If (IncidentResponse.IsError) Then
                ExportList.Items.Add("Line # " + lineno.ToString() + _
                    " Error occured while creating Case " + _
                    ImportedIncident)
                importerror = importerror + 1
            End If
            lineno = lineno + 1
        End While
        lineno = lineno - 1
    Catch ex As Exception
        Microsoft.VisualBasic.Interaction.MsgBox(_
            "Unexpected error " + _
            ex.Message, _
            MsgBoxStyle.Information)
    Finally
        ReadFile.Close()
        Dim summary As String
        summary = vbCrLf + "Total records processed: " + _
            lineno.ToString() + vbCrLf
        summary += "Successfully inserted: " + _
            CStr(lineno - importerror) + vbCrLf
        summary += "Failed: " + importerror.ToString() + vbCrLf

        Microsoft.VisualBasic.Interaction.MsgBox(_
           "Import task complted" + _
            vbCrLf + summary, MsgBoxStyle.Information)
        txtStatus.Text = "Completed..."

    End Try
End Sub

编写 VB.Net CRM 适配器，用于与 Sugar CRM 通信

**步骤 1.** 调用 Sugar CRM web 服务的 test 方法来检查连接。

**步骤 2.** 将凭据传递给 create_case 方法。

**步骤 3.** 返回 create_case 方法的响应，这将是一个 GUID

Dim crm As New CrmService.sugarsoap
Dim auth As New CrmService.user_auth
auth.user_name = ConnectionSettings.crmUserId
auth.password = ConnectionSettings.crmPassword
auth.version = ConnectionSettings.crmVer
crm.Url = ConnectionSettings.crmURL

Dim ReturnObject As New GenericEntity
Try
    Dim test As String = crm.test("test")
    Dim a As Object = crm.login(auth, "SoapTest")
Catch ex As Exception
    ReturnObject.IsError = True
    ReturnObject.Message = "Connection to SugarCrm was unsuccessfull"
    Return ReturnObject
End Try

Try
    Dim caseid As String = _
        crm.create_case(ConnectionSettings.crmUserId, _
        ConnectionSettings.crmPassword, CaseName)

    ReturnObject.Message = _
        "Case created in SugarCrm with CaseID - " + caseid
    Return ReturnObject
Catch ex As Exception
    ReturnObject.IsError = True
    ReturnObject.Message = _
        "Unable to create case in SugarCrm ErrorDetails - " + _
        ex.Message
    Return ReturnObject
End Try

成功的提示

在运行应用程序之前，请检查以下内容

1. 检查 Sugar CRM 是否正在运行。
2. 检查 CrmURL 等设置是否指向正确的位置。
3. 请注意，存储在 MD5 中的密码可以从 Sugar CRM 用户表中获取。
4. 用户应该有权在 Sugar CRM 中创建事件。

祝你编码愉快...

历史

• 2007 年 7 月 4 日 -- 发布原始版本