分三步走:
用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位编译器。