FreeBASIC通过Delphi7 DLL调用MS SOAP使用VB6 Webservice

前几篇笔记习练了IIS soapis30配置、VB6 webservice创建、Delphi7和VB6 webservice访问：

VB6 COM webservice发布，VB.NET和Delphi 7 对webservice访问，及MS Soap Toolkit 3.0在IIS上的ISAPI配置_Mongnewer的博客-CSDN博客

本篇笔记重点编写 Delphi7 DLL 对MS soap3 进行封装，让FreeBASIC通过Delphi7的DLL封装，访问IIS上的Webservice。

主要任务是：1. 编写 Delphi7 DLL， 2. 编写FreeBasic调用程序。

• 编写 Delphi7 DLL

打开Delphi7 ， File -> New -> others -> DLL wizard

在创建的DLL项目Project2上引入 Microsoft Soap Type Library v3.0(Version 3.0)

在Project2.pas中use引用的 MSSOAPLib30_TLB

编写三个function，一个是初始化dpSoap3Init、一个是dpEchoString、一个是dpAddNumbers，全部程序如下：

library Project2;

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  StrUtils,
  COMobj,
  MSSOAPLib30_TLB in 'C:\Program Files (x86)\Borland\Delphi7\Imports\MSSOAPLib30_TLB.pas';

type
  TinRecord = record
  vi_param1: short;
  vi_param2: short;
End;

var
    mySoapClient3: OleVariant;

function dpSoap3Init(): integer; stdcall;
    begin
        try
        mySoapClient3:= CreateOleObject('MSSOAP.SoapClient30');
        mySoapClient3.mssoapinit('http://192.168.3.113/Soap3DocSamples/DocSample1/Server/TestWEBservice.WSDL', 'TestWEBservice', 'Sample1SoapPort');
        Result:= 0;
        except
        Result:= 1;
        end;
    end;

function dpEchoString(inChars: pchar): pchar; stdcall;
    var
      I: integer;
      fromFBstring: string;
      fromWSDLstring: string;
      p: pchar;
    begin
        fromFBstring:='';
        for I:=0 to 255 do
            begin
              fromFBstring:= fromFBstring + inChars^;
              inc(inChars);
            end;
        fromFBstring:= Trim(fromFBstring);
        fromWSDLstring:= mySoapClient3.EchoString(fromFBstring);

        p:= pchar(fromWSDLstring);
        Result:= p;
    end;

function dpAddNumbers(inType: Pointer): smallint;
    var
      nBlock: TinRecord;
    begin
        CopyMemory(@nBlock, inType, sizeof(nBlock));
        Result:= mySoapClient3.AddNumbers(nBlock.vi_param1, nBlock.vi_param2);
    end;

exports
dpSoap3Init,
dpEchoString,
dpAddNumbers;

{$R *.res}

begin

end.

写好代码，然后编译生成 Project.DLL，放到FreeBasic项目的Release下(后面会进一步讲到)。

接下来，创建FreeBASIC标准32位x86窗体项目，放上一些控件，并在窗体通用中放入代码 Dim Shared library As Any Ptr， 这个library将作为动态装入Project2.DLL的指针，供整个程序运行期使用。

在窗体Create创建时，动态调入Project2.DLL，这个DLL要放在工程的 Release下面，与工程的exe放在一起。调入Project2.DLL后取得指针 library，利用指针找到 dpSoap3Init 过程入口地址，然后调用它，并在Text1中显示调用结果，为0表示成功，为1表示失败。

Sub Form1_WM_Create(hWndForm As hWnd, UserData As Integer)
   library = DyLibLoad("Project2") '就文件名，不能带 .DLL 
   If (library = 0) Then
      AfxMsg "加载DLL失败"
      Return
   End If
   
   Dim retVal As Integer 
   Dim FuncSoap As Function() As Integer
   FuncSoap = DyLibSymbol(library, "dpSoap3Init")
   If (FuncSoap = 0) Then
      AfxMsg "无法从开发DLL例题库中检索dpSoap3Init（）函数的地址"
      Return
   End If
   
   retVal = FuncSoap()
   Text1.text = Str(retVal)      'Should be 0 if success
End Sub

当项目运行结束时，释放 Project2.DLL，此时会用到 library 指针。

Function Form1_WM_Close(hWndForm As hWnd) As LResult
   DyLibFree(library)
   Function = False ' 返回 TRUE 阻止关闭窗口。
End Function

dpEchoString的实现。找到dpEchoString函数入口，将字符数组的首地址交给它，然后取得返回的字符数组的首地址。依据返回的首地址，变回Project.DLL发送出来的完整字符串。字符数组长度为256，足以满足使用要求。

   '===============================================================================================   
   Dim fHello As Function(ByVal As UByte Ptr) As UByte Ptr
   fHello = DyLibSymbol(library, "dpEchoString")
   
   If (fHello = 0) Then
      AfxMsg "无法从开发DLL例题库中检索dpEchoString（）函数的地址"
      Return
   End If
   
   Dim I As Integer
   Dim J As UByte Ptr
   Dim sTempString As String
   Dim sParam(255) As UByte
   
   sTempString = Trim(Text6.text) & " "
   memcpy(@sParam(0), StrPtr(sTempString), Len(sTempString))
   J= fHello(@sParam(0))
      
   sTempString = ""
   For I = 0 To 255
      sTempString = sTempString + Chr(*(J+I))
   Next I
   Text3.text = Trim(sTempString)

再看一下Project2.DLL中对应的代码，它接收来自FreeBASIC的指针，变成字符串后发送给MS Soap Toolkit3的SoapClient3实例mySoapClient3，并接收它返回的字符串，其pchar指针返回给FreeBASIC

function dpEchoString(inChars: pchar): pchar; stdcall;
    var
      I: integer;
      fromFBstring: string;
      fromWSDLstring: string;
      p: pchar;
    begin
        fromFBstring:='';
        for I:=0 to 255 do
            begin
              fromFBstring:= fromFBstring + inChars^;
              inc(inChars);
            end;
        fromFBstring:= Trim(fromFBstring);
        fromWSDLstring:= mySoapClient3.EchoString(fromFBstring);

        p:= pchar(fromWSDLstring);
        Result:= p;
    end;

dpAddNumbers调用使用了变量结构体，取得dpAddNumbers地址后通过它发送结构的地址指针，并在函数返回时获得16位short类型数据值。

   Type TParam1
      vi_Param1 As Short
      vi_Param2 As Short
   End Type
   
   Dim fAddNumbers As Function(ByVal As Any Ptr) As Short
   fAddNumbers = DyLibSymbol(library, "dpAddNumbers")
   
   If (fAddNumbers = 0) Then
      AfxMsg "无法从开发DLL例题库中检索dpAddNumbers（）函数的地址"
      Return
   End If
   
   Dim Resultval As Short
   Dim nParam1 As TParam1
   nParam1.vi_Param1 = Val(Text4.text): nParam1.vi_Param2 = Val(Text5.text)
   Resultval = fAddNumbers(@nParam1)
   Text2.text = Str(Resultval)

在Project2.DLL中，也使用了一个定义好的结构体TinRecord。当收到FreeBASIC的结构体指针后，直接将其指向的内容复制给TinRecord结构体实例，然后直接将结构体中的变量发送给mySoapClient3，并将返回的结果返送给FreeBASIC

function dpAddNumbers(inType: Pointer): smallint;
    var
      nBlock: TinRecord;
    begin
        CopyMemory(@nBlock, inType, sizeof(nBlock));
        Result:= mySoapClient3.AddNumbers(nBlock.vi_param1, nBlock.vi_param2);
    end;

type
  TinRecord = record
  vi_param1: short;
  vi_param2: short;
End;

至此，FreeBASIC通过Delphi7 DLL顺利访问IIS的VB6 webservice

FreeBASIC有个开发中的axSuite是做COM访问的，我还没有试用过。这篇笔记只是针对MS Soap Toolkit 3.0的习练。