Attribute VB_Name = "ZCreditWS"
Const strXML As String = "<?xml version=""1.0"" encoding=""utf-8""?>" & _
  "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">" & _
  "  <soap:Body>" & _
  "    <CommitSimpleTransaction xmlns=""http://z-credit.com/"">" & _
  "      <TerminalNumber>@TerminalNumber@</TerminalNumber> " & _
  "      <Password>@Password@</Password> " & _
  "      <Track2></Track2>" & _
  "      <CardNumber>@CardNumber@</CardNumber>" & _
  "      <ExpDate_MMYY>@ExpDate_MMYY@</ExpDate_MMYY>" & _
  "      <TransactionSum>@TransactionSum@</TransactionSum>" & _
  "      <HolderID>@HolderID@</HolderID>" & _
  "      <CVV>@CVV@</CVV>" & _
  "      <IsCustomerPresent>@IsCustomerPresent@</IsCustomerPresent>" & _
  "      <AuthNum></AuthNum>" & _
  "    </CommitSimpleTransaction>" & _
  "  </soap:Body>" & _
  "</soap:Envelope>"
  
Const strValidXML As String = "<?xml version=""1.0"" encoding=""utf-8""?>" & _
"<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">" & _
  "<soap:Body>" & _
    "<ValidateCard xmlns=""http://z-credit.com/"">" & _
      "<TerminalNumber>@TerminalNumber@</TerminalNumber>" & _
      "<Password>@Password@</Password>" & _
      "<Track2></Track2>" & _
      "<CardNumber>@CardNumber@</CardNumber>" & _
      "<ExpDate_MMYY>@ExpDate_MMYY@</ExpDate_MMYY>" & _
    "</ValidateCard>" & _
  "</soap:Body>" & _
"</soap:Envelope>"

Public Const strURL As String = "https://pci.zcredit.co.il/ZCreditWS.asmx"

Public Type ValidateResponse
    Result As Boolean
    Result_Code As Integer
    Result_Message As String
    CardName As String
    XML As String
End Type

Public Type SimpleTranResponse
    Result As Boolean
    Result_Code As Integer
    Result_Message As String
    AuthNum As String
    CardName As String
    CardIssuerCode As String
    CardFinancerCode As String
    CardBrandCode As String
    ReferenceNumber As Integer
    VoucherNumber As String
    ApprovalType As String
    XML As String
End Type

'ValidateCard "0963222014", "0963222014", "4580000000000000", "1214"
Public Function ValidateCard(ByVal TerminalNumber As String, ByVal Password As String, ByVal CardNumber As String, _
                           ByVal ExpDate As String) As ValidateResponse

Dim sXML As String
Dim strSoapAction As String
strSoapAction = "http://z-credit.com/ValidateCard"

    sXML = strValidXML
       
    sXML = Replace(sXML, "@TerminalNumber@", TerminalNumber)
    sXML = Replace(sXML, "@Password@", Password)
    sXML = Replace(sXML, "@CardNumber@", CardNumber)
    sXML = Replace(sXML, "@ExpDate_MMYY@", ExpDate)
      
    Set sRes = SendRequest(sXML, strURL, strSoapAction)
     
    If (sRes Is Nothing) Then
        ValidateCard.Result = False
        ValidateCard.Result_Message = "Local error : " + Err.Description
        Exit Function
    End If
  
    With ValidateCard
 
        .Result = IIf(sRes.getElementsByTagName("ValidateCardResult").Item(0).Text = "true", True, False)
        .Result_Code = sRes.getElementsByTagName("Validation_Result_Code").Item(0).Text
        .Result_Message = sRes.getElementsByTagName("Validation_Result_Message").Item(0).Text
        .CardName = sRes.getElementsByTagName("CardName").Item(0).Text
 
    End With
  
End Function



 'SimpleTran "0963222014", "0963222014", "4580000000000000", "1214", 0.01, ""
Public Function SimpleTran(ByVal TerminalNumber As String, ByVal Password As String, ByVal CardNumber As String, _
                           ByVal ExpDate As String, ByVal TransactionSum As Single, ByVal HolderID As String, _
                           Optional ByVal CVV As String = "", Optional ByVal IsCustomerPresent As Boolean = False) As SimpleTranResponse
                            
    Dim sXML As String
    Dim strSoapAction As String
    Dim sRes As MSXML2.DOMDocument
    
    sXML = strXML
    strSoapAction = "http://z-credit.com/CommitSimpleTransaction"
    
    sXML = Replace(sXML, "@TerminalNumber@", TerminalNumber)
    sXML = Replace(sXML, "@Password@", Password)
    sXML = Replace(sXML, "@CardNumber@", CardNumber)
    sXML = Replace(sXML, "@ExpDate_MMYY@", ExpDate)
    sXML = Replace(sXML, "@TransactionSum@", Format(TransactionSum, "#.00"))
    sXML = Replace(sXML, "@HolderID@", HolderID)
    sXML = Replace(sXML, "@CVV@", CVV)
    sXML = Replace(sXML, "@IsCustomerPresent@", IIf(IsCustomerPresent, "true", "false"))
    
    Set sRes = SendRequest(sXML, strURL, strSoapAction)

    If (sRes Is Nothing) Then
        SimpleTran.Result = False
        SimpleTran.Result_Message = "Local error : " + Err.Description
        Exit Function
    End If

    With SimpleTran
        .Result = IIf(sRes.getElementsByTagName("CommitSimpleTransactionResult").Item(0).Text = "true", True, False)
        .Result_Code = sRes.getElementsByTagName("Validation_Result_Code").Item(0).Text
        .Result_Message = sRes.getElementsByTagName("Validation_Result_Message").Item(0).Text
        .ApprovalType = sRes.getElementsByTagName("ApprovalType").Item(0).Text
        .AuthNum = sRes.getElementsByTagName("AuthNum").Item(0).Text
        .CardBrandCode = sRes.getElementsByTagName("CardBrandCode").Item(0).Text
        .CardFinancerCode = sRes.getElementsByTagName("CardFinancerCode").Item(0).Text
        .CardIssuerCode = sRes.getElementsByTagName("CardIssuerCode").Item(0).Text
        .CardName = sRes.getElementsByTagName("CardName").Item(0).Text
        .ReferenceNumber = sRes.getElementsByTagName("ReferenceNumber").Item(0).Text
        .VoucherNumber = sRes.getElementsByTagName("VoucherNumber").Item(0).Text
    End With

End Function

Private Function SendRequest(ByVal strXML As String, ByVal strURL As String, ByVal strSoapAction As String) As Object
    
    'Dim objDom As Object
    Dim objXmlHttp As Object
    Dim objRet As Object
    Dim strRet As String


    ' Create objects to DOMDocument and XMLHTTP
    Set objDom = CreateObject("MSXML2.DOMDocument")
    Set objRet = CreateObject("MSXML2.DOMDocument")
    Set objXmlHttp = CreateObject("MSXML2.XMLHTTP")

    ' Load XML
    objDom.async = False
    objDom.loadXML strXML

    ' Open the webservice
    objXmlHttp.open "POST", strURL, False

    ' Create headings
    objXmlHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
    objXmlHttp.setRequestHeader "SOAPAction", strSoapAction

    ' Send XML command
    On Error GoTo Err
    objXmlHttp.send objDom.XML

    ' Get all response text from webservice
    strRet = objXmlHttp.responseText
   
    If Not objRet.loadXML(strRet) Then
        Err.Raise objRet.parseError.ErrorCode, , objRet.parseError.reason
    End If
       
    ' Close object
    Set objXmlHttp = Nothing
    Set objDom = Nothing

    Set SendRequest = objRet

    Exit Function

Err:
    
    
End Function