Dim FILE_NAME As String = "C:\test.txt"
How could I make the C:\test.txt's "test" become the text in textbox1's text?
E.g. textbox1's text = "kenneth" then the C:\test.txt becomes C:\kenneth.txt
Denxerator
0
Newbie Poster
Recommended Answers
Jump to PostYou will have to use the file functions, there are plenty on google etc - "create a file in vb6" etc.
Then find out if a current file exist,if yes, copy its content into another file, delete the old file "test.txt" and save the new file with the new …
All 3 Replies
AndreRet
526
Senior Poster
You will have to use the file functions, there are plenty on google etc - "create a file in vb6" etc.
Then find out if a current file exist,if yes, copy its content into another file, delete the old file "test.txt" and save the new file with the new name "kenneth.txt"
That is about it in a nut shell. Once you know how to create a new file and how to read a certain files text, it should go fine from there.
This seems like a lot, but it seems like quite an effort to change the name on a file. I would presume that you will need administrator priveleges to perform the above tasks.
Good luck
Some quick samples -
'Delete a file
Kill ("C:\Folder\test.txt")
'This to find a file on a drive
Option Explicit
Private Const MAX_PATH As Long = 260
Private Declare Function SearchTreeForFile Lib "imagehlp" _
(ByVal sRootPath As String, _
ByVal InputPathName As String, _
ByVal OutputPathBuffer As String) As Boolean
Private Sub Command1_Click()
Dim sFile2Find As String
Dim sRootPath2Search As String
sFile2Find = "msvbvm50.dll"
sDrive2Scan = "c:\"
Label1.Caption = "Working ..."
Label1.Caption = LCase$(GetFileLocation(sDrive2Scan, sFile2Find))
End Sub
Private Function GetFileLocation(sDrive2Scan As String, sFile2Find As String) As String
'API returns True if found, or False otherwise.
'If True, sResult holds the full path
Dim sResult As String
sResult = Space(MAX_PATH)
If SearchTreeForFile(sDrive2Scan, sFile2Find, sResult) Then
GetFileLocation = Left(sResult, InStr(sResult, vbNullChar) - 1)
Else
GetFileLocation = "File was not found. Error: " & Err.LastDllError
End If
End Function
'This will check if another application has the file open before you can delete it
Option Explicit
Private Const GENERIC_READ As Long = &H80000000
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const MAX_PATH As Long = 260
'Enum containing values representing
'the status of the file
Private Enum IsFileResults
FILE_IN_USE = -1 'True
FILE_FREE = 0 'False
FILE_DOESNT_EXIST = -999 'arbitrary number, other than 0 or -1
End Enum
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 Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Private Sub Form_Load()
Command1.Caption = "IsFileInUse"
Text1.Text = "d:\test.doc"
Label1.Caption = ""
End Sub
Private Sub Command1_Click()
Dim bResult As IsFileResults
bResult = IsFileInUse(Text1.Text)
Select Case bResult
Case FILE_IN_USE
Label1.Caption = "File in use"
Case FILE_FREE
Label1.Caption = "File is available"
Case FILE_DOESNT_EXIST
Label1.Caption = "File does not exist!"
End Select
Label1.Caption = Label1.Caption & " (" & bResult & ")"
End Sub
Private Function IsFileInUse(sFile As String) As IsFileResults
Dim hFile As Long
If FileExists(sFile) Then
'note that FILE_ATTRIBUTE_NORMAL (&H80) has
'a different value than VB's constant vbNormal (0)!
hFile = CreateFile(sFile, _
GENERIC_READ, _
0, 0, _
OPEN_EXISTING, _
FILE_ATTRIBUTE_NORMAL, 0&)
'this will evaluate to either
'-1 (FILE_IN_USE) or 0 (FILE_FREE)
IsFileInUse = hFile = INVALID_HANDLE_VALUE
CloseHandle hFile
Else
'the value of FILE_DOESNT_EXIST in the Enum
'is arbitrary, as long as it's not 0 or -1
IsFileInUse = FILE_DOESNT_EXIST
End If
End Function
Private Function FileExists(sSource As String) As Boolean
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
hFile = FindFirstFile(sSource, WFD)
FileExists = hFile <> INVALID_HANDLE_VALUE
Call FindClose(hFile)
End Function
'This will create a test app you can use to enter a file, remote or local, and have the 'tool lock the file for testing the code above. Note that the Open method used 'will 'create any mistyped filename, so check for stray 0-length files after testing.
Private hFile As Long
Private Sub Form_Load()
Text1.Text = ""
Me.Caption = "ready"
End Sub
Private Sub Command1_Click()
On Local Error GoTo oops
hFile = FreeFile
Open Text1.Text For Binary Access Read Lock Read As #hFile
Caption = "file handle: " & hFile
oops_out:
Exit Sub
oops:
MsgBox Err.Number & vbCrLf & Err.Description
Resume oops_out
End Sub
Private Sub Command2_Click()
Close
hFile = 0
Me.Caption = "ready"
End SubI have found this, but did not test it at all, seems that a filename CAN be changed with the following. Not my work, so all goes to the author, Randy Birch
###########################################
While the FindFirstChange and FindNextChange APIs can easily be used to receive a notification as to when a file system object has changed under a single folder, that code is best used in an application that can afford to remain in a tight do-loop to provide the constant polling of the single specified folder that is required.
Shell notifications indicate when new printers are added, when a network or dial-up connection is added or deleted, when folders or files are moved, deleted or renamed, when registered files are opened and when items are added and/or removed from the recent documents listing. Notifications also inform Windows and Explorer when the recycled bin has been added to or emptied, or when a scheduled task has added, deleted or modified. By OR'ing the required flags you can customize the type and scope of the notifications your application will receive. The illustration shows the notifications and data received when three actions were performed: a new text file was created on the D: drive, the file was renamed, and then deleted.
The undocumented SHChangeNotifyRegister and SHChangeNotifyDeregister functions are the heart of this demo and are used to register the application with the shell in order to receive notification of any changes made in any part of the namespace specified in the SHChangeNotifyRegister call. The demo also provides a rather interesting study of what is actually happening in the namespace as well. Through subclassing, the VB app receives the Windows notifications.
Three BAS modules will be created. The first contains the definitions for the shell API definitions. The second will be for the subclassing, and the third the will handle the notification setup.
Place the following API declare code into the general declarations area of a bas module 1, shell API definitions.
Option Explicit
'Brought to you by Brad Martinez
' http://www.mvps.org/btmtz/
' http://www.mvps.org/ccrp/
'
'Demonstrates how to receive shell change
'notifications (ala "what happens when the
'SHChangeNotify API is called?")
'
'Interpretation of the shell's undocumented
'functions SHChangeNotifyRegister (ordinal 2)
'and SHChangeNotifyDeregister (ordinal 4) would
'not have been possible without the assistance of
'James Holderness. For a complete (and probably
'more accurate) overview of shell change notifications,
'please refer to James'"Shell Notifications" page at
'http://www.geocities.com/SiliconValley/4942/
'------------------------------------------------------
Public Const MAX_PATH As Long = 260
'Defined as an HRESULT that corresponds
'to S_OK.
Public Const ERROR_SUCCESS As Long = 0
Public Type SHFILEINFO 'shfi
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
'If pidl is invalid, SHGetFileInfoPidl can
'very easily blow up when filling the
'szDisplayName and szTypeName string members
'of the SHFILEINFO struct
Public Type SHFILEINFOBYTE 'sfib
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName(1 To MAX_PATH) As Byte
szTypeName(1 To 80) As Byte
End Type
'Special folder values for
'SHGetSpecialFolderLocation and
'SHGetSpecialFolderPath (Shell32.dll v4.71)
Public Enum SHSpecialFolderIDs
CSIDL_DESKTOP = &H0
CSIDL_INTERNET = &H1
CSIDL_PROGRAMS = &H2
CSIDL_CONTROLS = &H3
CSIDL_PRINTERS = &H4
CSIDL_PERSONAL = &H5
CSIDL_FAVORITES = &H6
CSIDL_STARTUP = &H7
CSIDL_RECENT = &H8
CSIDL_SENDTO = &H9
CSIDL_BITBUCKET = &HA
CSIDL_STARTMENU = &HB
CSIDL_DESKTOPDIRECTORY = &H10
CSIDL_DRIVES = &H11
CSIDL_NETWORK = &H12
CSIDL_NETHOOD = &H13
CSIDL_FONTS = &H14
CSIDL_TEMPLATES = &H15
CSIDL_COMMON_STARTMENU = &H16
CSIDL_COMMON_PROGRAMS = &H17
CSIDL_COMMON_STARTUP = &H18
CSIDL_COMMON_DESKTOPDIRECTORY = &H19
CSIDL_APPDATA = &H1A
CSIDL_PRINTHOOD = &H1B
CSIDL_ALTSTARTUP = &H1D ''DBCS
CSIDL_COMMON_ALTSTARTUP = &H1E ''DBCS
CSIDL_COMMON_FAVORITES = &H1F
CSIDL_INTERNET_CACHE = &H20
CSIDL_COOKIES = &H21
CSIDL_HISTORY = &H22
End Enum
Enum SHGFI_FLAGS
SHGFI_LARGEICON = &H0 'sfi.hIcon is large icon
SHGFI_SMALLICON = &H1 'sfi.hIcon is small icon
SHGFI_OPENICON = &H2 'sfi.hIcon is open icon
SHGFI_SHELLICONSIZE = &H4 'sfi.hIcon is shell size (not system size), rtns BOOL
SHGFI_PIDL = &H8 'pszPath is pidl, rtns BOOL
SHGFI_USEFILEATTRIBUTES = &H10 'parent pszPath exists, rtns BOOL
SHGFI_ICON = &H100 'fills sfi.hIcon, rtns BOOL, use DestroyIcon
SHGFI_DISPLAYNAME = &H200 'isf.szDisplayName is filled, rtns BOOL
SHGFI_TYPENAME = &H400 'isf.szTypeName is filled, rtns BOOL
SHGFI_ATTRIBUTES = &H800 'rtns IShellFolder::GetAttributesOf SFGAO_* flags
SHGFI_ICONLOCATION = &H1000 'fills sfi.szDisplayName with filename
' containing the icon, rtns BOOL
SHGFI_EXETYPE = &H2000 'rtns two ASCII chars of exe type
SHGFI_SYSICONINDEX = &H4000 'sfi.iIcon is sys il icon index, rtns hImagelist
SHGFI_LINKOVERLAY = &H8000& 'add shortcut overlay to sfi.hIcon
SHGFI_SELECTED = &H10000 'sfi.hIcon is selected icon
End Enum
Public Declare Function FlashWindow Lib "user32" _
(ByVal hWnd As Long, _
ByVal bInvert As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSource As Any, _
ByVal dwLength As Long)
'Frees memory allocated by the shell (pidls)
Public Declare Sub CoTaskMemFree Lib "ole32" _
(ByVal pv As Long)
'Retrieves the location of a special
'(system) folder. Returns ERROR_SUCCESS if
'successful or an OLE-defined error
'result otherwise.
Public Declare Function SHGetSpecialFolderLocation Lib "shell32" _
(ByVal hwndOwner As Long, _
ByVal nFolder As SHSpecialFolderIDs, _
pidl As Long) As Long
'Converts an item identifier list to a
'file system path. Returns TRUE if successful
'or FALSE if an error occurs, for example,
'if the location specified by the pidl
'parameter is not part of the file system.
Public Declare Function SHGetPathFromIDList Lib "shell32" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
'Retrieves information about an object
'in the file system, such as a file,
'a folder, a directory, or a drive root.
Public Declare Function SHGetFileInfoPidl Lib "shell32" _
Alias "SHGetFileInfoA" _
(ByVal pidl As Long, _
ByVal dwFileAttributes As Long, _
psfib As SHFILEINFOBYTE, _
ByVal cbFileInfo As Long, _
ByVal uFlags As SHGFI_FLAGS) As Long
Public Declare Function SHGetFileInfo Lib "shell32" _
Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbFileInfo As Long, _
ByVal uFlags As SHGFI_FLAGS) As Long
Public Function GetPIDLFromFolderID(hOwner As Long, _
nFolder As SHSpecialFolderIDs) As Long
'Returns an absolute pidl (relative to
'the desktop) from a special folder's ID.
'(Calling proc is responsible for freeing
'the pidl)
'hOwner - handle of window that will
' own any displayed msg boxes
'nFolder - special folder ID
Dim pidl As Long
If SHGetSpecialFolderLocation(hOwner, _
nFolder, _
pidl) = ERROR_SUCCESS Then
GetPIDLFromFolderID = pidl
End If
End Function
Public Function GetDisplayNameFromPIDL(pidl As Long) As String
'If successful returns the specified
'absolute pidl's displayname, returns
'an empty string otherwise.
Dim sfib As SHFILEINFOBYTE
If SHGetFileInfoPidl(pidl, 0, sfib, Len(sfib), _
SHGFI_PIDL Or SHGFI_DISPLAYNAME) Then
GetDisplayNameFromPIDL = _
GetStrFromBufferA(StrConv(sfib.szDisplayName, vbUnicode))
End If
End Function
Public Function GetPathFromPIDL(pidl As Long) As String
'Returns a path from only an absolute pidl
'(relative to the desktop).
Dim sPath As String * MAX_PATH
'SHGetPathFromIDList rtns TRUE (1),
'if successful, FALSE (0) if not
If SHGetPathFromIDList(pidl, sPath) Then
GetPathFromPIDL = GetStrFromBufferA(sPath)
End If
End Function
Public Function GetStrFromBufferA(sz As String) As String
'Return the string before first null
'char encountered (if any) from an
'ANSII string. If no null, return the
'string passed
If InStr(sz, vbNullChar) Then
GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
Else
GetStrFromBufferA = sz
End If
End FunctionPlace the following API declare code into the general declarations area of a bas module 2, shell subclassing.
Option Explicit
Private Const WM_NCDESTROY As Long = &H82
Private Const GWL_WNDPROC As Long = (-4)
Private Const OLDWNDPROC As String = "OldWndProc"
Private Declare Function GetProp Lib "user32" _
Alias "GetPropA" _
(ByVal hWnd As Long, _
ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" _
Alias "SetPropA" _
(ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32" _
Alias "RemovePropA" _
(ByVal hWnd As Long, _
ByVal lpString As String) As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Function SubClass(hWnd As Long) As Boolean
Dim lpfnOld As Long
Dim fSuccess As Boolean
If (GetProp(hWnd, OLDWNDPROC) = 0) Then
lpfnOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
If lpfnOld Then
fSuccess = SetProp(hWnd, OLDWNDPROC, lpfnOld)
End If
End If
If fSuccess Then
SubClass = True
Else
If lpfnOld Then Call UnSubClass(hWnd)
MsgBox "Unable to successfully subclass &H" & Hex(hWnd), vbCritical
End If
End Function
Public Function UnSubClass(hWnd As Long) As Boolean
Dim lpfnOld As Long
lpfnOld = GetProp(hWnd, OLDWNDPROC)
If lpfnOld Then
If RemoveProp(hWnd, OLDWNDPROC) Then
UnSubClass = SetWindowLong(hWnd, GWL_WNDPROC, lpfnOld)
End If
End If
End Function
Public Function WindowProc(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Select Case uMsg
Case WM_SHNOTIFY
Call Form1.NotificationReceipt(wParam, lParam)
Case WM_NCDESTROY
Call UnSubClass(hWnd)
MsgBox "Unsubclassed &H" & Hex(hWnd), vbCritical, "WindowProc Error"
End Select
WindowProc = CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam)
End FunctionPlace the following API declare code into the general declarations area of a bas module 3, shell notifications.
Option Explicit
'the one and only shell change notification
'handle for the desktop folder
Private m_hSHNotify As Long
'the desktop's pidl
Private m_pidlDesktop As Long
'User defined notification message sent
'to the specified window's window proc.
Public Const WM_SHNOTIFY = &H401
'------------------------------------------------------
Public Type PIDLSTRUCT
'Fully qualified pidl (relative to
'the desktop folder) of the folder
'to monitor changes in. 0 can also
'be specified for the desktop folder.
pidl As Long
'Value specifying whether changes in
'the folder's subfolders trigger a
'change notification event.
bWatchSubFolders As Long
End Type
Public Declare Function SHChangeNotifyRegister Lib "shell32" Alias "#2" _
(ByVal hWnd As Long, _
ByVal uFlags As SHCN_ItemFlags, _
ByVal dwEventID As SHCN_EventIDs, _
ByVal uMsg As Long, _
ByVal cItems As Long, _
lpps As PIDLSTRUCT) As Long
'hWnd - Handle of the window to receive
' the window message specified in uMsg.
'
'uFlags - Flag that indicates the meaning of
' the dwItem1 and dwItem2 members of
' the SHNOTIFYSTRUCT (which is pointed
' to by the window procedure's wParam
' value when the specified window message
' is received). This parameter can
' be one of the SHCN_ItemFlags enum
' values below. This interpretation may
' be inaccurate as it appears pidls are
' almost always returned in the SHNOTIFYSTRUCT.
' See James' site for more info...
'
'dwEventId- Combination of SHCN_EventIDs enum
' values that specifies what events the
' specified window will be notified of.
' See below.
'
'uMsg - Window message to be used to identify
' receipt of a shell change notification.
' The message should *not* be a value that
' lies within the specified window's
' message range ( i.e. BM_ messages for
' a button window) or that window may
' not receive all (if not any) notifications
' sent by the shell!!!
'
'cItems - Count of PIDLSTRUCT structures in the array
' pointed to by the lpps param.
'
'lpps - Pointer to an array of PIDLSTRUCT structures
' indicating what folder(s) to monitor changes in,
' and whether to watch the specified folder's subfolder.
'If successful, SHChangeNotifyRegister returns a notification
'handle which must be passed to SHChangeNotifyDeregister
'when no longer used. Returns 0 otherwise.
'Once the specified message is registered with SHChangeNotifyRegister,
'the specified window's function proc will be notified by the shell
'of the specified event in (and under) the folder(s) specified in a pidl.
'On message receipt, wParam points to a SHNOTIFYSTRUCT and lParam
'contains the event's ID value.
'The values in dwItem1 and dwItem2 are event specific. See the
'description of the values for the wEventId parameter of the
'documented SHChangeNotify API function.
Public Type SHNOTIFYSTRUCT
dwItem1 As Long
dwItem2 As Long
End Type
'...?
'Public Declare Function SHChangeNotifyUpdateEntryList Lib "shell32" Alias "#5" _
' (ByVal hNotify As Long, _
' ByVal Unknown As Long, _
' ByVal cItem As Long, _
' lpps As PIDLSTRUCT) As Boolean
'
'Public Declare Function SHChangeNotifyReceive Lib "shell32" Alias "#5" _
' (ByVal hNotify As Long, _
' ByVal uFlags As SHCN_ItemFlags, _
' ByVal dwItem1 As Long, _
' ByVal dwItem2 As Long) As Long
'Closes the notification handle returned from a call
'to SHChangeNotifyRegister. Returns True if successful,
'False otherwise.
Public Declare Function SHChangeNotifyDeregister Lib "shell32" _
Alias "#4" _
(ByVal hNotify As Long) As Boolean
'------------------------------------------------------
'This function should be called by any app that
'changes anything in the shell. The shell will then
'notify each "notification registered" window of this action.
Public Declare Sub SHChangeNotify Lib "shell32" _
(ByVal wEventId As SHCN_EventIDs, _
ByVal uFlags As SHCN_ItemFlags, _
ByVal dwItem1 As Long, _
ByVal dwItem2 As Long)
'Shell notification event IDs
Public Enum SHCN_EventIDs
SHCNE_RENAMEITEM = &H1 '(D) A non-folder item has been renamed.
SHCNE_CREATE = &H2 '(D) A non-folder item has been created.
SHCNE_DELETE = &H4 '(D) A non-folder item has been deleted.
SHCNE_MKDIR = &H8 '(D) A folder item has been created.
SHCNE_RMDIR = &H10 '(D) A folder item has been removed.
SHCNE_MEDIAINSERTED = &H20 '(G) Storage media has been inserted into a drive.
SHCNE_MEDIAREMOVED = &H40 '(G) Storage media has been removed from a drive.
SHCNE_DRIVEREMOVED = &H80 '(G) A drive has been removed.
SHCNE_DRIVEADD = &H100 '(G) A drive has been added.
SHCNE_NETSHARE = &H200 'A folder on the local computer is being
' shared via the network.
SHCNE_NETUNSHARE = &H400 'A folder on the local computer is no longer
' being shared via the network.
SHCNE_ATTRIBUTES = &H800 '(D) The attributes of an item or folder have changed.
SHCNE_UPDATEDIR = &H1000 '(D) The contents of an existing folder have changed,
' but the folder still exists and has not been renamed.
SHCNE_UPDATEITEM = &H2000 '(D) An existing non-folder item has changed, but the
' item still exists and has not been renamed.
SHCNE_SERVERDISCONNECT = &H4000 'The computer has disconnected from a server.
SHCNE_UPDATEIMAGE = &H8000& '(G) An image in the system image list has changed.
SHCNE_DRIVEADDGUI = &H10000 '(G) A drive has been added and the shell should
' create a new window for the drive.
SHCNE_RENAMEFOLDER = &H20000 '(D) The name of a folder has changed.
SHCNE_FREESPACE = &H40000 '(G) The amount of free space on a drive has changed.
#If (WIN32_IE >= &H400) Then
SHCNE_EXTENDED_EVENT = &H4000000 '(G) Not currently used.
#End If
SHCNE_ASSOCCHANGED = &H8000000 '(G) A file type association has changed.
SHCNE_DISKEVENTS = &H2381F '(D) Specifies a combination of all of the disk
' event identifiers.
SHCNE_GLOBALEVENTS = &HC0581E0 '(G) Specifies a combination of all of the global
' event identifiers.
SHCNE_ALLEVENTS = &H7FFFFFFF
SHCNE_INTERRUPT = &H80000000 'The specified event occurred as a result of a system
'interrupt. It is stripped out before the clients
'of SHCNNotify_ see it.
End Enum
#If (WIN32_IE >= &H400) Then
Public Const SHCNEE_ORDERCHANGED = &H2 'dwItem2 is the pidl of the changed folder
#End If
'Notification flags
'uFlags & SHCNF_TYPE is an ID which indicates
'what dwItem1 and dwItem2 mean
Public Enum SHCN_ItemFlags
SHCNF_IDLIST = &H0 'LPITEMIDLIST
SHCNF_PATHA = &H1 'path name
SHCNF_PRINTERA = &H2 'printer friendly name
SHCNF_DWORD = &H3 'DWORD
SHCNF_PATHW = &H5 'path name
SHCNF_PRINTERW = &H6 'printer friendly name
SHCNF_TYPE = &HFF
'Flushes the system event buffer. The
'function does not return until the system
'is finished processing the given event.
SHCNF_FLUSH = &H1000
'Flushes the system event buffer. The function
'returns immediately regardless of whether
'the system is finished processing the given event.
SHCNF_FLUSHNOWAIT = &H2000
#If UNICODE Then
SHCNF_PATH = SHCNF_PATHW
SHCNF_PRINTER = SHCNF_PRINTERW
#Else
SHCNF_PATH = SHCNF_PATHA
SHCNF_PRINTER = SHCNF_PRINTERA
#End If
End Enum
Public Function SHNotify_Register(hWnd As Long) As Boolean
'Registers the one and only shell change notification.
Dim ps As PIDLSTRUCT
'If we don't already have a notification going...
If (m_hSHNotify = 0) Then
'Get the pidl for the desktop folder.
m_pidlDesktop = GetPIDLFromFolderID(0, CSIDL_DESKTOP)
If m_pidlDesktop Then
'Fill the one and only PIDLSTRUCT, we're
'watching desktop and all of the its
'subfolders, everything...
ps.pidl = m_pidlDesktop
ps.bWatchSubFolders = True
'Register the notification, specifying that
'we want the dwItem1 and dwItem2 members of
'the SHNOTIFYSTRUCT to be pidls. We're
'watching all events.
m_hSHNotify = SHChangeNotifyRegister(hWnd, _
SHCNF_TYPE Or SHCNF_IDLIST, _
SHCNE_ALLEVENTS Or SHCNE_INTERRUPT, _
WM_SHNOTIFY, _
1, _
ps)
SHNotify_Register = CBool(m_hSHNotify)
Else
'If something went wrong...
Call CoTaskMemFree(m_pidlDesktop)
End If
End If
End Function
Public Function SHNotify_Unregister() As Boolean
'Unregisters the one and only shell change notification.
'If we have a registered notification handle.
If m_hSHNotify Then
'Unregister it. If the call is successful,
'zero the handle's variable, free and zero
'the the desktop's pidl.
If SHChangeNotifyDeregister(m_hSHNotify) Then
m_hSHNotify = 0
Call CoTaskMemFree(m_pidlDesktop)
m_pidlDesktop = 0
SHNotify_Unregister = True
End If
End If
End Function
Public Function SHNotify_GetEventStr(dwEventID As Long) As String
'Returns the event string associated
'with the specified event ID value.
Dim sEvent As String
Select Case dwEventID
Case SHCNE_RENAMEITEM: sEvent = "SHCNE_RENAMEITEM" '&H1
Case SHCNE_CREATE: sEvent = "SHCNE_CREATE" '&H2
Case SHCNE_DELETE: sEvent = "SHCNE_DELETE" '&H4
Case SHCNE_MKDIR: sEvent = "SHCNE_MKDIR" '&H8
Case SHCNE_RMDIR: sEvent = "SHCNE_RMDIR" '&H10
Case SHCNE_MEDIAINSERTED: sEvent = "SHCNE_MEDIAINSERTED" '&H20
Case SHCNE_MEDIAREMOVED: sEvent = "SHCNE_MEDIAREMOVED" '&H40
Case SHCNE_DRIVEREMOVED: sEvent = "SHCNE_DRIVEREMOVED" '&H80
Case SHCNE_DRIVEADD: sEvent = "SHCNE_DRIVEADD" '&H100
Case SHCNE_NETSHARE: sEvent = "SHCNE_NETSHARE" '&H200
Case SHCNE_NETUNSHARE: sEvent = "SHCNE_NETUNSHARE" '&H400
Case SHCNE_ATTRIBUTES: sEvent = "SHCNE_ATTRIBUTES" '&H800
Case SHCNE_UPDATEDIR: sEvent = "SHCNE_UPDATEDIR" '&H1000
Case SHCNE_UPDATEITEM: sEvent = "SHCNE_UPDATEITEM" '&H2000
Case SHCNE_SERVERDISCONNECT: sEvent = "SHCNE_SERVERDISCONNECT" '&H4000
Case SHCNE_UPDATEIMAGE: sEvent = "SHCNE_UPDATEIMAGE" '&H8000&
Case SHCNE_DRIVEADDGUI: sEvent = "SHCNE_DRIVEADDGUI" '&H10000
Case SHCNE_RENAMEFOLDER: sEvent = "SHCNE_RENAMEFOLDER" '&H20000
Case SHCNE_FREESPACE: sEvent = "SHCNE_FREESPACE" '&H40000
#If (WIN32_IE >= &H400) Then
Case SHCNE_EXTENDED_EVENT: sEvent = "SHCNE_EXTENDED_EVENT" '&H4000000
#End If
Case SHCNE_ASSOCCHANGED: sEvent = "SHCNE_ASSOCCHANGED" '&H8000000
Case SHCNE_DISKEVENTS: sEvent = "SHCNE_DISKEVENTS" '&H2381F
Case SHCNE_GLOBALEVENTS: sEvent = "SHCNE_GLOBALEVENTS" '&HC0581E0
Case SHCNE_ALLEVENTS: sEvent = "SHCNE_ALLEVENTS" '&H7FFFFFFF
Case SHCNE_INTERRUPT: sEvent = "SHCNE_INTERRUPT" '&H80000000
End Select
SHNotify_GetEventStr = sEvent
End FunctionTo a new form, add a timer (tmrFlashMe) control (used to flash the window in the demo), and a textbox (Text1) set to multiline.
Open the project's Properties (Project > Project1 Properties), and on the Make tab, enter "WIN32_IE = 256" (no quotes) as conditional compile arguments. Then add the following to the form:
Option Explicit
Private Sub Form_Load()
If SubClass(hWnd) Then
If IsIDE Then
Text1.Text = "**IMPORTANT**" & vbCrLf & _
"This window is subclassed. Do not close it from" & vbCrLf & _
"either VB's End button or End menu command," & vbCrLf & _
"or VB will blow up. Close this window only from" & vbCrLf & _
"the system menu above!" & vbCrLf & vbCrLf & Text1
End If
Call SHNotify_Register(hWnd)
Else
Text1.Text = "Well, it is supposed to work."
End If
'position the window in the bottom corner
Me.Move Screen.Width - Width, Screen.Height - Height
End Sub
Private Sub Form_Resize()
On Error GoTo Out
Text1.Move 0, 0, ScaleWidth, ScaleHeight
Out:
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call SHNotify_Unregister
Call UnSubClass(hWnd)
End Sub
Private Function IsIDE() As Boolean
On Error GoTo Out
Debug.Print 1 / 0
Out:
IsIDE = Err
End Function
Public Sub NotificationReceipt(wParam As Long, lParam As Long)
Dim sOut As String
Dim shns As SHNOTIFYSTRUCT
sOut = SHNotify_GetEventStr(lParam) & vbCrLf
'Fill the SHNOTIFYSTRUCT from its pointer.
CopyMemory shns, ByVal wParam, Len(shns)
'lParam is the ID of the notification event,
'one of the SHCN_EventIDs.
Select Case lParam
'----------------------------------------------------
'For the SHCNE_FREESPACE event, dwItem1 points
'to what looks like a 10 byte struct. The first
'two bytes are the size of the struct, and the
'next two members equate to SHChangeNotify's
'dwItem1 and dwItem2 params.
'The dwItem1 member is a bitfield indicating which
'drive(s) had its (their) free space changed.
'The bitfield is identical to the bitfield returned
'from a GetLogicalDrives call, i.e., bit 0 = A:\, bit
'1 = B:\, 2, = C:\, etc. Since VB does DWORD alignment
'when CopyMemory'ing to a struct, we'll extract the
'bitfield directly from its memory location.
Case SHCNE_FREESPACE
Dim dwDriveBits As Long
Dim wHighBit As Integer
Dim wBit As Integer
CopyMemory dwDriveBits, ByVal shns.dwItem1 + 2, 4
'Get the zero based position of the highest
'bit set in the bitmask (essentially determining
'the value's highest complete power of 2).
'Use floating point division (we want the exact
'values from the Logs) and remove the fractional
'value (the fraction indicates the value of
'the last incomplete power of 2, which means the
'bit isn't set).
wHighBit = Int(Log(dwDriveBits) / Log(2))
For wBit = 0 To wHighBit
'If the bit is set...
If (2 ^ wBit) And dwDriveBits Then
'... get its drive string
sOut = sOut & Chr$(vbKeyA + wBit) & ":\" & vbCrLf
End If
Next
'----------------------------------------------------
'shns.dwItem1 also points to a 10 byte struct. The
'struct's second member (after the struct's first
'WORD size member) points to the system imagelist
'index of the image that was updated.
Case SHCNE_UPDATEIMAGE
Dim iImage As Long
CopyMemory iImage, ByVal shns.dwItem1 + 2, 4
sOut = sOut & "Index of image in system imagelist: " & iImage & vbCrLf
'----------------------------------------------------
'Everything else except SHCNE_ATTRIBUTES is the
'pidl(s) of the changed item(s). For SHCNE_ATTRIBUTES,
'neither item is used. See the description of the
'values for the wEventId parameter of the
'SHChangeNotify API function for more info.
Case Else
Dim sDisplayname As String
If shns.dwItem1 Then
sDisplayname = GetDisplayNameFromPIDL(shns.dwItem1)
If Len(sDisplayname) Then
sOut = sOut & "first item displayname: " & sDisplayname & vbCrLf
sOut = sOut & "first item path: " & GetPathFromPIDL(shns.dwItem1) & vbCrLf
Else
sOut = sOut & "first item is invalid" & vbCrLf
End If
End If
If shns.dwItem2 Then
sDisplayname = GetDisplayNameFromPIDL(shns.dwItem2)
If Len(sDisplayname) Then
sOut = sOut & "second item displayname: " & sDisplayname & vbCrLf
sOut = sOut & "second item path: " & GetPathFromPIDL(shns.dwItem2) & vbCrLf
Else
sOut = sOut & "second item is invalid" & vbCrLf
End If
End If
End Select
'update the text window and flash
'the window title
Text1.Text = Text1.Text & sOut & vbCrLf
Text1.SelStart = Len(Text1.Text)
tmrFlashMe = True
End Sub
Private Sub tmrFlashMe_Timer()
'initial settings: Interval = 1, Enabled = False
Static nCount As Integer
If nCount = 0 Then tmrFlashMe.Interval = 200
nCount = nCount + 1
Call FlashWindow(hWnd, True)
'Reset everything after 3 flash cycles
If nCount = 6 Then
nCount = 0
tmrFlashMe.Interval = 1
tmrFlashMe = False
End If
End SubAs with all subclassed, save the project first. And never used VB's End button or menu End command to stop the program; use the application's system menu Close instead.
Run the project and perform any Explorer-based actions, including adding/removing/renaming printers, dropping/connecting to shared resources, opening/moving/renaming files and folders etc. As each action occurs, the text box will reflect the system notification messages sent.
This seems like a lot, but it seems like quite an effort to change the name on a file. I would presume that you will need administrator priveleges to perform the above tasks.
Good luck
vb5prgrmr
143
Posting Virtuoso
Andre...
Name OldFile As NewFileDen...
The syntax you are using....
Dim FILE_NAME As String = "C:\test.txt"Will throw an error in VB6.0. It actually looks like you are using vb.NET and as such you are in the wrong forum. So, if this is so, that you are using .net, then please PM a mod, or use the report this post button under your name to have a mod move this into the VB.NET forum...
Good Luck
AndreRet
526
Senior Poster
Hahahaha, I knew there MUST be a shorter route. Thanks vb5, as always you were one ahead of me. (Thanks anyways, never too old to learn...)
Good luck Den...
Be a part of the DaniWeb community
We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.