Attribute VB_Name = "Helpers"
Option Explicit

'TransactionType enum
Public Enum FMStocks_TransactionType
    Pending_Buy = 1
    Pending_Sell = 2
    Bought = 3
    Sold = 4
    Insufficient_Funds = 5
    Not_Enough_Shares = 6
End Enum

'Debug String Messages
Public Const cstrStarting_Method = "Starting Method call"
Public Const cstrFinishing_Method = "Finishing Method call"
Public Const cstrError_Method = "Error in Method call"

'WIN32 API Functions used to write to EventLog and get the Computername
Declare Function RegisterEventSource Lib "advapi32.dll" Alias _
  "RegisterEventSourceA" (ByVal lpUNCServerName As String, _
  ByVal lpSourceName As String) As Long
Declare Function DeregisterEventSource Lib "advapi32.dll" ( _
  ByVal hEventLog As Long) As Long
Declare Function ReportEvent Lib "advapi32.dll" Alias _
  "ReportEventA" (ByVal hEventLog As Long, ByVal wType As Integer, _
  ByVal wCategory As Integer, ByVal dwEventID As Long, _
  ByVal lpUserSid As Any, ByVal wNumStrings As Integer, _
  ByVal dwDataSize As Long, plpStrings As Long, _
  lpRawData As Any) As Boolean
Declare Function GetLastError Lib "kernel32" () As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
  hpvDest As Any, hpvSource As Any, _
  ByVal cbCopy As Long)
Declare Function GlobalAlloc Lib "kernel32" ( _
   ByVal wFlags As Long, _
   ByVal dwBytes As Long) As Long
Declare Function GlobalFree Lib "kernel32" ( _
   ByVal hMem As Long) As Long
Private Declare Function GetComputerNameAPI Lib "kernel32" Alias "GetComputerNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long

'Event Constants
Public Const EVENTLOG_SUCCESS = 0
Public Const EVENTLOG_ERROR_TYPE = 1
Public Const EVENTLOG_WARNING_TYPE = 2
Public Const EVENTLOG_INFORMATION_TYPE = 4
Public Const EVENTLOG_AUDIT_SUCCESS = 8
Public Const EVENTLOG_AUDIT_FAILURE = 10

Public Sub LogNTEvent(ByVal sString As String, ByVal iLogType As Integer, _
  ByVal iEventID As Long, ByVal sEventTitle As String)
  
  Dim bRC As Boolean
  Dim iNumStrings As Integer
  Dim hEventLog As Long
  Dim hMsgs As Long
  Dim cbStringSize As Long
  
  hEventLog = RegisterEventSource("", sEventTitle)
  cbStringSize = Len(sString) + 1
  hMsgs = GlobalAlloc(&H40, cbStringSize)
  
  CopyMemory ByVal hMsgs, ByVal sString, cbStringSize
  
  iNumStrings = 1
  
  Call ReportEvent(hEventLog, _
     iLogType, 0, _
     iEventID, 0&, _
     iNumStrings, cbStringSize, _
     hMsgs, hMsgs)
     
  Call GlobalFree(hMsgs)
  Call DeregisterEventSource(hEventLog)
  
End Sub


' mp is short for MakeParameter - does typesafe array creation for use with Run* functions
Public Function mp(ByVal PName As String, ByVal PType As ADODB.DataTypeEnum, ByVal PSize As Long, ByVal PValue As Variant)
    mp = Array(PName, PType, PSize, PValue)
End Function

'Converts a variant into a string. If the varaint is null, it is converted to the empty string.
Public Function ConvertToString(v As Variant) As String
    If IsNull(v) Then
        ConvertToString = ""
    Else
        ConvertToString = CStr(v)
    End If
End Function

'Converts any Null variant to null, otherwise it returns the existing value.
Public Function NullsToZero(v As Variant) As Variant
    If IsNull(v) Then
        NullsToZero = 0
    Else
        NullsToZero = v
    End If
End Function

'Raise an error without changing the transaction state.
Public Sub RaiseError(ByVal module As String, ByVal functionName As String, _
                      Optional ByVal strErrDesc As String = "", Optional ByVal lngErrNum As Long = 0, Optional bWriteToLog As Boolean = False)
    'log the error to the event for later use.
    Dim strSource As String
    
    If strErrDesc = "" Then strErrDesc = Err.description
    If lngErrNum = 0 Then lngErrNum = Err.Number
    
    strSource = CreateSourceStack(module, functionName)
    
    'add custom logging here... for now we log to application event log
    If bWriteToLog Then logError lngErrNum, strSource, strErrDesc
    
    Err.Raise lngErrNum, strSource, strErrDesc
End Sub

Function GetComputerName() As String
    ' Set or retrieve the name of the computer.
    Dim strBuffer As String
    Dim lngLen As Long
        
    strBuffer = Space(255 + 1)
    lngLen = Len(strBuffer)
    If CBool(GetComputerNameAPI(strBuffer, lngLen)) Then
        GetComputerName = Left$(strBuffer, lngLen)
    Else
        GetComputerName = ""
    End If
End Function

Private Function CreateSourceStack(ByVal objectName As String, ByVal procName As String) As String
    ' Returns an source stack like message like:  "[FMStocks_DB.Account] VerifyUser [on AHI version 5.21.176]"
    ' add tab to each line in the  new source stack
    
    CreateSourceStack = Replace(Err.source & vbNewLine & "[" & objectName & "]  " & procName & _
            " [" & GetComputerName() & " version " & GetVersionNumber() & "]", vbNewLine, vbTab & vbNewLine)
End Function

'returns the current DLL version number
Function GetVersionNumber() As String
    GetVersionNumber = App.Major & "." & App.Minor & "." & App.Revision
End Function

'function takes a string with an '=' in it and returns the left part
'GetKey("test=1") return test
Public Function GetKey(ByVal strItem As String) As String
    Dim i As Integer
    
    i = InStr(1, strItem, "=", vbTextCompare)
    If i > 0 Then
        GetKey = Left(strItem, i - 1)
    Else
        GetKey = ""
    End If
End Function

'function takes a string with an '=' in it and returns the right part
'GetValue("test=1") return 1
Public Function GetValue(ByVal strItem As String) As String
    Dim i As Integer
    
    i = InStr(1, strItem, "=", vbTextCompare)
    If i > 0 Then
        GetValue = Mid(strItem, 1 + i)
    Else
        GetValue = ""
    End If
End Function

'this procedure logs an error to the system application log
Private Sub logError(ByVal errnum As Long, ByVal source As String, _
                     ByVal description As String, Optional notes As String = "")
                     
    App.logEvent vbNewLine & "An error has occured in an FMStocks 2000 component." & vbNewLine & _
                "Error Number:" & errnum & vbNewLine & vbNewLine & _
                "Source: " & vbNewLine & source & vbNewLine & vbNewLine & _
                "Description:" & vbNewLine & description & vbNewLine & vbNewLine & _
                "Notes: " & vbNewLine & notes, vbLogEventTypeError  ' FMC1: App.LogEvent Optional Parameter

End Sub
'this procedure logs an error to the system application log
Private Sub logEvent(ByVal source As String, ByVal description As String, _
                     Optional ByVal notes As String = "")
                     
    App.logEvent vbNewLine & "FMStocks 2000 Debug event." & vbNewLine & _
                "Source: " & vbNewLine & source & vbNewLine & vbNewLine & _
                "Description:" & vbNewLine & description & vbNewLine & vbNewLine & _
                "Notes: " & vbNewLine & notes, vbLogEventTypeError ' FMC1: App.LogEvent Optional Parameter

End Sub
Public Sub logDebugMSG(ByVal bWriteMSG As Boolean, ByVal strEvent As String, _
                      ByVal strSource As String, Optional ByVal strMSG As String = "")
        
        If bWriteMSG Then logEvent strEvent & " -- " & strSource, _
                                  "Debug event from " & strSource, strMSG

End Sub
