VFP连接SAP的RFC函数接口

 *"----------------------------------------------------------------------
* 程序: SAP连接及RFC函数接口
* 设计: 红雨
* 日期: 2008.06.25
*"----------------------------------------------------------------------

Clear
Set Talk Off
Set Safety Off

* 定义参数对象
Local loSAP As Object
m.loSAP = SAPFunctionCreate( "ZMM_RFC_TEST", "TMM", "123456", "192.168.0.50", "", "DEV", "110", "00", "ZH")

* === 获取表
= SAPFunctionTables( m.loSAP, "T_Dealer" )
= SAPFunctionTables( m.loSAP, "T_Test" )
* === 输入参数
= SAPFunctionImporting( m.loSAP, "P_NAME", "塑料" )
* === 输出参数
= SAPFunctionExporting( m.loSAP, "P_USER", "" )
* === 回写表
Local lcReTable
m.lcReTable = "T_Print"
Create Cursor (m.lcReTable) (PTYPE C(2), PCARD C(10), PUSER C(12), PDATE D, PTIME C(8))
Insert Into (m.lcReTable) Values ("TT", "180000082", "红雨", Date(), Time(Datetime()))
Insert Into (m.lcReTable) Values ("TT", "180000085", "江南", Date(), Time(Datetime()))
= SAPFunctionReTables( m.loSAP, m.lcReTable )

If SAPFunctionCall( m.loSAP )
    * 输出参数
    Local loExport
    For Each m.loExport In m.loSAP.Exporting
        If Type("m.loExport.Name")="C" And !Empty(m.loExport.Name)
            ? "输出参数:", m.loExport.Name + " = " +  m.loExport.Value
        Endif
    Endfor
    * 获取表
    Local lcTable
    For Each m.lcTable In m.loSAP.GetTables
        If Type("m.lcTable")="C" And Used(m.lcTable)
            Select (m.lcTable)
            Go Top
            Browse
        Endif
    Endfor
Else
    = Messagebox("连接失败！", 0+16+0, "SAP函数")
Endif

Return

*"----------------------------------------------------------------------
Function SAPFunctionCall( toSAP As Object )
    Local IsOK As Boolean
    Local loConn, loFunc, loTable, loRow, loCol
    Local lcTable, loExport, loImport
    Local lcScript

    m.IsOK = .F.
    For Each m.lcTable In m.toSAP.GetTables
        If Type("m.lcTable")="C" And Used(m.lcTable)
            Use In (m.lcTable)
        Endif
    Endfor

    m.loConn = Createobject("SAP.FUNCTIONS.UNICODE")
    m.loConn.Connection.User = m.toSAP.User
    m.loConn.Connection.Password = m.toSAP.Password
    m.loConn.Connection.ApplicationServer = m.toSAP.ApplicationServer
    m.loConn.Connection.SAPRouter = m.toSAP.SAPRouter
    m.loConn.Connection.System = m.toSAP.System
    m.loConn.Connection.Client = m.toSAP.Client
    m.loConn.Connection.SystemNumber = m.toSAP.SystemNumber
    m.loConn.Connection.Language = m.toSAP.Language
    m.loConn.Connection.Codepage = m.toSAP.Codepage
    m.loConn.Connection.AutoLogon = .F.

    If m.loConn.Connection.Logon(0,.T.) And m.loConn.Connection.IsConnected=1
        * 函数名称
        m.loFunc = m.loConn.Add(m.toSAP.Function)

        * 输入参数赋值
        For Each m.loImport In m.toSAP.Importing
            If Type("m.loImport.Name")="C" And !Empty(m.loImport.Name)
                m.loFunc.Exports(m.loImport.Name) = m.loImport.Value
            Endif
        Endfor

        * 回写表赋值
        For Each m.lcTable In m.toSAP.PutTables
            m.loTable = m.loFunc.Tables(m.lcTable)

            * 清空数据对象
            For Each m.loRow In m.loTable.Rows
                m.loTable.DeleteRow(m.loRow.Index)
            Endfor

            * 填充数据对象
            Select (m.lcTable)
            Scan
                m.loRow = m.loTable.AppendRow
                For Each m.loCol In m.loTable.Columns
                    If Type(m.lcTable+"."+m.loCol.Name) # "U"
                        m.loRow.Value(m.loCol.Name) = Evaluate(m.loCol.Name)
                    Endif
                Endfor
            Endscan
        Endfor

        * 执行函数
        If m.loFunc.Call
            m.IsOK = .T.

            * 获取输出参数
            For Each m.loExport In m.toSAP.Exporting
                If Type("m.loExport.Name")="C" And !Empty(m.loExport.Name)
                    m.loImport = m.loFunc.Imports(m.loExport.Name)
                    m.loExport.Value = m.loImport.Value
                Endif
            Endfor

            * 获取表
            For Each m.lcTable In m.toSAP.GetTables
                If Type("m.lcTable")="C" And !Empty(m.lcTable)
                    m.loTable = m.loFunc.Tables(m.lcTable)

                    * 获取表结构
                    m.lcScript = "Create Cursor "+m.lcTable+" ( ;"+Chr(13)+Chr(10)
                    For Each m.loCol In m.loTable.Columns
                        m.lcScript = m.lcScript + "    " + SAPGetField(m.loCol) +", ;"+Chr(13)+Chr(10)
                    Endfor
                    m.lcScript = m.lcScript + "    i_VFP_Recno I AUTOINC)"+Chr(13)+Chr(10)
                    Execscript( m.lcScript )

                    * 获取表数据
                    For Each m.loRow In m.loTable.Rows     && 记录
                        Select (m.lcTable)
                        Append Blank
                        For Each m.loCol In m.loTable.Columns  && 字段
                            Do Case
                                Case m.loCol.TypeName=="BCD RFC"     && 数值
                                    Replace (m.loCol.Name) With Val(m.loRow.Value(m.loCol.Name))
                                Case m.loCol.TypeName=="Time RFC"    && 时间
                                    Replace (m.loCol.Name) With Time(m.loRow.Value(m.loCol.Name))
                                Case m.loCol.TypeName=="Date RFC"    && 日期
                                    Replace (m.loCol.Name) With m.loRow.Value(m.loCol.Name)
                                Otherwise                            && 其她
                                    Replace (m.loCol.Name) With m.loRow.Value(m.loCol.Name)
                            Endcase
                        Endfor
                    Endfor
                    m.IsOK = m.IsOK And Used(m.lcTable)
                Endif
            Endfor
        Else
            m.loConn.Connection.LastError
        Endif
        m.loConn.Connection.Logoff
    Endif
    Return m.IsOK
Endfunc

*"----------------------------------------------------------------------
* 转换SAP字段类型
*"----------------------------------------------------------------------
Function SAPGetField( toColumn )
    Local lcRetu
    m.lcRetu = ""
    If Type("m.toColumn.Name")="C"
        m.toColumn.Decimals = Min(8,m.toColumn.Decimals) && 调整最多8位小数
        Do Case
            Case m.toColumn.TypeName=="Long RFC"  && 整形
                m.lcRetu = m.toColumn.Name+" I"
            Case m.toColumn.TypeName=="Date RFC"  && 日期
                m.lcRetu = m.toColumn.Name+" D"
            Case m.toColumn.TypeName=="Time RFC"  && 时间
                m.lcRetu = m.toColumn.Name+" C(8)"
            Case m.toColumn.TypeName=="BCD RFC"   && 数值
                m.lcRetu = m.toColumn.Name+" N"
                If m.toColumn.IntLength > 0
                    m.lcRetu = m.lcRetu + "(" + Alltrim(Str(m.toColumn.IntLength+m.toColumn.Decimals))
                    If m.toColumn.Decimals > 0
                        m.lcRetu = m.lcRetu + "," + Alltrim(Str(m.toColumn.Decimals))
                    Endif
                    m.lcRetu = m.lcRetu + ")"
                Endif
            Case m.toColumn.TypeName=="Float RFC" && 浮点
                m.lcRetu = m.toColumn.Name+" F"
                If m.toColumn.IntLength > 0
                    m.lcRetu = m.lcRetu + "(" + Alltrim(Str(m.toColumn.IntLength+m.toColumn.Decimals))
                    If m.toColumn.Decimals > 0
                        m.lcRetu = m.lcRetu + "," + Alltrim(Str(m.toColumn.Decimals))
                    Endif
                    m.lcRetu = m.lcRetu + ")"
                Endif
            Otherwise
                If m.toColumn.IntLength > 127
                    m.lcRetu = m.toColumn.Name+" M"   && 备注
                Else
                    m.lcRetu = m.toColumn.Name+" C"   && 字符
                    If m.toColumn.IntLength > 0
                        m.lcRetu = m.lcRetu + "(" + Alltrim(Str(m.toColumn.IntLength)) + ")"
                    Endif
                Endif
        Endcase
    Endif
    Return m.lcRetu
Endfunc

*"----------------------------------------------------------------------
* 定义参数对象
*"----------------------------------------------------------------------
Function SAPFunctionCreate( tcFuncName, tcUser, tcPass, tcServer, tcSAPRouter, tcSystem, tcClient, tcNumber, tcLanguage )
    Local loSAP As Object
    m.loSAP = Createobject("Empty")
    = AddProperty(m.loSAP,"User",                m.tcUser)
    = AddProperty(m.loSAP,"Password",            m.tcPass)
    = AddProperty(m.loSAP,"ApplicationServer", m.tcServer)
    = AddProperty(m.loSAP,"SAPRouter",      m.tcSAPRouter)
    = AddProperty(m.loSAP,"System",            m.tcSystem)
    = AddProperty(m.loSAP,"Client",            m.tcClient)
    = AddProperty(m.loSAP,"SystemNumber",      m.tcNumber)
    = AddProperty(m.loSAP,"Language",        m.tcLanguage)
    = AddProperty(m.loSAP,"Codepage",                8400)

    = AddProperty(m.loSAP,"Function", tcFuncName)
    = AddProperty(m.loSAP,"GetTables[1]", Null)
    = AddProperty(m.loSAP,"Importing[1]", Null)
    = AddProperty(m.loSAP,"Exporting[1]", Null)
    = AddProperty(m.loSAP,"PutTables[1]", Null)
    Return m.loSAP
Endfunc

*"----------------------------------------------------------------------
* === 获取表
*"----------------------------------------------------------------------
Function SAPFunctionTables( toSAP, tcTableName )
    If Type("m.toSAP.Function") = "C"
        Local lnRow
        m.lnRow = Alen(m.toSAP.GetTables)
        If Type("m.toSAP.GetTables[m.lnRow]")="C"
            m.lnRow = m.lnRow + 1
            Dimension m.toSAP.GetTables[m.lnRow]
        Endif
        m.toSAP.GetTables[m.lnRow] = tcTableName
    Endif
Endfunc

*"----------------------------------------------------------------------
* === 回写表
*"----------------------------------------------------------------------
Function SAPFunctionReTables( toSAP, tcTableName )
    If Type("m.toSAP.Function") = "C"
        Local lnRow
        m.lnRow = Alen(m.toSAP.PutTables)
        If Type("m.toSAP.PutTables[m.lnRow]")="C"
            m.lnRow = m.lnRow + 1
            Dimension m.toSAP.PutTables[m.lnRow]
        Endif
        m.toSAP.PutTables[m.lnRow] = tcTableName
    Endif
Endfunc

*"----------------------------------------------------------------------
* === 输入参数
*"----------------------------------------------------------------------
Function SAPFunctionImporting( toSAP, tcName, tcValue )
    If Type("m.toSAP.Function") = "C"
        Local lnRow
        m.lnRow = Alen(m.toSAP.Importing)
        If Type("m.toSAP.Importing[m.lnRow]")="O"
            m.lnRow = m.lnRow + 1
            Dimension m.toSAP.Importing[m.lnRow]
        Endif
        m.toSAP.Importing[m.lnRow] = Createobject("Empty")
        = AddProperty( m.toSAP.Importing[m.lnRow],"Name",tcName)
        = AddProperty( m.toSAP.Importing[m.lnRow],"Value",tcValue)
    Endif
Endfunc

*"----------------------------------------------------------------------
* === 输出参数
*"----------------------------------------------------------------------
Function SAPFunctionExporting( toSAP, tcName, tcValue )
    If Type("m.toSAP.Function") = "C"
        Local lnRow
        m.lnRow = Alen(m.toSAP.Exporting)
        If Type("m.toSAP.Exporting[m.lnRow]")="O"
            m.lnRow = m.lnRow + 1
            Dimension m.toSAP.Exporting[m.lnRow]
        Endif
        m.toSAP.Exporting[m.lnRow] = Createobject("Empty")
        = AddProperty( m.toSAP.Exporting[m.lnRow],"Name",tcName)
        = AddProperty( m.toSAP.Exporting[m.lnRow],"Value",tcValue)
    Endif
Endfunc

*"----------------------------------------------------------------------