Delphi7通过VB6之COM对象调用PowerBASIC写的DLL功能。标题挺长，其实目标很简单，就是在Delphi7中使用PowerBASIC的MKI/CVI, MKS/CVS, MKD/CVD，并顺便加入CRC16检验函数，再进行16进制高低字节调整，方便在VB6、Delphi、Lazarus等环境下利用Modbus协议传送指令和数据时，进行十进制数的浮点转换和数据接收校验。我写的只是一个方法，其实用算法实现也并不十分复杂，但总觉得应该让曾经精典的老古懂们能做点事情。

分三步走：

用PowerBASIC写基本DLL

用VB6写COM组件

用Delphi7写界面验证程序

一、用PowerBASIC写基本DLL

PowerBASIC兼容VB6最好，甚至许多功能完胜VB6，而且QBASIC有的功能它基本上都保留了，只是随着VB6的淡出而停止了前行。如果用现在语言的功能衡量它们，它们确实老了，但在工控领域里还是有许多用武之地的，比如工厂一般使用的总线方面，Modbus在国内比较普及，即使有了TCP也只是从Modbus ASCII或Modbus RTU变成了Modbus TCP，所以小而精的东西在这方面比大而复杂的东西更受青睐。PowerBASIC写DLL很简单，DLL入口出口不用管，写自己的功能函数并EXPORT即可。

下面的MBFIEEE32PD.BAS是用PowerBASIC写的

'MBFIEEE32PD.BAS'===============================================================================''  Generic DLL Template for PowerBASIC for Windows'  Copyright (c) 1997-2011 PowerBASIC, Inc.'  All Rights Reserved.''  LIBMAIN function Purpose:''    User-defined function called by Windows each time a DLL is loaded into,'    and unloaded from, memory. In 32-bit Windows, LibMain is called each'    time a DLL is loaded by an application or process.  Your code should'    never call LibMain explicitly.''    hInstance is the DLL instance handle.  This handle is used by the'    calling application to identify the DLL being called.  To access'    resources in the DLL, this handle will need to be stored in a global'    variable.  Use the GetModuleHandle(BYVAL 0&) to get the instance'    handle of the calling EXE.''    fdwReason specifies a flag indicating why the DLL entry-point'    (LibMain) is being called by Windows.''    lpvReserved specifies further aspects of the DLL initialization'    and cleanup.  If fdwReason is %DLL_PROCESS_ATTACH, lpvReserved is'    NULL (zero) for dynamic loads and non-NULL for static loads.  If'    fdwReason is %DLL_PROCESS_DETACH, lpvReserved is NULL if LibMain'    has been called by using the FreeLibrary API call and non-NULL if'    LibMain has been called during process termination.'' Return''    If LibMain is called with %DLL_PROCESS_ATTACH, your LibMain function'    should return a zero (0) if any part of your initialization process'    fails or a one (1) if no errors were encountered.  If a zero is'    returned, Windows will abort and unload the DLL from memory. When'    LibMain is called with any other value than %DLL_PROCESS_ATTACH, the'    return value is ignored.''=============================================================================== #COMPILER PBWIN 10#COMPILE DLL #INCLUDE ONCE "Win32api.inc" GLOBAL ghInstance AS DWORD  '-------------------------------------------------------------------------------' Main DLL entry point called by Windows...'FUNCTION LIBMAIN (BYVAL hInstance   AS LONG, _                  BYVAL fwdReason   AS LONG, _                  BYVAL lpvReserved AS LONG) AS LONG     SELECT CASE fwdReason     CASE %DLL_PROCESS_ATTACH        'Indicates that the DLL is being loaded by another process (a DLL        'or EXE is loading the DLL).  DLLs can use this opportunity to        'initialize any instance or global data, such as arrays.         ghInstance = hInstance         FUNCTION = 1   'success!         'FUNCTION = 0   'failure!  This will prevent the EXE from running.     CASE %DLL_PROCESS_DETACH        'Indicates that the DLL is being unloaded or detached from the        'calling application.  DLLs can take this opportunity to clean        'up all resources for all threads attached and known to the DLL.         FUNCTION = 1   'success!         'FUNCTION = 0   'failure!     CASE %DLL_THREAD_ATTACH        'Indicates that the DLL is being loaded by a new thread in the        'calling application.  DLLs can use this opportunity to        'initialize any thread local storage (TLS).         FUNCTION = 1   'success!         'FUNCTION = 0   'failure!     CASE %DLL_THREAD_DETACH        'Indicates that the thread is exiting cleanly.  If the DLL has        'allocated any thread local storage, it should be released.         FUNCTION = 1   'success!         'FUNCTION = 0   'failure!     END SELECT END FUNCTION  FUNCTION myMKI ALIAS "myMKI" (BYVAL Param1 AS INTEGER) EXPORT AS STRING    DIM I AS INTEGER    DIM TString AS STRING     I=0: TString=""     ' code goes here    FOR I = 2 TO 1 STEP -1        TString=TString+RIGHT$(("0"+LTRIM$(HEX$(ASC(MID$(MKI$(Param1),I,1))))),2)    NEXT I    FUNCTION = TStringEND FUNCTION FUNCTION myCVI ALIAS "myCVI" (BYVAL Param1 AS STRING) EXPORT AS INTEGER    DIM I AS INTEGER    DIM TString AS STRING     I=0: TString=""     ' code goes here    FOR I = 3 TO 1 STEP -2        TString=TString+CHR$(VAL("&H"+MID$(Param1,I,2)))    NEXT I    FUNCTION = CVI(TString)END FUNCTION FUNCTION myMKL ALIAS "myMKL" (BYVAL Param1 AS LONG) EXPORT AS STRING    DIM I AS INTEGER    DIM TString AS STRING     I=0: TString=""     ' code goes here    FOR I = 4 TO 1 STEP -1        TString=TString+RIGHT$(("0"+LTRIM$(HEX$(ASC(MID$(MKL$(Param1),I,1))))),2)    NEXT I    FUNCTION = TStringEND FUNCTION FUNCTION myCVL ALIAS "myCVL" (BYVAL Param1 AS STRING) EXPORT AS LONG    DIM I AS INTEGER    DIM TString AS STRING     I=0: TString=""     ' code goes here    FOR I = 7 TO 1 STEP -2        TString=TString+CHR$(VAL("&H"+MID$(Param1,I,2)))    NEXT I    FUNCTION = CVL(TString)END FUNCTION FUNCTION myMKS ALIAS "myMKS" (BYVAL Param1 AS SINGLE) EXPORT AS STRING    DIM I AS INTEGER    DIM TString AS STRING     I=0: TString=""     ' code goes here    FOR I = 4 TO 1 STEP -1        TString=TString+RIGHT$(("0"+LTRIM$(HEX$(ASC(MID$(MKS$(Param1),I,1))))),2)    NEXT I    FUNCTION = TStringEND FUNCTION FUNCTION myCVS ALIAS "myCVS" (BYVAL Param1 AS STRING) EXPORT AS SINGLE    DIM I AS INTEGER    DIM TString AS STRING     I=0: TString=""     ' code goes here    FOR I = 7 TO 1 STEP -2        TString=TString+CHR$(VAL("&H"+MID$(Param1,I,2)))    NEXT I    FUNCTION = CVS(TString)END FUNCTION FUNCTION myMKD ALIAS "myMKD" (BYVAL Param2 AS DOUBLE) EXPORT AS STRING    DIM I AS INTEGER    DIM TString AS STRING     I=0: TString=""     ' code goes here    FOR I = 8 TO 1 STEP -1        TString=TString+RIGHT$(("0"+LTRIM$(HEX$(ASC(MID$(MKD$(Param2),I,1))))),2)    NEXT I    FUNCTION = TStringEND FUNCTION FUNCTION myCVD ALIAS "myCVD" (BYVAL Param1 AS STRING) EXPORT AS DOUBLE    DIM I AS INTEGER    DIM TString AS STRING     I=0: TString=""     ' code goes here    FOR I = 15 TO 1 STEP -2        TString=TString+CHR$(VAL("&H"+MID$(Param1,I,2)))    NEXT I    FUNCTION = CVD(TString)END FUNCTION FUNCTION myCRC16 ALIAS "myCRC16" (BYVAL Param1 AS STRING) EXPORT AS STRING    'An input string converted to a 4-byte HEX string    DIM DataA() AS BYTE    DIM CRC16Lo AS BYTE, CRC16Hi AS BYTE        'CRC寄存器    DIM CL     AS BYTE, CH       AS BYTE                  '多项式码&HA001    DIM SaveHi     AS BYTE, SaveLo       AS BYTE    DIM I     AS INTEGER    DIM Flag     AS INTEGER    DIM strMsg AS STRING    DIM intLen AS INTEGER    strMsg = Param1    REPLACE " " WITH "" IN StrMsg    intLen = LEN(strMsg) / 2 - 1    REDIM DataA(0 TO intLen) AS BYTE    FOR I = 0 TO intLen        DataA(I) = VAL("&H" & MID$(strMsg, I * 2 + 1, 2))    NEXT    CRC16Lo = &HFF    CRC16Hi = &HFF    CL = &H1    CH = &HA0    FOR I = 0 TO UBOUND(DataA, 1)        CRC16Lo = CRC16Lo XOR DataA(I)        FOR Flag = 0 TO 7            SaveHi = CRC16Hi            SaveLo = CRC16Lo            'CRC16Hi = CRC16Hi \ 2            SHIFT RIGHT CRC16Hi, 1            'CRC16Lo = CRC16Lo \ 2            SHIFT RIGHT CRC16Lo, 1            IF ((SaveHi AND &H1) = &H1) THEN                CRC16Lo = CRC16Lo OR &H80            END IF            IF ((SaveLo AND &H1) = &H1) THEN                CRC16Hi = CRC16Hi XOR CH                CRC16Lo = CRC16Lo XOR CL            END IF        NEXT Flag    NEXT    ERASE DataA    FUNCTION = RIGHT$("0" & HEX$(CRC16Lo), 2) & RIGHT$("0" & HEX$(CRC16Hi), 2)END FUNCTION FUNCTION myINSTRU ALIAS "myINSTRU" (BYVAL Param1 AS STRING) EXPORT AS STRING    DIM LParam1 AS STRING    DIM RETURNSTR AS STRING     RETURNSTR = "UNKNOWN"     LParam1 = TRIM$(Param1)    SELECT CASE LParam1        CASE "VERSION"             RETURNSTR = "VERSION 1.00 9AUG2023"        CASE "AUTHOR"             RETURNSTR = "Mongnewer"    END SELECT    FUNCTION = RETURNSTREND FUNCTION

不难看出，MKI/CVI MKS/CVS MKD/CVD这些函数在PowerBASIC里是保留的关键字，CRC16计算是我从CSDN上载了贴上去的，在这里感谢那位CSDN朋友的贡献。Modbus RTU一般使用十六进制浮点传送，因此程序里做了变换处理。

二、用VB6写COM组件

用VB6调用刚才编译后的MBFIEEE32PD.DLL非常容易，不需要做任何字符串处理，两者是100%一致的。做声明定义时完全按VB6的原则来即可，PowerBASIC是无条件遵从的。如果是写VB6应用程序，直接调用DLL中的函数，直接应用就可以了，这里路过就不多说了，还是接着往下写COM组件。

Private toSingle As SinglePrivate toDouble As Double Private Declare Function myMKI Lib "MBFIEEE32PD" (ByVal a As Integer) As StringPrivate Declare Function myCVI Lib "MBFIEEE32PD" (ByVal b As String) As IntegerPrivate Declare Function myMKL Lib "MBFIEEE32PD" (ByVal a As Long) As StringPrivate Declare Function myCVL Lib "MBFIEEE32PD" (ByVal b As String) As LongPrivate Declare Function myMKS Lib "MBFIEEE32PD" (ByVal a As Single) As StringPrivate Declare Function myCVS Lib "MBFIEEE32PD" (ByVal b As String) As SinglePrivate Declare Function myMKD Lib "MBFIEEE32PD" (ByVal a As Double) As StringPrivate Declare Function myCVD Lib "MBFIEEE32PD" (ByVal b As String) As DoublePrivate Declare Function myCRC16 Lib "MBFIEEE32PD" (ByVal a As String) As StringPrivate Declare Function myINSTRU Lib "MBFIEEE32PD" (ByVal a As String) As String Public Function ModbusRoutines(ByVal commandno As Integer, ByVal commandval As String) As String    Select Case commandno    Case 1        'MKI        ModbusRoutines = setMKI(Val(commandval))    Case 2        'MKL        ModbusRoutines = setMKL(Val(commandval))    Case 3        'MKS        ModbusRoutines = setMKS(Val(commandval))    Case 4        'MKD        ModbusRoutines = setMKD(Val(commandval))    Case 5        'CVI        ModbusRoutines = Str$(getCVI(commandval))    Case 6        'CVL        ModbusRoutines = Str$(getCVL(commandval))    Case 7        'CVS        toSingle = getCVS(commandval)        toDouble = toSingle        ModbusRoutines = Str$(toDouble)    Case 8        'CVD        ModbusRoutines = Str$(getCVD(commandval))    Case 9        'CRC16        ModbusRoutines = getCRC16(commandval)    Case 10        'Version        ModbusRoutines = getINSTRU(commandval)    End SelectEnd FunctionPrivate Function setMKI(ByVal a As Integer) As String    M2I3HiddenWND.Text1.Text = myMKI(a)    setMKI = M2I3HiddenWND.Text1.TextEnd FunctionPrivate Function getCVI(ByVal a As String) As Integer    M2I3HiddenWND.Text2.Text = a    getCVI = myCVI(M2I3HiddenWND.Text2.Text)End FunctionPrivate Function setMKL(ByVal a As Long) As String    M2I3HiddenWND.Text3.Text = myMKL(a)    setMKL = M2I3HiddenWND.Text3.TextEnd FunctionPrivate Function getCVL(ByVal a As String) As Long    M2I3HiddenWND.Text4.Text = a    getCVL = myCVL(M2I3HiddenWND.Text4.Text)End FunctionPrivate Function setMKS(ByVal a As Single) As String    M2I3HiddenWND.Text5.Text = myMKS(a)    setMKS = M2I3HiddenWND.Text5.TextEnd FunctionPrivate Function getCVS(ByVal a As String) As Single    M2I3HiddenWND.Text6.Text = a    getCVS = myCVS(M2I3HiddenWND.Text6.Text)End FunctionPrivate Function setMKD(ByVal a As Double) As String    M2I3HiddenWND.Text7.Text = myMKD(a)    setMKD = M2I3HiddenWND.Text7.TextEnd FunctionPrivate Function getCVD(ByVal a As String) As Double    M2I3HiddenWND.Text8.Text = a    getCVD = myCVD(M2I3HiddenWND.Text8.Text)End FunctionPrivate Function getCRC16(ByVal a As String) As String    getCRC16 = myCRC16(a)End FunctionPrivate Function getINSTRU(ByVal a As String) As String    getINSTRU = myINSTRU(a)End Function

打开VB6，选Active X，把上面的码贴进去，添加个无边的小窗体，放上Text1到Text7共7个文本框，Form的名字 M2I3HiddenWND，属性是 Hidden 隐藏的。文件名 MBFMODIEEE，类名 MBFIEEECRC，存盘、生成 MBFMODIEEE.DLL，即为其它开发环境使用的COM了。

加这个Hidden窗口是这么想的，VB6和PowerBASIC变量和字符串完全兼容，但Delphi7就不一定了，尤其是字符串存储方式的转换。从Delphi来的字符串显示在VB6的文本框可以，但直接传送给PowerBASIC或许有问题，于是就想让文本框做个过渡，或许直接传也不是问题，我没做验证。

因为这个DLL是COM，需要将 MBFMODIEEE.DLL和MBFIEEE32PD.DLL放在同一目录下，并在目录中放入Delphi7应用程序。为了让程序能互访，在CMD窗口里，转到它们所在的目录下，用regsvr32将MBFMODIEEE.DLL注册到系统中。regsvr32 MBFMODIEEE.DLL 回车即可。

三、用Delphi7写界面验证程序

在Delphi下引用刚才注册的MBFMODIEEE.DLL

在弹出的列表中选中刚才注册的MBFMODIEEE，并点击 Create Unit生成 MBFMODIEEE_TLB声明文件，刚才注册的DLL中要调用的类和接口就都有了。

在USE中引用生成的PAS，然后为接口声明个handle

在Form产生时创建对象

然后在需要的地方就可以通过接口使用对象中的功能函数了

然后就是正常的开发应用程序，编译后运行(有时开发环境下可能出现异常，但编译后运行是比较好的方法。都是老顽固，稳定可靠，但要就着它们的性子，不能太勉强了)。

BTW：这些功能除PowerBASIC外，FreeBASIC里更齐全，甚至包括了QBASIC的全部关键字，但它的字符串不同于VB和Delphi，需要另外处理。不过它可以写COM，除32位编译器，它还有64位编译器。