Imports Microsoft.VisualBasic
Imports SAP.Middleware.Connector
Imports System.Data
Imports System.IO
Imports LogInfo
Imports System.Diagnostics
Imports System.Collections
Imports System.Collections.Generic
Public Class SAPRFC
Implements IDestinationConfiguration '继承接口
Public Destination As RfcDestination 'SAP Connector3.0 的RFC源
Public SapFunction As IRfcFunction 'SAP RFC函数调用
Public mystruct As IRfcStructure
Public datatbl As IRfcTable '调用到的RFC SAP table
Public optionstbl As IRfcTable '调用到的OPTIONS table
Public fieldtbl As IRfcTable '调用到的FIELD table
Public ID As IDestinationConfiguration '继承
Public Function ChangeEventsSupported() As Boolean Implements IDestinationConfiguration.ChangeEventsSupported
Return False
End Function
Public Event ConfigurationChanged(ByVal destinationName As String, ByVal args As RfcConfigurationEventArgs) Implements IDestinationConfiguration.ConfigurationChanged '事件
Public Function GetParameters(ByVal destinationName As String) As RfcConfigParameters Implements IDestinationConfiguration.GetParameters
Dim parms As RfcConfigParameters = New RfcConfigParameters()
If ("qas_000".Equals(destinationName)) Then
parms.Add(RfcConfigParameters.AppServerHost, "") 'SAP主机IP
parms.Add(RfcConfigParameters.SystemNumber, "") 'SAP实例
parms.Add(RfcConfigParameters.User, "") ' 用户名
parms.Add(RfcConfigParameters.Password, "") '密码
parms.Add(RfcConfigParameters.Client, "777") ' Client
parms.Add(RfcConfigParameters.Language, "EN") '登陆语言
parms.Add(RfcConfigParameters.PoolSize, "5")
parms.Add(RfcConfigParameters.PeakConnectionsLimit, "10")
parms.Add(RfcConfigParameters.IdleTimeout, "6000")
Return parms
ElseIf ("prd_000".Equals(destinationName)) Then
'parms.Add(RfcConfigParameters.AppServerHost, "") 'SAP主机IP
parms.Add(RfcConfigParameters.AppServerHost, "") 'SAP主机IP
parms.Add(RfcConfigParameters.SystemNumber, "") 'SAP实例
parms.Add(RfcConfigParameters.User, "P") ' 用户名
parms.Add(RfcConfigParameters.Password, "") '密码
parms.Add(RfcConfigParameters.Client, "777") ' Client
parms.Add(RfcConfigParameters.Language, "EN") '登陆语言
parms.Add(RfcConfigParameters.PoolSize, "5")
'parms.Add(RfcConfigParameters.MaxPoolSize, "10")
parms.Add(RfcConfigParameters.PeakConnectionsLimit, "10")
parms.Add(RfcConfigParameters.IdleTimeout, "6000")
Return parms
ElseIf ("qa1_000".Equals(destinationName)) Then
'parms.Add(RfcConfigParameters.AppServerHost, "") 'SAP主机IP
parms.Add(RfcConfigParameters.AppServerHost, "") 'SAP主机IP
parms.Add(RfcConfigParameters.SystemNumber, "") 'SAP实例
parms.Add(RfcConfigParameters.User, "") ' 用户名
parms.Add(RfcConfigParameters.Password, "") '密码
parms.Add(RfcConfigParameters.Client, "777") ' Client
parms.Add(RfcConfigParameters.Language, "EN") '登陆语言
parms.Add(RfcConfigParameters.PoolSize, "5")
'parms.Add(RfcConfigParameters.MaxPoolSize, "10")
parms.Add(RfcConfigParameters.PeakConnectionsLimit, "10")
parms.Add(RfcConfigParameters.IdleTimeout, "6000")
Return parms
Else
Return Nothing
End If
End Function
Function ConnectSAP() As Boolean
Dim GetSapValue = System.Configuration.ConfigurationManager.AppSettings("SAP_Destination")
'Dim ID As IDestinationConfiguration = New SAPRFC() '继承
ID = New SAPRFC()
Try
If Destination Is Nothing Then
RfcDestinationManager.RegisterDestinationConfiguration(ID)
If GetSapValue = "QAS" Then
Destination = RfcDestinationManager.GetDestination("qas_000") '连接SAP, SAPConnector 3.0方式 QAS SYSTEM
ElseIf GetSapValue = "PRDALL" Then
Destination = RfcDestinationManager.GetDestination("prd_000") '连接SAP, SAPConnector 3.0方式 PRD SYSTEM
ElseIf GetSapValue = "QA1" Then
Destination = RfcDestinationManager.GetDestination("qa1_000")
End If
'RfcDestinationManager.UnregisterDestinationConfiguration(ID)
End If
Return True
Catch ex As RfcCommunicationException
Loger.Error("RfcCommunicationError:" & ex.Message.ToString)
Return False
Catch ex As RfcLogonException
Loger.Error("RfcLogonExceptionError:" & ex.Message.ToString)
Return False
Catch ex As RfcAbapRuntimeException
Loger.Error("RfcAbapRuntimeError:" & ex.Message.ToString)
Return False
Catch ex As RfcAbapBaseException
Loger.Error("RfcAbapBaseError:" & ex.Message.ToString)
Return False
Catch ex As Exception
Loger.Error(ex.Message.ToString)
Return False
End Try
End Function
Public Function ReadTableVBRK(ByVal strDOFrDate As String, ByVal strDOToDate As String) As DataTable
'VBELN is Billing document
'FKART is Billing type
'FKTYP is Billing category
'VBTYP is SD document category
'WAERK is SD document currency
'VKORG is Sales organization
'FKDAT is Billing date for billing index and printout
'BUKRS is Company Code
'KUNRG is Payer party
'KUNAG is Sold-to party
'KURST is Exchange rate type
'SFAKN is Cancelled billing document number
'KURRF is Exchange rate for FI postings
'CMKUF is Credit data exchange rate at billing document rate
'INCO1 is Incoterms (part 1)
Try
Destination = Nothing
SapFunction = Nothing
datatbl = Nothing
If ConnectSAP() = True Then
SapFunction = Destination.Repository.CreateFunction("RFC_READ_TABLE") '建立一个函数对象
SapFunction.SetValue("QUERY_TABLE", "VBRK")
'SapFunction.SetValue("DELIMITER", ";")
'SapFunction.SetValue("NO_DATA", "X")
fieldtbl = SapFunction.GetTable("FIELDS")
If fieldtbl.ElementCount = 0 Then
fieldtbl.Append()
fieldtbl.SetValue(0, "VBELN")
fieldtbl.Append()
fieldtbl.SetValue(0, "FKART")
fieldtbl.Append()
fieldtbl.SetValue(0, "FKTYP")
fieldtbl.Append()
fieldtbl.SetValue(0, "VBTYP")
fieldtbl.Append()
fieldtbl.SetValue(0, "WAERK")
fieldtbl.Append()
fieldtbl.SetValue(0, "VKORG")
fieldtbl.Append()
fieldtbl.SetValue(0, "FKDAT")
fieldtbl.Append()
fieldtbl.SetValue(0, "BUKRS")
fieldtbl.Append()
fieldtbl.SetValue(0, "KUNRG")
fieldtbl.Append()
fieldtbl.SetValue(0, "KUNAG")
fieldtbl.Append()
fieldtbl.SetValue(0, "KURST")
fieldtbl.Append()
fieldtbl.SetValue(0, "SFAKN")
fieldtbl.Append()
fieldtbl.SetValue(0, "KURRF")
fieldtbl.Append()
fieldtbl.SetValue(0, "CMKUF")
fieldtbl.Append()
fieldtbl.SetValue(0, "INCO1")
fieldtbl.Append()
fieldtbl.SetValue(0, "ERDAT")
End If
optionstbl = SapFunction.GetTable("OPTIONS")
If optionstbl.ElementCount = 0 Then
optionstbl.Append()
optionstbl.SetValue(0, " ERDAT >= '" & strDOFrDate & "' ")
optionstbl.Append()
optionstbl.SetValue(0, " AND ERDAT <= '" & strDOToDate & "' ")
optionstbl.Append()
optionstbl.SetValue(0, " AND VKORG = 'CSU' ")
optionstbl.Append()
optionstbl.SetValue(0, " AND FKART LIKE 'ZA%'")
optionstbl.Append()
optionstbl.SetValue(0, " AND BUKRS = 'CSU'")
optionstbl.Append()
optionstbl.SetValue(0, " AND WAERK = 'RMB'")
End If
SapFunction.Invoke(Destination) '激活提交
datatbl = SapFunction.GetTable("DATA") '返回表
End If
Catch ex As Exception
datatbl = Nothing
Loger.Error(ex.Message.ToString)
Finally
RfcDestinationManager.UnregisterDestinationConfiguration(ID)
ID = Nothing
SapFunction = Nothing
Destination = Nothing
End Try
Return GetDataTableFromRfcTable(datatbl)
End Function
Public Function ReadTableVBRP(ByVal dtVBRK As DataTable, ByVal i As Long) As DataTable
'VBELN is Billing document
'POSNR is Billing item
'FKIMG is Actual billed quantity
'NETWR is Net value of the billing item in document currency
'VGBEL is Document number of the reference document
'VGPOS is Item number of the reference item
'VGTYP is Document category of preceding SD document
'AUBEL is Sales document
'AUPOS is Sales document item
'MATNR is Material number
'CHARG is Batch number
'MATKL is Material group
'PSTYV is Sales document item category
'WERKS is Plant
'MWSBP is Tax amount in document currency
'SKFBP is Amount eligible for cash discount in document currency
'AUTYP is SD document category
'WAVWR is Cost in document currency
'LGORT is Storage location
'VRKME is Sales unit
Try
Destination = Nothing
SapFunction = Nothing
datatbl = Nothing
If ConnectSAP() = True Then
SapFunction = Destination.Repository.CreateFunction("RFC_READ_TABLE") '建立一个函数对象
SapFunction.SetValue("QUERY_TABLE", "VBRP")
'SapFunction.SetValue("DELIMITER", ";")
'SapFunction.SetValue("NO_DATA", "X")
fieldtbl = SapFunction.GetTable("FIELDS")
If fieldtbl.ElementCount = 0 Then
fieldtbl.Append()
fieldtbl.SetValue(0, "VBELN")
fieldtbl.Append()
fieldtbl.SetValue(0, "POSNR")
fieldtbl.Append()
fieldtbl.SetValue(0, "FKIMG")
fieldtbl.Append()
fieldtbl.SetValue(0, "NETWR")
fieldtbl.Append()
fieldtbl.SetValue(0, "VGBEL")
fieldtbl.Append()
fieldtbl.SetValue(0, "VGPOS")
fieldtbl.Append()
fieldtbl.SetValue(0, "VGTYP")
fieldtbl.Append()
fieldtbl.SetValue(0, "AUBEL")
fieldtbl.Append()
fieldtbl.SetValue(0, "AUPOS")
fieldtbl.Append()
fieldtbl.SetValue(0, "MATNR")
fieldtbl.Append()
fieldtbl.SetValue(0, "CHARG")
fieldtbl.Append()
fieldtbl.SetValue(0, "MATKL")
fieldtbl.Append()
fieldtbl.SetValue(0, "PSTYV")
fieldtbl.Append()
fieldtbl.SetValue(0, "WERKS")
fieldtbl.Append()
fieldtbl.SetValue(0, "MWSBP")
fieldtbl.Append()
fieldtbl.SetValue(0, "SKFBP")
fieldtbl.Append()
fieldtbl.SetValue(0, "AUTYP")
fieldtbl.Append()
fieldtbl.SetValue(0, "WAVWR")
fieldtbl.Append()
fieldtbl.SetValue(0, "LGORT")
fieldtbl.Append()
fieldtbl.SetValue(0, "VRKME")
End If
optionstbl = SapFunction.GetTable("OPTIONS")
If optionstbl.ElementCount = 0 Then
optionstbl.Append()
optionstbl.SetValue(0, " VBELN = '" & Trim(dtVBRK.Rows(i)(0).Substring(0, 10).ToString()) & "' ")
optionstbl.Append()
optionstbl.SetValue(0, " AND WERKS = 'CSU1' ")
optionstbl.Append()
optionstbl.SetValue(0, " AND VGTYP IN ('J', 'T') ")
End If
SapFunction.Invoke(Destination) '激活提交
datatbl = SapFunction.GetTable("DATA") '返回表
End If
Catch ex As RfcCommunicationException
datatbl = Nothing
Loger.Error("RfcCommunicationError:" & ex.Message.ToString)
Catch ex As RfcLogonException
Loger.Error("RfcLogonExceptionError:" & ex.Message.ToString)
Catch ex As RfcAbapRuntimeException
datatbl = Nothing
Loger.Error("RfcAbapRuntimeError:" & ex.Message.ToString)
Catch ex As RfcAbapBaseException
datatbl = Nothing
Loger.Error("RfcAbapBaseError:" & ex.Message.ToString)
Catch ex As Exception
datatbl = Nothing
Loger.Error(ex.Message.ToString)
Finally
RfcDestinationManager.UnregisterDestinationConfiguration(ID)
ID = Nothing
SapFunction = Nothing
Destination = Nothing
End Try
Return GetDataTableFromRfcTable(datatbl)
End Function
Public Function ReadTableLIPS(ByVal strDOVBELN As String, ByVal strDOPOSNR As String) As DataTable
''the function is used to get the post goods lines of delivery order from SAP table LIPS
'selected(fields)
'VBELN is Delivery order number
'POSNR is Delivery item
'MATNR is Material number
'MTART is Material type
'LFIMG is Actual quantity delivered
'EMPST is Receiving point for RSN number
Try
Destination = Nothing
SapFunction = Nothing
datatbl = Nothing
If ConnectSAP() = True Then
SapFunction = Destination.Repository.CreateFunction("RFC_READ_TABLE") '建立一个函数对象
SapFunction.SetValue("QUERY_TABLE", "LIPS")
'SapFunction.SetValue("DELIMITER", ";")
'SapFunction.SetValue("NO_DATA", "X")
fieldtbl = SapFunction.GetTable("FIELDS")
If fieldtbl.ElementCount = 0 Then
fieldtbl.Append()
fieldtbl.SetValue(0, "VBELN")
fieldtbl.Append()
fieldtbl.SetValue(0, "POSNR")
fieldtbl.Append()
fieldtbl.SetValue(0, "MATNR")
fieldtbl.Append()
fieldtbl.SetValue(0, "MTART")
fieldtbl.Append()
fieldtbl.SetValue(0, "LFIMG")
fieldtbl.Append()
fieldtbl.SetValue(0, "EMPST")
End If
optionstbl = SapFunction.GetTable("OPTIONS")
If optionstbl.ElementCount = 0 Then
optionstbl.Append()
optionstbl.SetValue(0, "VBELN = '" & strDOVBELN & "'")
optionstbl.Append()
optionstbl.SetValue(0, " AND POSNR = " & strDOPOSNR)
End If
SapFunction.Invoke(Destination) '激活提交
datatbl = SapFunction.GetTable("DATA") '返回表
End If
Catch ex As RfcCommunicationException
datatbl = Nothing
Loger.Error("RfcCommunicationError:" & ex.Message.ToString)
Catch ex As RfcLogonException
Loger.Error("RfcLogonExceptionError:" & ex.Message.ToString)
Catch ex As RfcAbapRuntimeException
datatbl = Nothing
Loger.Error("RfcAbapRuntimeError:" & ex.Message.ToString)
Catch ex As RfcAbapBaseException
datatbl = Nothing
Loger.Error("RfcAbapBaseError:" & ex.Message.ToString)
Catch ex As Exception
datatbl = Nothing
Loger.Error(ex.Message.ToString)
Finally
RfcDestinationManager.UnregisterDestinationConfiguration(ID)
ID = Nothing
SapFunction = Nothing
Destination = Nothing
End Try
Return GetDataTableFromRfcTable(datatbl)
End Function
Public Function ReadTableMARA(ByVal strMaterial As String) As DataTable
''the function is used to get the material type of material master from SAP table MARA
'MATNR is material number
'MTART is material type
'MATKL is material group
'MEINS is base unit of measure
Try
Destination = Nothing
SapFunction = Nothing
datatbl = Nothing
If ConnectSAP() = True Then
SapFunction = Destination.Repository.CreateFunction("RFC_READ_TABLE") '建立一个函数对象
SapFunction.SetValue("QUERY_TABLE", "MARA")
'SapFunction.SetValue("DELIMITER", ";")
'SapFunction.SetValue("NO_DATA", "X")
fieldtbl = SapFunction.GetTable("FIELDS")
If fieldtbl.ElementCount = 0 Then
fieldtbl.Append()
fieldtbl.SetValue(0, "MATNR")
fieldtbl.Append()
fieldtbl.SetValue(0, "MTART")
fieldtbl.Append()
fieldtbl.SetValue(0, "MATKL")
fieldtbl.Append()
fieldtbl.SetValue(0, "MEINS")
End If
optionstbl = SapFunction.GetTable("OPTIONS")
If optionstbl.ElementCount = 0 Then
optionstbl.Append()
optionstbl.SetValue(0, "MATNR = '" & strMaterial & "'")
End If
SapFunction.Invoke(Destination) '激活提交
datatbl = SapFunction.GetTable("DATA") '返回表
End If
Catch ex As RfcCommunicationException
datatbl = Nothing
Loger.Error("RfcCommunicationError:" & ex.Message.ToString)
Catch ex As RfcLogonException
Loger.Error("RfcLogonExceptionError:" & ex.Message.ToString)
Catch ex As RfcAbapRuntimeException
datatbl = Nothing
Loger.Error("RfcAbapRuntimeError:" & ex.Message.ToString)
Catch ex As RfcAbapBaseException
datatbl = Nothing
Loger.Error("RfcAbapBaseError:" & ex.Message.ToString)
Catch ex As Exception
datatbl = Nothing
Loger.Error(ex.Message.ToString)
Finally
RfcDestinationManager.UnregisterDestinationConfiguration(ID)
ID = Nothing
SapFunction = Nothing
Destination = Nothing
End Try
Return GetDataTableFromRfcTable(datatbl)
End Function
Public Function funGetProductionBOM(ByVal batch As String, ByVal product As String, ByVal plant As String) As DataTable
'I_Batch_Number is batch number
'I_Material is material number
'I_Plant is production plant
'Component_List contains all exploded components
Try
Destination = Nothing
SapFunction = Nothing
datatbl = Nothing
If ConnectSAP() = True Then
SapFunction = Destination.Repository.CreateFunction("Z_PRFC_LIST_COMPONENTS") '建立一个函数对象
SapFunction.SetValue("I_PLANT", plant) '传递参数
SapFunction.SetValue("I_MATERIAL", product)
SapFunction.SetValue("I_BATCH_NUMBER", batch)
SapFunction.Invoke(Destination) '激活提交
datatbl = SapFunction.GetTable("COMPONENT_LIST") '返回表
End If
Catch ex As RfcCommunicationException
datatbl = Nothing
Loger.Error("RfcCommunicationError:" & ex.Message.ToString)
Catch ex As RfcLogonException
Loger.Error("RfcLogonExceptionError:" & ex.Message.ToString)
Catch ex As RfcAbapRuntimeException
datatbl = Nothing
Loger.Error("RfcAbapRuntimeError:" & ex.Message.ToString)
Catch ex As RfcAbapBaseException
datatbl = Nothing
Loger.Error("RfcAbapBaseError:" & ex.Message.ToString)
Catch ex As Exception
datatbl = Nothing
Loger.Error(ex.Message.ToString)
Finally
RfcDestinationManager.UnregisterDestinationConfiguration(ID)
ID = Nothing
SapFunction = Nothing
Destination = Nothing
End Try
Return GetDataTableFromRfcTable(datatbl)
End Function
Public Function funGetMaterialBOM(ByVal product As String, ByVal plant As String, ByVal idate As String) As DataTable
'Fbstp is used to stop explosion at externally procured item
'I_Date is BOM effective date
'I_Matnr is material number
'I_Werks is production plant
'Z_Sortf contains sort string in BOM item
'Zbom_Tab contains all exploded components
Try
Destination = Nothing
SapFunction = Nothing
datatbl = Nothing
If ConnectSAP() = True Then
SapFunction = Destination.Repository.CreateFunction("Z_CBOM_EXPL_INTO_COMPONENT") '建立一个函数对象
SapFunction.SetValue("I_MATNR", product) '传递参数
SapFunction.SetValue("I_WERKS", plant)
SapFunction.SetValue("I_DATE", idate)
SapFunction.SetValue("FBSTP", "X")
SapFunction.Invoke(Destination) '激活提交
datatbl = SapFunction.GetTable("ZBOM_TAB") '返回表
End If
Catch ex As RfcCommunicationException
datatbl = Nothing
Loger.Error("RfcCommunicationError:" & ex.Message.ToString)
Catch ex As RfcLogonException
Loger.Error("RfcLogonExceptionError:" & ex.Message.ToString)
Catch ex As RfcAbapRuntimeException
datatbl = Nothing
Loger.Error("RfcAbapRuntimeError:" & ex.Message.ToString)
Catch ex As RfcAbapBaseException
datatbl = Nothing
Loger.Error("RfcAbapBaseError:" & ex.Message.ToString)
Catch ex As Exception
datatbl = Nothing
Loger.Error(ex.Message.ToString)
Finally
RfcDestinationManager.UnregisterDestinationConfiguration(ID)
ID = Nothing
SapFunction = Nothing
Destination = Nothing
End Try
Return GetDataTableFromRfcTable(datatbl)
End Function
Public Function GetDataTableFromRfcTable(ByVal rfcTable As IRfcTable) As DataTable
Dim dt As New DataTable()
If rfcTable Is Nothing Then
dt = Nothing
Else
Dim liElement As Integer = 0
Dim rfcEMD As RfcElementMetadata
Dim dr As DataRow
Dim row As IRfcStructure
For liElement = 0 To rfcTable.ElementCount - 1
rfcEMD = rfcTable.GetElementMetadata(liElement)
dt.Columns.Add(rfcEMD.Name)
Next
For Each row In rfcTable
dr = dt.NewRow()
For liElement = 0 To rfcTable.ElementCount - 1
rfcEMD = rfcTable.GetElementMetadata(liElement)
dr(rfcEMD.Name) = row.GetString(rfcEMD.Name)
Next
dt.Rows.Add(dr)
Next
End If
Return dt
End Function
End Class
Imports SAP.Middleware.Connector
Imports System.Data
Imports System.IO
Imports LogInfo
Imports System.Diagnostics
Imports System.Collections
Imports System.Collections.Generic
Public Class SAPRFC
Implements IDestinationConfiguration '继承接口
Public Destination As RfcDestination 'SAP Connector3.0 的RFC源
Public SapFunction As IRfcFunction 'SAP RFC函数调用
Public mystruct As IRfcStructure
Public datatbl As IRfcTable '调用到的RFC SAP table
Public optionstbl As IRfcTable '调用到的OPTIONS table
Public fieldtbl As IRfcTable '调用到的FIELD table
Public ID As IDestinationConfiguration '继承
Public Function ChangeEventsSupported() As Boolean Implements IDestinationConfiguration.ChangeEventsSupported
Return False
End Function
Public Event ConfigurationChanged(ByVal destinationName As String, ByVal args As RfcConfigurationEventArgs) Implements IDestinationConfiguration.ConfigurationChanged '事件
Public Function GetParameters(ByVal destinationName As String) As RfcConfigParameters Implements IDestinationConfiguration.GetParameters
Dim parms As RfcConfigParameters = New RfcConfigParameters()
If ("qas_000".Equals(destinationName)) Then
parms.Add(RfcConfigParameters.AppServerHost, "") 'SAP主机IP
parms.Add(RfcConfigParameters.SystemNumber, "") 'SAP实例
parms.Add(RfcConfigParameters.User, "") ' 用户名
parms.Add(RfcConfigParameters.Password, "") '密码
parms.Add(RfcConfigParameters.Client, "777") ' Client
parms.Add(RfcConfigParameters.Language, "EN") '登陆语言
parms.Add(RfcConfigParameters.PoolSize, "5")
parms.Add(RfcConfigParameters.PeakConnectionsLimit, "10")
parms.Add(RfcConfigParameters.IdleTimeout, "6000")
Return parms
ElseIf ("prd_000".Equals(destinationName)) Then
'parms.Add(RfcConfigParameters.AppServerHost, "") 'SAP主机IP
parms.Add(RfcConfigParameters.AppServerHost, "") 'SAP主机IP
parms.Add(RfcConfigParameters.SystemNumber, "") 'SAP实例
parms.Add(RfcConfigParameters.User, "P") ' 用户名
parms.Add(RfcConfigParameters.Password, "") '密码
parms.Add(RfcConfigParameters.Client, "777") ' Client
parms.Add(RfcConfigParameters.Language, "EN") '登陆语言
parms.Add(RfcConfigParameters.PoolSize, "5")
'parms.Add(RfcConfigParameters.MaxPoolSize, "10")
parms.Add(RfcConfigParameters.PeakConnectionsLimit, "10")
parms.Add(RfcConfigParameters.IdleTimeout, "6000")
Return parms
ElseIf ("qa1_000".Equals(destinationName)) Then
'parms.Add(RfcConfigParameters.AppServerHost, "") 'SAP主机IP
parms.Add(RfcConfigParameters.AppServerHost, "") 'SAP主机IP
parms.Add(RfcConfigParameters.SystemNumber, "") 'SAP实例
parms.Add(RfcConfigParameters.User, "") ' 用户名
parms.Add(RfcConfigParameters.Password, "") '密码
parms.Add(RfcConfigParameters.Client, "777") ' Client
parms.Add(RfcConfigParameters.Language, "EN") '登陆语言
parms.Add(RfcConfigParameters.PoolSize, "5")
'parms.Add(RfcConfigParameters.MaxPoolSize, "10")
parms.Add(RfcConfigParameters.PeakConnectionsLimit, "10")
parms.Add(RfcConfigParameters.IdleTimeout, "6000")
Return parms
Else
Return Nothing
End If
End Function
Function ConnectSAP() As Boolean
Dim GetSapValue = System.Configuration.ConfigurationManager.AppSettings("SAP_Destination")
'Dim ID As IDestinationConfiguration = New SAPRFC() '继承
ID = New SAPRFC()
Try
If Destination Is Nothing Then
RfcDestinationManager.RegisterDestinationConfiguration(ID)
If GetSapValue = "QAS" Then
Destination = RfcDestinationManager.GetDestination("qas_000") '连接SAP, SAPConnector 3.0方式 QAS SYSTEM
ElseIf GetSapValue = "PRDALL" Then
Destination = RfcDestinationManager.GetDestination("prd_000") '连接SAP, SAPConnector 3.0方式 PRD SYSTEM
ElseIf GetSapValue = "QA1" Then
Destination = RfcDestinationManager.GetDestination("qa1_000")
End If
'RfcDestinationManager.UnregisterDestinationConfiguration(ID)
End If
Return True
Catch ex As RfcCommunicationException
Loger.Error("RfcCommunicationError:" & ex.Message.ToString)
Return False
Catch ex As RfcLogonException
Loger.Error("RfcLogonExceptionError:" & ex.Message.ToString)
Return False
Catch ex As RfcAbapRuntimeException
Loger.Error("RfcAbapRuntimeError:" & ex.Message.ToString)
Return False
Catch ex As RfcAbapBaseException
Loger.Error("RfcAbapBaseError:" & ex.Message.ToString)
Return False
Catch ex As Exception
Loger.Error(ex.Message.ToString)
Return False
End Try
End Function
Public Function ReadTableVBRK(ByVal strDOFrDate As String, ByVal strDOToDate As String) As DataTable
'VBELN is Billing document
'FKART is Billing type
'FKTYP is Billing category
'VBTYP is SD document category
'WAERK is SD document currency
'VKORG is Sales organization
'FKDAT is Billing date for billing index and printout
'BUKRS is Company Code
'KUNRG is Payer party
'KUNAG is Sold-to party
'KURST is Exchange rate type
'SFAKN is Cancelled billing document number
'KURRF is Exchange rate for FI postings
'CMKUF is Credit data exchange rate at billing document rate
'INCO1 is Incoterms (part 1)
Try
Destination = Nothing
SapFunction = Nothing
datatbl = Nothing
If ConnectSAP() = True Then
SapFunction = Destination.Repository.CreateFunction("RFC_READ_TABLE") '建立一个函数对象
SapFunction.SetValue("QUERY_TABLE", "VBRK")
'SapFunction.SetValue("DELIMITER", ";")
'SapFunction.SetValue("NO_DATA", "X")
fieldtbl = SapFunction.GetTable("FIELDS")
If fieldtbl.ElementCount = 0 Then
fieldtbl.Append()
fieldtbl.SetValue(0, "VBELN")
fieldtbl.Append()
fieldtbl.SetValue(0, "FKART")
fieldtbl.Append()
fieldtbl.SetValue(0, "FKTYP")
fieldtbl.Append()
fieldtbl.SetValue(0, "VBTYP")
fieldtbl.Append()
fieldtbl.SetValue(0, "WAERK")
fieldtbl.Append()
fieldtbl.SetValue(0, "VKORG")
fieldtbl.Append()
fieldtbl.SetValue(0, "FKDAT")
fieldtbl.Append()
fieldtbl.SetValue(0, "BUKRS")
fieldtbl.Append()
fieldtbl.SetValue(0, "KUNRG")
fieldtbl.Append()
fieldtbl.SetValue(0, "KUNAG")
fieldtbl.Append()
fieldtbl.SetValue(0, "KURST")
fieldtbl.Append()
fieldtbl.SetValue(0, "SFAKN")
fieldtbl.Append()
fieldtbl.SetValue(0, "KURRF")
fieldtbl.Append()
fieldtbl.SetValue(0, "CMKUF")
fieldtbl.Append()
fieldtbl.SetValue(0, "INCO1")
fieldtbl.Append()
fieldtbl.SetValue(0, "ERDAT")
End If
optionstbl = SapFunction.GetTable("OPTIONS")
If optionstbl.ElementCount = 0 Then
optionstbl.Append()
optionstbl.SetValue(0, " ERDAT >= '" & strDOFrDate & "' ")
optionstbl.Append()
optionstbl.SetValue(0, " AND ERDAT <= '" & strDOToDate & "' ")
optionstbl.Append()
optionstbl.SetValue(0, " AND VKORG = 'CSU' ")
optionstbl.Append()
optionstbl.SetValue(0, " AND FKART LIKE 'ZA%'")
optionstbl.Append()
optionstbl.SetValue(0, " AND BUKRS = 'CSU'")
optionstbl.Append()
optionstbl.SetValue(0, " AND WAERK = 'RMB'")
End If
SapFunction.Invoke(Destination) '激活提交
datatbl = SapFunction.GetTable("DATA") '返回表
End If
Catch ex As Exception
datatbl = Nothing
Loger.Error(ex.Message.ToString)
Finally
RfcDestinationManager.UnregisterDestinationConfiguration(ID)
ID = Nothing
SapFunction = Nothing
Destination = Nothing
End Try
Return GetDataTableFromRfcTable(datatbl)
End Function
Public Function ReadTableVBRP(ByVal dtVBRK As DataTable, ByVal i As Long) As DataTable
'VBELN is Billing document
'POSNR is Billing item
'FKIMG is Actual billed quantity
'NETWR is Net value of the billing item in document currency
'VGBEL is Document number of the reference document
'VGPOS is Item number of the reference item
'VGTYP is Document category of preceding SD document
'AUBEL is Sales document
'AUPOS is Sales document item
'MATNR is Material number
'CHARG is Batch number
'MATKL is Material group
'PSTYV is Sales document item category
'WERKS is Plant
'MWSBP is Tax amount in document currency
'SKFBP is Amount eligible for cash discount in document currency
'AUTYP is SD document category
'WAVWR is Cost in document currency
'LGORT is Storage location
'VRKME is Sales unit
Try
Destination = Nothing
SapFunction = Nothing
datatbl = Nothing
If ConnectSAP() = True Then
SapFunction = Destination.Repository.CreateFunction("RFC_READ_TABLE") '建立一个函数对象
SapFunction.SetValue("QUERY_TABLE", "VBRP")
'SapFunction.SetValue("DELIMITER", ";")
'SapFunction.SetValue("NO_DATA", "X")
fieldtbl = SapFunction.GetTable("FIELDS")
If fieldtbl.ElementCount = 0 Then
fieldtbl.Append()
fieldtbl.SetValue(0, "VBELN")
fieldtbl.Append()
fieldtbl.SetValue(0, "POSNR")
fieldtbl.Append()
fieldtbl.SetValue(0, "FKIMG")
fieldtbl.Append()
fieldtbl.SetValue(0, "NETWR")
fieldtbl.Append()
fieldtbl.SetValue(0, "VGBEL")
fieldtbl.Append()
fieldtbl.SetValue(0, "VGPOS")
fieldtbl.Append()
fieldtbl.SetValue(0, "VGTYP")
fieldtbl.Append()
fieldtbl.SetValue(0, "AUBEL")
fieldtbl.Append()
fieldtbl.SetValue(0, "AUPOS")
fieldtbl.Append()
fieldtbl.SetValue(0, "MATNR")
fieldtbl.Append()
fieldtbl.SetValue(0, "CHARG")
fieldtbl.Append()
fieldtbl.SetValue(0, "MATKL")
fieldtbl.Append()
fieldtbl.SetValue(0, "PSTYV")
fieldtbl.Append()
fieldtbl.SetValue(0, "WERKS")
fieldtbl.Append()
fieldtbl.SetValue(0, "MWSBP")
fieldtbl.Append()
fieldtbl.SetValue(0, "SKFBP")
fieldtbl.Append()
fieldtbl.SetValue(0, "AUTYP")
fieldtbl.Append()
fieldtbl.SetValue(0, "WAVWR")
fieldtbl.Append()
fieldtbl.SetValue(0, "LGORT")
fieldtbl.Append()
fieldtbl.SetValue(0, "VRKME")
End If
optionstbl = SapFunction.GetTable("OPTIONS")
If optionstbl.ElementCount = 0 Then
optionstbl.Append()
optionstbl.SetValue(0, " VBELN = '" & Trim(dtVBRK.Rows(i)(0).Substring(0, 10).ToString()) & "' ")
optionstbl.Append()
optionstbl.SetValue(0, " AND WERKS = 'CSU1' ")
optionstbl.Append()
optionstbl.SetValue(0, " AND VGTYP IN ('J', 'T') ")
End If
SapFunction.Invoke(Destination) '激活提交
datatbl = SapFunction.GetTable("DATA") '返回表
End If
Catch ex As RfcCommunicationException
datatbl = Nothing
Loger.Error("RfcCommunicationError:" & ex.Message.ToString)
Catch ex As RfcLogonException
Loger.Error("RfcLogonExceptionError:" & ex.Message.ToString)
Catch ex As RfcAbapRuntimeException
datatbl = Nothing
Loger.Error("RfcAbapRuntimeError:" & ex.Message.ToString)
Catch ex As RfcAbapBaseException
datatbl = Nothing
Loger.Error("RfcAbapBaseError:" & ex.Message.ToString)
Catch ex As Exception
datatbl = Nothing
Loger.Error(ex.Message.ToString)
Finally
RfcDestinationManager.UnregisterDestinationConfiguration(ID)
ID = Nothing
SapFunction = Nothing
Destination = Nothing
End Try
Return GetDataTableFromRfcTable(datatbl)
End Function
Public Function ReadTableLIPS(ByVal strDOVBELN As String, ByVal strDOPOSNR As String) As DataTable
''the function is used to get the post goods lines of delivery order from SAP table LIPS
'selected(fields)
'VBELN is Delivery order number
'POSNR is Delivery item
'MATNR is Material number
'MTART is Material type
'LFIMG is Actual quantity delivered
'EMPST is Receiving point for RSN number
Try
Destination = Nothing
SapFunction = Nothing
datatbl = Nothing
If ConnectSAP() = True Then
SapFunction = Destination.Repository.CreateFunction("RFC_READ_TABLE") '建立一个函数对象
SapFunction.SetValue("QUERY_TABLE", "LIPS")
'SapFunction.SetValue("DELIMITER", ";")
'SapFunction.SetValue("NO_DATA", "X")
fieldtbl = SapFunction.GetTable("FIELDS")
If fieldtbl.ElementCount = 0 Then
fieldtbl.Append()
fieldtbl.SetValue(0, "VBELN")
fieldtbl.Append()
fieldtbl.SetValue(0, "POSNR")
fieldtbl.Append()
fieldtbl.SetValue(0, "MATNR")
fieldtbl.Append()
fieldtbl.SetValue(0, "MTART")
fieldtbl.Append()
fieldtbl.SetValue(0, "LFIMG")
fieldtbl.Append()
fieldtbl.SetValue(0, "EMPST")
End If
optionstbl = SapFunction.GetTable("OPTIONS")
If optionstbl.ElementCount = 0 Then
optionstbl.Append()
optionstbl.SetValue(0, "VBELN = '" & strDOVBELN & "'")
optionstbl.Append()
optionstbl.SetValue(0, " AND POSNR = " & strDOPOSNR)
End If
SapFunction.Invoke(Destination) '激活提交
datatbl = SapFunction.GetTable("DATA") '返回表
End If
Catch ex As RfcCommunicationException
datatbl = Nothing
Loger.Error("RfcCommunicationError:" & ex.Message.ToString)
Catch ex As RfcLogonException
Loger.Error("RfcLogonExceptionError:" & ex.Message.ToString)
Catch ex As RfcAbapRuntimeException
datatbl = Nothing
Loger.Error("RfcAbapRuntimeError:" & ex.Message.ToString)
Catch ex As RfcAbapBaseException
datatbl = Nothing
Loger.Error("RfcAbapBaseError:" & ex.Message.ToString)
Catch ex As Exception
datatbl = Nothing
Loger.Error(ex.Message.ToString)
Finally
RfcDestinationManager.UnregisterDestinationConfiguration(ID)
ID = Nothing
SapFunction = Nothing
Destination = Nothing
End Try
Return GetDataTableFromRfcTable(datatbl)
End Function
Public Function ReadTableMARA(ByVal strMaterial As String) As DataTable
''the function is used to get the material type of material master from SAP table MARA
'MATNR is material number
'MTART is material type
'MATKL is material group
'MEINS is base unit of measure
Try
Destination = Nothing
SapFunction = Nothing
datatbl = Nothing
If ConnectSAP() = True Then
SapFunction = Destination.Repository.CreateFunction("RFC_READ_TABLE") '建立一个函数对象
SapFunction.SetValue("QUERY_TABLE", "MARA")
'SapFunction.SetValue("DELIMITER", ";")
'SapFunction.SetValue("NO_DATA", "X")
fieldtbl = SapFunction.GetTable("FIELDS")
If fieldtbl.ElementCount = 0 Then
fieldtbl.Append()
fieldtbl.SetValue(0, "MATNR")
fieldtbl.Append()
fieldtbl.SetValue(0, "MTART")
fieldtbl.Append()
fieldtbl.SetValue(0, "MATKL")
fieldtbl.Append()
fieldtbl.SetValue(0, "MEINS")
End If
optionstbl = SapFunction.GetTable("OPTIONS")
If optionstbl.ElementCount = 0 Then
optionstbl.Append()
optionstbl.SetValue(0, "MATNR = '" & strMaterial & "'")
End If
SapFunction.Invoke(Destination) '激活提交
datatbl = SapFunction.GetTable("DATA") '返回表
End If
Catch ex As RfcCommunicationException
datatbl = Nothing
Loger.Error("RfcCommunicationError:" & ex.Message.ToString)
Catch ex As RfcLogonException
Loger.Error("RfcLogonExceptionError:" & ex.Message.ToString)
Catch ex As RfcAbapRuntimeException
datatbl = Nothing
Loger.Error("RfcAbapRuntimeError:" & ex.Message.ToString)
Catch ex As RfcAbapBaseException
datatbl = Nothing
Loger.Error("RfcAbapBaseError:" & ex.Message.ToString)
Catch ex As Exception
datatbl = Nothing
Loger.Error(ex.Message.ToString)
Finally
RfcDestinationManager.UnregisterDestinationConfiguration(ID)
ID = Nothing
SapFunction = Nothing
Destination = Nothing
End Try
Return GetDataTableFromRfcTable(datatbl)
End Function
Public Function funGetProductionBOM(ByVal batch As String, ByVal product As String, ByVal plant As String) As DataTable
'I_Batch_Number is batch number
'I_Material is material number
'I_Plant is production plant
'Component_List contains all exploded components
Try
Destination = Nothing
SapFunction = Nothing
datatbl = Nothing
If ConnectSAP() = True Then
SapFunction = Destination.Repository.CreateFunction("Z_PRFC_LIST_COMPONENTS") '建立一个函数对象
SapFunction.SetValue("I_PLANT", plant) '传递参数
SapFunction.SetValue("I_MATERIAL", product)
SapFunction.SetValue("I_BATCH_NUMBER", batch)
SapFunction.Invoke(Destination) '激活提交
datatbl = SapFunction.GetTable("COMPONENT_LIST") '返回表
End If
Catch ex As RfcCommunicationException
datatbl = Nothing
Loger.Error("RfcCommunicationError:" & ex.Message.ToString)
Catch ex As RfcLogonException
Loger.Error("RfcLogonExceptionError:" & ex.Message.ToString)
Catch ex As RfcAbapRuntimeException
datatbl = Nothing
Loger.Error("RfcAbapRuntimeError:" & ex.Message.ToString)
Catch ex As RfcAbapBaseException
datatbl = Nothing
Loger.Error("RfcAbapBaseError:" & ex.Message.ToString)
Catch ex As Exception
datatbl = Nothing
Loger.Error(ex.Message.ToString)
Finally
RfcDestinationManager.UnregisterDestinationConfiguration(ID)
ID = Nothing
SapFunction = Nothing
Destination = Nothing
End Try
Return GetDataTableFromRfcTable(datatbl)
End Function
Public Function funGetMaterialBOM(ByVal product As String, ByVal plant As String, ByVal idate As String) As DataTable
'Fbstp is used to stop explosion at externally procured item
'I_Date is BOM effective date
'I_Matnr is material number
'I_Werks is production plant
'Z_Sortf contains sort string in BOM item
'Zbom_Tab contains all exploded components
Try
Destination = Nothing
SapFunction = Nothing
datatbl = Nothing
If ConnectSAP() = True Then
SapFunction = Destination.Repository.CreateFunction("Z_CBOM_EXPL_INTO_COMPONENT") '建立一个函数对象
SapFunction.SetValue("I_MATNR", product) '传递参数
SapFunction.SetValue("I_WERKS", plant)
SapFunction.SetValue("I_DATE", idate)
SapFunction.SetValue("FBSTP", "X")
SapFunction.Invoke(Destination) '激活提交
datatbl = SapFunction.GetTable("ZBOM_TAB") '返回表
End If
Catch ex As RfcCommunicationException
datatbl = Nothing
Loger.Error("RfcCommunicationError:" & ex.Message.ToString)
Catch ex As RfcLogonException
Loger.Error("RfcLogonExceptionError:" & ex.Message.ToString)
Catch ex As RfcAbapRuntimeException
datatbl = Nothing
Loger.Error("RfcAbapRuntimeError:" & ex.Message.ToString)
Catch ex As RfcAbapBaseException
datatbl = Nothing
Loger.Error("RfcAbapBaseError:" & ex.Message.ToString)
Catch ex As Exception
datatbl = Nothing
Loger.Error(ex.Message.ToString)
Finally
RfcDestinationManager.UnregisterDestinationConfiguration(ID)
ID = Nothing
SapFunction = Nothing
Destination = Nothing
End Try
Return GetDataTableFromRfcTable(datatbl)
End Function
Public Function GetDataTableFromRfcTable(ByVal rfcTable As IRfcTable) As DataTable
Dim dt As New DataTable()
If rfcTable Is Nothing Then
dt = Nothing
Else
Dim liElement As Integer = 0
Dim rfcEMD As RfcElementMetadata
Dim dr As DataRow
Dim row As IRfcStructure
For liElement = 0 To rfcTable.ElementCount - 1
rfcEMD = rfcTable.GetElementMetadata(liElement)
dt.Columns.Add(rfcEMD.Name)
Next
For Each row In rfcTable
dr = dt.NewRow()
For liElement = 0 To rfcTable.ElementCount - 1
rfcEMD = rfcTable.GetElementMetadata(liElement)
dr(rfcEMD.Name) = row.GetString(rfcEMD.Name)
Next
dt.Rows.Add(dr)
Next
End If
Return dt
End Function
End Class