Attribute VB_Name = "mdlApis"
Option Explicit

'---- May 2004
'----   Added in Recycle option (instead of deletion/kill)
'---- I am unsure as to fully working state as NoConfirmation does a Kill, and all others ask for user to confirm...

'---- June 2002
'----   Get unc code added... for some reason missing ?

'---- April 2001
'----   Moved this into a shared area part, which means that it is updated for each app. This does mean
'---- that some of the apps requiring set api calls may need to have them unremarked out again and visa versa for the calls not used
'---- this is so only one api list is in existance, instead of a lot - has its plus's and minus's

'---- 19 Mar 2001
'----   This coding was taken from the database I was attempting to do in vb6 and access 2000
'---- for a friend of my GF. They were looking at a fairly complex database, with bits interacting,
'---- and as I developed it slowly (never to be used though - too much trouble if it goes wrong to update)
'---- I was online experimenting with some API calls, to make it more 'nifty' ;)
'----
'---- Either that or it was whilst I was in Transco and was experimenting for two reasons
'----   1) I was bored - no work load - or I had completed everything
'----   2) I had an application in the making which required further usage of windoze.
'----
'---- useful sites : 'www.vb-world.com' and a link from there 'www.vbapi.com'

'---- Constants ----
'---- Registry Constants
'Public Const regHkey_Classes_Root = &H80000000
'Public Const regHkey_Current_User = &H80000001
'Public Const regHkey_Local_Machine = &H80000002
'Public Const regHkey_Users = &H80000003
'Public Const regHkey_Current_Config = &H80000005
'Public Const regHkey_DYN_DATA = &H80000006
'Public Const regREG_NONE = 0
'Public Const regREG_SZ = 1 'Unicode nul terminated string
'Public Const regREG_BINARY = 3 'Free form binary
'Public Const regREG_DWORD = 4 '32-bit number
'Public Const regError_Success = 0&

'Public Const regREG_EXPAND_SZ = 2 'memo ?
'Public Const regREG_DWORD_LITTLE_ENDIAN = 4
'Public Const regREG_DWORD_BIG_ENDIAN = 5 'Double ?
'Public Const regREG_LINK = 6
'Public Const regREG_MULTI_SZ = 7
'Public Const regREG_RESOURCE_LIST = 8

'---- sam desired levels (Reg)
'Public Const regKey_All_Access = &HF003F

'Public Const regKey_Create_Link = &H20
'Public Const regKey_Create_Sub_Key = &H4
'Public Const regKey_Enumerate_Sub_Keys = &H8
'Public Const regKey_Execute = &H20019
'Public Const regKey_Notify = &H10
'Public Const regKey_Query_Value = &H1
'Public Const regKey_Read = &H20019
'Public Const regKey_Set_Value = &H2
'Public Const regKey_Write = &H20006

'---- Keyboard constants
'----   Virtual Key Code (search on this for full listing on MS site)
Public Const vk_Left = &H25
Public Const vk_Up = &H26
Public Const vk_Right = &H27
Public Const vk_Down = &H28
Public Const vk_LShift = &HA0
Public Const vk_RShift = &HA1
Public Const vk_LControl = &HA2
Public Const vk_RControl = &HA3
Public Const vk_LMenu = &HA4
Public Const vk_RMenu = &HA5
Public Const vk_LButton = &H1
Public Const vk_RButton = &H2
'Public Const vk_MButton = 0

'---- File constants
Public Const mMax_Path = 512
'Private Const Error_Success = 0&
'Private Const FO_Copy = &H2
Private Const FO_Delete = &H3
'Private Const FO_Move = &H1
'Private Const FO_Rename = &H4
Private Const FOF_AllowUndo = &H40
Private Const FOF_ConfirmMouse = &H2
Private Const FOF_FilesOnly = &H80
Private Const FOF_MultiDestFiles = &H1
Private Const FOF_NoConfirmation = &H10
Private Const FOF_NoConfirmMKDir = &H200
Private Const FOF_RenameOnCollision = &H8
Private Const FOF_Silent = &H4
Private Const FOF_SimpleProgress = &H100
Private Const FOF_WantMappingHandle = &H20

'---- Possible return codes from the API - get unc
'Public Const Error_BAD_DEVICE As Long = 1200
'Public Const Error_CONNECTION_UNAVAIL As Long = 1201
'Public Const Error_EXTENDED_ERROR As Long = 1208
'Public Const Error_MORE_DATA As Long = 234
'Public Const Error_NOT_SUPPORTED As Long = 50
'Public Const Error_No_NET_OR_BAD_PATH As Long = 1203
'Public Const Error_No_NETWORK As Long = 1222
'Public Const Error_Not_CONNECTED As Long = 2250
'Public Const No_Error As Long = 0


'---------------
'---- Types ----
Public Type mSecurityAttributes
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Type mFileTime
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Type mWin32_Find_Data
    dwFileAttributes As Long
    ftCreationTime As mFileTime
    ftLastAccessTime As mFileTime
    ftLastWriteTime As mFileTime
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * mMax_Path
    cAlternate As String * 14
End Type

Public Type mOpenFilename
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Public Type mChooseColor
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    Flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Type mRect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Type mPointAPI
        x As Long
        y As Long
End Type

Private Type mSHFileOpStruct
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As String ' only used if FOF_SIMPLEPROGRESS
End Type


'---- API Functions ----
'----
'---- With these I have replaced the calls ;) so its easier to see if its an api or a built in call or one of mine ;)
'---- Not all of them are active - maily because I read somewhere that they take up a lot of memory - so only use the
'---- ones you require :) or feel good ;)
'----
'----

'---- mouse
Public Declare Function apiGetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As mPointAPI) As Long
Public Declare Function apiSetCursorPos Lib "user32.dll" Alias "SetCursorPos" (ByVal x As Long, ByVal y As Long) As Long

'---- shell link
Public Declare Function apiCreateShellLink Lib "STKIT432.DLL" Alias "fCreateShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long

'---- graphics
'Public Declare Function apiBitBlit Lib "gdi32" Alias "BitBlt" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
'Public Declare Function apiSetPixelV Lib "gdi32" Alias "SetPixelV" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

'---- common dialog stuff :)
Public Declare Function apiGetOpenFilename Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pmOpenFilename As mOpenFilename) As Long
Public Declare Function apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pmOpenFilename As mOpenFilename) As Long
Public Declare Function apiGetChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pmChooseColor As mChooseColor) As Long

'---- file commands
Public Declare Function apiFileGetLogicalDriveStrings Lib "kernel32.dll" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function apiFileFindFirst Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As mWin32_Find_Data) As Long
Public Declare Function apiFileFindNext Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As mWin32_Find_Data) As Long
'Public Declare Function apiCopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
'Public Declare Function apiDeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Declare Function apiWNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long

Private Declare Function apiSHFileOperation Lib "shell32.dll" Alias "SHFileOperation" (ByRef lpFileOp As mSHFileOpStruct) As Long


'---- Registry stuff
'Public Declare Function apiRegCloseKey Lib "advapi32.dll" Alias "RegCloseKey" (ByVal hKey As Long) As Long
'Public Declare Function apiRegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
'Public Declare Function apiRegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

'Public Declare Function apiRegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
'Public Declare Function apiRegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

'Public Declare Function apiRegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As mSecurityAttributes, phkResult As Long, lpdwDisposition As Long) As Long
'Public Declare Function apiRegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
'Public Declare Function apiRegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
'Public Declare Function apiRegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
'Public Declare Function apiRegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As mFileTime) As Long

'Public Declare Function apiRegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long

'------------------
'---- windows stuff
'------------------
'Public Declare Function apiWindowFind Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Public Declare Function apiWindowMove Lib "user32.dll" Alias "MoveWindow" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Declare Function apiWindowSetPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'Public Declare Function apiWindowGetRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As Long, lpmRect As mRect) As Long
'Public Declare Function apiWindowGetText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
'Public Declare Function apiWindowGetDesktop Lib "user32" Alias "GetDesktopWindow" () As Long
'Public Declare Function apiWindowGetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'Public Declare Function apiWindowGetThreadProcessId Lib "user32" Alias "GetWindowThreadProcessId" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function apiWindowShow Lib "user32.dll" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function apiGetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'---- these enumerate windoze - beware! they call themselves on all child/sub and take ages
'Public Declare Function apiEnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
'Public Declare Function apiEnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
'Public Declare Function apiEnumThreadWindows Lib "user32" (ByVal dwThreadId As Long, ByVal lpfn As Long, ByVal lParam As Long) As Long


'---- Requires shell32 - v4.71 (only v4 on this machine)
'Public Declare Function apiFindEnvironmentString Lib "shell32.dll" Alias "FindEnvironmentStringA" (ByVal szEnvVar As String) As String


'---- this exits windoze --- kills it properly -- apparently ;)
'Public Declare Function apiExitWindowsEx Lib "user32.dll" alias "ExitWindowsEx"  (ByVal uFlags As Long, ByVal dwReserved As Long) As Long


'---- Keyboard status stuff ---- 2B Experimented on for gaming situations... - Need the virtual key code next time I'm online
Public Declare Function apiKeyStateAsync Lib "user32.dll" Alias "GetAsyncKeyState" (ByVal vKey As Long) As Integer
Public Declare Function apiKeyboardState Lib "user32.dll" Alias "GetKeyboardState" (lpKeyState As Byte) As Long
Public Declare Function apiKeyState Lib "user32.dll" Alias "GetKeyState" (ByVal nVirtKey As Long) As Integer


'---- Flash - flashes a window - well the title bar...
'---- sleep - delays the program running for x milliseconds - and windoze
Public Declare Function apiWindowFlash Lib "user32.dll" Alias "FlashWindow" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
Public Declare Sub apiAppSleep Lib "kernel32.dll" Alias "Sleep" (ByVal dwMilliseconds As Long)

'---- Timer function
Public Declare Function apiGetTickCount Lib "kernel32" Alias "GetTickCount" () As Long




'---- my design based on MS Help - Selects a colour using the common dialog box
Public Function ColourSelection(Optional lngFlags, Optional lngInitColour) As Long
'---- Uses the common dialog box / colour selection
'---- usual flags are : 1 - starting colour specified, 2 - full open
'----   so use 3 as the flag every time

'---- Returns :
'----   -1 : Failed/cancelled
'----   >=0 : colour in long

    Dim cChoose As mChooseColor
    Dim lngRes As Long
    Dim intI As Integer
    Dim bytCols As Byte

    On Error Resume Next

    ColourSelection = -1

    With cChoose

'---- default info
        .lStructSize = Len(cChoose)
        .hwndOwner = 0
        .hInstance = 0
        .lpCustColors = StrConv(bytCols, vbUnicode)

'---- optional bits
        .Flags = 0
        .rgbResult = 0

        If Not IsMissing(lngFlags) Then .Flags = lngFlags
        If Not IsMissing(lngInitColour) Then .rgbResult = lngInitColour

        lngRes = apiGetChooseColor(cChoose)
        If lngRes > 0 Then ColourSelection = .rgbResult
    End With

    If Not Err.Number = 0 Then ColourSelection = -1
End Function

'---- Selects a/several file(s) using common dialogs
Public Function FileSelection(ByVal strInitDir As String, ByVal lngFlag As Long, ByVal strFilter As String, ByVal lngFilterIndex As Long, ByVal blnOpen As Boolean, Optional strTitle, Optional strFileExtension, Optional lngOwnerHwnd) As String
'---- Selects one or more filenames
'---- Requires
'----   inital directory to open in
'----   flags for opening


'---- usual flags are :
'----   &H200000 - use long filenames
'----   &H80000 - Explorer type window
'----   &H200 - multi select
'----   &H4 - hide read only option on box - v useful
'----   &H8 - force same dir as when opened
'----   &H1000 - file must exist - useful for opening
'---- usual I use : &H280004

'---- Returns a string holding either :
'----   nothing
'----   path and filename
'----   path chr$(0) filenames separated by chr$(0)
'---- NOTE : current max chars = 257 ... I think expand if neccessary

    Dim strTemp As String
    Dim lngReturn As Long, lngP As Long, lngO As Long
    Dim cOpenFilename As mOpenFilename

    On Error Resume Next

    With cOpenFilename

'---- Default values according to another developer
        .lStructSize = Len(cOpenFilename)
        .hInstance = 0
        .nFilterIndex = 1
        .nFileOffset = 0
        .lpstrFile = String(5000, 0)
        .nMaxFile = Len(.lpstrFile) - 1
        .lpstrFileTitle = .lpstrFile
        .nMaxFileTitle = .nMaxFile

        If Not IsMissing(strFileExtension) Then .lpstrDefExt = strFileExtension


'---- Bits like the common dialog control
        If blnOpen Then
            .lpstrTitle = "Open a file..."
        Else
            .lpstrTitle = "Save file as..."
        End If
        If Not IsMissing(strTitle) Then .lpstrTitle = strTitle

'---- messing
'----   default filter

'---- each filter is separated by a character of 0 - Name - filter - name filter (etc..)
'---- example :
'        .lpstrFilter = "All Files" & Chr$(0) & "*.*" & Chr$(0) & "Text Files" & Chr$(0) & "*.txt;*.csv"
'---- replace filter with the selection chosen by the programmer...
        .lpstrFilter = "All Files (*.*)" & Chr$(0) & "*.*"

        lngO = 1
        lngP = InStr(1, strFilter, "|")
        If lngP > 0 Then
            strTemp = ""
            Do Until lngP = 0
                strTemp = strTemp & IIf(Len(strTemp) > 0, Chr$(0), "") & Mid$(strFilter, lngO, lngP - lngO)
                lngO = lngP + 1
                lngP = InStr(lngP + 1, strFilter, "|")
            Loop
            strTemp = strTemp & Chr$(0) & Right$(strFilter, Len(strFilter) - lngO + 1)
        Else
            strTemp = strFilter
        End If
        .lpstrFilter = strTemp

        .Flags = lngFlag

        .hwndOwner = 0
        If Not IsMissing(lngOwnerHwnd) Then .hwndOwner = lngOwnerHwnd
'---- remark out the next line - or amend it as applicable
        If .hwndOwner = 0 Then .hwndOwner = Application.hWndAccessApp

        .lpstrInitialDir = strInitDir

    End With

'---- is the dialog box an open or save?
    If blnOpen Then
        lngReturn = apiGetOpenFilename(cOpenFilename)
    Else
        lngReturn = apiGetSaveFileName(cOpenFilename)
    End If

'---- send back the selected file(s)
    If lngReturn = 0 Then
        FileSelection = ""
    Else
        FileSelection = RemoveNonPChars(cOpenFilename.lpstrFile)
    End If

End Function

Public Function RemoveNonPChars(ByVal strText As String) As String
'---- gets rid of the extra chr$(0)'s in the text
'---- by looking for two chr$(0)'s together (only happens at the end...)
'---- NOTE : only removes those at the end of the string - for multi means that you can get the filenames...
    Dim lngP As Long

    On Error Resume Next

    RemoveNonPChars = " "
    If Len(strText) = 0 Then Exit Function
    lngP = InStr(1, strText, Chr$(0) & Chr$(0))
    If lngP > 1 Then RemoveNonPChars = Left$(strText, lngP - 1)
    If Not Err.Number = 0 Then
        RemoveNonPChars = " "
        Err.Clear
    End If
End Function

Public Sub FlashAWindow(ByVal lngHWnd As Long, ByVal lngTimeOn As Long, ByVal lngTimeOff As Long, ByVal lngRepeatFor As Long)
'---- surprisingly flashes a window ;)
    Dim lngCount As Long, lngRes As Long

    On Error Resume Next

    For lngCount = 0 To lngRepeatFor
        lngRes = apiWindowFlash(lngHWnd, 1)
        apiAppSleep lngTimeOn
        lngRes = apiWindowFlash(lngHWnd, 1)
        apiAppSleep lngTimeOff
    Next
    lngRes = apiWindowFlash(lngHWnd, 0)
End Sub

Public Function AllDrives() As String
'---- pulls and returns either a string of all drives or a 0 length string
'---- Example : A:\(null)C:\(null)D:\(null)

    Dim strDrives As String * 255
    Dim lngRes As Long

    On Error Resume Next

    AllDrives = ""
    lngRes = apiFileGetLogicalDriveStrings(255, strDrives)
    If lngRes > 0 Then AllDrives = RemoveNonPChars(strDrives)

End Function

Public Function LikeDir(ByVal blnReturnAllAsString As Boolean, ByVal strpath As String, ByVal lngAttributes As Long, ByRef lngSearch As Long, Optional blnFileSizeToo, Optional blnAttributes, Optional blnShortFile) As String
'---- returns either one or all filenames for a dir - chr$(0) separated
'---- replaces Dir$ using the apis to do the same job
'----
'---- * if blnReturnallasstring is set, all matching filenames are returned - separated by chr$(0), otherwise only one is returned
'---- * strpath is the search path - NOTE - ensure *.* is added before calling here - or amend below to check this is present
'---- * lngAttributes - these are the attributes bit of the files -it filters them out for you :)
'---- * lngSearch is sent back to the calling procedure, so therefore could be stored for multiple search bits - "-1" for new search
'---- The following optional fields return info in the return string separated by chr$(0)
'----   (so you don't need two api calls)
'---- * added an optional file size too
'---- * added an optional attributes
'---- * added an optional shortfilename
'---- The above optional fields make the return string longer - developers choice
'----
'----   Returns : LongFilename [optional fields from above in that order separated by chr$(0) ]
'----
'----   Note: Please use -1 on its own for a single search, or a VARIABLE long for mutliple (although best practice use a long variable always)

    Dim Win32FileData As mWin32_Find_Data
    Dim lngRes As Long, lngMore As Long
    Dim strResultFilename As String, strTempFN As String
    Dim blnLeave As Boolean

    On Error Resume Next

'---- validation check - this doesn't seem to work if you specify just the drive...
'---- so this stops it by assuming the drive exists...
    If Len(strpath) < 4 Then
        LikeDir = strpath
        Exit Function
    End If

'---- initialize
    strResultFilename = ""
    blnLeave = False

'---- now we loop through all this until either we have them all - or if its only one we have that one or an error
    Do Until blnLeave
        With Win32FileData
            .dwFileAttributes = 63
            .cAlternate = String(270, Chr$(0))
            .cFileName = String(270, Chr$(0))
            .nFileSizeHigh = 0
            .nFileSizeLow = 0
        End With

'---- recursive bit to keep adding on the files using the long value specified
        If lngSearch = -1 Then
            lngSearch = apiFileFindFirst(strpath, Win32FileData)
            blnLeave = (lngSearch = -1)
            lngMore = 1
        Else
            lngMore = apiFileFindNext(lngSearch, Win32FileData)
        End If

'---- if we haven't finished
'---- we do some checks and store the information into the return string
'---- such as filename and attributes selected
        If Not blnLeave Then
            strTempFN = Trim$(RemoveNonPChars(Win32FileData.cFileName))

            If Not (strTempFN = "." Or strTempFN = "..") And (Len(strTempFN) > 0) Then
                If lngAttributes > 0 Then
                    If (lngAttributes And Win32FileData.dwFileAttributes) > 0 Then
                        strResultFilename = strResultFilename & IIf(Len(strResultFilename) > 0, Chr$(0), "") & strTempFN
                        If Not IsMissing(blnFileSizeToo) Then strResultFilename = strResultFilename & IIf(Len(strResultFilename) > 0, Chr$(0), "") & CStr((Win32FileData.nFileSizeHigh * (2 ^ 32)) + Win32FileData.nFileSizeLow)
                        If Not IsMissing(blnAttributes) Then strResultFilename = strResultFilename & IIf(Len(strResultFilename) > 0, Chr$(0), "") & CStr(Win32FileData.dwFileAttributes)
                        If Not IsMissing(blnShortFile) Then strResultFilename = strResultFilename & IIf(Len(strResultFilename) > 0, Chr$(0), "") & Win32FileData.cAlternate
                        If Not blnReturnAllAsString Then blnLeave = True
                    End If
                Else
                    strResultFilename = strResultFilename & IIf(Len(strResultFilename) > 0, Chr$(0), "") & strTempFN
                    If Not IsMissing(blnFileSizeToo) Then strResultFilename = strResultFilename & IIf(Len(strResultFilename) > 0, Chr$(0), "") & CStr((Win32FileData.nFileSizeHigh * (2 ^ 32)) + Win32FileData.nFileSizeLow)
                    If Not IsMissing(blnAttributes) Then strResultFilename = strResultFilename & IIf(Len(strResultFilename) > 0, Chr$(0), "") & CStr(Win32FileData.dwFileAttributes)
                    If Not IsMissing(blnShortFile) Then strResultFilename = strResultFilename & IIf(Len(strResultFilename) > 0, Chr$(0), "") & RemoveNonPChars(Win32FileData.cAlternate)
                    If Not blnReturnAllAsString Then blnLeave = True
                End If
            End If

'---- if the more is not 1
'---- or there was an error - we Leave
            If Not lngMore = 1 Then blnLeave = True
            If Not Err.Number = 0 Then blnLeave = True
        End If
    Loop

'---- clears the error and also what was pulled
    If Not Err.Number = 0 Then
        Err.Clear
        strResultFilename = ""
    End If

'---- send it all back to the calling sub/function
    LikeDir = strResultFilename
End Function

Public Function GetTheWindozePath()
'---- retrieves the path to windoze incase you need it
'---- original was from a web page, modified a lil for this code

    Dim strFolder As String
    Dim lngResult As Long

    On Error Resume Next

'---- set default value
    GetTheWindozePath = ""

'---- set api buffer and call it
    strFolder = String(512, 0)
    lngResult = apiGetWindowsDirectory(strFolder, 512)

'---- if the result is NOT 0 then its returned the path
    If Not lngResult = 0 Then GetTheWindozePath = Left(strFolder, InStr(strFolder, Chr$(0) & Chr$(0)) - 1)

    If Not Err.Number = 0 Then Err.Clear

End Function

Function GetUNCPath(ByVal strDriveLetter As String) As String
'---- Requires
'----   Drive letter and colon ONLY
'----   Example : Debug.Print GetUNCPath("c:")

'---- grabbed from vbworld
'---- modified as I didn't like all his code

    Dim strMsg As String
    Dim lngReturn As Long
    Dim strLocalName As String
    Dim strRemoteName As String
    Dim lngRemoteName As Long

    On Error Resume Next
    
    GetUNCPath = strDriveLetter & "\"
    
    strLocalName = strDriveLetter
    strRemoteName = String$(255, " ")
    lngRemoteName = Len(strRemoteName)

'---- Attempt to grab UNC
    lngReturn = apiWNetGetConnection(strLocalName, strRemoteName, lngRemoteName)
    
'---- If no errors AND lngreturn was 0 (so no error there either) then you have the unc path
    If Err.Number = 0 Then
        If lngReturn = 0 Then
            strRemoteName = Trim$(strRemoteName)
            GetUNCPath = Left$(strRemoteName, Len(strRemoteName) - 1)
        End If
    End If
End Function

Public Function DeleteFileToRecycleBin(ByVal strFilename As String, ByVal lngHWnd As Long, ByVal blnShowMsg As Boolean) As Boolean
'---- deletes the specified file to the recycle bin (if allowed) (see size restrictions)
'---- From http://kandkconsulting.tripod.com/VB/Code/tips/recyclebin.htm
    Dim CFileStruct As mSHFileOpStruct

    On Error Resume Next

    DeleteFileToRecycleBin = False
    
    If nnz(Len(Dir$(strFilename, 63)), 0) = 0 Then Exit Function
    
    With CFileStruct
        .hwnd = lngHWnd
        .fFlags = FOF_AllowUndo Or FOF_NoConfirmation Or FOF_Silent
        .pFrom = strFilename
        .wFunc = FO_Delete
    End With

    If apiSHFileOperation(CFileStruct) <> 0 Then
       If blnShowMsg Then MsgBox "Failed to Recycle file", vbOKOnly + vbInformation, "Error"
    Else
        DeleteFileToRecycleBin = True
    End If

End Function

