Showing posts with label API. Show all posts
Showing posts with label API. Show all posts

Monday, June 16, 2008

VBA APIs

This is as much for my benefit while traveling as it hopefully will be for yours, but the following is a list of my most-used APIs. I know there are plenty of sites out there that offer the same information, but many times they are not formatted to my liking or they offer it in another language which I have to convert to VBA. This should at least make it a little easier when looking for a specific API.

This is also going to be post 1 of 3 of this sort of information; I will also (likely very shortly) be posting some of my commonly used CONST values as well as Enum setups.

Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal _
lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long

Public Declare Function CloseClipboard Lib "user32.dll" () As Long

Public Declare Function EmptyClipboard Lib "user32.dll" () As Long

Public Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal _
hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

Public Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long

Public Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal _
lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal _
hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal _
lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function FtpCreateDirectory Lib "wininet.dll" Alias _
"FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String _
) As Boolean

Public Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal _
hFtpSession As Long, ByVal lpszFileName As String) As Boolean

Public Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
(ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As _
WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long

Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias _
"FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory _
As String, lpdwCurrentDirectory As Long) As Long

Public Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal _
hConnect As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, _
ByVal fFailIfExists As Long, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags _
As Long, ByRef dwContext As Long) As Boolean

Public Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal _
hConnect As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As _
String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean

Public Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias _
"FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) _
As Boolean

Public Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal _
hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean

Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias _
"FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As _
String) As Boolean

Public Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long

Public Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long

Public Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hDC As Long, ByVal _
nIndex As Long) As Long

Public Declare Function GetFileAttributes Lib "kernel32.dll" Alias _
"GetFileAttributesA" (ByVal lpFileName As String) As Long

Public Declare Function GetOpenFileNameB Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Declare Function GetQueueStatus Lib "user32.dll" (ByVal fuFlags As Long) As Long

Public Declare Function GetSaveFileNameB Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long

Public Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags&, ByVal _
dwBytes As Long) As Long

Public Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long

Public Declare Function GlobalSize Lib "kernel32.dll" (ByVal hMem As Long) As Long

Public Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long

Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet _
As Long) As Long

Public Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
(ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort _
As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService _
As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias _
"InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long

Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias _
"InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean

Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal _
sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal _
sProxyBypass As String, ByVal lFlags As Long) As Long

Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
(ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength _
As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal _
sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Long

Public Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent _
As Long) As Long

Public Declare Function lstrcpy Lib "kernel32.dll" (ByVal lpString1 As Any, ByVal _
lpString2 As Any) As Long

Public Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString _
As String) As Long

Public Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal _
lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition _
As Long) As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(ByVal hKey As Long, ByVal lpValueName As String) As Long

Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal _
hKey As Long, ByVal lpValueName As String, phkResult As Long) As Long

Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal _
hKey As Long, ByVal lpValueName As String, ByVal ulOptions As Long, ByVal _
samDesired As Long, phkResult As Long) As Long

Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, lpReserved As Long, lpType As _
Long, ByVal lpData As String, lpcbData As Long) As Long

Public Declare Function RegSetValueEx 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 ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hDC _
As Long) As Long

Public Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, _
ByVal hMem As Long) As Long

Public Declare Function SetDefaultPrinter Lib "winspool.drv" Alias "SetDefaultPrinterA" _
(ByVal pszPrinter As String) As Long

Public Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long

Public Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent _
As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal _
hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function SetWindowPos Lib "user32.dll" (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 SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long

Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public 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

Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Public Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal _
nCmdShow As Long) As Long

Public Declare Function URLDownloadToFile Lib "urlmon.dll" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, ByVal szFilename As String, ByVal _
dwReserved As Long, ByVal lpfnCB As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef lpDest _
As Any, ByRef lpSource As Any, ByVal iLen As Long)

Public Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As _
Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Public Declare Function adh_apiGetTime Lib "winmm.dll" Alias "timeGetTime" () As Long

Public Declare Function IsCharAlphaNumeric Lib "User32" Alias "IsCharAlphaNumericA" _
(ByVal cChar As Byte) As Long

Friday, May 16, 2008

Looping through a directory, speed test

That last post got me thinking I should share my routine for checking the speeds of the various ways to loop through a folder (vb's Dir, FileSystemObject, findfile APIs, excel's application.filesearch). It also would be a good way to put those methods out here for people to use, if you so choose.
I want to warn that you should probably delete your temporary internet files and possibly even your temporary files if you plan on doing this to your root C drive.

First, the results.
On my root C drive
FSO took 109.047000000002 seconds, 32297 files found
DIR took 73.8910000000013 seconds, 32297 files found
FileSearch took 234.421999999998 seconds, 31727 files found
APIs took 87.999999999998 seconds, 32296 files found


On a network drive
FSO took 3.60899999999802 seconds, 133 files found
DIR took 1.59400000000128 seconds, 133 files found
FileSearch took 0.999999999996682 seconds, 133 files found
APIs took 2.12499999999668 seconds, 133 files found


Taking a bit of a step back, here is the same test on a much bigger network drive
FSO took 801.625000000002 seconds, 8006 files found
DIR took 200.782000000003 seconds, 8006 files found
FileSearch took 77.5940000000007 seconds, 8006 files found
APIs took 282.483999999998 seconds, 8006 files found


These are pretty consistent with my original findings of it, kinda interesting that filesearch would be so slow on a local drive but much faster on network shares. Either way, it reaffirms my belief that Dir is the better overall method (filesearch was discontinued, obviously only works in VBA). The slight disparity of file counts (on my local drive) does concern me, though I can only assume (without delving further into it) that a file's attribute (system, hidden, etc) has something to do with it.

Take a look at the code I use to test this, if you see any kind of flaw in my logic I'd love to hear about improving it. Give it a shot on your own computer and see how it works out for you, and post back your results if you'd like!

Option Explicit
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" ( _
ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const MAX_PATH = 260
Private Const MAXDWORD = &HFFFF
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private FSO As Object

Sub SpeedTestCheckCDrive()
Dim DirArray() As String, FSOArray() As String
Dim FSArray() As String, APIArray() As String
Dim i As Long, SearchPath As String
Dim Timer1 As Double, Timer2 As Double, Timer3 As Double, Timer4 As Double

SearchPath = "C:\"
ReDim FSOArray(0)
ReDim DirArray(1, 0)
ReDim FSArray(0)
ReDim APIArray(0)

Timer1 = Timer
Set FSO = CreateObject("scripting.filesystemobject")
ReturnAllFilesUsingFSO SearchPath, FSOArray
Set FSO = Nothing
Timer1 = Timer - Timer1
DoEvents
Timer2 = Timer
ReturnAllFilesUsingDir SearchPath, DirArray
Timer2 = Timer - Timer2
DoEvents
Timer3 = Timer
ReturnAllFilesUsingFileSearch SearchPath, FSArray
Timer3 = Timer - Timer3
DoEvents
Timer4 = Timer
ReturnAllFilesUsingAPI SearchPath, APIArray
Timer4 = Timer - Timer4

Debug.Print Join(Array( _
"FSO took " & Timer1 & " seconds, " & UBound(FSOArray) + 1 & " files found", _
"DIR took " & Timer2 & " seconds, " & UBound(DirArray, 2) + 1 & " files found", _
"FileSearch took " & Timer3 & " seconds, " & UBound(FSArray) + 1 & " files found", _
"APIs took " & Timer4 & " seconds, " & UBound(APIArray) + 1 & " files found"), vbCrLf)
End Sub

Function ReturnAllFilesUsingDir(ByVal vPath As String, ByRef vsArray() _
As String, Optional IncludeSubfolders As Boolean = True) As Boolean
'You must send this a string array, ReDim'med to (1,0)
' (0,x) = path of file
' (1,x) = file name
Dim TempStr As String, vDirs() As String, Cnt As Long, dirCnt As Long
dirCnt = 0
If Len(vsArray(0, 0)) = 0 Then
Cnt = 0
Else
Cnt = UBound(vsArray, 2) + 1
End If
If Right(vPath, 1) <> "\" Then vPath = vPath & "\"

If IncludeSubfolders Then
On Error GoTo BadDir
TempStr = Dir(vPath, 31)
Do Until Len(TempStr) = 0
If Asc(TempStr) <> 46 Then
If GetAttr(vPath & TempStr) And vbDirectory Then
ReDim Preserve vDirs(dirCnt)
vDirs(dirCnt) = TempStr
dirCnt = dirCnt + 1
DoEvents
End If
BadDirGo:
End If
TempStr = Dir
SkipDir:
Loop
End If

On Error GoTo BadFile
TempStr = Dir(vPath, 15)
Do Until Len(TempStr) = 0
ReDim Preserve vsArray(1, Cnt)
vsArray(0, Cnt) = vPath
vsArray(1, Cnt) = TempStr
Cnt = Cnt + 1
TempStr = Dir
DoEvents
Loop
BadFileGo:
On Error GoTo 0
If dirCnt > 0 Then
For dirCnt = 0 To UBound(vDirs)
If Len(Dir(vPath & vDirs(dirCnt))) = 0 Then
GetFilesWithDir vPath & vDirs(dirCnt), vsArray
End If
Next
End If
Exit Function
BadDir:
If TempStr = "pagefile.sys" Or TempStr = "???" Then
Debug.Print "DIR: Skipping: " & vPath & TempStr
Resume BadDirGo
ElseIf Err.Number = 52 Then
Debug.Print "No read dir rights: " & vPath & TempStr
Resume SkipDir
End If
Debug.Print "Error with DIR Dir: " & Err.Number & " - " & Err.Description
Exit Function
BadFile:
If Err.Number = 52 Then
Debug.Print "No read file rights: " & vPath & TempStr
Else
Debug.Print "Error with DIR File: " & Err.Number & " - " & Err.Description
End If
Resume BadFileGo
End Function

Function ReturnAllFilesUsingFSO(ByVal vPath As String, _
ByRef vsArray() As String) As Boolean
Dim f As Object, fld As Object, Cnt As Long
Set fld = FSO.GetFolder(vPath)
If Len(vsArray(0)) = 0 Then
Cnt = 0
Else
Cnt = UBound(vsArray) + 1
End If
On Error GoTo UhOhs
For Each f In fld.Files
ReDim Preserve vsArray(Cnt)
vsArray(Cnt) = f.Path
Cnt = Cnt + 1
DoEvents
Next
For Each f In fld.SubFolders
ReturnAllFilesUsingFSO f.Path, vsArray
Next
LaterGater:
Set f = Nothing
Set fld = Nothing
Exit Function
UhOhs:
If Err.Number = 70 Then
Debug.Print "FSO Permission denied: " & vPath
Else
Debug.Print "Error with FSO: " & Err.Number & " - " & Err.Description
End If
Resume LaterGater
End Function

Function ReturnAllFilesUsingFileSearch(ByVal vPath As String, ByRef vsArray() _
As String) As Long
Dim i As Long, Cnt As Long
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = vPath
.FileType = msoFileTypeAllFiles
If .Execute > 0 Then
Cnt = 0
On Error GoTo PermissionDenied
ReDim Preserve vsArray(.FoundFiles.Count - 1)
For i = 1 To .FoundFiles.Count
vsArray(Cnt) = .FoundFiles(i)
Cnt = Cnt + 1
SkipIt:
DoEvents
Next
End If
End With
Exit Function
PermissionDenied:
ReDim Preserve vsArray(UBound(vsArray) - 1)
Resume SkipIt
End Function

Function ReturnAllFilesUsingAPI(vPath As String, ByRef vsArray() As String) As Boolean
Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Long
Dim i As Long
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Long
Dim Cnt As Long
If Len(vsArray(0)) = 0 Then
Cnt = 0
Else
Cnt = UBound(vsArray) + 1
End If
If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(vPath & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(vPath & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
ReDim Preserve dirNames(nDir)
dirNames(nDir) = DirName
nDir = nDir + 1
DoEvents
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(vPath & "*", WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") And ((GetFileAttributes(vPath _
& FileName) And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
ReDim Preserve vsArray(Cnt)
vsArray(Cnt) = vPath & FileName
Cnt = Cnt + 1
End If
Cont = FindNextFile(hSearch, WFD)
Wend
Cont = FindClose(hSearch)
End If
If nDir > 0 Then
For i = 0 To nDir - 1
ReturnAllFilesUsingAPI vPath & dirNames(i) & "\", vsArray
Next i
End If
End Function

Private Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function