Attribute VB_Name = "modMisc"
'License:   GPL
'Copyright: 2005 iDefense a Verisign Company
'Site:      http://labs.idefense.com
'
'Author:    David Zimmer <david@idefense.com, dzzie@yahoo.com>
'
'         This program is free software; you can redistribute it and/or modify it
'         under the terms of the GNU General Public License as published by the Free
'         Software Foundation; either version 2 of the License, or (at your option)
'         any later version.
'
'         This program is distributed in the hope that it will be useful, but WITHOUT
'         ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
'         FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
'         more details.
'
'         You should have received a copy of the GNU General Public License along with
'         this program; if not, write to the Free Software Foundation, Inc., 59 Temple
'         Place, Suite 330, Boston, MA 02111-1307 USA

'Used in several projects do not change interface!

 
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hWndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
'Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
'Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
'Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal path As String, ByVal cbBytes As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer


Private Type COPYDATASTRUCT
    dwFlag As Long
    cbSize As Long
    lpData As Long
End Type

Private Const WM_COPYDATA = &H4A
Private Const WM_DISPLAY_TEXT = 3

Private Type sockaddr_in
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

Private Type sockaddr_gen
    AddressIn As sockaddr_in
    filler(0 To 7) As Byte
End Type

Private Type INTERFACE_INFO
    iiFlags  As Long
    iiAddress As sockaddr_gen
    iiBroadcastAddress As sockaddr_gen
    iiNetmask As sockaddr_gen
End Type

Private Type INTERFACEINFO
    iInfo(0 To 7) As INTERFACE_INFO
End Type

Private Const WSADESCRIPTION_LEN As Long = 256
Private Const WSASYS_STATUS_LEN  As Long = 128

Private Type WSAData
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * WSADESCRIPTION_LEN
    szSystemStatus As String * WSASYS_STATUS_LEN
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type

Private Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal Protocol As Long) As Long
Private Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Private Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Any, ByVal cbInBuffer As Long, lpvOutBuffer As Any, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long
Private Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As Long, ByVal ByteLen As Long)
Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVR As Long, lpWSAD As WSAData) As Long

'DiE Detect it Easy signature scanner: http://ntinfo.biz/
Private hDieDll As Long

'old version
'Private Const DIE_SHOWERRORS = &H1
'Private Const DIE_SHOWOPTIONS = &H2
'Private Const DIE_SHOWVERSION = &H4
'Private Const DIE_SHOWENTROPY = &H8
'Private Const DIE_SINGLELINEOUTPUT = &H10
'Private Const DIE_SHOWFILEFORMATONCE = &H20
'Private Declare Function DiEScanA Lib "diedll.dll" Alias "_DIE_scanA@16" (ByVal fileName As String, ByVal buf As String, ByVal bufSz As Long, ByVal flags As Long) As Long
'Private Declare Function dieScanEx Lib "diedll.dll" Alias "_DIE_scanExA@20" (ByVal fileName As String, ByVal buf As String, ByVal bufSz As Long, ByVal flags As Long, ByVal dbPath As String) As Long
'Private Declare Function dieVer Lib "diedll.dll" Alias "_DIE_versionA@0" () As Long

Const DIE_DEEPSCAN = &H1
Const DIE_HEURISTICSCAN = &H2
Const DIE_ALLTYPESSCAN = &H4
Const DIE_RECURSIVESCAN = &H8
Const DIE_VERBOSE = &H10
Const DIE_RESULTASXML = &H10000
Const DIE_RESULTASJSON = &H20000
Const DIE_RESULTASTSV = &H40000
Const DIE_RESULTASCSV = &H80000

'https://github.com/horsicq/die_library
Private Declare Function DIEScan Lib "dieshim.dll" (ByVal fileName As Long, ByVal flags As Long, ByVal db As Long, ByVal buf As Long, ByVal bufSz As Long) As Long
Private Declare Sub DieAbort Lib "dieshim.dll" Alias "Abort" ()
Private Declare Sub DIESetCallBacks Lib "dieshim.dll" Alias "SetCallBacks" (ByVal lpfnMsgHandler As Long)
Private dieRaceKill As Boolean

Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (ByVal path As String) As Long




'Enum vbKeys
'    vbk_LeftMouseButton = 1
'    vbk_MiddleMouseButton = 4
'    vbk_RightMouseButton = 2
'End Enum

'Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private startTime As Long

Global fileprops As New CFileProperties

Function isVTApiKeySet() As Boolean

    Dim i, txtUserPrivateKey, txtUserPublicKey
    
    i = GetSetting("VirusTotal", "config", "key_option", 0)
    
    If i < 1 Or i > 2 Then
        isVTApiKeySet = False
        Exit Function
    End If
    
    txtUserPublicKey = GetSetting("VirusTotal", "config", "user_public_api_key", "")
    
    If i = 1 And Len(txtUserPublicKey) = 0 Then
        isVTApiKeySet = False
        Exit Function
    End If
    
    txtUserPrivateKey = GetSetting("VirusTotal", "config", "private_api_key", "")
    If i = 2 And Len(txtUserPrivateKey) = 0 Then
        isVTApiKeySet = False
        Exit Function
    End If
    
    isVTApiKeySet = True
    
End Function

Sub StartBenchMark(Optional ByRef t As Long = -111)
    If t = -111 Then
        startTime = GetTickCount()
    Else
        t = GetTickCount()
    End If
End Sub

Function EndBenchMark(Optional ByRef t As Long = -111) As String
    Dim endTime As Long, loadTime As Long
    endTime = GetTickCount()
    If t = -111 Then
        loadTime = endTime - startTime
    Else
        loadTime = endTime - t
    End If
    EndBenchMark = loadTime / 1000 & " seconds"
End Function

Function ShowInNotepad(fpath) 'thanks MS for breaking 20yr old code with stupid shit..
    On Error Resume Next
    
    'Shell "cmd /c notepad.exe """ & fPath & """", vbHide ''aanndd now they removed it... 3.21.24
    
    Dim exe As String
    exe = App.path & "\notepad.exe"
    If Not fso.FileExists(exe) Then exe = fso.GetParentFolder(App.path) & "\notepad.exe"
    If Not fso.FileExists(exe) Then exe = Environ("windir") & "\notepad.exe"
    If Not fso.FileExists(exe) Then exe = Environ("windir") & "\Syswow64\notepad.exe"
    If Not fso.FileExists(exe) Then exe = Environ("windir") & "\System32\notepad.exe"
    
    If Not fso.FileExists(exe) Then
        MsgBox "Notepad.exe not found? thanks ms you suck", vbExclamation
        Exit Function
    End If
    
    Shell """" & exe & """ """ & fpath & """", vbNormalFocus
    
End Function

Function GetKeyState(k As KeyCodeConstants) As Boolean
    If GetAsyncKeyState(k) Then GetKeyState = True
End Function

Public Function FileSizeBytes(ByVal fsize As Long) As String
 
    Dim szName As String
    On Error GoTo hell
    
    szName = " bytes"
    If fsize > 1024 Then
        fsize = fsize / 1024
        szName = " Kb"
    End If
    
    If fsize > 1024 Then
        fsize = fsize / 1024
        szName = " Mb"
    End If
    
    FileSizeBytes = fsize & szName
    
    Exit Function
hell:
    
End Function

Function ado_buildInsert(tblName, fields, ParamArray params()) As String
    Dim Values()
    Values() = params() 'force byval
    ado_buildInsert = ado_buildInsert2(tblName, fields, Values)
End Function

Function ado_buildInsert2(tblName, fields, params()) As String

    Dim sSql As String, sTmp As String, i As Integer, x
    Dim Values()
    
    Values() = params() 'force byval
    sSql = "Insert into " & tblName & " (" & fields & ") VALUES(____)"
    
    Dim tn As String
    For i = 0 To UBound(Values)
        tn = LCase(TypeName(Values(i)))
        If tn = "string" Or tn = "textbox" Or tn = "date" Then
            Values(i) = """" & Replace(Values(i), """", """""") & """"
        End If
    Next
    
    sTmp = Join(Values, ",")
    ado_buildInsert2 = Replace(sSql, "____", sTmp)
     
    
End Function


Public Function FileSize(fpathOrSize, Optional showBytes As Boolean = True) As String
    Dim fsize As Long
    Dim szName As String
    On Error GoTo hell
    
    If fso.FileExists(CStr(fpathOrSize)) Then
        fsize = FileLen(fpathOrSize)
    Else
        fsize = CLng(fpathOrSize)
    End If
    
    If showBytes Then szName = " bytes"
    
    If fsize > 1024 Then
        fsize = fsize / 1024
        szName = " Kb"
    End If
    
    If fsize > 1024 Then
        fsize = fsize / 1024
        szName = " Mb"
    End If
    
    FileSize = fsize & szName
    
    Exit Function
hell:
    
End Function

'Private Type debugDir
'    Characteristics As Long
'    timestamp As Long
'    major As Integer
'    min As Integer
'    dbgtype As Long
'    sizeofData As Long
'    adrRawData As Long
'    ptrRawData As Long
'End Type


'Function LaunchStrings(data As String, Optional isPath As Boolean = False)
'
'    Dim b() As Byte
'    Dim f As String
'    Dim exe As String
'    Dim h As Long
'
'    On Error Resume Next
'
'    exe = App.path & IIf(IsIde(), "\..\..", "") & "\shellext.exe"
'    If Not fso.FileExists(exe) Then
'        MsgBox "Could not launch strings shellext not found", vbInformation
'        Exit Function
'    End If
'
'    If isPath Then
'        If fso.FileExists(data) Then
'            f = data
'        Else
'            MsgBox "Can not launch strings, File not found: " & data, vbInformation
'        End If
'    Else
'        b() = StrConv(dataOrPath, vbFromUnicode, LANG_US)
'        f = fso.GetFreeFileName(Environ("temp"), ".bin")
'        h = FreeFile
'    End If
'
'    Open f For Binary As h
'    Put h, , b()
'    Close h
'
'    Shell exe & " """ & f & """ /peek"
'
'End Function
 

Sub DIE_UpdateUI_Callback(ByVal reason As Long, ByVal buf As Long)
    DoEvents
    If dieRaceKill Then doDieAbort
    'Debug.Print Now & " die ui callback"
End Sub

Sub doDieAbort()
    If hDieDll = 0 Then
        Debug.Print "doDieAbort but hDieDll=0"
        dieRaceKill = True
        Exit Sub
    End If
    DieAbort
End Sub

Private Function LoadDie() As Boolean
    Dim p As String
    
    If hDieDll = 0 Then
        p = App.path & IIf(isIde(), "\..", "") & "\DiELib\dieshim.dll"
        If fso.FileExists(p) Then
            SetDllDirectory fso.GetParentFolder(p)
            hDieDll = LoadLibrary(p)
            If hDieDll <> 0 Then
                DIESetCallBacks AddressOf DIE_UpdateUI_Callback
            End If
        End If
    End If
    
    LoadDie = (hDieDll <> 0)
    
End Function

'Function DieVersion() As String 'old version
'    Dim addr As Long, leng As Long, b() As Byte
'
'    If Not LoadDie Then Exit Function
'
'    addr = dieVer()
'    If addr Then
'        leng = lstrlenA(addr)
'        If leng > 0 Then
'            ReDim b(1 To leng)
'            CopyMemory ByVal VarPtr(b(1)), ByVal addr, leng
'            DieVersion = StrConv(b, vbUnicode, &H409)
'        End If
'    End If
'
'End Function

'Function DIEScan(fPath As String, ByRef outVal) As Boolean 'old version
'    Dim v As Long
'    Dim buf As String
'    Dim flags As Long
'    Dim a As Long
'    Dim tmp() As String
'    Dim x
'    Const et = "Entropy"
'
'    On Error GoTo hell
'
'    outVal = Empty
'    If Not LoadDie Then Exit Function
'
'    flags = DIE_SHOWOPTIONS Or DIE_SHOWVERSION Or DIE_SINGLELINEOUTPUT 'Or DIE_SHOWENTROPY
'    buf = String(1000, Chr(0))
'    'v = DiEScanA(fPath, buf, Len(buf), flags)
'    v = dieScanEx(fPath, buf, Len(buf), flags, App.path & IIf(isIde(), "\..", "") & "\die\db\")
'
'    a = InStr(buf, Chr(0))
'    If a > 0 Then buf = Left(buf, a - 1)
'    buf = Replace(buf, vbLf, vbCrLf)
'    tmp = Split(buf, ";")
'    buf = Join(tmp, vbCrLf & vbTab & "   ")
'    outVal = buf
'
'    DIEScan = (InStr(1, buf, "Nothing found", vbBinaryCompare) < 1)
'
''    tmp = Split(buf, ";")
''
''    For i = 0 To UBound(tmp)
''        tmp(i) = trim(tmp(i))
''        If Left(tmp(i), Len(et)) = et Then
''            entropy = trim(Mid(tmp(i), Len(et) + 2))
''            tmp(i) = Empty
''            Exit For
''        End If
''    Next
'
''    DiEScan = Join(tmp, ";")
'
'    Exit Function
'hell:
'    outVal = Err.Description
'End Function

Function vbDIEScan(fpath As String, ByRef outVal, Optional verbose As Boolean = True) As Boolean
    Dim v As Long
    Dim buf As String, db As String
    Dim flags As Long
    Dim a As Long
    Dim tmp() As String
    Dim x
    Const et = "Entropy"
    
    On Error GoTo hell
    
    outVal = Empty
    If Not LoadDie Then Exit Function
    dieRaceKill = False
    
    db = App.path & IIf(isIde(), "\..", "") & "\dielib\db\"
    
    If Not fso.FolderExists(db) Then
        MsgBox "die db not found: " & db
    End If
    
    flags = DIE_ALLTYPESSCAN Or IIf(verbose, DIE_VERBOSE, 0)
    buf = String(3000, Chr(0))
    v = DIEScan(StrPtr(fpath), flags, StrPtr(db), StrPtr(buf), Len(buf))
    
    a = InStr(buf, Chr(0))
    If a > 0 Then buf = Left(buf, a - 1)
    buf = trim(Replace(buf, vbLf, vbCrLf))
    buf = Replace(buf, vbTab, Empty)
    buf = Replace(buf, "MSDOS", Empty)
    buf = Replace(buf, "PE32", Empty)
    buf = Replace(buf, "PE64", Empty)
    buf = Replace(buf, "Operation system: ", Empty)
    buf = Replace(buf, vbCrLf & vbCrLf, vbCrLf)
    If Left(buf, 2) = vbCrLf Then buf = Mid(buf, 3)
    
    'tmp = Split(buf, vbCrLf)
    'buf = Join(tmp, vbCrLf & vbTab & "   ")
    outVal = buf
    'MsgBox Replace(outVal, Chr(0), "")
    
    vbDIEScan = (InStr(1, buf, "Nothing found", vbBinaryCompare) < 1)
    
    Exit Function
hell:
    outVal = Err.Description
End Function


Function HexDump(ByVal str, Optional hexOnly = 0, Optional offset As Long = 0) As String
    Dim s() As String, chars As String, tmp As String
    On Error Resume Next
    Dim ary() As Byte
   
    str = " " & str
    ary = StrConv(str, vbFromUnicode, LANG_US)
    
    chars = "   "
    For i = 1 To UBound(ary)
        tt = Hex(ary(i))
        If Len(tt) = 1 Then tt = "0" & tt
        tmp = tmp & tt & " "
        x = ary(i)
        'chars = chars & IIf((x > 32 And x < 127) Or x > 191, Chr(x), ".") 'x > 191 causes \x0 problems on non us systems... asc(chr(x)) = 0
        chars = chars & IIf((x > 32 And x < 127), Chr(x), ".")
        If i > 1 And i Mod 16 = 0 Then
            h = Hex(offset)
            While Len(h) < 6: h = "0" & h: Wend
            If hexOnly = 0 Then
                push s, h & "   " & tmp & chars
            Else
                push s, tmp
            End If
            offset = offset + 16
            tmp = Empty
            chars = "   "
        End If
    Next
    'if read length was not mod 16=0 then
    'we have part of line to account for
    If tmp <> Empty Then
        If hexOnly = 0 Then
            h = Hex(offset)
            While Len(h) < 6: h = "0" & h: Wend
            h = h & "   " & tmp
            While Len(h) <= 56: h = h & " ": Wend
            push s, h & chars
        Else
            push s, tmp
        End If
    End If
    
    HexDump = Join(s, vbCrLf)
    
    If hexOnly <> 0 Then
        HexDump = Replace(HexDump, " ", "")
        HexDump = Replace(HexDump, vbCrLf, "")
    End If
    
End Function

Private Sub push(ary, value) 'this modifies parent ary object
    On Error GoTo init
    Dim x As Integer
    x = UBound(ary) '<-throws Error If Not initalized
    ReDim Preserve ary(UBound(ary) + 1)
    ary(UBound(ary)) = value
    Exit Sub
init:     ReDim ary(0): ary(0) = value
End Sub

Private Function AryIsEmpty(ary) As Boolean
  On Error GoTo oops
    i = UBound(ary)  '<- throws error if not initalized
    AryIsEmpty = False
  Exit Function
oops: AryIsEmpty = True
End Function


'Function GetAllElements(lv As ListView, Optional selOnly As Boolean = False) As String
'    Dim ret() As String, i As Integer, tmp As String
'    Dim li As ListItem
'
'    For i = 1 To lv.ColumnHeaders.Count
'        tmp = tmp & lv.ColumnHeaders(i).text & vbTab
'    Next
'
'    push ret, tmp
'    push ret, String(50, "-")
'
'    For Each li In lv.ListItems
'
'        tmp = Empty
'
'        If selOnly Then
'            If li.selected Then tmp = li.text & vbTab
'        Else
'            tmp = li.text & vbTab
'        End If
'
'        For i = 1 To lv.ColumnHeaders.Count - 1
'            If selOnly Then
'                If li.selected Then tmp = tmp & li.subItems(i) & vbTab
'            Else
'                tmp = tmp & li.subItems(i) & vbTab
'            End If
'        Next
'
'        If Len(tmp) > 0 Then push ret, tmp
'
'    Next
'
'    GetAllElements = Join(ret, vbCrLf)
'
'End Function

Function GetAllElements(lv As ListView, Optional selOnly As Boolean = False) As String
    Dim ret() As String
    Dim i As Integer, tmp As String
    Dim li As ListItem
    Dim colWidths() As Long
    Dim rowData() As String
    Dim allRows() As Variant
    Dim rowCount As Long
    Dim maxWidth As Long
    Dim j As Long
    
    ' Initialize column widths array
    ReDim colWidths(1 To lv.ColumnHeaders.Count)
    ReDim allRows(0 To lv.ListItems.Count) ' Header + separator + items
    rowCount = 0
    
    ' First pass: collect all data and track column widths
    ' Header row
    ReDim rowData(1 To lv.ColumnHeaders.Count)
    For i = 1 To lv.ColumnHeaders.Count
        rowData(i) = lv.ColumnHeaders(i).text
        If Len(rowData(i)) > colWidths(i) Then colWidths(i) = Len(rowData(i))
    Next
    allRows(rowCount) = rowData
    rowCount = rowCount + 1
    
    ' Data rows
    For Each li In lv.ListItems
        If selOnly And Not li.selected Then GoTo NextItem
        
        ReDim rowData(1 To lv.ColumnHeaders.Count)
        rowData(1) = li.text
        If Len(rowData(1)) > colWidths(1) Then colWidths(1) = Len(rowData(1))
        
        For i = 1 To lv.ColumnHeaders.Count - 1
            rowData(i + 1) = li.subItems(i)
            If Len(rowData(i + 1)) > colWidths(i + 1) Then colWidths(i + 1) = Len(rowData(i + 1))
        Next
        
        allRows(rowCount) = rowData
        rowCount = rowCount + 1
        
NextItem:
    Next
    
    ' Second pass: build output with padding (no pre-allocation of ret)
    ' Header
    tmp = Empty
    rowData = allRows(0)
    For i = 1 To UBound(rowData)
        tmp = tmp & rowData(i) & Space(colWidths(i) - Len(rowData(i)) + 2)
    Next
    push ret, RTrim(tmp)
    
    ' Separator line (using max width across all columns + padding)
    maxWidth = 0
    For i = 1 To UBound(colWidths)
        maxWidth = maxWidth + colWidths(i) + 2
    Next
    push ret, String(maxWidth, "-")
    
    ' Data rows
    For j = 1 To rowCount - 1
        tmp = Empty
        rowData = allRows(j)
        For i = 1 To UBound(rowData)
            tmp = tmp & rowData(i) & Space(colWidths(i) - Len(rowData(i)) + 2)
        Next
        push ret, RTrim(tmp)
    Next
    
    GetAllElements = Join(ret, vbCrLf)
End Function


Function GetAllText(lv As ListView, Optional subItemRow As Long = 0) As String
    Dim i As Long
    Dim tmp As String, x As String
    
    For i = 1 To lv.ListItems.Count
        If subItemRow = 0 Then
            x = lv.ListItems(i).text
            If Len(x) > 0 Then
                tmp = tmp & x & vbCrLf
            End If
        Else
            x = lv.ListItems(i).subItems(subItemRow)
            If Len(x) > 0 Then
                tmp = tmp & x & vbCrLf
            End If
        End If
    Next
    
    GetAllText = tmp
End Function

Function isIde() As Boolean
    On Error GoTo hell
    Debug.Print 1 \ 0
Exit Function
hell: isIde = True
End Function

Sub SetLiColor(li As ListItem, newcolor As Long)
    Dim f As ListSubItem
'    On Error Resume Next
    li.ForeColor = newcolor
    For Each f In li.ListSubItems
        f.ForeColor = newcolor
    Next
End Sub

Function c2a(c As Collection) As String()
    Dim t() As String, f
    For Each f In c
        push t, f
    Next
    c2a = t
End Function

Function c2s(c As Collection, Optional delimiter = vbCrLf) As String
    c2s = Join(c2a(c), delimiter)
End Function

Function DatetoTimeStamp(d As Date) As Long

    On Error Resume Next
    Dim base As Date
    Dim compiled As Date
    
    base = DateSerial(1970, 1, 1)
    DatetoTimeStamp = DateDiff("s", base, d)

End Function

Function timeStampToDate(timestamp As Long, Optional formatStr As String = "mmm d yyyy h:nn:ss") As String

    On Error Resume Next
    Dim base As Date
    Dim compiled As Date
    
    base = DateSerial(1970, 1, 1)
    compiled = DateAdd("s", timestamp, base)
    timeStampToDate = Format(compiled, formatStr)

End Function


'ported from Detect It Easy - Binary::calculateEntropy
'   https://github.com/horsicq/DIE-engine/blob/master/binary.cpp#L2319
'   https://github.com/dzzie/DIE-engine/blob/master/binary.cpp#L2300
' more:
'   https://rosettacode.org/wiki/Entropy#FreeBASIC
'Function fileEntropy(pth As String, Optional offset As Long = 0, Optional leng As Long = -1) As Single
'
'    Dim sz As Long
'    Dim fEntropy As Single
'    Dim bytes(255) As Single
'    Dim temp As Single
'    Dim nSize As Long
'    Dim nTemp As Long
'    Const BUFFER_SIZE = &H1000
'    Dim buf() As Byte
'    Dim f As Long
'
'    On Error Resume Next
'
'    f = FreeFile
'    Open pth For Binary Access Read As f
'    If Err.Number <> 0 Then GoTo ret0
'
'    sz = LOF(f) - 1
'
'    If leng = 0 Then GoTo ret0
'
'    If leng = -1 Then
'        leng = sz - offset
'        If leng = 0 Then GoTo ret0
'    End If
'
'    If offset >= sz Then GoTo ret0
'    If offset + leng > sz Then GoTo ret0
'
'    Seek f, offset
'    nSize = leng
'    fEntropy = 1.44269504088896
'    ReDim buf(BUFFER_SIZE)
'
'    'read the file in chunks and count how many times each byte value occurs
'    While (nSize > 0)
'        nTemp = IIf(nSize < BUFFER_SIZE, nSize, BUFFER_SIZE)
'        If nTemp <> BUFFER_SIZE Then ReDim buf(nTemp) 'last chunk, partial buffer
'        Get f, , buf()
'        For i = 0 To UBound(buf)
'            bytes(buf(i)) = bytes(buf(i)) + 1
'        Next
'        nSize = nSize - nTemp
'    Wend
'
'    For i = 0 To UBound(bytes)
'        temp = bytes(i) / CSng(leng)
'        If temp <> 0 Then
'            fEntropy = fEntropy + (-Log(temp) / Log(2)) * bytes(i)
'        End If
'    Next
'
'    Close f
'    fileEntropy = fEntropy / CSng(leng)
'
'Exit Function
'ret0:
'    Close f
'End Function

Function fileEntropy(pth As String, Optional offset As Long = 0, Optional leng As Long = -1) As Double

    Dim sz As Long
    Dim fEntropy As Double
    Dim bytes(255) As Double
    Dim temp As Double
    Dim nSize As Long
    Dim nTemp As Long
    Const BUFFER_SIZE As Long = &H1000
    Dim buf() As Byte
    Dim f As Long
    Dim i As Long

    On Error Resume Next

    f = FreeFile
    Open pth For Binary Access Read As #f
    If Err.Number <> 0 Then GoTo ret0

    sz = LOF(f)

    If leng = 0 Then GoTo ret0

    If leng = -1 Then
        leng = sz - offset
        If leng <= 0 Then GoTo ret0
    End If

    If offset >= sz Then GoTo ret0
    If offset + leng > sz Then GoTo ret0

    Seek #f, offset + 1

    nSize = leng
    ReDim buf(0 To BUFFER_SIZE - 1) As Byte

    ' Count byte frequencies
    While nSize > 0

        If nSize < BUFFER_SIZE Then
            nTemp = nSize
            ReDim buf(0 To nTemp - 1)
        Else
            nTemp = BUFFER_SIZE
        End If

        Get #f, , buf

        For i = 0 To nTemp - 1
            bytes(buf(i)) = bytes(buf(i)) + 1#
        Next

        nSize = nSize - nTemp

    Wend

    ' Shannon entropy
    For i = 0 To 255

        If bytes(i) <> 0# Then
            temp = bytes(i) / CDbl(leng)
            fEntropy = fEntropy - temp * (Log(temp) / Log(2#))
        End If

    Next

    Close #f
    fileEntropy = fEntropy
    Exit Function

ret0:
    On Error Resume Next
    Close #f
    fileEntropy = 0#
End Function

Public Function memEntropy(buf() As Byte, Optional ByVal offset As Long = 0, Optional ByVal leng As Long = -1) As Double
    On Error GoTo ret0

    Dim last As Long
    last = UBound(buf)                 ' last valid index

    Dim totalLen As Long
    totalLen = last + 1                ' total bytes in buf()

    If leng = 0 Then GoTo ret0

    If leng = -1 Then
        leng = totalLen - offset
        If leng <= 0 Then GoTo ret0
    End If

    ' Validate requested window: [offset .. offset+leng-1]
    If offset < 0 Then GoTo ret0
    If offset >= totalLen Then GoTo ret0
    If offset + leng > totalLen Then GoTo ret0

    Dim counts(255) As Double
    Dim i As Long
    Dim endPos As Long
    endPos = offset + leng - 1

    ' Count frequencies
    For i = offset To endPos
        counts(buf(i)) = counts(buf(i)) + 1#
    Next

    ' Shannon entropy in bits/byte
    Dim h As Double
    Dim p As Double
    Dim invLen As Double
    invLen = 1# / CDbl(leng)

    For i = 0 To 255
        If counts(i) <> 0# Then
            p = counts(i) * invLen
            h = h - p * (Log(p) / Log(2#))
        End If
    Next

    If h < 0# Then h = 0# ' clamp tiny negative epsilon
    memEntropy = h
    Exit Function

ret0:
    memEntropy = 0#
End Function


'Function memEntropy(buf() As Byte, Optional offset As Long = 0, Optional leng As Long = -1) As Single
'
'    Dim sz As Long
'    Dim fEntropy As Single
'    Dim bytes(255) As Single
'    Dim temp As Single
'    Const BUFFER_SIZE = &H1000
'
'    sz = UBound(buf)
'
'    If leng = 0 Then GoTo ret0
'    If leng = -1 Then
'        leng = sz - offset
'        If leng = 0 Then GoTo ret0
'    End If
'
'    If offset >= sz Then GoTo ret0
'    If offset + leng > sz Then GoTo ret0
'
'    fEntropy = 1.44269504088896
'
'    While (offset < sz)
'        'count each byte value occurance
'        bytes(buf(offset)) = bytes(buf(offset)) + 1
'        offset = offset + 1
'    Wend
'
'    For i = 0 To UBound(bytes)
'        temp = bytes(i) / CSng(leng)
'        If temp <> 0 Then
'            fEntropy = fEntropy + (-Log(temp) / Log(2)) * bytes(i)
'        End If
'    Next
'
'    memEntropy = fEntropy / CSng(leng)
'
'Exit Function
'ret0:
'End Function


Function sectNamesList(pe2 As sppe3.CPEEditor, Optional withEntropy As Boolean = False, Optional wCRLF As Boolean = False) As String
    On Error Resume Next
    Dim cs As sppe3.CSection, tmp As String, x() As String
    
    If Not withEntropy Then
        For Each cs In pe2.Sections
            tmp = tmp & cs.nameSec & IIf(wCRLF, vbCrLf, ", ")
        Next
        If Len(tmp) > 2 Then sectNamesList = Mid(tmp, 1, Len(tmp) - 2)
    Else
        For Each cs In pe2.Sections
             push x, rpad(cs.nameSec) & fileEntropy(pe2.LoadedFile, pe2.RvaToOffset(cs.PointerToRawData), cs.SizeOfRawData)
        Next
        sectNamesList = Join(x, vbCrLf)
    End If
    
End Function

Sub recRescDeets(ary() As String, pe As sppe3.CPEEditor, tblName As String, hash As String)
    
    On Error GoTo hell
    
    Const fields As String = "hash,rva,size,path,codepage,entropy,ssize"

    Dim d As sppe3.CResData, sql As String, o As Long, e As Single, ssize As String
    
    For Each d In pe.Resources.entries
        o = pe.RvaToOffset(d.OffsetToDataRVA)
        e = fileEntropy(pe.LoadedFile, o, d.size - 1)
        ssize = FileSizeBytes(d.size)
        sql = ado_buildInsert(tblName, fields, hash, d.OffsetToDataRVA, d.size, d.path, d.CodePage, e, ssize)
        push ary, sql & ";"
    Next
    
    Exit Sub
hell:
    Debug.Print "Error in recRescDeets:" & pe.LoadedFile & " " & Err.Description
End Sub

Sub recExportDeets(ary() As String, pe As sppe3.CPEEditor, tblName As String, hash As String)

    Const fields As String = "hash,offset,name,ordinal"

    Dim d As sppe3.CExport, sql As String, o As String
    
    For Each d In pe.exports.functions
        sql = ado_buildInsert(tblName, fields, hash, Hex(d.FunctionAddress), d.FunctionName, d.FunctionOrdial)
        push ary, sql & ";"
    Next
    
End Sub


Sub recSectDeets(ary() As String, pe As sppe3.CPEEditor, tblName As String, hash As String, epSectIndex)

    Const fields As String = "hash,i,name,virtAddr,virtSz,rawOff,rawSz,flags,flagNames,hasEP,entropy,crc32"

    Dim cs As sppe3.CSection, entropy, sql As String, crc32 As String

    For Each cs In pe.Sections
        
        crc32 = Hex(cs.crc32)
        entropy = Round(cs.entropy, 2)
        'entropy = fileEntropy(pe.LoadedFile, pe.RvaToOffset(cs.PointerToRawData), cs.SizeOfRawData)
        
        flagNames = FlagsAsStr(cs.Characteristics)
        
        sql = ado_buildInsert(tblName, fields, _
                hash, cs.index, cs.nameSec, Hex(cs.VirtualAddress), _
                Hex(cs.VirtualSize), Hex(cs.PointerToRawData), Hex(cs.SizeOfRawData), Hex(cs.Characteristics), _
                flagNames, IIf((epSectIndex = cs.index), 1, 0), entropy, crc32)
                
        push ary, sql & ";"
                
    Next
    
End Sub

Function FlagsAsStr(flagValue As Long) As String
    On Error Resume Next
    Dim tmp() As String
    'lblFlagValue = "0x" & Right("00000000" & Hex(flagValue), 8)
    tmp = getSectFlags(flagValue)
    If AryIsEmpty(tmp) Then Exit Function
    FlagsAsStr = Join(tmp, ", ")
End Function

'https://learn.microsoft.com/en-us/windows/win32/debug/pe-format#section-flags
'0x00000020  IMAGE_SCN_CNT_CODE  The section contains executable code.
'0x00000040  IMAGE_SCN_CNT_INITIALIZED_DATA The section contains initialized data.
'0x00000080  IMAGE_SCN_CNT_UNINITIALIZED_ DATA The section contains uninitialized data.
'0x00000200  IMAGE_SCN_LNK_INFO   The section contains comments or other information. The .drectve section has this type. This is valid for object files only.
'0x00000800  IMAGE_SCN_LNK_REMOVE    The section will not become part of the image. This is valid only for object files.
'0x00001000  IMAGE_SCN_LNK_COMDAT     The section contains COMDAT data. For more information, see COMDAT Sections (Object Only). This is valid only for object files.
'0x00008000  IMAGE_SCN_GPREL     The section contains data referenced through the global pointer (GP).
'0x01000000  IMAGE_SCN_LNK_NRELOC_OVFL   The section contains extended relocations.
'0x02000000  IMAGE_SCN_MEM_DISCARDABLE    The section can be discarded as needed.
'0x04000000  IMAGE_SCN_MEM_NOT_CACHED     The section cannot be cached.
'0x08000000  IMAGE_SCN_MEM_NOT_PAGED  The section is not pageable.
'0x10000000  IMAGE_SCN_MEM_SHARED     The section can be shared in memory.
'0x20000000  IMAGE_SCN_MEM_EXECUTE    The section can be executed as code.
'0x40000000  IMAGE_SCN_MEM_READ   The section can be read.
'0x80000000  IMAGE_SCN_MEM_WRITE  The section can be written to.
Function getSectFlags(x As Long) As String()

    Dim flags(), names(), ret() As String, i
    
    flags = Array(&H20, &H40, &H80, &H200, _
                  &H800, &H1000, &H8000, &H1000000, &H2000000, _
                  &H4000000, &H8000000, &H10000000, &H20000000, _
                  &H40000000, &H80000000)
                 
    names = Array("Executable Code", "Initilized Data", "Uninitialized Data", "Information Section", _
                   "Remove", "COMDAT", "Global Ptr", "Extended Relocations", "Discardable", _
                   "Not Cached", "Not Paged", "Shared", "Executable", _
                   "Readable", "Writable")
                 
    For i = 0 To UBound(flags)
        If (x And flags(i)) = flags(i) Then
            push ret, names(i)
        End If
    Next
    
    getSectFlags = ret
    
End Function

Function CountOccurances(it, find) As Integer
    Dim tmp() As String
    If InStr(1, it, find, vbTextCompare) < 1 Then CountOccurances = 0: Exit Function
    tmp = Split(it, find, , vbTextCompare)
    CountOccurances = UBound(tmp)
End Function

'Function pdbPath(pe As CPEEditor, outRet As String) As Boolean
'
'    Dim rvaDebug As Long
'    Dim rawDebug As Long
'    Dim f As Long
'    Dim dd As debugDir
'    Dim bb() As Byte
'    Dim tmp As String
'    Dim a As Long, b As Long
'
'    On Error GoTo hell
'    outRet = Empty
'    If Not pe.isLoaded Then Exit Function
'
'    rvaDebug = pe.OptionalHeader.ddVirtualAddress(Debug_Data)
'    If rvaDebug = 0 Then Exit Function
'
'    rawDebug = pe.RvaToOffset(rvaDebug)
'    If rawDebug = 0 Then Exit Function
'
'    f = FreeFile
'    Open pe.LoadedFile For Binary As f
'    Get f, rawDebug + 1, dd
'
'    ReDim bb(dd.sizeofData)
'    Get f, dd.ptrRawData + 1, bb()
'    Close f
'    f = 0
'
'    tmp = StrConv(bb, vbUnicode, LANG_US)
'    a = InStr(1, tmp, ".pdb", vbTextCompare)
'    If a < 1 Then Exit Function
'    a = a + 4
'
'    b = InStrRev(tmp, ":\", a)
'    If b < 1 Then Exit Function
'    b = b - 1
'
'    outRet = Mid(tmp, b, a - b)
'    pdbPath = True
'
'    Exit Function
'hell:
'    On Error Resume Next
'    If f <> 0 Then Close f
'
'End Function
