Results 1 to 11 of 11
  1. #1
    3 Star Lounger
    Join Date
    Dec 2001
    Location
    Nevada, USA
    Posts
    207
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Third Party API Call (Access 2002)

    This is my first experience in calling a third party API so please pardon the dumb question. I may even be posting in the wrong forum. I'm not certain.

    I am attempting to call a third party API from within my Access 2002 VBA application. I have checked off all available references from the vendor under Tools | References in the VBA Editor. The vendor has provided a number of txt files containing public and private functions, subs and procedures which I assume are to be included in my code. It follows my questions.

    Question: Do I include them as modules or class modules? I've tried both ways and am getting syntax errors both ways. Is this even VBA code?

    Thanks.
    ************************************************** *****************************************
    '------------------------------------------------------------------------------------------
    ' APIConIP.cls
    '------------------------------------------------------------------------------------------
    Option Explicit

    ' consts
    Private Const MODNAME As String = "APIConIP"

    ' vars
    Private WithEvents mfrmIP As frmIP
    Private WithEvents mfrmSend As frmSend

    Public Sub SendData(ByVal strData As String, ByVal strDestination As String, ByVal iPort As Integer)

    On Error GoTo SendFailed
    g_Log.LogProcEnter MODNAME, "SendData"

    mfrmIP.SendData strDestination, strData, iPort
    g_Log.LogProcExit MODNAME, "SendData"
    Exit Sub

    SendFailed:
    g_Log.LogError Err
    End Sub
    '------------------------------------------------------------------------------------------
    ' APIConsole.cls
    '------------------------------------------------------------------------------------------
    Option Explicit
    ' consts
    Private Const MODNAME As String = "APIConsole"

    Dim mAPISingleAC As APISingleton

    Private Sub Class_Initialize()


    ' Init private data

    g_Log.LogProcEnter MODNAME, "Class_Initialize"

    ' get a ref to the correct interfaces
    Set mAPISingleAC = GetAPISingleton

    End Sub

    '------------------------------------------------------------------------------------------
    ' APISingleton.cls
    '------------------------------------------------------------------------------------------
    Option Explicit
    ' consts
    Private Const APPCON_INVALID_HOST As Long = -10001
    Private Const APPCON_INVALID_REQUEST As Long = -10002

    Private Const FINISHED As Long = 2

    Private Const MODNAME As String = "APISingleton"

    ' vars
    Private mAPIConIP As APIConIP
    Private WithEvents mtmrAsynch As TimerObj


    Private Sub Class_Initialize()
    ' Init private data
    g_Log.LogProcEnter MODNAME, "Class_Initialize"
    On Error GoTo InitFailed

    Set mtmrAsynch = New TimerObj

    Set mAPIConIP = New APIConIP

    g_Log.LogProcExit MODNAME, "Class_Initialize"
    Exit Sub

    InitFailed:
    g_Log.LogError Err
    g_Log.LogProcExit MODNAME, "Class_Initialize"
    End Sub

    Private Sub Class_Terminate()
    g_Log.LogProcEnter MODNAME, "Class_Terminate"

    ' Clean up
    Set mAPIConIP = Nothing

    g_Log.LogProcExit MODNAME, "Class_Terminate"

    End Sub

    Private Sub mtmrAsynch_OnNotify()

    'Dim acReq As ACRequest

    mtmrAsynch.StopTimer

    End Sub
    '------------------------------------------------------------------------------------------
    ' FileBeingSend.cls
    '------------------------------------------------------------------------------------------
    Option Explicit
    Private m_sFileName As String
    Private m_sTextRead As String
    Private m_sTextToBeSent As String
    Private m_foMyFile As FileSystemObject
    Private m_tsMyFile As TextStream
    'read-only properties
    Public Property Get EOF() As Boolean
    If m_tsMyFile.AtEndOfStream Then
    EOF = True
    Else
    EOF = False
    End If
    End Property
    Public Property Get TextRead() As String
    TextRead = m_sTextRead
    End Property
    'read/write properties
    Public Property Let TextToBeSent(sData As String)
    m_sTextToBeSent = sData
    End Property
    Public Property Get TextToBeSent() As String
    TextToBeSent = m_sTextToBeSent
    End Property
    Public Property Let FileName(sData As String)
    m_sFileName = sData
    End Property
    Public Property Get FileName() As String
    FileName = m_sFileName
    End Property
    'private methods
    Private Sub Class_Initialize()
    m_sFileName = ""
    m_sTextToBeSent = ""
    Set m_foMyFile = New FileSystemObject
    End Sub

    Private Sub Class_Terminate()
    Set m_tsMyFile = Nothing
    Set m_foMyFile = Nothing
    End Sub

    'public methods
    Public Function OpenFile()
    Set m_tsMyFile = m_foMyFile.OpenTextFile(m_sFileName, ForReading, False)
    End Function
    Public Function CloseFile()
    m_tsMyFile.Close
    End Function
    Public Function FileExists() As Boolean
    If m_foMyFile.FileExists(m_sFileName) Then
    FileExists = True
    Else
    FileExists = False
    End If
    End Function
    Public Function ReadText()
    m_sTextRead = m_tsMyFile.Read(200)
    m_sTextToBeSent = m_sTextRead
    End Function
    '------------------------------------------------------------------------------------------
    ' FileReceived.cls
    '------------------------------------------------------------------------------------------
    Option Explicit
    Private m_sFileName As String
    Private m_sLastData As String
    Private m_sRemoteHost As String
    Private m_iRemotePort As Integer
    Private m_bDone As Boolean
    Private m_sStatus As String
    Private m_dtTimeStarted As Date
    Private m_dtLastUpdate As Date
    Private m_foMyFile As FileSystemObject
    Private m_tsMyFile As TextStream

    Private Sub Class_Initialize()
    m_dtTimeStarted = Time()
    m_sLastData = ""
    m_sFileName = ""
    m_sRemoteHost = ""
    m_sStatus = "Initialized"
    End Sub
    Private Sub Class_Terminate()
    Set m_tsMyFile = Nothing
    Set m_foMyFile = Nothing
    End Sub
    'read-only properties
    Public Property Get TimeStarted() As Date
    TimeStarted = m_dtTimeStarted
    End Property
    Public Property Get EOF() As Boolean
    If UCase(Right(m_sLastData, 7)) = "</FILE>" Then
    EOF = True
    Else
    EOF = False
    End If
    End Property
    Public Property Get LastUpdate() As Date
    LastUpdate = m_dtLastUpdate
    End Property
    'read/write properties
    Public Property Let Status(ByVal sData As String)
    m_sStatus = sData
    End Property
    Public Property Get Status() As String
    Status = m_sStatus
    End Property
    Public Property Let RemoteHost(sData As String)
    m_sRemoteHost = sData
    End Property
    Public Property Get RemoteHost() As String
    RemoteHost = m_sRemoteHost
    End Property
    Public Property Let RemotePort(iData As Integer)
    m_iRemotePort = iData
    End Property
    Public Property Get RemotePort() As Integer
    RemotePort = m_iRemotePort
    End Property
    Public Property Let FileName(sData As String)
    m_sFileName = sData
    End Property
    Public Property Get FileName() As String
    FileName = m_sFileName
    End Property
    'public methods
    Public Function WriteFile(sData As String)
    m_sLastData = Right(m_sLastData & sData, 10)
    m_tsMyFile.Write sData
    m_dtLastUpdate = Time()
    End Function
    Public Function OpenFile()
    Set m_foMyFile = New FileSystemObject
    Set m_tsMyFile = m_foMyFile.OpenTextFile(m_sFileName, ForWriting, True)
    m_sStatus = "Open"
    End Function
    Public Function CloseFile()
    m_tsMyFile.Close
    m_sStatus = "Closed"
    End Function

    '------------------------------------------------------------------------------------------
    ' frmAPI.frm
    '------------------------------------------------------------------------------------------

    Option Explicit
    'UDT's required by Shell_NotifyIcon API call
    Private Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uId As Long
    uFlags As Long
    uCallBackMessage As Long
    hIcon As Long
    szTip As String * 64
    End Type

    ' consts required by Shell_NotifyIcon API call:
    Private Const NIM_ADD = &H0
    Private Const NIM_MODIFY = &H1
    Private Const NIM_DELETE = &H2
    Private Const NIF_MESSAGE = &H1
    Private Const NIF_ICON = &H2
    Private Const NIF_TIP = &H4
    Private Const WM_MOUSEMOVE = &H200
    Private Const WM_LBUTTONDOWN = &H201 'Button down
    Private Const WM_LBUTTONUP = &H202 'Button up
    Private Const WM_LBUTTONDBLCLK = &H203 'Double-click
    Private Const WM_RBUTTONDOWN = &H204 'Button down
    Private Const WM_RBUTTONUP = &H205 'Button up
    Private Const WM_RBUTTONDBLCLK = &H206 'Double-click

    Private Declare Function SetForegroundWindow Lib "user32" _
    (ByVal hwnd As Long) As Long

    Private Declare Function Shell_NotifyIcon Lib "shell32" _
    Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, _
    pnid As NOTIFYICONDATA) As Boolean


    ' consts
    Private Const AUTOSTART_PATH = "SOFTWAREMicrosoftWindowsCurrentVersionRun"
    Private Const AUTOSTART_ITEM = "vitalAPI"
    Private Const MSINFO_LOCPATH = "SOFTWAREMicrosoftShared Tools Location"
    Private Const MSINFO_LOCITEM = "MSINFO"
    Private Const MSINFO_PATH = "SOFTWAREMicrosoftShared ToolsMSINFO"
    Private Const MSINFO_ITEM = "PATH"

    ' vars
    Private mAC As APIConsole
    Private mNid As NOTIFYICONDATA
    Private msAppPath As String
    Private msMSInfoPath As String

    Private Sub cmdOK_Click()

    Me.Hide

    End Sub

    Private Sub cmdShutdown_Click()

    modAPISingleton.Shutdown

    End Sub

    Private Sub cmdSysInfo_Click()

    On Error GoTo ErrTrap

    Shell msMSInfoPath, vbNormalFocus
    Exit Sub

    ErrTrap:

    MsgBox "POS-partner cannot find or run the application." & _
    vbCrLf & "(" & msMSInfoPath & ")"

    End Sub

    Private Sub Form_Load()

    ' init data
    Dim v As Variant

    Set mAC = New APIConsole
    picIcon.Picture = Me.Icon
    Me.Caption = App.Title
    lblVersion.Caption = "Version " & App.Major & "." & _
    App.Minor & "." & App.Revision
    lblTitle.Caption = App.Title
    lblDisclaimer.Caption = ""


    ' start the tray icon
    With mNid
    .cbSize = Len(mNid)
    .hwnd = Me.hwnd
    .uId = vbNull
    .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    .uCallBackMessage = WM_MOUSEMOVE
    .hIcon = Me.Icon
    .szTip = App.Title & vbNullChar
    End With

    Shell_NotifyIcon NIM_ADD, mNid

    End Sub

    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

    Dim lMsg As Long
    Dim lResult As Long

    ' the value of X will vary depending upon the
    ' scalemode setting

    If Me.ScaleMode = vbPixels Then
    lMsg = x
    Else
    lMsg = x / Screen.TwipsPerPixelX
    End If ' ScaleMode

    Select Case lMsg
    Case WM_LBUTTONUP
    ' if we aren't hidden, pull to the front
    If Me.Visible Then
    lResult = SetForegroundWindow(Me.hwnd)
    Me.Show
    End If ' Me.Visible
    Case WM_LBUTTONDBLCLK
    lResult = SetForegroundWindow(Me.hwnd)
    Me.Show
    End Select

    End Sub

    Private Sub Form_Unload(Cancel As Integer)

    ' clean up
    Set mAC = Nothing
    ' remove the tray icon
    Shell_NotifyIcon NIM_DELETE, mNid

    End Sub

    '------------------------------------------------------------------------------------------
    ' frmIP.frm
    '------------------------------------------------------------------------------------------
    Option Explicit

    ' consts
    Private Const APPCON_CONNECT_FAILED = -10000
    Private Const IP_CLIENT As Integer = 0
    Private Const IP_CLIENT_IDX As String = "C"
    Private Const IP_EOL As String = "" ' Chr(127)
    Private Const IP_SERVER As Integer = 1
    Private Const IP_SERVER_IDX As String = "S"

    Private Const MODNAME As String = "frmIP"
    Private Const WSAEWOULDBLOCK As Long = 25036

    Private varFiles() As Variant

    ' vars
    Private mdicPortFileIB As Scripting.Dictionary
    Private mdicPortFileOB As Scripting.Dictionary

    Private m_sTCPFilePath As String
    Private mintPort As Integer
    Private mlngBuff As Long

    Public Event DataArrived(frX As FileReceived)

    Public Sub SendData(ByVal Remote As String, ByVal sFileName As String, ByVal iPort As Integer)

    Dim intIdx As Integer
    Dim vntKey As Variant
    Dim fbsX As FileBeingSent

    g_Log.LogProcEnter MODNAME, "SendData"
    intIdx = FindNextClientNum
    Load ippClient(intIdx)

    With ippClient(intIdx)
    If Not .WinsockLoaded Then
    .WinsockLoaded = True
    End If
    .RemotePort = iPort
    .RemoteHost = Remote
    .Connected = True
    End With
    g_Log.LogEntry MODNAME, "SendData", "API Sending data to port " & Str(ippClient(intIdx).RemotePort)

    vntKey = IP_CLIENT_IDX & intIdx
    Set fbsX = New FileBeingSent
    fbsX.FileName = sFileName
    If fbsX.FileExists Then
    fbsX.OpenFile
    mdicPortFileOB.Add vntKey, fbsX
    Else
    g_Log.LogEntry MODNAME, "SendData", "File does not exist."
    End If
    g_Log.LogProcExit MODNAME, "SendData"
    Set fbsX = Nothing

    ' allow the "Connected" message to be raised and handled...
    DoEvents
    End Sub


    Private Sub Form_Load()

    ' init data
    g_Log.LogProcEnter MODNAME, "Form_Load"

    Set mdicPortFileIB = New Scripting.Dictionary
    Set mdicPortFileOB = New Scripting.Dictionary

    ReDim varFiles(0 To 1, 0 To 1)

    m_sTCPFilePath = Trim(App.Path) & ""

    Listen
    g_Log.LogProcExit MODNAME, "Form_Load"

    End Sub

    Private Sub Form_Unload(Cancel As Integer)

    ' clean up
    g_Log.LogProcEnter MODNAME, "Form_Unload"
    Set mdicPortFileOB = Nothing
    Set mdicPortFileIB = Nothing

    End Sub

    Private Sub ipdServer_Connected(ConnectionID As Integer, StatusCode As Integer, Description As String)

    g_Log.LogProcEnter MODNAME, "ipdServer_Connected"
    ipdServer.EOL(ConnectionID) = IP_EOL

    End Sub

    Private Sub ipdServer_DataIn(ConnectionID As Integer, _
    Text As String, EOL As Integer)

    g_Log.LogProcEnter MODNAME, "ipdServer_DataIn"
    SocketRead IP_SERVER, ConnectionID, Text, EOL, ipdServer.RemoteHost(ConnectionID), ipdServer.RemotePort(ConnectionID)
    g_Log.LogProcExit MODNAME, "ipdServer_DataIn"

    End Sub

    Private Sub ipdServer_Disconnected(ConnectionID As Integer, StatusCode As Integer, Description As String)

    Dim vntKey As Variant
    Dim frX As FileReceived

    g_Log.LogEntry MODNAME, "ipdServer_Disconnected", ""

    vntKey = IP_SERVER_IDX & ConnectionID
    If mdicPortFileIB.Exists(vntKey) Then
    Set frX = mdicPortFileIB.Item(vntKey)
    If frX.Status <> "Closed" Then
    frX.Status = "Failed"
    Me.tmrProcess.Enabled = True
    End If
    End If
    Set frX = Nothing
    g_Log.LogProcExit MODNAME, "ipdServer_Disconnected"

    End Sub

    Private Sub ipdServer_Error(ErrorCode As Integer, Description As String)

    g_Log.LogEntry MODNAME, "ipdServer_Error", LTrim(Str(ErrorCode)) & Description

    End Sub

    Private Sub ipdServer_ReadyToSend(ConnectionID As Integer)

    g_Log.LogProcEnter MODNAME, "ipdServer_ReadyToSend"
    SocketWrite IP_SERVER, ConnectionID

    End Sub

    Private Sub ippClient_Connected(Index As Integer, _
    StatusCode As Integer, Description As String)

    Dim strFileName As String
    Dim vntKey As Variant
    Dim fbsX As FileBeingSent

    If StatusCode = 0 Then
    g_Log.LogEntry MODNAME, "ippClient_Connected", "Status OK"
    ippClient(Index).EOL = IP_EOL
    Else
    g_Log.LogEntry MODNAME, "ippClient_Connected", "Status Failed"
    vntKey = IP_CLIENT_IDX & Index
    Set fbsX = mdicPortFileOB(vntKey)
    mdicPortFileOB.Remove vntKey
    Unload ippClient(Index)
    End If ' StatusCode=0

    Set fbsX = Nothing
    End Sub

    Private Sub ippClient_DataIn(Index As Integer, Text As String, EOL As Integer)

    g_Log.LogProcEnter MODNAME, "ippClient_DataIn"
    SocketRead IP_CLIENT, Index, Text, EOL, ippClient(Index).RemoteHost, ippClient(Index).RemotePort
    g_Log.LogProcExit MODNAME, "ipdServer_DataIn"

    End Sub

    Private Sub ippClient_Disconnected(Index As Integer, StatusCode As Integer, Description As String)

    Dim vntKey As Variant

    g_Log.LogProcEnter MODNAME, "ippClient_Disconnected"
    vntKey = IP_CLIENT_IDX & Index
    If mdicPortFileOB.Exists(vntKey) Then
    mdicPortFileOB.Remove vntKey
    End If

    Unload ippClient(Index)
    g_Log.LogProcExit MODNAME, "ippClient_Disconnected"

    End Sub

    Private Sub ippClient_Error(Index As Integer, _
    ErrorCode As Integer, Description As String)

    g_Log.LogEntry MODNAME, "ippClient_Error", LTrim(Str(ErrorCode)) & Description
    ippClient(Index).Connected = False

    End Sub

    Private Sub ippClient_ReadyToSend(Index As Integer)

    g_Log.LogProcEnter MODNAME, "ippClient_ReadyToSend"
    SocketWrite IP_CLIENT, Index

    End Sub

    Private Function FindNextClientNum() As Integer

    Dim ipp As IPPort
    Dim intIdx As Integer
    Dim intIdxPrev As Integer

    g_Log.LogProcEnter MODNAME, "FindNextClientNum"
    intIdxPrev = 1
    For Each ipp In ippClient
    intIdx = ipp.Index
    If intIdx - intIdxPrev > 1 Then
    FindNextClientNum = intIdxPrev + 1
    Exit Function
    Else
    intIdxPrev = intIdx
    End If
    Next ipp

    ' if no holes, grab one plus the upper bound
    intIdx = ippClient.UBound + 1
    FindNextClientNum = intIdx
    g_Log.LogProcExit MODNAME, "FindNextClientNum"

    End Function

    Private Sub SocketRead(SktType As Integer, Index As Integer, _
    Text As String, EOL As Integer, sRemoteHost As String, iRemotePort As Integer)

    Dim blnExists
    Dim blnPostEvent As Boolean
    Dim strData As String
    Dim vntKey As Variant
    Dim intFCount As Integer
    Dim frX As FileReceived
    Dim frx2 As FileReceived
    On Error GoTo Error_handler

    g_Log.LogProcEnter MODNAME, "SocketRead"
    If SktType = IP_CLIENT Then
    vntKey = IP_CLIENT_IDX & Index
    Else
    vntKey = IP_SERVER_IDX & Index
    End If

    'create a file to put the data in if one doesn't already exist
    'create a file to put the data in if one doesn't already exist
    'otherwise just get the file info from the dictionary
    If Not mdicPortFileIB.Exists(vntKey) Then
    Set frX = New FileReceived
    frX.RemoteHost = sRemoteHost
    frX.RemotePort = iRemotePort
    frX.FileName = GetNewFileName()
    frX.OpenFile
    mdicPortFileIB.Add vntKey, frX
    g_Log.LogEntry MODNAME, "SocketRead", "Writing to new file " & frX.FileName
    Else
    Set frX = mdicPortFileIB(vntKey)
    g_Log.LogEntry MODNAME, "SocketRead", "Writing to file " & frX.FileName
    End If

    'write the data to the file
    frX.WriteFile Text

    If frX.EOF Then
    frX.CloseFile
    ' drop the connection...
    If SktType = IP_CLIENT Then
    If ippClient(Index).Connected Then
    ippClient(Index).Connected = False
    End If ' if Connected
    Else
    If ipdServer.Connected(Index) Then
    ipdServer.Connected(Index) = False
    End If ' if Connected
    End If ' if IP_CLIENT
    Me.tmrProcess.Enabled = True
    End If

    exit_proc:
    Set frX = Nothing
    g_Log.LogProcExit MODNAME, "SocketRead"
    Exit Sub
    Error_handler:
    If Err.Number = 20127 Then
    Resume Next
    End If
    GoTo exit_proc
    End Sub
    Public Function GetNewFileName()
    Dim intFCount As Integer
    Dim sFileName As String
    Dim foX As New FileSystemObject

    g_Log.LogProcEnter MODNAME, "GetNewFileName"
    intFCount = 1
    Do While True
    sFileName = m_sTCPFilePath & "tstf" & Right("0000" & LTrim(Str(intFCount)), 4) & ".txt"
    If Not foX.FileExists(sFileName) Then
    Exit Do
    End If
    intFCount = intFCount + 1
    Loop
    Set foX = Nothing
    GetNewFileName = sFileName
    g_Log.LogProcExit MODNAME, "GetNewFileName"
    End Function
    Private Sub SocketWrite(SktType As Integer, Index As Integer)
    On Error GoTo Error_handler
    Dim lngBytes As Long
    Dim strData As String
    Dim strFileName As String
    Dim vntKey As Variant
    Dim fbsX As FileBeingSent

    g_Log.LogProcEnter MODNAME, "SocketWrite"

    If SktType = IP_CLIENT Then
    vntKey = IP_CLIENT_IDX & Index
    Else
    vntKey = IP_SERVER_IDX & Index
    End If

    If mdicPortFileOB.Exists(vntKey) Then
    Set fbsX = mdicPortFileOB(vntKey)
    If Not fbsX.FileExists Then
    g_Log.LogEntry MODNAME, "SocketWrite", "Exit, no data"
    g_Log.LogProcExit MODNAME, "SocketWrite"
    Exit Sub
    Else
    Do While True
    If Len(fbsX.TextToBeSent) = 0 Then
    If Not fbsX.EOF Then
    fbsX.ReadText
    Else
    Exit Do
    End If
    End If
    If SktType = IP_CLIENT Then
    ippClient(Index).DataToSend = fbsX.TextToBeSent
    Else
    ipdServer.DataToSend(Index) = fbsX.TextToBeSent
    End If
    fbsX.TextToBeSent = ""
    Loop
    fbsX.CloseFile
    End If

    mdicPortFileOB.Remove vntKey
    Set fbsX = Nothing
    End If
    ippClient(Index).Connected = False

    exit_proc:
    g_Log.LogProcExit MODNAME, "SocketWrite"
    Exit Sub

    Error_handler:

    ' if the error is not WSAEWOULDBLOCK or if no data
    ' was sent, i.e. lngBytes = 0, another ReadyToSend
    ' event should fire when the TCP/IP subsystem is ready

    Select Case Err.Number
    Case WSAEWOULDBLOCK
    g_Log.LogEntry MODNAME, "SocketWrite", "WSAEWOULDBLOCK"
    If SktType = IP_CLIENT Then
    lngBytes = ippClient(Index).BytesSent
    Else
    lngBytes = ipdServer.BytesSent(Index)
    End If

    If lngBytes > 0 Then
    ' modify the string to reflect the data that
    ' got out on the wire
    fbsX.TextToBeSent = Mid(fbsX.TextToBeSent, lngBytes + 1)
    DoEvents
    Resume
    End If ' if lngBytes > 0
    Case 340 'index does not exist
    Resume Next
    End Select ' if WOULDBLOCK

    g_Log.LogEntry MODNAME, "SocketWrite", "Exit, w/ Error: " & Err.Description
    GoTo exit_proc
    End Sub

    Private Sub tmrProcess_Timer()

    g_Log.LogProcEnter MODNAME, "tmrProcess_Timer"

    Dim strData As String
    Dim strKey As String
    Dim i As Integer
    Dim frX As New FileReceived

    With mdicPortFileIB
    Do While .Count > 0
    i = 0
    Do While True
    strKey = .Keys(i)
    Set frX = .Item(strKey)
    Select Case frX.Status
    Case "Closed"
    frX.Status = "DataArrived"
    .Remove strKey
    RaiseEvent DataArrived(frX)
    Case "Failed"
    .Remove strKey
    RaiseEvent DataArrived(frX)
    End Select
    Set frX = Nothing
    i = i + 1
    If i >= .Count Then
    Exit Do
    End If
    Loop
    Loop
    End With
    If mdicPortFileIB.Count = 0 Then
    Me.tmrProcess.Enabled = False
    End If

    Set frX = Nothing
    g_Log.LogProcExit MODNAME, "tmrProcess_Timer"
    End Sub
    Public Function Listen(Optional vPort As Variant)
    g_Log.LogProcEnter MODNAME, "Listen"
    mlngBuff = 32767 ' 32K : (2^15) -1

    With ipdServer
    If g_lListeningPort <> .LocalPort Then
    .Listening = False
    .WinsockLoaded = False
    End If
    .MaxLineLength = mlngBuff
    .WinsockLoaded = True
    If IsMissing(vPort) Then
    .LocalPort = g_lListeningPort
    Else
    .LocalPort = vPort
    End If
    .Listening = True
    End With ' ipdServer
    g_Log.LogEntry MODNAME, "Listen", "Port = " & Str(ipdServer.LocalPort)
    g_Log.LogProcExit MODNAME, "Listen"

    End Function
    '------------------------------------------------------------------------------------------
    ' frmSend.frm
    '------------------------------------------------------------------------------------------
    Public Event SendFile(sFileName As String, sDestination As String, iPort As Integer)

    Private Sub chkLogging_Click()
    If Me.chkLogging = 1 Then
    g_Log.LogStart App.Path & "SendTCP.log"
    Else
    g_Log.LogEnd
    End If
    End Sub

    Private Sub cmdRefresh_Click()
    Me.filSendFile.Refresh
    End Sub

    Private Sub cmdSend_Click()
    Dim foX As New FileSystemObject
    Dim tsX As TextStream
    Dim sData As String
    Dim sFileName As String

    If Len(Me.txtIPAddress) = 0 Then
    MsgBox "You must enter an IP Address to send to"
    Else
    Me.txtDataReceived = ""
    sFileName = Trim(Me.dirSendFile) & "" & Trim(Me.filSendFile)
    If foX.FileExists(sFileName) Then
    RaiseEvent SendFile(sFileName, Me.txtIPAddress, Me.txtPort)
    Else
    MsgBox "file does not exist."
    End If
    End If
    End Sub

    Private Sub dirSendFile_Change()
    Me.filSendFile.Path = Me.dirSendFile.Path
    End Sub

    Private Sub drvSendFile_Change()
    Me.dirSendFile.Path = Left(Me.drvSendFile.Drive, 2)
    End Sub

    Private Sub Form_Load()
    Dim spath As String
    Dim fsoX As New FileSystemObject
    Me.filSendFile.Pattern = "*.xml"
    spath = Left(Me.drvSendFile, 1) & ":transferapi projectxmldatawriterfiles"
    If fsoX.FolderExists(spath) Then
    Me.dirSendFile.Path = spath
    End If
    g_Log.LogEnd
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
    Shutdown
    End Sub

    '------------------------------------------------------------------------------------------
    ' frmTimer.frm
    '------------------------------------------------------------------------------------------

    Option Explicit


    Public Event OnNotify()


    Public Property Get TimerInterval() As Long

    TimerInterval = tmrNotify.Interval

    End Property

    Public Property Let TimerInterval(lngData As Long)

    tmrNotify.Interval = lngData

    End Property

    Public Property Get TimerEnabled() As Boolean

    TimerEnabled = tmrNotify.Enabled

    End Property

    Public Property Let TimerEnabled(boolData As Boolean)

    tmrNotify.Enabled = boolData

    End Property

    Public Sub StartTimer(Optional lngInterval As Long = -1)

    If lngInterval > -1 Then TimerInterval = lngInterval
    TimerEnabled = True

    End Sub

    Public Sub StopTimer()

    TimerEnabled = False

    End Sub

    Public Sub ResetTimer()

    ' if its running then bounce it
    If TimerEnabled Then
    TimerEnabled = False
    TimerEnabled = True
    End If

    End Sub

    Private Sub Form_Load()

    ' disable the timer
    tmrNotify.Interval = 0

    End Sub

    Private Sub Form_Unload(Cancel As Integer)

    ' disable the timer
    tmrNotify.Interval = 0

    End Sub

    Private Sub tmrNotify_Timer()

    RaiseEvent OnNotify

    End Sub
    '------------------------------------------------------------------------------------------
    ' LogFile.cls
    '------------------------------------------------------------------------------------------
    Private fsoX As FileSystemObject
    Private tsoX As TextStream
    Private bLogging As Boolean
    Private Function WriteLog(ByVal sText As String)
    If bLogging Then
    tsoX.WriteLine Format(Now(), "hh:mm:ss") & " " & sText
    End If
    End Function
    '-----------------------------------------------------------------------------
    ' public functions
    '-----------------------------------------------------------------------------
    Public Function LogEntry(ByVal sModName As String, ByVal sSubName As String, ByVal sMessage As String)
    WriteLog sModName & " - " & sSubName & ": " & sMessage
    End Function
    Public Function LogStart(ByVal sFileName As String)
    If Not fsoX Is Nothing Then
    LogEnd
    End If
    bLogging = True
    Set fsoX = New FileSystemObject
    Set tsoX = fsoX.CreateTextFile(sFileName, True)
    WriteLog "Log Started"
    End Function
    Public Function LogProcEnter(ByVal sModName As String, ByVal sSubName As String)
    WriteLog sModName & " - " & sSubName & ": " & "Enter"
    End Function
    Public Function LogProcExit(ByVal sModName As String, ByVal sSubName As String)
    WriteLog sModName & " - " & sSubName & ": " & "Exit"
    End Function
    Public Function LogEnd()
    On Error Resume Next
    WriteLog "Log Ended"
    bLogging = False
    tsoX.Close
    If Not fsoX Is Nothing Then
    Set fsoX = Nothing
    End If
    End Function
    Public Function LogError(ByRef errX As ErrObject)
    WriteLog "Error: Num=" & LTrim(Str(Err.Number)) & ", Description=" & Err.Description
    End Function
    Private Sub Class_Initialize()
    bLogging = False
    End Sub

    Private Sub Class_Terminate()
    If Not fsoX Is Nothing Then
    Set fsoX = Nothing
    End If
    End Sub
    '------------------------------------------------------------------------------------------
    ' modAPISingleton.bas
    '------------------------------------------------------------------------------------------
    Option Explicit

    ' consts
    Private Const MODNAME As String = "modAPISingleton"
    'vars
    Private mAPISingle As APISingleton
    Private mfrmAPI As frmAPI

    Public g_Log As LogFile
    Public g_lListeningPort As Long
    Public Function GetAPISingleton() As APISingleton

    ' This will create and/or return the module level
    ' APISingleton. Because this is implemented in a EXE,
    ' there will be one singleton per machine.

    g_Log.LogProcEnter MODNAME, "GetAPISingleton"
    If mAPISingle Is Nothing Then
    ' create it
    Set mAPISingle = New APISingleton
    End If

    Set GetAPISingleton = mAPISingle
    g_Log.LogProcExit MODNAME, "GetAPISingleton"

    End Function

    Public Sub FreeAPISingleton()

    g_Log.LogEntry MODNAME, "FreeAPISingleton", "FreeAPISingleton"

    Set mAPISingle = Nothing

    End Sub

    Sub Main()

    If App.PrevInstance = True Then Exit Sub

    Set g_Log = New LogFile
    g_Log.LogStart App.Path & "SendTCP.log"

    g_lListeningPort = 0
    Do While g_lListeningPort < 1024 Or g_lListeningPort > 65535
    g_lListeningPort = Val(InputBox("Listen on Port?", , 2115))
    If g_lListeningPort = 0 Then
    Exit Sub
    End If
    Loop

    If mfrmAPI Is Nothing Then
    Set mfrmAPI = New frmAPI
    Load mfrmAPI
    End If

    End Sub

    Sub Shutdown()
    Dim frmX As Form

    If Not mAPISingle Is Nothing Then
    FreeAPISingleton
    End If
    If Not mfrmAPI Is Nothing Then
    Unload mfrmAPI
    Set mfrmAPI = Nothing
    End If

    For Each frmX In Forms
    Unload frmX
    Next
    g_Log.LogEnd

    End Sub

    '------------------------------------------------------------------------------------------
    ' TimerObj.cls
    '------------------------------------------------------------------------------------------
    Option Explicit

    Private WithEvents mfrmTmr As frmTimer

    Public Event OnNotify()

    Public Property Get Interval() As Long

    Interval = mfrmTmr.TimerInterval

    End Property

    Public Property Let Interval(lngData As Long)

    mfrmTmr.TimerInterval = lngData

    End Property

    Public Property Get Enabled() As Boolean

    Enabled = mfrmTmr.TimerEnabled

    End Property

    Public Property Let Enabled(boolData As Boolean)

    mfrmTmr.TimerEnabled = boolData

    End Property

    Public Sub StartTimer(Optional lngInterval As Long = -1)

    mfrmTmr.StartTimer lngInterval

    End Sub

    Public Sub StopTimer()

    mfrmTmr.StopTimer

    End Sub

    Public Sub ResetTimer()

    ' if its running then bounce it
    mfrmTmr.ResetTimer

    End Sub

    Private Sub Class_Initialize()

    Set mfrmTmr = New frmTimer

    End Sub

    Private Sub Class_Terminate()

    Set mfrmTmr = Nothing

    End Sub

    Private Sub mfrmTmr_OnNotify()

    RaiseEvent OnNotify

    End Sub

    Private Sub Class_Initialize()

    ' Init private data
    g_Log.LogProcEnter MODNAME, "Class_Initialize"

    Set mfrmIP = New frmIP
    Load mfrmIP
    Set mfrmSend = New frmSend
    Load mfrmSend
    mfrmSend.Show

    g_Log.LogProcExit MODNAME, "Class_Initialize"

    End Sub

    Private Sub Class_Terminate()

    ' Clean up
    g_Log.LogProcEnter MODNAME, "Class_Terminate"

    Unload mfrmIP
    Set mfrmIP = Nothing
    g_Log.LogProcExit MODNAME, "Class_Terminate"

    End Sub

    Private Sub mfrmIP_DataArrived(frX As FileReceived)

    Dim lngStatus As Long
    Dim strKey As String

    g_Log.LogProcEnter MODNAME, "mfrmIP_DataArrived"

    mfrmSend.txtDataReceived = "File Received " & Time & " - " & frX.FileName

    g_Log.LogProcExit MODNAME, "mfrmIP_DataArrived"

    End Sub

    Private Sub mfrmSend_SendFile(sFileName As String, sDestination As String, iPort As Integer)
    SendData sFileName, sDestination, iPort
    End Sub
    Carol W.

  2. #2
    Super Moderator
    Join Date
    Aug 2001
    Location
    Evergreen, CO, USA
    Posts
    6,623
    Thanks
    3
    Thanked 60 Times in 60 Posts

    Re: Third Party API Call (Access 2002)

    First, I think your post should be in the VB/VBA forum rather than this one. I will suggest that Charlotte or one of the other moderators move it to that forum. Second, what you have looks like VBA, but VB looks like VBA, so it could be either. In fact I rather suspect it is VB. It would help if you indicated what the third party product was, as someone may have experience with it. It is entirely possible that it may not be compatible with Access - there are many Active-X controls that are just fine with VB, but do not work with Access. As to your question, such code would normally go in a module, and since it doesn't compile, that reinforces my suspicion that it is VB, not VBA.
    Wendell

  3. #3
    3 Star Lounger
    Join Date
    Dec 2001
    Location
    Nevada, USA
    Posts
    207
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Third Party API Call (Access 2002)

    Thanks for the reply.

    The product is POS Partner 2000 API from Vital Processing Services. It is a system that is used to process credit card transactions for retail establishments. Please see this page.

    If this system is not compatible with Access, does anyone know of one that is? Thanks.
    Carol W.

  4. #4
    Super Moderator
    Join Date
    Dec 2000
    Location
    New York, NY
    Posts
    2,970
    Thanks
    3
    Thanked 29 Times in 27 Posts

    Re: Third Party API Call (Access 2002)

    <P ID="edit" class=small>Edited by Gary Frieder on 28-Feb-02 20:55.</P>Hi,

    Based on just a quick look, it doesn't look like there's anything in there that should be incompatible with VBA (although I have no idea what this code is supposed to do).

    It looks like you need to put some of it into class (.cls) modules, some of it into standard code modules (.bas), and some of it into the code modules behind userforms (.frm) - you'd need to create a separate module, of the appropriate type, for each headed section of code that contains a mention of one of the above types. [Edit: also note that when creating these modules, you must give them the exact names that are indicated in the code - this matters in the case of the .cls and .frm modules.]
    There's also mention in the code of FileSystemObject - have you set a reference to that? (think it's "Microsoft Scripting Runtime" - scrrun.dll.)

    After that, keep compiling the code, and see which specific statements raise the error - maybe post back with the specific offending statements and the error messages they raise.

    Gary

  5. #5
    3 Star Lounger
    Join Date
    Dec 2001
    Location
    Nevada, USA
    Posts
    207
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Third Party API Call (Access 2002)

    Gary:

    Thanks very much for the reply.

    I now understand where to put the individual components (.cls goes in class modules, .bas goes in standard code modules) but I'm still unclear about the .frm files. Do I put these in the Microsoft Access Class Objects section? I don't yet have any forms to which to attach these routines. Do I wait until I develop forms for the user to complete?
    Carol W.

  6. #6
    Super Moderator
    Join Date
    Dec 2000
    Location
    New York, NY
    Posts
    2,970
    Thanks
    3
    Thanked 29 Times in 27 Posts

    Re: Third Party API Call (Access 2002)

    I've never worked with Access forms, and understand they're a bit different from other Office forms, so don't want to hazard a guess. It definitely does look though like the .frm code is designed to go behind specific, already existing forms (as they have references to various controls on the form) - are there no actual forms provided with the application - or files which describe the form? (think these may be .frx, but not sure). I've never worked with third party apps, but find it hard to imagine that you're expected to build your own userforms for their app(!)

    Gary

  7. #7
    3 Star Lounger
    Join Date
    Dec 2001
    Location
    Nevada, USA
    Posts
    207
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Third Party API Call (Access 2002)

    I don't see any forms off the top of my head. They did include the schematic shown in the attached file. Does this make sense to anyone?
    Attached Files Attached Files
    Carol W.

  8. #8
    Plutonium Lounger
    Join Date
    Dec 2000
    Location
    Sacramento, California, USA
    Posts
    16,775
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Third Party API Call (Access 2002)

    This sounds more and more like a VB sample program, which is frequently the case with third party APIs. The one I've worked with is WinTab, which comes with samples in VB, C++ and something else which I have forgotten.

    If it's a VB sample, that doesn't mean the API won't work in Access, but it means you can't just dump the sample into Access and make it work. Is there a vbp file included with what they sent you? If so, it's definitely a Visual Basic project, and your first step is to try and open it in VB. If you can do that, you'll be able to examine the forms (.frm files) and then reproduce them (mostly) in Access. The cls files *may* work in Access class modules or they may be the modules for the .frm files, but they'll probably require some tweaking since VB classes are slightly different from Access/VBA classes. The bas files go into standard code modules, but if they were written for VB, there will be some additional tweaking required.

    If you don't have VB or aren't familiar with it, you'll need to get someone else to convert the sample to Access for you.
    Charlotte

  9. #9
    Super Moderator
    Join Date
    Aug 2001
    Location
    Evergreen, CO, USA
    Posts
    6,623
    Thanks
    3
    Thanked 60 Times in 60 Posts

    Re: Third Party API Call (Access 2002)

    OK - I looked at their web site and have a bit better idea of what is going on, but I am not familiar with the product. What I did learn is that their product is based on either the MSDE or on SQL Server - apparently only V7. That further suggests to me that you are dealing with code that was done in VB rather than VBA. There are also some methods being used that I don't think are VBA. Never the less, I suspect you may be able to write code that would work with the product. I didn't get into the technical documentation on their site to any great extent, but we do use some products with similar lineage to integrate with an image management system, and to do address validation via another system.

    As to other credit card processing software that will work with Access, the only one we have used is a product called PC Charge (from GO Software I believe), and I can't say that I highly recommend it. It seems to work about 99.9 % of the time, but every once in a while things go south, and we get a time out on an authorization, and then we have to figure out whether the charge really got accepted or not, and jump through a bunch of hoops to make sure double billing didn occur, etc. We only have one client who does credit card processing, and I think we are going to move them to one of the internet services and let them handle the problems that occur. There seems to be lots of black magic going on from the point at which you send the transaction into the ether and the point at which the bank actually credits the charge - we haven't been able to get a coherent explanation of any of the steps along the way. Didn't mean to start a rant here, but hopefully our experience will give you some things to look out for.
    Wendell

  10. #10
    Plutonium Lounger
    Join Date
    Dec 2000
    Location
    Sacramento, California, USA
    Posts
    16,775
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Third Party API Call (Access 2002)

    FileSystemObject should be available with a reference to the Office object library if the scripting library isn't available.
    Charlotte

  11. #11
    3 Star Lounger
    Join Date
    Dec 2001
    Location
    Nevada, USA
    Posts
    207
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Third Party API Call (Access 2002)

    My apologies to the group. The code that I posted was from a sample application that the vendor had supplied along with the software. I do not need to include this code in my application. The API provides two ways of sending and receiving information: TCP/IP and File Drop. As our application is not a web app, we will be using the file drop method and thus will not need anything that remotely resembles what I posted.

    Guess I panicked because I had never done an API call. Sorry!
    Carol W.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •