Hi,
About a year ago I wrote PbAttrib.dll to overcome the problem that A5 didn't find all files in a directory. Now I have translated this to Xbasic with the use of API-calls. Use it at your own risk and see it as a (tiny) lesson for using the internal Windows functions (API-call) from A5.
Marcel
About a year ago I wrote PbAttrib.dll to overcome the problem that A5 didn't find all files in a directory. Now I have translated this to Xbasic with the use of API-calls. Use it at your own risk and see it as a (tiny) lesson for using the internal Windows functions (API-call) from A5.
Marcel
Code:
constant shared FILE_ATTRIBUTE_ARCHIVE = 32 constant shared FILE_ATTRIBUTE_COMPRESSED = 2048 constant shared FILE_ATTRIBUTE_NORMAL = 128 constant shared FILE_ATTRIBUTE_DIRECTORY = 16 constant shared FILE_ATTRIBUTE_HIDDEN = 2 constant shared FILE_ATTRIBUTE_READONLY = 1 constant shared FILE_ATTRIBUTE_SYSTEM = 4 constant shared FILE_ATTRIBUTE_TEMPORARY = 256 constant shared FILE_ATTRIBUTE_SPARSE_FILE = hex_to_dec("200") constant shared FILE_ATTRIBUTE_REPARSE_POINT = hex_to_dec("400") constant shared FILE_ATTRIBUTE_OFFLINE = hex_to_dec("1000") constant shared FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = hex_to_dec("00002000") constant shared FILE_ATTRIBUTE_ENCRYPTED = hex_to_dec("4000") constant shared ERROR_NO_MORE_FILES = 18 constant shared INVALID_HANDLE_VALUE = hex_to_dec("ffffffff") 'Declare two structures to hold the filename and alternatefilename. 'Use the structure name _FILENAME as TYPE in the structure WIN32_FIND_DATA 'Use the structure name _FILENAMEA as TYPE in the structure WIN32_FIND_DATA declarestruct _FILENAME C260filename declarestruct _FILENAMEA C14filenameA type _FILETIME dwLowDateTime as Integer dwHighDateTime as Integer end type type WIN32_FIND_DATA dwFileAttributes as Integer ftCreationTime as {_FILETIME} ftLastAccessTime as {_FILETIME} ftLastWriteTime as {_FILETIME} nFileSizeHigh as Integer nFileSizeLow as Integer dwReserved0 as Integer dwReserved1 as Integer cFileName as {_FILENAME} cAlternateFileName as {_FILENAMEA} end type 'HANDLE FindFirstFile(LPCTSTR lpFileName,LPWIN32_FIND_DATA lpFindFileData); 'The FindFirstFile function searches a directory for a file whose name matches 'the specified file name. FindFirstFile examines subdirectory names as well as 'file names. 'lpFileName '[in] Pointer to a null-terminated string that specifies a valid directory or 'path and file name, which can contain wildcard characters (* and ?). If the 'string ends with a wildcard, a period, or a directory name, the user must have 'access to the root and all subdirectories on the path. 'lpFindFileData '[out] Pointer to the WIN32_FIND_DATA structure that receives information about 'the found file or subdirectory. 'Return Values 'If the function succeeds, the return value is a search handle used in a subsequent 'call to FindNextFile or FindClose. If the function fails, the return value is 'INVALID_HANDLE_VALUE. To get extended error information, call GetLastError. declare KERNEL32 FindFirstFile@FindFirstFileA LC(WIN32_FIND_DATA) 'BOOL FindNextFile(HANDLE hFindFile,LPWIN32_FIND_DATA lpFindFileData); 'The FindNextFile function continues a file search from a previous call to the 'FindFirstFile function. 'hFindFile '[in] Search handle returned by a previous call to the FindFirstFile function. 'lpFindFileData '[out] Pointer to the WIN32_FIND_DATA structure that receives information about 'the found file or subdirectory. The structure can be used in subsequent calls to 'FindNextFile to see the found file or directory. 'Return Values 'If the function succeeds, the return value is nonzero. 'If the function fails, the return value is zero. To get extended error information, 'call GetLastError. If no matching files can be found, the GetLastError function 'returns ERROR_NO_MORE_FILES. 'Remarks 'The FindNextFile function searches for files by name only; it cannot be used for 'attribute-based searches. It searches both the long and short file names. 'In rare cases, file attribute information on NTFS file systems may not be current 'at the time you call this function. To be assured of getting the current NTFS file 'attributes, call GetFileInformationByHandle. 'The order in which this function returns the file names is dependent on the file 'system type. With NTFS and CDFS file systems, the names are returned in alphabetical 'order. With FAT file systems, the names are returned in the order the files were 'written to the disk, which may or may not be in alphabetical order. declare KERNEL32 FindNextFile@FindNextFileA LL(WIN32_FIND_DATA) 'The FindClose function closes the specified search handle. The FindFirstFile, 'FindFirstFileEx, and FindNextFile 'functions use the search handle to locate files with names that match a given name. declare KERNEL32 FindClose LL 'DWORD GetFileAttributes(LPCTSTR lpFileName); 'lpFileName '[in] Pointer to a null-terminated string that specifies the name of a file or directory. declare KERNEL32 GetFileAttributes@GetFileAttributesA LC 'BOOL SetFileAttributes(LPCTSTR lpFileName,DWORD dwFileAttributes); declare KERNEL32 SetFileAttributes@SetFileAttributesA LCL 'DWORD GetLastError(void); declare KERNEL32 GetLastError L 'debug(1)'Sometimes you need to debug. Especially when it comes to API calling functions. 'TIP. In case of errors, quit A5, start A5 open database, open function and when the error 'stays think what you did wrong. Use a debugger. 'In case the error disappears smile and proceed. 'This one is my favourites when it comes to API calling: '"Oh. and have one of my Yellow little pills.... they work quite well, and the man in the 'white coats are really very nice...." 'Source: John McGhie MVP - Word 'Good luck SetAttributes("c:\\","*.*","") 'SetAttributes("c:\\","*.doc","H")'Set all Word documents in the root to hidden. :-) undeclare FindFirstFile undeclare GetFileAttributes undeclare FindNextFile undeclare FindClose undeclare GetLastError end 'of main '--------------------------------------------------------------------------------------------- ' Synopsis: SetAttributes(cDirname,cFilename,cFileAttributesToChange) ' Parameters: cDirname Path to the directory where files resides. ' cFileName Filename or wildcards: *.txt, a*.?x? ' cFileAttributesToChange one of the collection AaRrSsHh ' Uppercase set an attribute, lowercase reset an attribute. ' If empty just walks through the filelist. '---------------------------------------------------------------------------------------------- function SetAttributes(cDirname as C, cFilename as C, cFileAttributesToChange as C) dim udtFindfiledata as {WIN32_FIND_DATA} 'variable of type WIN32_FIND_DATA dim hFind as N 'Search handle -1 No Files found, 0 dim properties as C dim succeed as A dim finished as L dim nProcessFileType as N dim nFileAttributes as N dim aRetValue as A dim nAttrs as N dim cSingleAttribute as C dim nPos as N nProcessFileType = 1 finished = .F. hFind = FindFirstFile( cDirname + cFilename , udtFindfiledata ) if .NOT. ((hFind == INVALID_HANDLE_VALUE) .OR. (hFind == -1)) then while nProcessFileType nFileAttributes = GetFileAttributes(cDirname + udtFindfiledata.cFileName.filename) if (nFileAttributes .AND. FILE_ATTRIBUTE_DIRECTORY) = 0 then if .NOT. (nFileAttributes == -1) then'Skip freaky files such as pagefile.sys ui_msg_box("Filename",udtFindfiledata.cFileName.filename) for nPos = 1 To Len(cFileAttributesToChange) cSingleAttribute = substr(cFileAttributesToChange, nPos, 1) select case cSingleAttribute == "a" If ((nFileAttributes .AND. FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE) then nFileAttributes = nFileAttributes .XOR. FILE_ATTRIBUTE_ARCHIVE end if case cSingleAttribute == "A" If (nFileAttributes .AND. FILE_ATTRIBUTE_ARCHIVE) = 0 then nFileAttributes = nFileAttributes .OR. FILE_ATTRIBUTE_ARCHIVE end if case cSingleAttribute == "r" If ((nFileAttributes .AND. FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY) then nFileAttributes = nFileAttributes .XOR. FILE_ATTRIBUTE_READONLY end if case cSingleAttribute == "R" If (nFileAttributes .AND. FILE_ATTRIBUTE_READONLY) = 0 then nFileAttributes = nFileAttributes .OR. FILE_ATTRIBUTE_READONLY end if case cSingleAttribute == "s" If ((nFileAttributes .AND. FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM) then nFileAttributes = nFileAttributes .XOR. FILE_ATTRIBUTE_SYSTEM end if case cSingleAttribute == "S" If (nFileAttributes .AND. FILE_ATTRIBUTE_SYSTEM) = 0 then nFileAttributes = nFileAttributes .OR. FILE_ATTRIBUTE_SYSTEM end if case cSingleAttribute == "h" If ((nFileAttributes .AND. FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN) then nFileAttributes = nFileAttributes .XOR. FILE_ATTRIBUTE_HIDDEN end if case cSingleAttribute == "H" If (nFileAttributes .AND. FILE_ATTRIBUTE_HIDDEN) = 0 then nFileAttributes = nFileAttributes .OR. FILE_ATTRIBUTE_HIDDEN end if end select next npos if SetFileAttributes(cDirname + udtFindfiledata.cFileName.filename,nFileAttributes) == 0 then ui_msg_box("Warning","Error in setting file attributes") end if end if end if nProcessFileType = FindNextFile(hFind,udtFindfiledata)'1 is success, 0 when the function fails end while FindClose(hFind) else ui_msg_box("Warning","No files found.") return end if End function