.
by Michael Rüsweg-Gilbert
To get the amount of available disk space you can call GetDiskFreeSpace or GetDiskFreeSpaceEx.
GetDiskFreeSpaceEx is best because it supports disks larger than 2 gigabyte. Unfortunately this function may not be available on every Windows version (Windows 95 before OSR2 only supports GetDiskFreeSpace).
The following program shows how to call GetDiskFreeSpaceEx. Note how the 64-bit parameters are cast in MEMPTR variables and converted to decimal values.
/* ===============================================================================
Program: VolSpace.p
Created: Michael R?Gilbert Feb 2001
mailto:rg@rgilbert.de
Description: returns the capacity and free space of a volume (even if Vol > 2 GB)
Usage: for ex. run VolSpace.p ("C:",
"KB",
output freeSpace,
output totalSpace).
Parameters: - Volume to check or Blank
(Blank returns informations abaout the working drirector drive)
It does not have to be the root, accepts any directory.
- Unit to format the result; legal entries are
"KB", "MB" or "GB".
If the unit is not recognized or empty, VolSpace will return
Number of Bytes.
- OUTPUT available free space in given unit
- OUTPUT total space in given unit
When VolSpace is not successful, both output parameters will return ?.
modifications:
March 14, 2001: Jurjen - added function IsAPIFunctionSupported()
===================================================================================== */
DEFINE INPUT PARAMETER ip_drive AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER ip_unit AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER op_free AS DECIMAL NO-UNDO.
DEFINE OUTPUT PARAMETER op_total AS DECIMAL NO-UNDO.
&SCOPED-DEFINE WTRUE 1
&SCOPED-DEFINE WFALSE 0
FUNCTION get64BitValue RETURNS DECIMAL
(INPUT m64 AS MEMPTR) FORWARD.
FUNCTION IsAPIFunctionSupported RETURNS LOGICAL
(FunctionName AS CHAR, ModuleName AS CHARACTER) FORWARD.
DEFINE VARIABLE retval AS INTEGER NO-UNDO.
DEFINE VARIABLE divident AS INTEGER NO-UNDO INIT 1.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DEFINE VARIABLE mem1 AS MEMPTR NO-UNDO.
DEFINE VARIABLE mem2 AS MEMPTR NO-UNDO.
DEFINE VARIABLE mem3 AS MEMPTR NO-UNDO.
/* See if GetDiskFreeSpaceEx is available in this Windows version.
(it is available in NT4, Windows 95 OSR2, Windows 98, Windows 2000) */
IF NOT IsAPIFunctionSupported("GetDiskFreeSpaceExA":U, "kernel32.dll":U) THEN DO:
MESSAGE "Sorry, your version of Windows does not support GetDiskFreeSpaceEx"
VIEW-AS ALERT-BOX.
ASSIGN op_free = ?
op_total = ?.
RETURN.
END.
IF CAN-DO("KB,Kilo,Kilobyte,Kilobytes", ip_unit)
THEN divident = 1024.
ELSE
IF CAN-DO("MB,Mega,Megabyte,Megabytes", ip_unit)
THEN divident = 1024 * 1024.
ELSE
IF CAN-DO("GB,Giga,Gigabyte,Gigabytes", ip_unit)
THEN divident = 1024 * 1024 * 1024.
ELSE divident = 1.
/* No directory specified? Then use the current directory */
IF (ip_drive = "") OR (ip_drive=?) THEN DO:
FILE-INFO:FILE-NAME = ".".
ip_drive = FILE-INFO:FULL-PATHNAME.
END.
/* If a UNC name was specified, make sure it ends with a backslash ( \\drive\share\dir\ )
This won't hurt for a mapped drive too */
IF SUBSTR(ip_drive, LENGTH(ip_drive), 1) NE "\"
THEN ip_drive = ip_drive + "\".
SET-SIZE(mem1) = 8. /* 64 bit integer! */
SET-SIZE(mem2) = 8.
SET-SIZE(mem3) = 8.
RUN GetDiskFreeSpaceExA ( ip_drive + CHR(0),
OUTPUT mem1,
OUTPUT mem2,
OUTPUT mem3,
OUTPUT retVal ).
IF retVal NE {&WTRUE} THEN DO:
op_free = ?.
op_total = ?.
END.
ELSE DO:
ASSIGN
op_free = TRUNC( get64BitValue(mem3) / divident, 3)
op_total = TRUNC( get64BitValue(mem2) / divident, 3).
END.
SET-SIZE(mem1) = 0.
SET-SIZE(mem2) = 0.
SET-SIZE(mem3) = 0.
RETURN.
PROCEDURE GetModuleHandleA EXTERNAL "kernel32.dll" :
DEFINE INPUT PARAMETER lpModuleName AS CHARACTER NO-UNDO.
DEFINE RETURN PARAMETER hModule AS LONG NO-UNDO.
END PROCEDURE.
PROCEDURE GetProcAddress EXTERNAL "kernel32.dll" :
DEFINE INPUT PARAMETER hModule AS LONG NO-UNDO.
DEFINE INPUT PARAMETER lpProcName AS CHARACTER NO-UNDO.
DEFINE RETURN PARAMETER lpFarproc AS LONG NO-UNDO.
END PROCEDURE.
PROCEDURE GetDiskFreeSpaceExA EXTERNAL "kernel32.dll" :
DEFINE INPUT PARAMETER lpDirectoryName AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER FreeBytesAvailable AS MEMPTR NO-UNDO.
DEFINE OUTPUT PARAMETER TotalNumberOfBytes AS MEMPTR NO-UNDO.
DEFINE OUTPUT PARAMETER TotalNumberOfFreeBytes AS MEMPTR NO-UNDO.
DEFINE RETURN PARAMETER retval AS LONG NO-UNDO.
END PROCEDURE.
/* See if GetDiskFreeSpaceEx is available in this Windows version */
FUNCTION IsAPIFunctionSupported RETURNS LOGICAL
(FunctionName AS CHAR, ModuleName AS CHARACTER):
DEFINE VARIABLE hModule AS INTEGER NO-UNDO.
DEFINE VARIABLE lpFarProc AS INTEGER NO-UNDO.
/* you should run LoadLibraryA to load the module into memory,
but this is not necessary for ModuleName="kernel32.dll": the kernel is
always available. */
RUN GetModuleHandleA (ModuleName, OUTPUT hModule).
RUN GetProcAddress (hModule, FunctionName, OUTPUT lpFarProc).
RETURN lpFarProc NE 0.
END FUNCTION.
/* Converts a 64-bit integer given in a 8 byte mempointer into a decimal */
FUNCTION get64BitValue RETURNS DECIMAL
( INPUT m64 AS MEMPTR ):
/* constant 2^32 */
&SCOPED-DEFINE BigInt 4294967296
DEFINE VARIABLE d1 AS DECIMAL NO-UNDO.
DEFINE VARIABLE d2 AS DECIMAL NO-UNDO.
d1 = GET-LONG(m64, 1).
IF d1 < 0
THEN d1 = d1 + {&BigInt}.
d2 = GET-LONG(m64, 5).
IF d2 < 0
THEN d2 = d2 + {&BigInt}.
IF d2 GT 0
THEN d1 = d1 + (d2 * {&BigInt}).
RETURN d1.
END FUNCTION.
To get the amount of available disk space you can call GetDiskFreeSpace or GetDiskFreeSpaceEx.
There are differences between Windows 95, Windows 95 OSR/2 and Windows NT 4.0.
This text is quoted from MSDN Library:
In Windows 95, the existing Win32 function GetDiskFreeSpace may obtain incorrect values for volumes that are larger than 2 gigabytes (GB). In OSR 2, the function GetDiskFreeSpace has been modified to cap the value returned and never reports volume sizes greater than 2 GB. On very large empty volumes, existing applications will see only 2 GB free. If less than 2 GB are free, the correct amount will be returned. Windows 95 OSR 2 and Windows NT 4.0 support the GetDiskFreeSpaceEx function. GetDiskFreeSpaceEx obtains correct values on all platforms for all volumes, including those that are larger than 2 GB. New applications should use the GetDiskFreeSpaceEx function instead of the GetDiskFreeSpace function.
The following code shows how to call GetDiskFreeSpace. This example was submitted by Stuart Morris [stuart@IBS-PUBLIC-SERVICES.CO.UK]
DEFINE VARIABLE iSectorsPerCluster AS INTEGER NO-UNDO.
DEFINE VARIABLE iBytesPerSector AS INTEGER NO-UNDO.
DEFINE VARIABLE iFreeClusters AS INTEGER NO-UNDO.
DEFINE VARIABLE iClusters AS INTEGER NO-UNDO.
DEFINE VARIABLE iResult AS INTEGER NO-UNDO.
DEFINE VARIABLE iVolName AS CHARACTER NO-UNDO INIT "c:\".
PROCEDURE GetDiskFreeSpaceA EXTERNAL "kernel32.dll":
DEFINE INPUT PARAM lpRootPathName AS CHARACTER.
DEFINE OUTPUT PARAM opSectorsPerCluster AS LONG.
DEFINE OUTPUT PARAM opBytesPerSector AS LONG.
DEFINE OUTPUT PARAM opFreeClusters AS LONG.
DEFINE OUTPUT PARAM opClusters AS LONG.
DEFINE RETURN PARAM bResult AS LONG.
END PROCEDURE.
RUN GetDiskFreeSpaceA(INPUT iVolName,
OUTPUT iSectorsPerCluster,
OUTPUT iBytesPerSector,
OUTPUT iFreeClusters,
OUTPUT iClusters,
OUTPUT iResult
).
MESSAGE "SectorsPerCluster = " iSectorsPerCluster SKIP
"BytesPerSector = " iBytesPerSector SKIP
"FreeClusters = " iFreeClusters SKIP
"Clusters = " iClusters SKIP(1)
"BytesPerCluster = " (iSectorsPerCluster * iBytesPerSector) SKIP
"DiskSpaceFree = " ((iFreeClusters * iSectorsPerCluster) * iBytesPerSector)
VIEW-AS ALERT-BOX INFO TITLE "disk " + iVolname.
Sometimes you want to choose a folder but the usual system dialogs require you to choose a file as well. The API function SHBrowseForFolder does not show any files: it does exactly what the name implies.
/* a test/demo program */
DEFINE VARIABLE folder AS CHARACTER NO-UNDO.
DEFINE VARIABLE canceled AS LOGICAL NO-UNDO.
RUN BrowseForFolder.p ("choose the directory where you want to dump your data",
OUTPUT folder,
OUTPUT canceled).
MESSAGE "folder=" folder SKIP
"canceled=" canceled
VIEW-AS ALERT-BOX.
/* ==========================================================
file: BrowseForFolder.p
========================================================== */
{windows.i}
DEFINE INPUT PARAMETER DialogTitle AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER FolderName AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER Canceled AS LOGICAL NO-UNDO.
DEFINE VARIABLE MAX_PATH AS INTEGER INITIAL 260.
DEFINE VARIABLE lpbi AS MEMPTR. /* pointer to BROWSEINFO structure */
DEFINE VARIABLE pszDisplayName AS MEMPTR.
DEFINE VARIABLE lpszTitle AS MEMPTR.
DEFINE VARIABLE lpItemIDList AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
SET-SIZE(lpbi) = 32.
SET-SIZE(pszDisplayName) = MAX_PATH.
SET-SIZE(lpszTitle) = LENGTH(DialogTitle) + 1.
PUT-STRING(lpszTitle,1) = DialogTitle.
PUT-LONG(lpbi, 1) = 0. /* hwnd for parent */
PUT-LONG(lpbi, 5) = 0.
PUT-LONG(lpbi, 9) = GET-POINTER-VALUE(pszDisplayName).
PUT-LONG(lpbi,13) = GET-POINTER-VALUE(lpszTitle).
PUT-LONG(lpbi,17) = 1. /* BIF_RETURNONLYFSDIRS = only accept a file system directory */
PUT-LONG(lpbi,21) = 0. /* lpfn, callback function */
PUT-LONG(lpbi,25) = 0. /* lParam for lpfn */
PUT-LONG(lpbi,29) = 0.
RUN SHBrowseForFolder IN hpApi ( INPUT GET-POINTER-VALUE(lpbi),
OUTPUT lpItemIDList ).
/* parse the result: */
IF lpItemIDList=0 THEN DO:
Canceled = YES.
FolderName = "".
END.
ELSE DO:
Canceled = NO.
FolderName = FILL(" ", MAX_PATH).
RUN SHGetPathFromIDList IN hpApi(lpItemIDList,
OUTPUT FolderName,
OUTPUT ReturnValue).
FolderName = TRIM(FolderName).
END.
/* free memory: */
SET-SIZE(lpbi)=0.
SET-SIZE(pszDisplayName)=0.
SET-SIZE(lpszTitle)=0.
RUN CoTaskMemFree (lpItemIDList).
PROCEDURE CoTaskMemFree EXTERNAL "ole32.dll" :
DEFINE INPUT PARAMETER lpVoid AS LONG.
END PROCEDURE.
Documentation says that SHBrowseForFolder is not supported on Windows NT. However the above procedure was tested on Windows NT and seemed to work fine.
The memory occupied by lpItemIDList can be freed by CoTaskMemFree. This was discovered by Todd G. Nist who explains "This will free the memory the shell allocated for the ITEMIDLIST structure which consists of one or more consecutive ITEMIDLIST structures packed on byte boundaries, followed by a 16-bit zero value. An application can walk a list of item identifiers by examining the size specified in each SHITEMID structure and stopping when it finds a size of zero. A pointer to an item identifier list, is called a PIDL (pronounced piddle.) "
An different but very interesting approach is to use COM Automation: the "shell.application" interface contains a BrowseForFolder function. There is an example in article 18823 of the Progress Knowledgebase.
There is a different example by Julian Lyndon-Smith on page BrowseForFolder using COM
SHBrowseForFolder supports the use of a callback function from where you can specify an initial folder or perform some validations. Unfortunately, callback functions can not be written in Progress 4GL so you will have to wrap it in a DLL. This has been done by Cyril O'Floinn, see BrowseForFolder with an initial folder
Instead of using API-function SHBrowseForFolder to select a directory, you can also use the COM-interface of the "Shell".
There is an example in article 18823 of the Progress Knowledgebase.
Julian Lyndon-Smith wrote the following example, different from the one in the Knowledge Base.
FUNCTION DotRGetFolder RETURNS CHARACTER
( INPUT ip_cTitle AS CHARACTER /* title for browse dialog */ ) :
/* constants for BrowseForFolder options */
&SCOPED BIF_RETURNONLYFSDIRS 1
&SCOPED BIF_DONTGOBELOWDOMAIN 2
DEFINE VARIABLE lv_chShell AS COM-HANDLE NO-UNDO. /* shell application */
DEFINE VARIABLE lv_chFolder AS COM-HANDLE NO-UNDO. /* holder for selected folder object */
DEFINE VARIABLE lv_cPathName AS CHARACTER NO-UNDO. /* folder pathame */
IF ip_cTitle EQ "":U OR ip_cTitle EQ ? THEN
ASSIGN ip_cTitle = "Select Folder".
/* create Shell Automation object */
CREATE "Shell.Application":U lv_chShell NO-ERROR.
IF NOT VALID-HANDLE(lv_chShell) THEN
RETURN "":u. /* automation object not present on system */
/* execute the browseForFolderMethod */
lv_chFolder = lv_chShell:BrowseForFolder(CURRENT-WINDOW:HWND,
ip_cTitle,
{&BIF_DONTGOBELOWDOMAIN}
+ {&BIF_RETURNONLYFSDIRS}).
/* see if user has selected a valid folder */
IF VALID-HANDLE(lv_chFolder) AND lv_chFolder:SELF:IsFolder THEN
ASSIGN lv_cPathName = lv_chFolder:SELF:Path.
ELSE
ASSIGN lv_cPathName = "":U.
/* always release com objects when done */
RELEASE OBJECT lv_chFolder NO-ERROR.
RELEASE OBJECT lv_chShell NO-ERROR.
RETURN lv_cPathName.
END FUNCTION.
Cyril O'Floinn has wrapped function SHBrowseForFolder into a higher-level DLL function, named BrowseForFolder. This has the advantage of being able to specify an initial directory.
The source for this new function is written in Delphi and is added to PROEXTRA.DLL.
The declaration is added to PROEXTRA.P and looks like this:
PROCEDURE BrowseForFolder EXTERNAL {&ProExtra} :
DEFINE INPUT PARAMETER hWndOwner AS LONG.
DEFINE INPUT PARAMETER lpTitle AS CHARACTER.
DEFINE INPUT PARAMETER uiFlags AS LONG.
DEFINE INPUT PARAMETER lpInitialFolder AS CHARACTER.
DEFINE OUTPUT PARAMETER lpFolder AS CHARACTER.
DEFINE RETURN PARAMETER BoolRetVal AS LONG.
END PROCEDURE.
PROEXTRA.DLL and PROEXTRA.P are part of 'everything.zip' November 29, 1998 and can be downloaded from page windows.i and hpApi.
Cyril also made an example procedure, demonstrating the options of this function. This example is attached.
folder.w.zip : example
by Todd G. Nist
Program source is available for download: w-createshortcut.p
This program demonstrates how to create a shortcut in Windows and how to modify it. More specifically, the demo will create a folder called "SomeApplication", place a link to a "Readme.txt" file into the folder created, add it to the end users desktop, and create a link to this website under "Favorites".
By using the SHAddToRecentDocs() call, a shortcut can be created on the fly and added to the user's Documents item on the Start menu. Then by using the SHFileOperation function, one can move and rename files or folders across drives. By applying the SHGetSpecialFolderLocation API, we can get the current user's "Special" systems paths - their Start Menu, their Recent Files path, and others.
The code uses SHAddToRecentDocs to create shortcuts, SHGetSpecialFolderLocation to find the appropriate folders for the system, and SHFileOperation to create a folder, move and then rename the shortcuts. The end result is the ability to create any shortcut you want, to any file you want, and place it anywhere on the user's system. The example code does not do all the necessary error checking so if run more then once, you may encounter errors.
API-procedures used in this example are listed here to be included in the search index: PROCEDURE SHAddToRecentDocs EXTERNAL "shell32.dll" : PROCEDURE SHFileOperationA EXTERNAL "shell32.dll" : PROCEDURE SHGetPathFromIDListA EXTERNAL "shell32.dll" : PROCEDURE SHGetSpecialFolderLocation EXTERNAL "shell32.dll" : PROCEDURE SHChangeNotify EXTERNAL "shell32.dll" : PROCEDURE CoTaskMemFree EXTERNAL "ole32.dll" : PROCEDURE GetTempPathA EXTERNAL "kernel32.dll" : PROCEDURE Sleep EXTERNAL "kernel32.dll" : PROCEDURE FindClose EXTERNAL "kernel32.dll" : PROCEDURE FindFirstFileA EXTERNAL "kernel32.dll" :
w-createshortcut.p.zip : example
Hi there,
Working with an NTFS based operating system, I'd like to link so-called "File Summary Information" with our R-Codes (and get the "Summary" tab when accessing the "properties" of a R-Code in the Windows Explorer... just like .DOC, .XLS,... files).
I've seen that we have to use these functions to achieve this:
stgCreateStorageEx (to create a "File Summary Information" structure);
stgOpenStorageEx (to access the structure);
SetFileSummaryInfo (to fill the structure with info).
Does anyone have yet "played" with these functions, or have any advice or sample I can use to set this up?
Thanks in advance,
This code was posted to PEG by Jared Middleton.
/*******************************************************************
Procedure: shellfile.p
Description: Demo program to access File Summary Properties
using Shell FolderItems object GetDetailsOf method.
Written by: Jared Middleton (January 17, 2007)
*******************************************************************/
DEFINE VAR chApp AS COM-HANDLE NO-UNDO.
DEFINE VAR chFolder AS COM-HANDLE NO-UNDO.
DEFINE VAR chFolderItem AS COM-HANDLE NO-UNDO.
DEFINE VAR cFile AS CHARACTER NO-UNDO.
DEFINE VAR cDir AS CHARACTER NO-UNDO.
DEFINE VAR cBase AS CHARACTER NO-UNDO.
DEFINE VAR lOpen AS LOGICAL NO-UNDO.
DEFINE VAR cLabel AS CHARACTER NO-UNDO FORMAT "x(24)".
DEFINE VAR cValue AS CHARACTER NO-UNDO FORMAT "x(50)".
DEFINE FRAME frmDisp
cLabel
cValue
WITH NO-LABELS DOWN.
SYSTEM-DIALOG GET-FILE cFile
FILTERS
'All Files (*.*)' '*.*',
'MP3 Files (*.mp3)' '*.mp3', /* optional */
'JPG Files (*.jpg,*.jpeg)' '*.jpg,*.jpeg' /* optional */
UPDATE lOpen.
IF NOT lOpen THEN RETURN.
CREATE "Shell.Application" chApp NO-ERROR.
IF VALID-HANDLE(chApp) THEN DO:
ASSIGN cDir = SUBSTRING(cFile,1,R-INDEX(cFile,"\") - 1)
cBase = SUBSTRING(cFile,LENGTH(cDir) + 2).
ASSIGN chFolder = chApp:Namespace(cDir).
IF VALID-HANDLE(chFolder) THEN DO:
ASSIGN chFolderItem = chFolder:ParseName(cBase).
/* Extended File Properties are OS version specific.
The following are valid for Windows XP/2003 */
IF VALID-HANDLE(chFolderItem) THEN DO:
RUN get-item ("File:",0).
RUN get-item ("Size:",1).
RUN get-item ("Type:",2).
RUN get-item ("Title:",10).
RUN get-item ("Subject:",11).
RUN get-item ("Category:",12).
RUN get-item ("Artist:",16).
RUN get-item ("Album:",17).
RUN get-item ("Year:",18).
RUN get-item ("Track:",19).
RUN get-item ("Genre:",20).
RUN get-item ("Duration:",21).
RUN get-item ("Bit Rate:",22).
/*RUN get-item ("Protected:",23).*/
/*RUN get-item ("Episode Name:",29).*/
/*RUN get-item ("Audio Sample Size:",32).*/
RUN get-item ("Audio Sample Rate:",33).
RUN get-item ("Channels:",34).
RUN get-item ("Camera Model:",24).
RUN get-item ("Date Taken:",25).
/*RUN get-item ("Dimensions:",26).*/
RUN get-item ("Width:",27).
RUN get-item ("Height:",28).
END.
END.
END.
RELEASE OBJECT chFolderItem NO-ERROR.
RELEASE OBJECT chFolder NO-ERROR.
RELEASE OBJECT chApp NO-ERROR.
PROCEDURE get-item:
DEFINE INPUT PARAMETER l-cLabel AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER l-cItem AS INTEGER NO-UNDO.
DEFINE VAR l-cValue AS CHARACTER NO-UNDO.
DO WITH FRAME frmDisp:
ASSIGN l-cValue = chFolder:GetDetailsOf(chFolderItem,l-cItem).
IF l-cValue > "" THEN DO:
DISPLAY l-cLabel @ cLabel
l-cValue @ cValue.
DOWN.
END.
END.
END PROCEDURE.
/* End of program */
Most win32 binaries, like executables (exe), dynamic link libraries (dll) and automation controls (ocx) contain a version information structure. The data in this version information structure is used by setup programs to decide if it's ok to overwrite the file.
The version information can also be useful for support engineers for determining why a feature doesn't work as expected. Especially when used in a list of all modules loaded by the current Progress process, see ListModules.
Typically a file contains both a productversion and fileversion. The version info structure may also contain strings describing the file or its publisher, but this textual information is kind of difficult to read because they are grouped together in codepage blocks. Productversion and fileversion are not language specific so these are easier to read.
DEFINE VARIABLE vProductVersion AS CHARACTER NO-UNDO.
DEFINE VARIABLE vFileVersion AS CHARACTER NO-UNDO.
RUN GetProductVersion ( 'c:\windows\system\mfc42.dll',
OUTPUT vProductVersion,
OUTPUT vFileVersion).
MESSAGE vProductVersion SKIP
vFileVersion
VIEW-AS ALERT-BOX.
/* shows 6.0.1.0
6.0.8267.0
on my system. This indicates someone or something installed the
runtime modules for MS Visual Studio 6 */
PROCEDURE GetProductVersion :
DEFINE INPUT PARAMETER pFilename AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER pProductVersion AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER pFileVersion AS CHARACTER NO-UNDO.
DEFINE VARIABLE dummy AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
DEFINE VARIABLE lpVersionInfo AS MEMPTR NO-UNDO. /* VS_VERSION_INFO structure */
DEFINE VARIABLE lpFixedFileInfo AS MEMPTR NO-UNDO. /* VS_FIXEDFILEINFO structure */
DEFINE VARIABLE versize AS INTEGER NO-UNDO. /* size of lpVersionInfo */
DEFINE VARIABLE ptrInfo AS INTEGER NO-UNDO. /* address of lpFixedFileInfo */
DEFINE VARIABLE cInfo AS INTEGER NO-UNDO. /* size of lpFixedFileInfo */
RUN GetFileVersionInfoSizeA (pFileName,
OUTPUT dummy,
OUTPUT versize).
IF versize = 0 THEN RETURN.
SET-SIZE(lpVersionInfo) = 0.
SET-SIZE(lpVersionInfo) = versize.
RUN GetFileVersionInfoA ( pFileName,
0,
INPUT versize,
INPUT GET-POINTER-VALUE(lpVersionInfo),
OUTPUT returnvalue).
IF returnvalue = 0 THEN DO:
SET-SIZE(lpVersionInfo) = 0.
RETURN.
END.
RUN VerQueryValueA (GET-POINTER-VALUE(lpVersionInfo),
"\":U,
OUTPUT ptrInfo,
OUTPUT cInfo,
OUTPUT returnvalue).
IF NOT (returnvalue=0 OR cInfo=0) THEN DO:
SET-SIZE(lpFixedFileInfo) = cInfo.
SET-POINTER-VALUE(lpFixedFileInfo) = ptrInfo.
pProductVersion = STRING(GET-SHORT (lpFixedFileInfo,19)) + '.' +
STRING(GET-SHORT (lpFixedFileInfo,17)) + '.' +
STRING(GET-SHORT (lpFixedFileInfo,23)) + '.' +
STRING(GET-SHORT (lpFixedFileInfo,21)).
pFileVersion = STRING(GET-SHORT (lpFixedFileInfo,11)) + '.' +
STRING(GET-SHORT (lpFixedFileInfo, 9)) + '.' +
STRING(GET-SHORT (lpFixedFileInfo,15)) + '.' +
STRING(GET-SHORT (lpFixedFileInfo,13)).
END.
SET-SIZE (lpVersionInfo) = 0.
/* ------ DON'T DO THIS: --------
SET-SIZE (lpFixedFileInfo) = 0. */
END PROCEDURE.
Definitions used in this procedure:
PROCEDURE GetFileVersionInfoSizeA EXTERNAL "version.dll" : DEFINE INPUT PARAMETER lptstrFilename AS CHARACTER. DEFINE OUTPUT PARAMETER lpdwHandle AS LONG. DEFINE RETURN PARAMETER VersionInfoSize AS LONG. END PROCEDURE. PROCEDURE GetFileVersionInfoA EXTERNAL "version.dll" : DEFINE INPUT PARAMETER lptstrFilename AS CHARACTER. DEFINE INPUT PARAMETER dwHandle AS LONG. DEFINE INPUT PARAMETER dwLen AS LONG. DEFINE INPUT PARAMETER lpData AS LONG. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE. PROCEDURE VerQueryValueA EXTERNAL "version.dll" : DEFINE INPUT PARAMETER lpBlock AS LONG. DEFINE INPUT PARAMETER lpSubBlock AS CHARACTER. DEFINE OUTPUT PARAMETER lplpBuffer AS LONG. DEFINE OUTPUT PARAMETER puLen AS LONG. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE.
by Stuart Morris
This allows you to call a standard system dialog for formatting Floppy disks and Hard drives etc.
/* S.A.Morris - 01/02/2000 */
&GLOB SHFD_CAPACITY_DEFAULT 0 /* default drive capacity */
&GLOB SHFD_CAPACITY_360 3 /* 360KB, applies to 5.25" drives only */
&GLOB SHFD_CAPACITY_720 5 /* 720KB, applies to 3.5" drives only */
&GLOB SHFD_FORMAT_QUICK 0 /* quick format */
&GLOB SHFD_FORMAT_FULL 1 /* full format */
&GLOB SHFD_FORMAT_SYSONLY 2 /* copies system files only (Win95 Only!) */
DEFINE VARIABLE RESULT AS INTEGER NO-UNDO.
PROCEDURE SHFormatDrive EXTERNAL "shell32.dll" :
DEFINE INPUT PARAM hwndOwner AS LONG.
DEFINE INPUT PARAM iDrive AS LONG.
DEFINE INPUT PARAM iCapacity AS LONG.
DEFINE INPUT PARAM iFormatType AS LONG.
DEFINE OUTPUT PARAM lpResult AS LONG.
END PROCEDURE.
RUN SHFormatDrive (INPUT CURRENT-WINDOW:HWND,
0, /* Drive A=0, B=1 (if present, otherwise C=1 etc) */
{&SHFD_CAPACITY_DEFAULT},
{&SHFD_FORMAT_QUICK},
OUTPUT RESULT
)
NO-ERROR. /* Needs this to stop Stack Errors */
function GetShortPathName retrieves the 8.3 pathname for an existing long pathname.
PROCEDURE GetShortPathNameA EXTERNAL "kernel32.dll" :
DEFINE INPUT PARAMETER lpszLongPath AS CHARACTER.
DEFINE OUTPUT PARAMETER lpszShortPath AS CHARACTER.
DEFINE INPUT PARAMETER cchBuffer AS LONG.
DEFINE RETURN PARAMETER ReturnValue AS LONG.
END PROCEDURE.
DEFINE VARIABLE longname AS CHARACTER NO-UNDO.
DEFINE VARIABLE shortname AS CHARACTER NO-UNDO.
DEFINE VARIABLE returnvalue AS INTEGER NO-UNDO.
&GLOB shortsize 68
longname = "C:\Program Files\VendorName\Some Application\Data\Monthly Revenue.txt".
shortname = FILL("-", {&shortsize}).
RUN GetShortPathNameA (longname,
OUTPUT shortname,
LENGTH(shortname),
OUTPUT ReturnValue).
IF ReturnValue > {&shortsize} THEN
MESSAGE "buffer too short, specify at least " ReturnValue.
ELSE
IF ReturnValue = 0 THEN
MESSAGE "file does not exist".
ELSE
shortname = ENTRY(1, shortname, CHR(0)).
MESSAGE GetSpecialFolder({&CSIDL_SYSTEM}) VIEW-AS ALERT-BOX.
will return "c:\windows\system" or "c:\winnt\system32" or whatever is valid on your PC.
There are different implementations of this function. This page shows one by Stuart Morris and one by Jan Verley.
by Stuart Morris, stuart@IBS-PUBLIC-SERVICES.co.uk
PROCEDURE SHGetPathFromIDListA EXTERNAL "shell32.dll":U :
DEFINE INPUT PARAMETER pidl AS LONG.
DEFINE OUTPUT PARAMETER pszPath AS CHARACTER.
DEFINE RETURN PARAMETER iResult AS LONG.
END PROCEDURE.
PROCEDURE SHGetSpecialFolderLocation EXTERNAL "shell32.dll":U :
DEFINE INPUT PARAMETER hwndOwner AS LONG.
DEFINE INPUT PARAMETER nFolder AS LONG.
DEFINE OUTPUT PARAMETER pidl AS LONG.
DEFINE RETURN PARAMETER iResult AS LONG.
END PROCEDURE.
PROCEDURE CoTaskMemFree EXTERNAL "ole32.dll":U :
DEFINE INPUT PARAMETER lpPidl AS LONG.
END PROCEDURE.
FUNCTION GetSpecialFolder RETURNS CHARACTER (INPUT iCSIDL AS INT):
/*-----------------------------------------------------------
Purpose:
Notes:
-------------------------------------------------------------*/
DEFINE VARIABLE iResult AS INTEGER NO-UNDO.
DEFINE VARIABLE cPath AS CHARACTER NO-UNDO.
DEFINE VARIABLE pidl AS INTEGER NO-UNDO.
RUN SHGetSpecialFolderLocation (INPUT 0,
INPUT iCSIDL,
OUTPUT pidl,
OUTPUT iResult
).
IF iResult = 0 THEN DO:
cPath = FILL(' ', {&MAX_PATH}).
RUN SHGetPathFromIDListA(INPUT pidl,
OUTPUT cPath,
OUTPUT iResult
).
RUN CoTaskMemFree(INPUT pidl).
IF iResult GT 0 THEN
RETURN TRIM(cPath) + '\':U.
END.
RETURN "". /* Function return value. */
END FUNCTION.
by Jan Verley, jverle@softcell.be
Jan made a similar function, using SHGetFolderPathA in shfolder.dll. SHGetFolderPathA is more programmer-friendly because it simply returns the path as a string, not as as pidl. SHGetFolderPathA is a wrapper to lower-level procedures, it selects the appropriate procedures matching the current Windows version. Another interesting aspect is that this procedure lets you impersonate any user to get his/her personal folders. The downside is that SHGetFolderPathA doesn't support every defined CSIDL.
Info (for Visual Basic programmers) about this on: http:www.mvps.org/vbnet/code/shell/csidl.htm and on http:developer.earthweb.com/journal/techworkshop/020400_vbwin2k.html
Be careful: shfolder.dll may not be available on your target machine. It is a freely redistributable dll and ships with Win2000 and NT4 service pack 4 and later, IE5, Win98 Second Edition and probably ships with other MS products as well.
PROCEDURE SHGetFolderPathA EXTERNAL "shfolder.dll":U :
DEFINE INPUT PARAMETER hwndOwner AS LONG.
DEFINE INPUT PARAMETER nFolder AS LONG.
DEFINE INPUT PARAMETER hToken AS LONG.
DEFINE INPUT PARAMETER dwFlags AS LONG.
DEFINE OUTPUT PARAMETER pszPath AS CHARACTER.
DEFINE RETURN PARAMETER hResult AS LONG.
END PROCEDURE.
FUNCTION GetSpecialFolder RETURNS CHARACTER (INPUT iCSIDL AS INT):
/*-----------------------------------------------------------
Purpose:
Notes:
-------------------------------------------------------------*/
DEFINE VARIABLE op_dir AS CHARACTER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
ASSIGN op_dir = FILL (" " ,{&MAX_PATH}).
RUN SHGetFolderPathA (INPUT 0,
INPUT iCSIDL,
INPUT 0,
INPUT 0,
OUTPUT op_dir,
OUTPUT ReturnValue).
RETURN TRIM(op_dir).
END FUNCTION.
Constants used in this example, and a few more. This is a subset from te list in [[winconst]] wikilink.zip.
&GLOBAL-DEFINE CSIDL_ADMINTOOLS 48 &GLOBAL-DEFINE CSIDL_ALTSTARTUP 29 &GLOBAL-DEFINE CSIDL_APPDATA 26 &GLOBAL-DEFINE CSIDL_BITBUCKET 10 &GLOBAL-DEFINE CSIDL_COMMON_ADMINTOOLS 47 &GLOBAL-DEFINE CSIDL_COMMON_ALTSTARTUP 30 &GLOBAL-DEFINE CSIDL_COMMON_DESKTOPDIRECTORY 25 &GLOBAL-DEFINE CSIDL_COMMON_DOCUMENTS 46 &GLOBAL-DEFINE CSIDL_COMMON_FAVORITES 31 &GLOBAL-DEFINE CSIDL_COMMON_PROGRAMS 23 &GLOBAL-DEFINE CSIDL_COMMON_STARTMENU 22 &GLOBAL-DEFINE CSIDL_COMMON_STARTUP 24 &GLOBAL-DEFINE CSIDL_COMMON_TEMPLATES 45 &GLOBAL-DEFINE CSIDL_CONTROLS 3 &GLOBAL-DEFINE CSIDL_COOKIES 33 &GLOBAL-DEFINE CSIDL_DESKTOP 0 &GLOBAL-DEFINE CSIDL_DESKTOPDIRECTORY 16 &GLOBAL-DEFINE CSIDL_DRIVES 17 &GLOBAL-DEFINE CSIDL_FAVORITES 6 &GLOBAL-DEFINE CSIDL_FONTS 20 &GLOBAL-DEFINE CSIDL_HISTORY 34 &GLOBAL-DEFINE CSIDL_INTERNET 1 &GLOBAL-DEFINE CSIDL_INTERNET_CACHE 32 &GLOBAL-DEFINE CSIDL_LOCAL_APPDATA 28 &GLOBAL-DEFINE CSIDL_MYPICTURES 39 &GLOBAL-DEFINE CSIDL_NETHOOD 19 &GLOBAL-DEFINE CSIDL_NETWORK 18 &GLOBAL-DEFINE CSIDL_PERSONAL 5 &GLOBAL-DEFINE CSIDL_PRINTERS 4 &GLOBAL-DEFINE CSIDL_PRINTHOOD 27 &GLOBAL-DEFINE CSIDL_PROFILE 40 &GLOBAL-DEFINE CSIDL_PROGRAMS 2 &GLOBAL-DEFINE CSIDL_PROGRAM_FILES 38 &GLOBAL-DEFINE CSIDL_PROGRAM_FILESX86 42 &GLOBAL-DEFINE CSIDL_PROGRAM_FILES_COMMON 43 &GLOBAL-DEFINE CSIDL_PROGRAM_FILES_COMMONX86 44 &GLOBAL-DEFINE CSIDL_RECENT 8 &GLOBAL-DEFINE CSIDL_SENDTO 9 &GLOBAL-DEFINE CSIDL_STARTMENU 11 &GLOBAL-DEFINE CSIDL_STARTUP 7 &GLOBAL-DEFINE CSIDL_SYSTEM 37 &GLOBAL-DEFINE CSIDL_SYSTEMX86 41 &GLOBAL-DEFINE CSIDL_TEMPLATES 21 &GLOBAL-DEFINE CSIDL_WINDOWS 36 &GLOBAL-DEFINE CSIDL_FLAG_CREATE 32768 &GLOBAL-DEFINE CSIDL_FLAG_DONT_VERIFY 16384 &GLOBAL-DEFINE CSIDL_FLAG_MASK 65280 &GLOBAL-DEFINE MAX_PATH 260
This page explains how to find the size (in bytes) of a certain file, the long and short filenames, the date and time a file was last modified. It also shows a way to get a directory listing.
This is based on a rather large procedure library, file-api.p and file-api.i, which are available in everything.zip in page windows.i and hpApi
To use any of the functions in library file-api.p simply include {file-api.i} in the definitions section of your program. This will define some constants you might want to use and it runs file-api.p persistent in handle hpFileApi.
The library file-api.p defines a couple of API functions but you will probably not run these directly. Instead, you will probably run one of the 4GL internal procedures in there.
The procedures work with a memptr to a WIN32_FIND_DATA structure. So the procedures will either have an output parameter or an input parameter of this type. You don't have to allocate or fill this structure or fetch information from it; this is all done by the procedures themselves.
Here's an example of getting information about file "c:\autoexec.bat" :
{file-api.i}
DEFINE VARIABLE lpFindData AS MEMPTR.
DEFINE VARIABLE longname AS CHARACTER.
DEFINE VARIABLE shortname AS CHARACTER.
DEFINE VARIABLE SIZE AS INTEGER.
DEFINE VARIABLE chDate AS DATE.
DEFINE VARIABLE chTime AS INTEGER.
/* get a lpFindData structure */
RUN FileFind IN hpFileApi ("c:\autoexec.bat", OUTPUT lpFindData).
/* read information from the lpFileInfo structure */
RUN FileInfo_LongName IN hpFileApi(lpFindData, OUTPUT longname).
RUN FileInfo_ShortName IN hpFileApi(lpFindData, OUTPUT shortname).
RUN FileInfo_Size IN hpFileApi(lpFindData, OUTPUT SIZE).
RUN FileInfo_LastWrite IN hpFileApi(lpFindData, OUTPUT chDate, OUTPUT chTime).
MESSAGE
"name=" longname SKIP
"short name=" shortname SKIP
"modified=" chDate STRING(chTime,"hh:mm:ss") SKIP
"size=" SIZE " bytes"
VIEW-AS ALERT-BOX.
The general idea is: find the first file in the directory and repeat to find the next file until no more files are found. This loop is performed by the procedure FileFindLoop in file-api.p. Whenever it finds a file, it runs an internal procedure you specified with an lpFindData pointer as input parameter. Example:
{file-api.i}
RUN FileFindLoop IN hpFileApi ("d:\progress\*.p", /* mask, must contain wildcards */
"ProcessOneFile", /* name of callback procedure */
THIS-PROCEDURE:HANDLE). /* location of callback proc */
PROCEDURE ProcessOneFile :
DEFINE INPUT PARAMETER lpFindData AS MEMPTR.
/* do whatever you like here, for example show the file name
if modified within last 3 days */
DEFINE VARIABLE longname AS CHARACTER NO-UNDO.
DEFINE VARIABLE chDate AS DATE NO-UNDO.
DEFINE VARIABLE chTime AS INTEGER NO-UNDO.
RUN FileInfo_LongName IN hpFileApi(lpFindData, OUTPUT longname).
RUN FileInfo_LastWrite IN hpFileApi(lpFindData, OUTPUT chDate, OUTPUT chTime).
IF chDate> TODAY - 3 THEN
MESSAGE longname VIEW-AS ALERT-BOX.
END PROCEDURE.
The callback procedure in the above example will be called for every file that meets the mask, these can include files or (sub)directories. Often you will want to show only directories, or only files, or only files that have the Archive-bit set, or skip all hidden and system files. Whatever. In those cases you will need to test the file attributes during the callback function.
File attributes are one DWORD where each bit represents one certain attribute. The attributes are stored in the first element of the lpFindData structure, the meaning of the different bits is listed in file-api.i for your convenience. To test for the presence of a certain bit you must use binary logic (the AND), covered on page "Bitwise operators using ProExtra.DLL".
So if you want to make sure if a file is actually a directory, you would include a test like this:
{file-api.i}
PROCEDURE ProcessOneFile :
DEFINE INPUT PARAMETER lpFindData AS MEMPTR.
DEFINE VARIABLE attribs AS INTEGER NO-UNDO.
DEFINE VARIABLE RESULT AS INTEGER NO-UNDO.
attribs = GET-LONG(lpFindData,1).
RUN Bit_And IN hpExtra(attribs, {&DDL_DIRECTORY}, OUTPUT RESULT).
IF result NE 0 THEN DO:
/* whatever you want to do with a directory */
END.
ELSE DO:
/* whatever you want to do with a file */
END.
END PROCEDURE.
Note that flag DDL_READWRITE has value 0. This is a brain teaser: it can't be set, so you can't test for its presence! The definition says: a file is READWRITE unless any other bit is set. In other words: you don't use Bit_And() to test if attribs contains DDL_READWRITE, but you simply test if attribs=DDL_READWRITE.
by Michael Rüsweg-Gilbert
Procedure WNetGetConnection retrieves the name of the network resource associated with a local device. In other words, it can be used to get the UNC name for a mapped network drive or printer. If K: is the drive letter of a mapped network drive, the following example finds the UNC name for this network drive.
DEFINE VARIABLE Drive_Name AS CHARACTER NO-UNDO INIT "K:".
DEFINE VARIABLE UNC_Name AS CHARACTER NO-UNDO.
DEFINE VARIABLE namelen AS INTEGER NO-UNDO INITIAL 100.
DEFINE VARIABLE retBool AS INTEGER NO-UNDO.
UNC_Name = FILL("x",namelen).
RUN WNetGetConnectionA ( Drive_Name,
OUTPUT UNC_Name,
INPUT-OUTPUT namelen,
OUTPUT retBool).
IF retBool = 0 THEN
UNC_Name = SUBSTRING(UNC_Name, 1, namelen).
ELSE
UNC_Name = "".
MESSAGE
UNC_Name
VIEW-AS ALERT-BOX.
API definitions used in this exampe, not listed in windows.p :
PROCEDURE WNetGetConnectionA EXTERNAL "mpr.dll" : DEFINE INPUT PARAMETER lpDrive AS CHARACTER. DEFINE OUTPUT PARAMETER lpUNCName AS CHARACTER. DEFINE INPUT-OUTPUT PARAMETER lpnLength AS LONG. DEFINE RETURN PARAMETER RetBool AS LONG. END PROCEDURE.
Code found in an e-mail to Peg, send by by Jeffrey L. Boyer
Sometimes you want to read a file and be sure that nobody else is writing to the file in the meantime. So you want to lock it for writing.
&GLOBAL-DEFINE GENERIC_WRITE 1073741824 /* &H40000000 */
&GLOBAL-DEFINE OPEN_EXISTING 3
&GLOBAL-DEFINE FILE_SHARE_READ 1 /* = &H1 */
&GLOBAL-DEFINE FILE_ATTRIBUTE_NORMAL 128 /* = &H80 */
PROCEDURE CreateFileA EXTERNAL "kernel32":
DEFINE INPUT PARAMETER lpFileName AS CHARACTER.
DEFINE INPUT PARAMETER dwDesiredAccess AS LONG.
DEFINE INPUT PARAMETER dwShareMode AS LONG.
DEFINE INPUT PARAMETER lpSecurityAttributes AS LONG.
DEFINE INPUT PARAMETER dwCreationDisposition AS LONG.
DEFINE INPUT PARAMETER dwFlagsAndAttributes AS LONG.
DEFINE INPUT PARAMETER hTemplateFile AS LONG.
DEFINE RETURN PARAMETER ReturnValue AS LONG.
END PROCEDURE.
PROCEDURE CloseHandle EXTERNAL "kernel32" :
DEFINE INPUT PARAMETER hObject AS LONG.
DEFINE RETURN PARAMETER ReturnValue AS LONG.
END PROCEDURE.
DEFINE VARIABLE lpSecurityAtt AS INTEGER NO-UNDO.
DEFINE VARIABLE hObject AS INTEGER NO-UNDO.
DEFINE VARIABLE nReturn AS INTEGER NO-UNDO.
/* Lock file agains writing */
RUN CreateFileA (INPUT source.txt,
INPUT {&GENERIC_WRITE},
{&FILE_SHARE_READ},
lpSecurityAtt,
{&OPEN_EXISTING},
{&FILE_ATTRIBUTE_NORMAL},
0,
OUTPUT hObject).
input from source.txt.
repeat:
import aline.
/* do stuff */
end.
input close.
/* Release file handle */
RUN CloseHandle (INPUT hObject,
OUTPUT nReturn).
Let's start with a couple of definitions:
&GLOBAL-DEFINE FILE_ATTRIBUTE_READONLY 1 &GLOBAL-DEFINE FILE_ATTRIBUTE_HIDDEN 2 &GLOBAL-DEFINE FILE_ATTRIBUTE_SYSTEM 4 &GLOBAL-DEFINE FILE_ATTRIBUTE_DIRECTORY 16 &GLOBAL-DEFINE FILE_ATTRIBUTE_ARCHIVE 32 &GLOBAL-DEFINE FILE_ATTRIBUTE_NORMAL 128 &GLOBAL-DEFINE FILE_ATTRIBUTE_COMPRESSED 2048 PROCEDURE SetFileAttributesA EXTERNAL "kernel32" : DEFINE INPUT PARAMETER lpFilename AS CHARACTER. DEFINE INPUT PARAMETER dwFileAttributes AS LONG. END. PROCEDURE GetFileAttributesA EXTERNAL "kernel32" : DEFINE INPUT PARAMETER lpFilename AS CHARACTER. DEFINE RETURN PARAMETER dwFileAttributes AS LONG. END.
The first example shows how to make a file read-only. It also clears most of the existing attributes because only one attribute is specified.
RUN SetFileAttributesA ( "c:\autoexec.bat", {&FILE_ATTRIBUTE_READONLY} ).
(Specify FILE_ATTRIBUTE_NORMAL to clear all attributes.)
The next example makes the file read-only and leaves the existing attributes intact.
DEFINE VARIABLE lv_attribs AS INTEGER NO-UNDO.
RUN GetFileAttributesA ( "c:\autoexec.bat", OUTPUT lv-attribs ).
/* if lv-attribs does not include {&FILE_ATTRIBUTE_READONLY} then */
RUN SetFileAttributesA ( "c:\autoexec.bat", lv-attribs + {&FILE_ATTRIBUTE_READONLY}).
The commented line should be replaced by an actual IF-statement. You can use procedure CheckOneAttribute by Dmitri, or a variant of his procedure, to test if the file already has the attribute set.
/* by Dmitri Levin, dlevin@ryland.com */ DEFINE VARIABLE lv-filename AS CHARACTER INIT "c:\autoexec.bat" NO-UNDO. DEFINE VARIABLE lv-attribs AS INTEGER NO-UNDO. DEFINE VARIABLE lv-attribs-list AS CHARACTER NO-UNDO. RUN GetFileAttributesA ( lv-filename, OUTPUT lv-attribs ). RUN CheckOneAttribute( lv-attribs, {&FILE_ATTRIBUTE_READONLY}, "READONLY", INPUT-OUTPUT lv-attribs-list). RUN CheckOneAttribute( lv-attribs, {&FILE_ATTRIBUTE_HIDDEN}, "HIDDEN", INPUT-OUTPUT lv-attribs-list). RUN CheckOneAttribute( lv-attribs, {&FILE_ATTRIBUTE_SYSTEM}, "SYSTEM", INPUT-OUTPUT lv-attribs-list). RUN CheckOneAttribute( lv-attribs, {&FILE_ATTRIBUTE_DIRECTORY}, "DIRECTORY", INPUT-OUTPUT lv-attribs-list). RUN CheckOneAttribute( lv-attribs, {&FILE_ATTRIBUTE_ARCHIVE}, "ARCHIVE", INPUT-OUTPUT lv-attribs-list). MESSAGE "File Attributes:" lv-attribs-list VIEW-AS ALERT-BOX. PROCEDURE CheckOneAttribute : DEFINE INPUT PARAMETER lp-attribs AS INTEGER NO-UNDO. DEFINE INPUT PARAMETER lp-attrib-num AS INTEGER NO-UNDO. DEFINE INPUT PARAMETER lp-attrib-name AS CHARACTER NO-UNDO. DEFINE INPUT-OUTPUT PARAMETER lp-attrib-list AS CHARACTER NO-UNDO. IF lp-attribs MOD ( lp-attrib-num * 2 ) GE lp-attrib-num THEN lp-attrib-list = lp-attrib-list + MIN(lp-attrib-list,", ") + lp-attrib-name. END.
by Simon Sweetman
This is a demo program that uses SHAutoComplete from shlwapi.dll to enable the Windows filename auto complete (like the Win2K file-open dialog) on an editor field, the same call can be used on a fill-in but it doesn?t work real well with progress. The editor version works fine except for TAB and BACK-TAB which seem to be trapped by SHAutoComplete before they get to progress.
by Scott Anderson, Stuart Morris and Jurjen
"SYSTEM-DIALOG GET-FILE" allows to select only one filename. When you want to select multiple filenames you can call API function GetOpenFileNameA, specifying the OFN_ALLOWMULTISELECT flag.
Procedure SelectMultipleFileNames uses GetOpenFileNameA for the purpose of selecting multiple filenames. The first listing shows how to call the procedure, the second listing shows the implementation of the procedure.
The parameters are:
* FilterList
a list of filters separated by 'pipe'-symbols ( "|" ). Each individual filter is a description, followed by a pipe-symbol, followed by a semicolon-separated list of wildcards. The format of the description is not important but by convention it should be a text followed by the list of wildcards between brackets. The first filter is the default.
* InitialDirectory
Name of the directory where you want to the dialog to start. Specify the unknown value (?) to start in the current directory.
* DialogTitle
Specifies the title for the dialog.
* FileNames
returns a comma-separated list of selected filenames unless OK=FALSE.
* OK
returns FALSE if the user selected the Cancel button.
DEFINE VARIABLE lv-Files AS CHARACTER NO-UNDO.
DEFINE VARIABLE OK AS LOGICAL NO-UNDO.
RUN SelectMultipleFileNames (INPUT "Word Documents (*.doc,*.rtf)|*.doc;*.rtf" + "|" +
"Excel Worksheets (*.xls)|*.xls" + "|" +
"Access Databases (*.mdb)|*.mdb" + "|" +
"All (doc,rtf,xls,mdb,ppt)|*.doc;*.rtf;*.xls;*.mdb;*.ppt",
INPUT "C:\My Documents",
INPUT "Select one or more Office documents",
OUTPUT lv-Files,
OUTPUT OK
).
IF OK THEN
MESSAGE "you selected these files:" SKIP
lv-Files
VIEW-AS ALERT-BOX.
ELSE
MESSAGE "you pressed Cancel" VIEW-AS ALERT-BOX.
&GLOBAL-DEFINE OFN_OVERWRITEPROMPT 2
&GLOBAL-DEFINE OFN_HIDEREADONLY 4
&GLOBAL-DEFINE OFN_NOCHANGEDIR 8
&GLOBAL-DEFINE OFN_ALLOWMULTISELECT 512
&GLOBAL-DEFINE OFN_PATHMUSTEXIST 2048
&GLOBAL-DEFINE OFN_FILEMUSTEXIST 4096
&GLOBAL-DEFINE OFN_NOREADONLYRETURN 32768
&GLOBAL-DEFINE OFN_EXPLORER 524288
PROCEDURE GetOpenFileNameA EXTERNAL "comdlg32.dll" :
DEFINE INPUT PARAMETER lpOfn AS LONG.
DEFINE RETURN PARAMETER pReturn AS LONG.
END PROCEDURE.
PROCEDURE SelectMultipleFileNames :
/*------------------------------------------------------------------------------
Purpose: Replaces the SYSTEM-DIALOG-GET-FILE common dialog,
supports multiselect.
Parameters:
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER FilterList AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER InitialDirectory AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER DialogTitle AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER FileNames AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER OK AS INTEGER NO-UNDO.
DEFINE VARIABLE Flags AS INTEGER NO-UNDO.
DEFINE VARIABLE lpOfn AS MEMPTR NO-UNDO.
DEFINE VARIABLE lpstrFilter AS MEMPTR NO-UNDO.
DEFINE VARIABLE lpstrTitle AS MEMPTR NO-UNDO.
DEFINE VARIABLE lpstrInitialDir AS MEMPTR NO-UNDO.
DEFINE VARIABLE lpstrFile AS MEMPTR NO-UNDO.
DEFINE VARIABLE offset AS INTEGER NO-UNDO.
/* Flags controls the behaviour and appearance of the dialog-box.
There is much room for experiments. This combination works nice: */
Flags = {&OFN_ALLOWMULTISELECT} +
{&OFN_EXPLORER} +
{&OFN_NOCHANGEDIR}.
/* convert the "|"-separated list of filters to a CHR(0)-separated
list and make sure it's terminated with a double CHR(0): */
FilterList = TRIM(FilterList,"|") + "|". /* this will cause the double CHR(0) */
SET-SIZE(lpstrFilter) = LENGTH(FilterList) + 1.
PUT-STRING(lpstrFilter, 1) = FilterList.
DO offset=1 TO GET-SIZE(lpstrFilter) :
IF GET-BYTE(lpstrFilter,offset)=124 /* =ASC("|") */ THEN
PUT-BYTE(lpstrFilter,offset)=0.
END.
/* get memory-pointers to the string parameters: */
SET-SIZE(lpstrFile) = 1024. /* room for a couple of files... */
PUT-BYTE(lpstrFile,1) = 0. /* don't initialize dialog to a file */
SET-SIZE(lpstrTitle) = LENGTH(DialogTitle) + 1.
PUT-STRING(lpstrTitle,1) = DialogTitle.
IF InitialDirectory NE ? THEN DO:
SET-SIZE(lpstrInitialDir) = LENGTH(InitialDirectory) + 1.
PUT-STRING(lpstrInitialDir,1) = InitialDirectory.
END.
/* create and initialize an OPENFILENAME structure: */
SET-SIZE(lpOfn) = 76. /* = {&OPENFILENAME_SIZE_VERSION_400}
to be used in NT4 and Windows 95/98.
Windows 2000 supports a couple more fields. */
/* size */ PUT-LONG (lpOfn, 1) = GET-SIZE(lpOfn).
/* hwndOwner */ PUT-LONG (lpOfn, 5) = CURRENT-WINDOW:HWND.
/* hInstance */ PUT-LONG (lpOfn, 9) = 0.
/* lpstrFilter */ PUT-LONG (lpOfn,13) = GET-POINTER-VALUE(lpstrFilter).
/* lpstrCustomFilter */ PUT-LONG (lpOfn,17) = 0.
/* nMaxCustFilter */ PUT-LONG (lpOfn,21) = 0.
/* nFilterIndex */ PUT-LONG (lpOfn,25) = 0.
/* lpstrFile */ PUT-LONG (lpOfn,29) = GET-POINTER-VALUE(lpstrFile).
/* nMaxFile */ PUT-LONG (lpOfn,33) = GET-SIZE(lpstrFile).
/* lpstrFileTitle */ PUT-LONG (lpOfn,37) = 0.
/* nMaxFileTitle */ PUT-LONG (lpOfn,41) = 0.
/* lpstrInitialDir */ PUT-LONG (lpOfn,45) = GET-POINTER-VALUE(lpstrInitialDir).
/* lpstrTitle */ PUT-LONG (lpOfn,49) = GET-POINTER-VALUE(lpstrTitle).
/* flags */ PUT-LONG (lpOfn,53) = Flags.
/* nFileOffset */ PUT-SHORT(lpOfn,57) = 0.
/* nFileExtension */ PUT-SHORT(lpOfn,59) = 0.
/* lpstrDefExt */ PUT-LONG (lpOfn,61) = 0.
/* lCustData */ PUT-LONG (lpOfn,65) = 0.
/* lpfnHook */ PUT-LONG (lpOfn,69) = 0.
/* lpTemplateName */ PUT-LONG (lpOfn,73) = 0.
/* run the dialog: */
RUN GetOpenFileNameA (GET-POINTER-VALUE(lpOfn), OUTPUT OK).
/* release memory: */
SET-SIZE(lpstrFilter) = 0.
SET-SIZE(lpOfn) = 0.
SET-SIZE(lpstrTitle) = 0.
SET-SIZE(lpstrInitialDir) = 0.
/* lpstrFilter now contains a path, followed by CHR(0), followed
by a CHR(0)-separated list of filenames, terminated by a double CHR(0).
Unless the user selected only one file: then lpstrFilter will simply
contain the fully-qualified filename.
Either way, let's convert the result to a comma-separated list of
fully-qualified filenames: */
IF OK NE 0 THEN DO:
DEFINE VARIABLE cPath AS CHARACTER NO-UNDO.
DEFINE VARIABLE cList AS CHARACTER NO-UNDO.
DEFINE VARIABLE cFile AS CHARACTER NO-UNDO.
ASSIGN cPath = GET-STRING(lpstrFile,1)
offset = LENGTH(cPath) + 2.
REPEAT:
cFile = GET-STRING(lpstrFile, offset).
IF cFile = "" THEN LEAVE.
ASSIGN cList = cList + ',' + cPath + '\' + cFile
offset = offset + LENGTH(cFile) + 1.
END.
ASSIGN cList = TRIM(cList, ",")
FileNames = IF cList = "" THEN cPath ELSE cList.
END.
SET-SIZE(lpstrFile) = 0.
END PROCEDURE. /* SelectMultipleFileNames */
by Todd G. Nist
Program source is available for download: w-SHFileOp.p
By calling SHFileOperation, one can leverage the existing dialogs for moving files and providing user feed back as to the status of the process all with just one call. It is a fairly simple demo, where it will ask for a directory to be copied, accepting wild cards, a destination directory, a delete directory file specification and a title for the dialog box. Then by invoking the call to SHFileOperation the standard windows dialog box showing the folders and the flying documents will be displayed, this is making the assumption that the information being copied is large enough to allow the dialog to be created. Also, if the files already exist, it will bring up the standard dialog asking if you wish to over write, the size of the file and the date of the files in question. Finally, if delete files is chosen, it will remove the files from the "delete file spec" and bring up the same general dialogs.
To test just make sure you are coping a large file or directory structure. Once it has completed, choose "copy files" again and you should see all the standard dialogs. Finally, specify a delete file spec and choose "delete files".
API-procedures used in this example are listed here to be included in the search index: PROCEDURE SHFileOperationA EXTERNAL "Shell32.dll": PROCEDURE FormatMessageA EXTERNAL "kernel32.dll":
w-shfileop.p.zip : example
by Gordon Campbell
I created a test program that illustrates how to 'watch a folder' in MS Windows. The code can be downloaded at: http://www.epro-sys.com/samples/watchfolder.w The sample watches a directory called c:\watch\in and via an IP (ProcessFile) moves the contents to c:\watch\out. The ProcessFile IP can be modified to process a file in the 'in' directory. You could use this to automate conversion of text files to PDF via PDFinclude or automate the sending of documents to e-mail addresses .... or whatever automated process you would consider when dealing with a file. Later, Gordon Campbell WIKA Instruments Ltd.
This source code example uses the following Win32 API functions:
* FindFirstChangeNotificationA
* FindCloseChangeNotification
* FindNextChangeNotification
* WaitForSingleObject
Just to be on the safe side, I have also attached a copy of his source code:
watchfolder.w.zip : original from Gordon Campbell