如何用vb6.0采用xml-rpc联接访问后台web
有两年都没有搞vb6了，转做 php 和 python ，但一直很怀念那段时光，无法割舍他的简单与实用，由于项目关系，时常也会用上vb6,
为此我也分享我应用的一些喜悦。
xml-rpc（什么叫xml-rpc,在这里我就不作过多的专业说明，大家可以 baidu一下） 其实也是满有用的，也是简单、实用，在一些小项目上可以做出很优越的表现，vb6结合xml-rpc与后台web服务器联结,真的可以说是太完美了，刚好可以结合我现在的项目。
言归正转，
需求分析：
1.客户端之前是用vb6写的，现在需要访问外部网络数据（比如获取实时外汇汇率，等等），但是又不想开放外网访问权限给你的客户端
2.目前有一台 web 服务器为apache + php 或 python
3.因为之前vb6写的程序不想一下全部转为 网页（因为这是个大工程）
解决方案：
（一） php 为后台web服务语言的解决方案：（服务器安装，这里就不讲了）
先下载 XML-RPC for PHP ，解压后放到你的服务器网页根目录下，用于后台 xml-rpc 服务，
现在你应该可以在服务器上执行：http://localhost/xmlrpc/debugger/index.php，
Address: localhost , Path: /xmlrpc/demo/server/server.php, 选择 list available methods, 点 execute 后，应该可以看到如下图结果，则说明你xml-rpc 服务可以使用。
（二）python 为后台web服务语言的解决方案：
python 本身就支持 xml-rpc的，在这里我写一个简单的服务器例子：
from xmlrpc.server import SimpleXMLRPCServer
from xmlrpc.server import SimpleXMLRPCRequestHandler
# Restrict to a particular path.
class RequestHandler(SimpleXMLRPCRequestHandler):
rpc_paths = ('/RPC2',)
# Create server
server = SimpleXMLRPCServer(("localhost", 8000),
requestHandler=RequestHandler)
server.register_introspection_functions()
# Register pow() function; this will use the value of
# pow.__name__ as the name, which is just 'pow'.
server.register_function(pow)
# Register a function under a different name
def adder_function(x,y):
return x + y
server.register_function(adder_function, 'add')
# Register an instance; all the methods of the instance are
# published as XML-RPC methods (in this case, just 'mul').
class MyFuncs:
def mul(self, x, y):
return x * y
server.register_instance(MyFuncs())
# Run the server's main loop
server.serve_forever()
保存为rpc.py文件在服务端，双击执行ok
（三） 现在讲 客户端 vb6 如何联接 web服务器
1.)先下载 两个dll: vbXML.dll , vbXMLRPC.dll ,分别为 xml-rpc 解析工具库，在这里有下载（还提供原代码哦）
http://www.enappsys.com/backend/vbXMLRPC/vbXMLRPCBinaries.jsp
2.) 接着注册COM
regsvr32 /s vbXML.dll
regsvr32 /s vbXMLRPC.dll
3.) 在vb6中引用，如下图
4.）vb6 客户端代码如何写，如下图
Option Explicit
Private Sub Command_Click()
Dim vRequest As New XMLRPCRequest
Dim vResponse As XMLRPCResponse
Dim vUtility As New XMLRPCUtility
Me.MousePointer = vbHourglass
Set vRequest = GetPYRpc("add")
vRequest.Params.AddInteger Text1.Text
vRequest.Params.AddInteger Text2.Text
'Debug.Print vRequest.XMLToSend
Set vResponse = vRequest.Submit
Select Case vResponse.Status
Case XMLRPC_PARAMSRETURNED
If vResponse.Params.Count = 1 Then
Debug.Print vResponse.HTTPHeaders
Debug.Print vResponse.XMLResponse
Text3.Text = vResponse.Params(1).IntegerValue
Else
BugOut "Expecting one return parameter, received '" & vResponse.Params.Count & "'."
End If
Case XMLRPC_FAULTRETURNED
BugOut "Server returned a fault. Code is '" & vResponse.Fault.FaultCode & "', description is '" & vResponse.Fault.FaultString & "'."
Case XMLRPC_HTTPERROR
BugOut "HTTP error encountered. Code is '" & vResponse.HTTPStatusCode & "', description is '" & vUtility.GetHTTPError(vResponse.HTTPStatusCode) & "'."
Case XMLRPC_XMLPARSERERROR
BugOut "XML Parsing Error encountered '" & vResponse.XMLParseError & "'."
Case XMLRPC_NOTINITIALISED
BugOut "Weird, the response claims not to be initialised !!!"
Case Else
BugOut "Double Weird, unknown response status '" & vResponse.Status & "'."
End Select
Me.MousePointer = vbDefault
End Sub
Private Sub BugOut(ByVal vstrError As String)
MsgBox vstrError, vbOKOnly + vbCritical, App.Title
End Sub
Option Explicit
Public Function GetPHPRpc(ByVal vMethod As String) As XMLRPCRequest
Dim mReq As XMLRPCRequest
Set mReq = New XMLRPCRequest
mReq.ConnectTimeOut = 60
mReq.ReceiveTimeOut = 60
mReq.SendTimeOut = 60
mReq.HostName = "localhost"
mReq.HostPort = 80
mReq.HostURI = "/xmlrpc/demo/server/server.php"
mReq.MethodName = vMethod
Set GetPHPRpc = mReq
End Function
Public Function GetPYRpc(ByVal vMethod As String) As XMLRPCRequest
Dim mReq As XMLRPCRequest
Set mReq = New XMLRPCRequest
mReq.ConnectTimeOut = 0
mReq.ReceiveTimeOut = 0
mReq.SendTimeOut = 120
mReq.HostName = "localhost"
mReq.HostPort = 8000
mReq.HostURI = "/RPC2"
mReq.MethodName = vMethod
Set GetPYRpc = mReq
End Function
测试结果如下图：