Attribute VB_Name = "modFunctions"
'-----------------------------------------------------
' MirageBot Functions Module
' Written by Christopher Nevin (lancergli@gmail.com)
'-----------------------------------------------------

Option Explicit

Private Declare Function PlaySoundA Lib "winmm.dll" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Public Declare Function FlashWindowEx Lib "User32" (FWInfo As FLASHWINFO) As Boolean
Public Type FLASHWINFO
    cbSize As Long     ' size of structure
    hwnd As Long       ' hWnd of window to use
    dwFlags As Long    ' Flags, see below
    uCount As Long     ' Number of times to flash window
    dwTimeout As Long  ' Flash rate of window in milliseconds. 0 is default.
End Type

'FlashWindow Constants
Public Const FLASHW_STOP        As Long = 0
Public Const FLASHW_CAPTION     As Long = 1
Public Const FLASHW_TRAY        As Long = 2
Public Const FLASHW_ALL         As Long = FLASHW_CAPTION Or FLASHW_TRAY
Public Const FLASHW_TIMER       As Long = 4
Public Const FLASHW_TIMERNOFG   As Long = 12

'PlaySoundA Constants
Public Const SND_APPLICATION    As Long = &H80       '  look for application specific association
Public Const SND_ALIAS          As Long = &H10000    '  name is a WIN.INI [sounds] entry
Public Const SND_ALIAS_ID       As Long = &H110000   '  name is a WIN.INI [sounds] entry identifier
Public Const SND_ASYNC          As Long = &H1        '  play asynchronously
Public Const SND_FILENAME       As Long = &H20000    '  name is a file name
Public Const SND_LOOP           As Long = &H8        '  loop the sound until next sndPlaySound
Public Const SND_MEMORY         As Long = &H4        '  lpszSoundName points to a memory file
Public Const SND_NODEFAULT      As Long = &H2        '  silence not default, if sound not found
Public Const SND_NOSTOP         As Long = &H10       '  don't stop any currently playing sound
Public Const SND_NOWAIT         As Long = &H2000     '  don't wait if the driver is busy
Public Const SND_PURGE          As Long = &H40       '  purge non-static events for task
Public Const SND_RESOURCE       As Long = &H40004    '  name is a resource name or atom
Public Const SND_SYNC           As Long = &H0        '  play synchronously (default)

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private ErrorList As New Collection
'Private ErrorQ As New Collection

Public Function SanityCheck() As Boolean
    SanityCheck = False
    If SelBot = -1 Then Exit Function
    If frmBot.Bot(SelBot) Is Nothing Then Exit Function
    If frmBot.Bot(SelBot).IsLoaded = False Then Exit Function
    If frmBot.Bot(SelBot).Config Is Nothing Then Exit Function
    SanityCheck = True
End Function

Public Sub OpenDir(Directory As String)
    On Error Resume Next
    ShellExecute 0, "OPEN", vbNS, vbNS, Directory, 5
End Sub

Public Sub OpenFile(FileName As String)
    On Error Resume Next
    ShellExecute 0, "OPEN", FileName, vbNS, vbNS, 5
End Sub

Public Sub OpenLink(Website As String)
    OpenFile Website
End Sub

Public Sub ChangeOpacity(F As Form, Value As Long)
    SetWindowLong F.hwnd, GWL_EXSTYLE, WS_EX_LAYERED
    SetLayeredWindowAttributes F.hwnd, 0, 255 * (Value / 100), LWA_ALPHA
End Sub

Public Function TestIDE() As Boolean
     On Error GoTo IDEInUse
     Debug.Print 1 \ 0 'division by zero error
     TestIDE = False
     Exit Function
IDEInUse:
     TestIDE = True
End Function

Public Function CheckReqFiles() As Boolean
    Dim FS As New FileSystemObject
    If Not FS.FileExists(App.Path & "\STAR.ini") Then Exit Function
    If Not FS.FileExists(App.Path & "\SEXP.ini") Then Exit Function
    If Not FS.FileExists(App.Path & "\WAR3.ini") Then Exit Function
    If Not FS.FileExists(App.Path & "\W3XP.ini") Then Exit Function
    If Not FS.FileExists(App.Path & "\WardenHandler.dll") Then Exit Function
    If Not FS.FileExists(App.Path & "\zLib.dll") Then Exit Function
    If Not FS.FileExists(App.Path & "\BNCSutil.dll") Then Exit Function
    If Not FS.FileExists(App.Path & "\CheckRevision.dll") Then Exit Function
    CheckReqFiles = True
End Function

Public Sub LoadErrors()
    Dim Content As String, EL() As String, I As Integer
    Content = ReadFile(AppData & "ErrorLog.txt")
    EL = Split(Content, vbNewLine)
    For I = 0 To UBound(EL)
        Dim VersionStr As String
        VersionStr = Prefix(EL(I), " ")
        If VersionStr = AppVersion & "." & AppBuild Then AddError EL(I)
    Next
    Content = vbNS
    For I = 1 To ErrorList.Count
        Content = Content & ErrorList(I) & vbNewLine
    Next
    SaveFile AppData & "ErrorLog.txt", Content
End Sub

Private Function AddError(str As String) As Boolean
    Dim I As Integer
    For I = 1 To ErrorList.Count
        If ErrorList(I) = str Then
            'Error Already Occurred Don't Output
            Exit Function
        End If
    Next
    ErrorList.Add str
    AddError = True
End Function

Public Sub ErrorHandler(ByRef Number As Long, ByRef Descr As String, ByRef Erl As Long, ByRef Class As String, ByRef Procedure As String, Optional ByRef sErr As error, Optional ByVal BotIndex As Integer)
On Error Resume Next
    Dim FF As Integer, Profile As String
    FF = FreeFile
    If BotIndex > -1 Then Profile = frmBot.Bot(BotIndex).Profile
    If sErr Is Nothing Then
        Dim OutputStr As String, I As Integer
        OutputStr = AppVersion & "." & AppBuild & " -- " & IIf(Len(Profile), Profile & ".", vbNS) & Class & "." & Procedure & " [" & Erl & "] -- " & Descr
        If AddError(OutputStr) Then
            Open AppData & "ErrorLog.txt" For Append As #FF
            Print #FF, OutputStr
            Close #FF
        End If
        OutputFocus frmErrorConsole.rtbErr, -1, &HB3, , "<b>" & IIf(Len(Profile), Profile & ".", vbNS) & Class & "." & Procedure & "</b> [Line: " & Erl & "]"
        OutputFocus frmErrorConsole.rtbErr, -1, &HB3, , Descr
    Else
        OutputFocus frmErrorConsole.rtbErr, -1, &HB3, , "<b>" & IIf(Len(Profile), Profile & ".", vbNS) & Prefix(Suffix(Class, "["), "]") & "." & Procedure & "</b> [Col: " & sErr.Column & ", Line: " & sErr.Line & "]"
        OutputFocus frmErrorConsole.rtbErr, -1, &HB3, , sErr.Description
    End If
AlreadyWritten:
    ErrorCount = ErrorCount + 1
    frmBot.mnuError.Visible = True
    frmBot.mnuError.Caption = "<Errors: " & ErrorCount & ">"
End Sub

Public Function ArrayInit(ByVal NotValue As Long) As Boolean
    ArrayInit = Not (NotValue = -1&)
    If App.LOGMODE <> 0 Then Exit Function
    On Error Resume Next
    Debug.Assert 0.1
    On Error GoTo 0
End Function

Public Function PlaySound(sFilePath As String, Optional lFlags As Long = SND_FILENAME Or SND_ASYNC) As Long
    PlaySound = PlaySoundA(sFilePath, 0&, lFlags)
End Function

Public Sub FlashWindow()
    Dim FWInfo As FLASHWINFO
    With FWInfo
       .cbSize = 20
       .hwnd = frmBot.hwnd
       .dwFlags = FLASHW_ALL
       .uCount = 3
       .dwTimeout = 500
    End With
    Call FlashWindowEx(FWInfo)
End Sub

Public Function AddBuffer(ByRef B As String, t As String, S As String, Optional L As Long = 0) As Long
    If Len(S) > L Then
        B = B & t & S & vbNewLine
        AddBuffer = Len(t) + Len(S) + 2
    End If
End Function
 
Public Function Encrypt(ByVal Text As String) As String
    Select Case options.Encryption
    Case 0
        Encrypt = ASCENCRYPTION_CHAR & StringToAsc(Text)
    Case 1
        Encrypt = HEXENCRYPTION_CHAR & StringToHex(Text)
    Case 2
        Encrypt = B64ENCRYPTION_CHAR & Base64.Encode(Text)
    Case 3
        Encrypt = ROTENCRYPTION_CHAR & Rot13(Text)
    Case 4
        Encrypt = XORENCRYPTION_CHAR & XOREncryption(XORENCRYPTION_KEY, Text)
    End Select
End Function

Public Function Decrypt(ByVal Text As String, ByRef Encryption As String) As String
    Dim Content As String
    Content = Mid$(Text, 2)
    If Len(Content) = 0 Then GoTo ElseCase:
    Select Case Left$(Text, 1)
    Case ASCENCRYPTION_CHAR
        Encryption = "ASCII"
        Decrypt = AscToString(Content)
    Case HEXENCRYPTION_CHAR, Chr(163)
        Encryption = "Hex"
        Decrypt = HexToString(Content)
    Case B64ENCRYPTION_CHAR
        Encryption = "Base-64"
        Decrypt = Base64.Decode(Content)
    Case ROTENCRYPTION_CHAR
        Encryption = "Rot-13"
        Decrypt = Rot13(Content)
    Case XORENCRYPTION_CHAR
        Encryption = "XOR"
        Decrypt = XORDecryption(XORENCRYPTION_KEY, Content)
    Case Else
ElseCase:
        Encryption = vbNS
        Decrypt = Text
    End Select
End Function

Public Function Hex2Color(strHexValue As String) As Long
    strHexValue = Right$("010101" & strHexValue, 6)
    strHexValue = Replace$(strHexValue, "00", "01")
    Hex2Color = Val("&H0" & Right$(strHexValue, 2) & StrReverse$(Mid$(strHexValue, 2, 2)) & Left$(strHexValue, 2))
End Function

Public Function Color2Hex(lngValue As String) As String
    Dim strHexValue As String
    strHexValue = Right$("000000" & Hex$(lngValue), 6)
    Color2Hex = Right$(strHexValue, 2) & StrReverse$(Mid$(strHexValue, 2, 2)) & Left$(strHexValue, 2)
End Function

'Sort Array
Public Sub MedianThreeQuickSort1(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
    Dim lngFirst As Long
    Dim lngLast As Long
    Dim varMid As Variant
    Dim lngIndex As Long
    Dim varSwap As Variant
    Dim A As Long
    Dim B As Long
    Dim C As Long
    If plngRight = 0 Then
        plngLeft = LBound(pvarArray)
        plngRight = UBound(pvarArray)
    End If
    lngFirst = plngLeft
    lngLast = plngRight
    lngIndex = plngRight - plngLeft + 1
    A = Int(lngIndex * Rnd) + plngLeft
    B = Int(lngIndex * Rnd) + plngLeft
    C = Int(lngIndex * Rnd) + plngLeft
    If pvarArray(A) <= pvarArray(B) And pvarArray(B) <= pvarArray(C) Then
        lngIndex = B
    Else
        If pvarArray(B) <= pvarArray(A) And pvarArray(A) <= pvarArray(C) Then
            lngIndex = A
        Else
            lngIndex = C
        End If
    End If
    varMid = pvarArray(lngIndex)
    Do
        Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
            lngFirst = lngFirst + 1
        Loop
        Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
            lngLast = lngLast - 1
        Loop
        If lngFirst <= lngLast Then
            varSwap = pvarArray(lngFirst)
            pvarArray(lngFirst) = pvarArray(lngLast)
            pvarArray(lngLast) = varSwap
            lngFirst = lngFirst + 1
            lngLast = lngLast - 1
        End If
    Loop Until lngFirst > lngLast
    If lngLast - plngLeft < plngRight - lngFirst Then
        If plngLeft < lngLast Then MedianThreeQuickSort1 pvarArray, plngLeft, lngLast
        If lngFirst < plngRight Then MedianThreeQuickSort1 pvarArray, lngFirst, plngRight
    Else
        If lngFirst < plngRight Then MedianThreeQuickSort1 pvarArray, lngFirst, plngRight
        If plngLeft < lngLast Then MedianThreeQuickSort1 pvarArray, plngLeft, lngLast
    End If
End Sub

