We are very close to the first official version.
Some changes that may affect to your code:
All the classes share the same namespace name, "Afx", so remove the Afx.CwindowClass, etc., that we have been using, an use only
USING Afx
The CBSTR.inc file has been renamed as CWSTR.inc.
All the procedures that did return a CBSTR have been modified to return the faster CWSTR.
CBSTR strings and CWSTR strings work very well together: you can assign a CBSTR to a CWSTR, and viceversa, as well as concatenate them with the + or & operators, append with the += or &= operators, also combining them with FB strings, wstrings and literals. Most FB operators and string functions, like MID, TRIM, etc., work with them. Notable exceptions are LEFT, RIGHT and VAL, that don't generate intermediate temporary strings and don't call the operators of the classes. They can still be used if you use double indirection (**).
You can use VARPTR or @ to pass the CWSTR or CBSTR variable to a function that expects to be passed by reference, but use the right one: CWSTR for out WSTRING parameters and CBSTR for out BSTR parameters. The equivalent to STRPTR is *cbs and *cws, although you can also use STRPTR(**cbs) and STRPTR(**cbs), but it is more compilcated. A double * dereferences the string data, e.g. **cbs, **cws.
A very useful feature is that both data types are dynamic. Therefore you don't have to specify its size in advance, unlike ZSTRING and WSTRING. No more problems to write functions that return an unicode string.
I also have adapted the templates for the winFBE editor.
Hope it all goes well despite the number 13 :)
thank you :)
For those that haven't followed previous discussions, be aware that you must use RETURN instead of FUNCTION = to return a CWSTR or a CBSTR type as the result of a function. FUNCTION = calls the destructor of the returned type before calling the constructor of the temporary copy to be returned, making it impossible to make a copy. While returning a CBSTR succeeds in most cases because, by default, Windows caches BSTR strings, if done with CWSTR it will crash.
This is a serious bug that invalidates FUNCTION = to return user defined types that have a constructor.
AfxTime. inc.
An include file with many functions to deal with dates.
Jose,
This fails:
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'afxtime tests
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
#include once "Afx/AfxTime.inc"
Dim As Word w1 = AfxLocalDay()
? w1
sleep
with
fbc -s console "C:\FbRadAsm\Fb64\Examples\jcf\afxtime01.bas"
C:\FreeBASIC-1.05.0-win64\inc\win\msxml.bi(121) error 58: Illegal specification, at parameter 4 (ppTInfo) in 'GetTypeInfo as function(byval This as IXMLDOMImplementation ptr, byval iTInfo as UINT, byval lcid as LCID, byval ppTInfo as ITypeInfo ptr ptr) as HRESULT'
C:\FreeBASIC-1.05.0-win64\inc\win\msxml.bi(122) error 58: Illegal specification, at parameter 6 (rgDispId) in 'GetIDsOfNames as function(byval This as IXMLDOMImplementation ptr, byval riid as const IID const ptr, byval rgszNames as LPOLESTR ptr, byval cNames as UINT, byval lcid as LCID, byval rgDispId as DISPID ptr) as HRESULT'
C:\FreeBASIC-1.05.0-win64\inc\win\msxml.bi(123) error 58: Illegal specification, at parameter 2 (dispIdMember) in 'Invoke as function(byval This as IXMLDOMImplementation ptr, byval dispIdMember as DISPID, byval riid as const IID const ptr, byval lcid as LCID, byval wFlags as WORD, byval pDispParams as DISPPARAMS ptr, byval pVarResult as VARIANT ptr, byval pExcepInfo as EXCEPINFO ptr, byval puArgErr as UINT ptr) as HRESULT'
C:\FreeBASIC-1.05.0-win64\inc\win\msxml.bi(154) error 58: Illegal specification, at parameter 4 (ppTInfo) in 'GetTypeInfo as function(byval This as IXMLDOMNode ptr, byval iTInfo as UINT, byval lcid as LCID, byval ppTInfo as ITypeInfo ptr ptr) as HRESULT'
C:\FreeBASIC-1.05.0-win64\inc\win\msxml.bi(155) error 58: Illegal specification, at parameter 6 (rgDispId) in 'GetIDsOfNames as function(byval This as IXMLDOMNode ptr, byval riid as const IID const ptr, byval rgszNames as LPOLESTR ptr, byval cNames as UINT, byval lcid as LCID, byval rgDispId as DISPID ptr) as HRESULT'
C:\FreeBASIC-1.05.0-win64\inc\win\msxml.bi(156) error 58: Illegal specification, at parameter 2 (dispIdMember) in 'Invoke as function(byval This as IXMLDOMNode ptr, byval dispIdMember as DISPID, byval riid as const IID const ptr, byval lcid as LCID, byval wFlags as WORD, byval pDispParams as DISPPARAMS ptr, byval pVarResult as VARIANT ptr, byval pExcepInfo as EXCEPINFO ptr, byval puArgErr as UINT ptr) as HRESULT'
C:\FreeBASIC-1.05.0-win64\inc\win\msxml.bi(159) error 70: Incomplete type, before ')' in 'put_nodeValue as function(byval This as IXMLDOMNode ptr, byval value as VARIANT) as HRESULT'
C:\FreeBASIC-1.05.0-win64\inc\win\msxml.bi(168) error 70: Incomplete type, before ',' in 'insertBefore as function(byval This as IXMLDOMNode ptr, byval newChild as IXMLDOMNode ptr, byval refChild as VARIANT, byval outNewChild as IXMLDOMNode ptr ptr) as HRESULT'
C:\FreeBASIC-1.05.0-win64\inc\win\msxml.bi(181) error 70: Incomplete type, before ')' in 'put_nodeTypedValue as function(byval This as IXMLDOMNode ptr, byval typedValue as VARIANT) as HRESULT'
C:\FreeBASIC-1.05.0-win64\inc\win\msxml.bi(192) error 70: Incomplete type, before ')' in 'transformNodeToObject as function(byval This as IXMLDOMNode ptr, byval stylesheet as IXMLDOMNode ptr, byval outputObject as VARIANT) as HRESULT'
C:\FreeBASIC-1.05.0-win64\inc\win\msxml.bi(192) error 132: Too many errors, exiting
Sorry, it was missing "using Afx". I have reuploaded the file.
Jose,
A number of warnings now with the new upload.
James
fbc -s console "C:\FbRadAsm\Fb64\Examples\jcf\afxtime01.bas"
C:\FreeBASIC-1.05.0-win64\inc\Afx\AfxTime.inc(723) warning 3(1): Passing different pointer types, at parameter 4 of VARBSTRFROMDATE()
C:\FreeBASIC-1.05.0-win64\inc\Afx\AfxTime.inc(733) warning 3(1): Passing different pointer types, at parameter 4 of VARBSTRFROMDATE()
C:\FreeBASIC-1.05.0-win64\inc\Afx\AfxTime.inc(743) warning 3(1): Passing different pointer types, at parameter 4 of VARBSTRFROMDATE()
C:\FbRadAsm\Fb64\Examples\jcf\afxtime01.c: In function 'AFXWEEKONE':
C:\FbRadAsm\Fb64\Examples\jcf\afxtime01.c:1193:32: warning: 'NFIRSTDAY$1' is used uninitialized in this function [-Wuninitialized]
NFIRSTDAY$1 = (int32)(int64)-((int64)NFIRSTDAY$1 == ((int64)vr$2 + -1ll));
^
Make done.
I'm not getting these errors. You must be using different compiler switches.
New file uploaded.
Quote from: Jose Roca on July 16, 2016, 10:54:22 AM
I'm not getting these errors. You must be using different compiler switches.
New file uploaded.
fbc -s console "C:\FbRadAsm\Fb64\Examples\jcf\afxtime01.bas"
New file seems to be fine on a quick retest.
James
Jose,
How do you center the IFileOpenDialog if the hwndOwner is the Desktop?
James
You can try to find the handle of the dialog and use MoveWindow or SetWindowPos.
AfxPrinter.inc
Some useful printer procedures.
AfxNls.inc - National language support functions
Renamed the old AfxEnumPrinterPorts as AfxEnumLocalPrinterPorts and added a new AfxEnumPrinterPorts function that can also enumerate ports available for printing in the specified server.
New file reuploaded in the original post.
Problems with AfxStrPathName. Jose, there were a couple of problems with the routine so I fixed them and include the modified source below:
1) PATH did not return the trailing "\".
2) NAME would return a blank string if the incoming file string did not have a path. In PB, a filename without a path will return the filename.
3) NAMEX. Same problem as NAME.
Private Function AfxStrPathName (ByRef wszOption As WString, ByRef wszFileSpec As WString) As CWSTR
Dim cws As CWSTR = ""
If Len(wszFileSpec) = 0 Then Return cws
Select Case Ucase(wszOption)
Case "PATH"
' // Returns the path portion of file spec
Dim nPos As Long = InstrRev(wszFileSpec, Any ":/\")
If nPos Then cws = Mid(wszFileSpec, 1, nPos)
Return cws
Case "NAME"
' // Retrieve the full filename
cws = wszFileSpec
Dim nPos As Long = InstrRev(wszFileSpec, Any ":/\")
If nPos Then cws = Mid(wszFileSpec, nPos + 1)
' // Retrieve the filename
nPos = InstrRev(cws, ".")
If nPos Then cws = Mid(cws, 1, nPos - 1)
Return cws
Case "NAMEX"
' // Retrieve the name and extension combined
Dim nPos As Long = InStrRev(wszFileSpec, Any ":/\")
If nPos Then cws = Mid(wszFileSpec, nPos + 1) Else cws = wszFileSpec
Return cws
Case "EXTN"
' // Retrieve the name and extension combined
Dim nPos As Long = InstrRev(wszFileSpec, Any ":/\")
If nPos Then cws = Mid(wszFileSpec, nPos + 1) Else cws = wszFileSpec
' // Retrieve the extension
nPos = InStrRev(cws, ".")
If nPos Then cws = Mid(cws, nPos) Else cws = ""
Return cws
End Select
End Function
Thanks very much. I have modified the code.
Jose,
Would you please show a snippet using cWindow.UserData
Thank you,
James
Quote from: James Fuller on July 17, 2016, 11:14:12 AM
Jose,
Would you please show a snippet using cWindow.UserData
Thank you,
James
UserData is great place to store 32-bit values. I used it to store pointers. You just need to cast the value to the correct pointer before you use it. You can store handles to fonts that you created and then retrieve them in WM_DESTROY so you can delete them. Very versatile.
Here is a simple example where I am storing and later retrieving a manually created/allocated WSTRING ptr.
' ========================================================================================
' Save the base folder path that was set when user called ctlExTree_AddFolder
' ========================================================================================
Function ctlExTree_SetBaseFolder( ByVal hTree As HWND, ByRef wszFolder As WString ) As BOOLEAN
Dim pWindow As CWindow Ptr = AfxCWindowOwnerPtr(hTree)
If pWindow = 0 Then Exit Function
Dim As WSTRING Ptr pwsz = CALLOCATE( (Len(wszFolder) * 2) + 2 )
*pwsz = wszFolder
pWindow->UserData(0) = Cast( ULONG_PTR, pwsz)
Function = True
End Function
' ========================================================================================
' Retrieve the base folder path that was set when user called ctlExTree_AddFolder
' ========================================================================================
Function ctlExTree_GetBaseFolder(ByVal hTree As HWND) As CBSTR
Dim pWindow As CWindow Ptr = AfxCWindowOwnerPtr(hTree)
If pWindow = 0 Then Return ""
Dim pwsz As WSTRING ptr = Cast(WString Ptr, pWindow->UserData(0))
If pwsz Then Return *pwsz
End Function
Jose,
I'd like to propose adding a function to retrieve a DateTime value for a specified filename. FB has a function called FileDateTime but you need to use ** double indirection for CWSTR. (Likewise, for the function FileExists you need to use **, but for that function I have substituted AfxPathFileExists).
Maybe something like this (based somewhat on your code from CSED):
FUNCTION AfxFileDateTime( BYREF wszFileSpec AS WSTRING ) AS DOUBLE
DIM fd AS WIN32_FIND_DATA
DIM ft AS SYSTEMTIME
DIM hFile AS HANDLE
hFile = FindFirstFile( wszFileSpec, @fd)
IF hFile = INVALID_HANDLE_VALUE THEN EXIT FUNCTION
FindClose hFile
' Convert the file to system time. The result value is not compatible
' with the FB function DateFileTime().
FileTimeToSystemTime @fd.ftLastWriteTime, @ft
FUNCTION = VAL( str(ft.wYear) + _
AfxStrRSet(str(ft.wMonth), 2, "0") + _
AfxStrRSet(str(ft.wDay), 2, "0") + _
"." + _
AfxStrRSet(str(ft.wHour), 2, "0") + _
AfxStrRSet(str(ft.wMinute), 2, "0") + _
AfxStrRSet(str(ft.wSecond), 2, "0") _
)
END FUNCTION
I have in my todo list an include file with wrappers for file functions. They will accept an optional datetime mask because each country has its own way to format dates and times. Besides the unicode problem, there is also the internationalization problem.
Paul,
I hope it is a 64bit value in 64bit as all pointers are 64bit are they not?
James
Quote from: James Fuller on July 17, 2016, 12:29:18 PM
Paul,
I hope it is a 64bit value in 64bit as all pointers are 64bit are they not?
James
If you check Jose's CWindow source code you will see that UserData is defined as:
DIM m_rgUserData(0 TO 99) AS LONG_PTR
A hundred slots of data! Lots of room to do things.
If you look in \inc\win\basetsd.bi you will see a conditional that defines LONG_PTR depending on whether the system is 32 or 64 bit. So, yes it is a 64 bit value on a 64 bit system.
In an application, you can use an enumeration to remember more easily which data is stored, e.g.
ENUM AFX_USERDATA
AFX_LAYOUTPTRIDX = 0
...
...
END ENUM
Using constants not only is easier to remember, but more difficult to overwrite it by accident.
DIM pLayout AS CLayout PTR = CAST(CLayout PTR, pWindow->UserData(AFX_LAYOUTPTRIDX))
pWindow.UserData(AFX_LAYOUTPTRIDX) = CAST(LONG_PTR, @pLayout)
In one example I'm using it instead of Set/Get/Remove Property.
A variation of Paul's function:
FUNCTION AfxFileDateTime( BYREF wszFileSpec AS WSTRING ) AS DATE_
DIM fd AS WIN32_FIND_DATA
DIM ft AS SYSTEMTIME
DIM hFile AS HANDLE
hFile = FindFirstFile( wszFileSpec, @fd)
IF hFile = INVALID_HANDLE_VALUE THEN EXIT FUNCTION
FindClose hFile
' Convert the file to system time. The result value is not compatible
' with the FB function DateFileTime().
RETURN AfxFileTimeToVariantTime(fd.ftLastWriteTime)
END FUNCTION
The value is returned as a double in the same format that the old VB6 did, and it can ve converted to a string calling the AfxVariantDateToStr, AfxVariantTimeToStr or AfxVariantDateTimeToString.
I will add functions to allow the use of SYSTEMTIME and FILETIME, so the function can just return fd.ftLastWriteTime.
For example:
FUNCTION AfxFileDateTime( BYREF wszFileSpec AS WSTRING ) AS FILETIME
DIM fd AS WIN32_FIND_DATAW
DIM hFile AS HANDLE
hFile = FindFirstFileW( wszFileSpec, @fd)
IF hFile = INVALID_HANDLE_VALUE THEN EXIT FUNCTION
FindClose hFile
' Convert the file to system time. The result value is not compatible
' with the FB function DateFileTime().
RETURN fd.ftLastWriteTime
END FUNCTION
' ========================================================================================
' Converts a FILETIME type to a string containing the date and the time. based on the
' specified mask, e.g. "dd-MM-yyyy"
' ========================================================================================
PRIVATE FUNCTION AfxFileTimeToDateStr (BYREF FT AS FILETIME, BYREF wszMask AS WSTRING, BYVAL lcid AS LCID = LOCALE_USER_DEFAULT) AS CWSTR
DIM ST AS SYSTEMTIME, wszDateStr AS WSTRING * 260
FileTimeToSystemTime(@FT, @ST)
GetDateFormatW(lcid, NULL, @ST, wszMask, wszDateStr, SIZEOF(wszDateStr))
RETURN wszDateStr
END FUNCTION
' ========================================================================================
We can call it as
AfxMsg AfxFileTimeToDateStr(AfxFileDateTime(AfxGetExeFullPath), "dd-MM-yyyy")
if we are Spanish
or
AfxMsg AfxFileTimeToDateStr(AfxFileDateTime(AfxGetExeFullPath), "yyyy/MM/dd")
etc.
Later I will have to overload the wrappers that use GetDateFormatW and GetTimeFormatW to use GetDateFormatExW and GetTimeFormatExW and a string locale, such "es-ES", because Microsoft started to migrate toward the use of locale names instead of locale identifiers for new locales.
Quote
Note For interoperability reasons, the application should prefer the GetDateFormatEx function to GetDateFormat because Microsoft is migrating toward the use of locale names instead of locale identifiers for new locales. Any application that will be run only on Windows Vista and later should use GetDateFormatEx.
Quote
(Likewise, for the function FileExists you need to use **, but for that function I have substituted AfxPathF
You can also use AfxFileExists (in AfxWin.inc) if you dont need to include AfxPath.inc for other purposes.
An update of AfxTime.inc.
I have added the following functions:
' ========================================================================================
' Converts a DATE_ (double) to a SYSTEMTIME.
' ========================================================================================
PRIVATE FUNCTION AfxVariantTimeToSystemTime (BYVAL dt AS DATE_) AS SYSTEMTIME
DIM ST AS SYSTEMTIME
VariantTimeToSystemTime dt, @ST
RETURN ST
END FUNCTION
' ========================================================================================
' ========================================================================================
' Converts a FILETIME type to a string containing the date and the time. based on the
' specified mask, e.g. "dd-MM-yyyy"
' ========================================================================================
PRIVATE FUNCTION AfxFileTimeToDateStr (BYREF FT AS FILETIME, BYREF wszMask AS WSTRING, BYVAL lcid AS LCID = LOCALE_USER_DEFAULT) AS CWSTR
DIM ST AS SYSTEMTIME, wszDateStr AS WSTRING * 260
FileTimeToSystemTime(@FT, @ST)
GetDateFormatW(lcid, NULL, @ST, wszMask, wszDateStr, SIZEOF(wszDateStr))
RETURN wszDateStr
END FUNCTION
' ========================================================================================
' ========================================================================================
' Converts a FILETIME type to a string containing the date and the time. based on the
' specified mask, e.g. "hh':'mm':'ss".
' ========================================================================================
PRIVATE FUNCTION AfxFileTimeToTimeStr (BYREF FT AS FILETIME, BYREF wszMask AS WSTRING, BYVAL lcid AS LCID = LOCALE_USER_DEFAULT) AS CWSTR
DIM ST AS SYSTEMTIME, wszDateStr AS WSTRING * 260
FileTimeToSystemTime(@FT, @ST)
GetTimeFormatW(lcid, NULL, @ST, wszMask, wszDateStr, SIZEOF(wszDateStr))
RETURN wszDateStr
END FUNCTION
' ========================================================================================
' ========================================================================================
' Converts a SYSTEMTIME type to a string containing the date and the time. based on the
' specified mask, e.g. "dd-MM-yyyy"
' ========================================================================================
PRIVATE FUNCTION AfxSystemTimeToDateStr (BYREF ST AS SYSTEMTIME, BYREF wszMask AS WSTRING, BYVAL lcid AS LCID = LOCALE_USER_DEFAULT) AS CWSTR
DIM wszDateStr AS WSTRING * 260
GetDateFormatW(lcid, NULL, @ST, wszMask, wszDateStr, SIZEOF(wszDateStr))
RETURN wszDateStr
END FUNCTION
' ========================================================================================
' ========================================================================================
' Converts a FILETIME type to a string containing the date and the time. based on the
' specified mask, e.g. "hh':'mm':'ss".
' ========================================================================================
PRIVATE FUNCTION AfxSystemTimeToTimeStr (BYREF ST AS SYSTEMTIME, BYREF wszMask AS WSTRING, BYVAL lcid AS LCID = LOCALE_USER_DEFAULT) AS CWSTR
DIM wszDateStr AS WSTRING * 260
GetTimeFormatW(lcid, NULL, @ST, wszMask, wszDateStr, SIZEOF(wszDateStr))
RETURN wszDateStr
END FUNCTION
' ========================================================================================
Hi Paul,
I have added some file functions to AfxWin.inc, among them
' ========================================================================================
' Returns the time the file was created.
' - wszFileSpec: The directory or path, and the file name, which can include wildcard characters,
' for example, an asterisk (*) or a question mark (?).
' This parameter should not be NULL, an invalid string (for example, an empty string or a
' string that is missing the terminating null character), or end in a trailing backslash (\).
' If the string ends with a wildcard, period (.), or directory name, the user must have access
' permissions to the root and all subdirectories on the path.
' To extend the limit from MAX_PATH to 32,767 wide characters, prepend "\\?\" to the path.
' - bUTC: Pass FALSE if you want to get the time in local time.
' Usage: AfxFileTimeToDateStr(AfxGetFileCreationTime("C:\Tests\test.bas", FALSE), "dd/MM/yyyy")
' ========================================================================================
PRIVATE FUNCTION AfxGetFileCreationTime (BYREF wszFileSpec AS WSTRING, BYVAL bUTC AS BOOLEAN = TRUE) AS FILETIME
DIM fd AS WIN32_FIND_DATAW
DIM hFind AS HANDLE = FindFirstFileW(wszFileSpec, @fd)
IF hFind <> INVALID_HANDLE_VALUE THEN
FindClose hFind
IF bUTC = TRUE THEN
RETURN fd.ftCreationTime
ELSE
DIM FT AS FILETIME
FileTimeToLocalFileTime(@fd.ftCreationTime, @FT)
RETURN FT
END IF
END IF
END FUNCTION
' ========================================================================================
' ========================================================================================
' Returns the time the file was las accessed.
' ========================================================================================
PRIVATE FUNCTION AfxGetFileLastAccessTime (BYREF wszFileSpec AS WSTRING, BYVAL bUTC AS BOOLEAN = TRUE) AS FILETIME
DIM fd AS WIN32_FIND_DATAW
DIM hFind AS HANDLE = FindFirstFileW(wszFileSpec, @fd)
IF hFind <> INVALID_HANDLE_VALUE THEN
FindClose hFind
IF bUTC = TRUE THEN
RETURN fd.ftLastAccessTime
ELSE
DIM FT AS FILETIME
FileTimeToLocalFileTime(@fd.ftLastAccessTime, @FT)
RETURN FT
END IF
END IF
END FUNCTION
' ========================================================================================
' ========================================================================================
' Returns the time the file was written to, truncated, or overwritten.
' ========================================================================================
PRIVATE FUNCTION AfxGetFileLastWriteTime (BYREF wszFileSpec AS WSTRING, BYVAL bUTC AS BOOLEAN = TRUE) AS FILETIME
DIM fd AS WIN32_FIND_DATAW
DIM hFind AS HANDLE = FindFirstFileW(wszFileSpec, @fd)
IF hFind <> INVALID_HANDLE_VALUE THEN
FindClose hFind
IF bUTC = TRUE THEN
RETURN fd.ftLastWriteTime
ELSE
DIM FT AS FILETIME
FileTimeToLocalFileTime(@fd.ftLastWriteTime, @FT)
RETURN FT
END IF
END IF
END FUNCTION
' ========================================================================================
They return a FILETIME that can be converted to a string using the AfxFileTimeToDateStr and AfxFileTimeToTimeStr using a date or time mask for localization. Can be used also with folders.
Quote from: Jose Roca on July 17, 2016, 04:13:43 PM
Quote
(Likewise, for the function FileExists you need to use **, but for that function I have substituted AfxPathF
You can also use AfxFileExists (in AfxWin.inc) if you dont need to include AfxPath.inc for other purposes.
Ah, excellent. That will save me from having to Include the Path file.
For the Date/Time routines, I like the new functions. The only need I have right now is to get a value representing the file's last modified date and time. When the application regains focus it checks this value against the current disk file to see if modifications have occurred and the file needs to be reloaded. Storing FILETIME or SYSTEMTIME does not make it as easy to do the comparison. I could store the value as a formatted date/time string and then do the comparisons but simply comparing two DOUBLES is a lot easier.
Filetimes can be stored as quads
DIM ull AS ULONGLONG = FT.dwHighDateTime shl 32 OR FT.dwLowDateTime
The problem is that the 32-bit compiler complains about shl 32.
If you want a double, you can use this function (in AfxTime.inc):
' ========================================================================================
' Converts a FILETIME to a DATE_ (double).
' ========================================================================================
PRIVATE FUNCTION AfxFileTimeToVariantTime (BYREF FT AS FILETIME) AS DATE_
DIM dt AS DATE_, ST AS SYSTEMTIME
FileTimeToSystemTime(@FT, @ST)
SystemTimeToVariantTime @ST, @dt
RETURN dt
END FUNCTION
' ========================================================================================
DATE_ is defined as double. It is the format used by VB6.
If this format is not what you need, you can write an ad hoc function.
I think that VB6 dates can be compared, don't they?
See: http://www.freevbcode.com/ShowCode.asp?ID=573
The original function that I wrote for AfxFileDateTime works well but I want to use your standard functions in order to make it easier to maintain the code over the long run. I have attempted to store the datetime values using AfxGetFileLastWriteTime. I am then doing the comparison using AfxFileTimeToVariantTime. I can not compile the application because of warnings for:
1) The shl 32 error you mentioned that occurs in AfxQuadDateTime.
2) Error at parameter 4 in:
VarBstrFromDate(vbDate, lcid, VAR_DATEVALUEONLY, @bstrOut)
Which is found in AfxVariantDateToStr, AfxVariantTimeToStr, and AfxVariantDateTimeToString
You aren't using the latest version. I reuploaded it in post #3 fixing these issues.
This is the fixed version with the new four functions added.
Regarding the shl problem with the 32 bit compiler, I will see if I find a way of doing it without using shl. Apparently, I can't use an union as I did with PB because of alignment issues. For the moment, I have wrapped the three functions between #ifdef __FB_64BIT__ #endif waiting for a solution.
Well, I have find a workaround for the shl and alignment problems, using and intermediate ULARGE_INTEGER structure.
' ========================================================================================
' Returns the curent date and time as a QUAD (8 bytes). IN FB, a QUAD is an ULONGLONG.
' ========================================================================================
PRIVATE FUNCTION AfxQuadDateTime () AS ULONGLONG
DIM ST AS SYSTEMTIME, FT AS FILETIME
GetLocalTime @ST
SystemTimeToFileTime @ST, @FT
DIM uli AS ULARGE_INTEGER
uli.LowPart = FT.dwLowDateTime
uli.HighPart = FT.dwHighDateTime
RETURN uli.QuadPart
END FUNCTION
' ========================================================================================
The attached file contains the latest version.
Quote
The original function that I wrote for AfxFileDateTime works well but I want to use your standard functions in order to make it easier to maintain the code over the long run.
The problem with custom formats is that they can't be used for general purpose progamming. You can do it to solve a particular problem in your application, but for general purpose we have to use the standard formats: FILETIME, SYSTEMTIME, DATE_, ULONGLONG/ULONGINT.
Thanks Jose, the new file worked perfectly.
The date comparison worked perfectly as well:
If AfxFileTimeToVariantTime(ft) <> AfxFileTimeToVariantTime(pDoc->DateFileTime) Then
I'm going to add to AfxWin.inc the following function:
' ========================================================================================
' Retrieves the path of an special folder. Requires Windows Vista/Windows 7 or superior.
' - rfid: A reference to the KNOWNFOLDERID that identifies the folder. The folders associated
' with the known folder IDs might not exist on a particular system.
' - dwFlags: Flags that specify special retrieval options. This value can be 0; otherwise,
' it is one or more of the KNOWN_FOLDER_FLAG values.
' - hToken: An access token used to represent a particular user. This parameter is usually
' set to NULL, in which case the function tries to access the current user's instance of
' the folder. However, you may need to assign a value to hToken for those folders that can
' have multiple users but are treated as belonging to a single user. The most commonly used
' folder of this type is Documents.
' The calling application is responsible for correct impersonation when hToken is non-null.
' It must have appropriate security privileges for the particular user, including TOKEN_QUERY
' and TOKEN_IMPERSONATE, and the user's registry hive must be currently mounted. See Access
' Control for further discussion of access control issues.
' https://msdn.microsoft.com/en-us/library/windows/desktop/aa374860(v=vs.85).aspx
' Assigning the hToken parameter a value of -1 indicates the Default User. This allows
' clients of SHGetKnownFolderIDList to find folder locations (such as the Desktop folder)
' for the Default User. The Default User user profile is duplicated when any new user
' account is created, and includes special folders such as Documents and Desktop.
' Any items added to the Default User folder also appear in any new user account.
' Note that access to the Default User folders requires administrator privileges.
' Return value:
' The path of the requested folder on success, or an empty string on failure.
' Remarks: For a list of KNOWNFOLDERID constants see:
' https://msdn.microsoft.com/en-us/library/windows/desktop/dd378457(v=vs.85).aspx
' Usage example: AfxGetKnowFolderPath(@FOLDERID_CommonPrograms)
' ========================================================================================
PRIVATE FUNCTION AfxGetKnowFolderPath (BYVAL rfid AS CONST KNOWNFOLDERID CONST PTR, BYVAL dwFlags AS DWORD = 0, BYVAL hToken AS HANDLE = NULL) AS CWSTR
DIM pidl AS ITEMIDLIST PTR ' // Pointer to an item identifier list (PIDL)
DIM wszPath AS WSTRING * MAX_PATH ' // Folder's path
IF SHGetKnownFolderIDList(rfid, dwFlags, hToken, @pidl) = S_OK THEN
SHGetPathFromIDListW pidl, @wszPath
CoTaskMemFree pidl
RETURN wszPath
END IF
END FUNCTION
' ========================================================================================
For a list of known folders, see:
https://msdn.microsoft.com/en-us/library/windows/desktop/dd378457(v=vs.85).aspx
It uses SHGetKnownFolderIDList, that requires Vista or superior and replaces the deprecated SHGetSpecialFolderLocation.
For XP users
' ========================================================================================
' Retrieves the path of an special folder.
' - nFolder: A CSIDL value that identifies the folder of interest.
' For a list of CSIDL values see:
' https://msdn.microsoft.com/en-us/library/windows/desktop/bb762494(v=vs.85).aspx
' ========================================================================================
PRIVATE FUNCTION AfxGetSpecialFolderLocation (BYVAL nFolder AS LONG) AS CWSTR
DIM pidl AS ITEMIDLIST PTR ' // Pointer to an item identifier list (PIDL)
DIM wszPath AS WSTRING * MAX_PATH ' // Folder's path
IF SHGetSpecialFolderLocation(0, nFolder, @pidl) = S_OK THEN
SHGetPathFromIDListW pidl, @wszPath
CoTaskMemFree pidl
RETURN wszPath
END IF
END FUNCTION
' ========================================================================================
An update of AfxWin.inc with the new functions and the AfxBrowseForFolder dialog.
Jose,
1 question on : PRIVATE FUNCTION AfxUcode OVERLOAD (BYREF ansiStr AS CONST STRING, BYVAL nCodePage AS LONG = 0) AS AFX_BSTR
DIM pbstr AS AFX_BSTR
IF nCodePage = CP_UTF8 THEN
DIM dwLen AS DWORD = MultiByteToWideChar(CP_UTF8, 0, STRPTR(ansiStr), LEN(ansiStr), NULL, 0)
IF dwLen THEN
pbstr = SysAllocString(WSTR(SPACE(dwLen)))
dwLen = MultiByteToWideChar(CP_UTF8, 0, STRPTR(ansiStr), LEN(ansiStr), pbstr, dwLen * 2)
END IF
ELSE
pbstr = SysAllocString(WSTR(SPACE(LEN(ansiStr))))
MultiByteToWideChar(nCodePage, MB_PRECOMPOSED, STRPTR(ansiStr), LEN(ansiStr), pbstr, LEN(ansiStr) * 2)
END IF
FUNCTION = pbstr
END FUNCTION
why do you go with AFX_BSTR ( wich is wstring ptr) and not the following using the CWSTR way
PRIVATE FUNCTION AfxUcode OVERLOAD (BYREF ansiStr AS CONST STRING, BYVAL nCodePage AS LONG = 0) AS CWSTR
DIM cwstr AS CWSTR
IF nCodePage = CP_UTF8 THEN
DIM dwLen AS DWORD = MultiByteToWideChar(CP_UTF8, 0, STRPTR(ansiStr), LEN(ansiStr), NULL, 0)
IF dwLen THEN
cwstr = WSTR(SPACE(dwLen))
dwLen = MultiByteToWideChar(CP_UTF8, 0, STRPTR(ansiStr), LEN(ansiStr), @cwstr, dwLen * 2)
END IF
ELSE
cwstr = WSTR(SPACE(LEN(ansiStr)))
MultiByteToWideChar(nCodePage, MB_PRECOMPOSED, STRPTR(ansiStr), LEN(ansiStr), @cwstr, LEN(ansiStr) * 2)
END IF
return cwstr
END FUNCTION
is is because you need it on the memory allocation form to COM ?
Marc
I wrote them before the CWSTR class, when I was trying other ways. Maybe it may need them or not in the future.
> why do you go with AFX_BSTR ( wich is wstring ptr) and not the following using the CWSTR way
Well, a BSTR is not a WSTRING PTR, it has a prefix length. The problem is that the FB compiler has no idea of what a BSTR is. I even have to use AFX_BSTR because in the latest headers they changed the definition to WCHAR.
Because BSTR have a prefix length, they allow to work with embedded nulls, but because with FB we have to treat i as if it was a WSTRING PTR, we can only deal with embedded nulls using pointers.
See below what kind of stunts I have needed to do to get the non COM versions of the open and save file dialogs working.
Unicode versions of the open and save file dialogs using the Windows API.
' ========================================================================================
' Creates an Open dialog box that lets the user specify the drive, directory, and the name
' of a file or set of files to be opened.
' - hwndOwner: A handle to the window that owns the dialog box. This parameter can be any
' valid window handle, or it can be NULL if the dialog box has no owner.
' - wszTitle: A string to be placed in the title bar of the dialog box. If this member is NULL,
' the system uses the default title (that is, Save As or Open).
' - wszFile: The file name used to initialize the File Name edit control. When the GetOpenFileName
' or GetSaveFileName function returns successfully, this buffer contains the drive designator,
' path, file name, and extension of the selected file.
' If the OFN_ALLOWMULTISELECT flag is set and the user selects multiple files, the buffer
' contains the current directory followed by the file names of the selected files. For
' Explorer-style dialog boxes, the directory and file name strings are NULL separated,
' with an extra NULL character after the last file name. For old-style dialog boxes, the
' strings are space separated and the function uses short file names for file names with
' spaces. You can use the FindFirstFile function to convert between long and short file
' names. If the user selects only one file, the lpstrFile string does not have a separator
' between the path and file name.
' - wszInitialDir: The initial directory.
' - wszFilter: A buffer containing pairs of "|" separated filter strings. The first string
' in each pair is a display string that describes the filter (for example, "Text Files"),
' and the second string specifies the filter pattern (for example, "*.TXT"). To specify
' multiple filter patterns for a single display string, use a semicolon to separate the
' patterns (for example, "*.TXT;*.DOC;*.BAK"). A pattern string can be a combination of
' valid file name characters and the asterisk (*) wildcard character. Do not include spaces
' in the pattern string.
' The system does not change the order of the filters. It displays them in the File Types
' combo box in the order specified in wszFilter. If wszFilter is NULL, the dialog box
' does not display any filters.
' - wszDefExt: The default extension. GetOpenFileName and GetSaveFileName append this
' extension to the file name if the user fails to type an extension. This string can be
' any length, but only the first three characters are appended. The string should not
' contain a period (.). If this member is NULL and the user fails to type an extension,
' no extension is appended.
' - pdwFlags: A set of bit flags you can use to initialize the dialog box. When the dialog
' box returns, it sets these flags to indicate the user's input. For example, to check
' if the user has checked the read only checkbox:
' IF (pdwFlags AND %OFN_READONLY) = %OFN_READONLY THEN ...
' This value can be a combination of the following flags:
' See complete list and explanations at:
' https://msdn.microsoft.com/en-us/library/windows/desktop/ms646839(v=vs.85).aspx
' - pdwBufLen: The size of the buffer, in charactersm where the names of the selected
' files will be returned.
' Return value:
' An string containing a comma separated list of the selected files.
' Parse the number of ",". If only one, then the user has selected only a file and the
' string contains the full path. If more, The first substring contains the path and the
' others the files.
' If the user has not selected any file, an empty string is returned.
' On failure, an empty string is returned and, if not null, the pdwBufLen parameter will
' be filled by the size of the required buffer in characters.
' ========================================================================================
PRIVATE FUNCTION AfxOpenFileDialog ( _
BYVAL hwndOwner AS HWND _ ' // Parent window
, BYREF wszTitle AS WSTRING _ ' // Caption
, BYREF wszFile AS WSTRING _ ' // Filename
, BYREF wszInitialDir AS WSTRING _ ' // Start directory
, BYREF wszFilter AS WSTRING _ ' // Filename filter
, BYREF wszDefExt AS WSTRING _ ' // Default extension
, BYVAL pdwFlags AS DWORD PTR = NULL _ ' // Flags
, BYVAL pdwBufLen AS DWORD PTR = NULL _ ' // Buffer length
) AS CBSTR
DIM dwFlags AS DWORD, dwBufLen AS DWORD
IF pdwFlags THEN dwFlags = *pdwFlags
IF pdwBufLen THEN dwBufLen = *pdwBuflen
' // Filter is a sequence of WSTRINGs with a final (extra) double null terminator
' // The "|" characters are replaced with nulls
DIM wszMarkers AS WSTRING * 4 = "||"
IF RIGHT(wszFilter, 1) <> "|" THEN wszMarkers += "|"
DIM cbsFilter AS CBSTR = SysAllocString(wszFilter & wszMarkers)
' // Replace markers("|") with nulls
DIM pchar AS WCHAR PTR = *cbsFilter
DIM i AS LONG
FOR i = 0 TO LEN(cbsFilter) - 1
IF pchar[i] = ASC("|") THEN pchar[i] = 0
NEXT
' // If the initial directory has not been specified, assume the current directory
IF LEN(wszInitialDir) = 0 THEN wszInitialDir = CURDIR
' // The size of the buffer must be at least MAX_PATH characters
IF dwBufLen = 0 THEN
IF (dwFlags AND OFN_ALLOWMULTISELECT = OFN_ALLOWMULTISELECT) THEN dwBufLen = 32768 ' // 64 Kb buffer (enough for at least 126 files)
END IF
IF dwBufLen < 260 THEN dwBufLen = 260 ' // Make room for at least one path
' // Allocate the file name and a marker ("|") to be replaced with a null
DIM cbsFile AS CBSTR = SysAllocString(wszFile & "|")
' // Store the position of the marker
DIM cbPos AS LONG = LEN(cbsFile) - 1
' // Allocate room for the buffer
IF LEN(cbsFile) < dwBufLen THEN cbsFile += SPACE(dwBufLen - LEN(cbsFile))
' // The filename must be null terminated (replace the marker with a null)
pchar = *cbsFile
pchar[cbPos] = 0
' // Fill the members of the structure
DIM ofn AS OPENFILENAMEW
ofn.lStructSize = SIZEOF(ofn)
IF AfxWindowsVersion < 5 THEN ofn.lStructSize = 76
ofn.hwndOwner = hwndOwner
ofn.lpstrFilter = *cbsFilter
ofn.nFilterIndex = 1
ofn.lpstrFile = *cbsFile
ofn.nMaxFile = LEN(cbsFile)
ofn.lpstrInitialDir = @wszInitialDir
IF LEN(wszTitle) THEN ofn.lpstrTitle = @wszTitle
ofn.Flags = dwFlags OR OFN_EXPLORER
IF LEN(wszDefExt) THEN ofn.lpstrDefExt = @wszDefExt
' // Call the open file dialog
IF GetOpenFilenameW(@ofn) THEN
pchar = *cbsFile
FOR i = 0 TO LEN(cbsFile) - 1
' // If double null, exit
IF pchar[i] = 0 AND pchar[i + 1] = 0 THEN EXIT FOR
' // Replace null with ","
IF pchar[i] = 0 THEN pchar[i] = ASC(",")
NEXT
' // Trim trailing spaces
cbsFile = RTRIM(cbsFile, CHR(32))
ELSE
' // Buffer too small
IF CommDlgExtendedError = FNERR_BUFFERTOOSMALL THEN
dwBufLen = ASC(**cbsFile)
END IF
cbsFile = ""
END IF
' // Return the retrieved values
IF pdwFlags THEN *pdwFlags = ofn.Flags
IF pdwBufLen THEN *pdwBufLen = dwBufLen
RETURN cbsFile
END FUNCTION
' ========================================================================================
' ========================================================================================
' The parameters are the same that for AfxOpenFileDialog, except the optional pdwBufferLen.
' In the pdwFlags parameter you may add OFN_OVERWRITEPROMPT to be asked if you want to
' overwrite an existing file.
' ========================================================================================
PRIVATE FUNCTION AfxSaveFileDialog ( _
BYVAL hwndOwner AS HWND _ ' // Parent window
, BYREF wszTitle AS WSTRING _ ' // Caption
, BYREF wszFile AS WSTRING _ ' // Filename
, BYREF wszInitialDir AS WSTRING _ ' // Start directory
, BYREF wszFilter AS WSTRING _ ' // Filename filter
, BYREF wszDefExt AS WSTRING _ ' // Default extension
, BYVAL pdwFlags AS DWORD PTR = NULL _ ' // Flags
) AS CBSTR
DIM dwFlags AS DWORD
IF pdwFlags THEN dwFlags = *pdwFlags
' // Filter is a sequence of WSTRINGs with a final (extra) double null terminator
' // The "|" characters are replaced with nulls
DIM wszMarkers AS WSTRING * 4 = "||"
IF RIGHT(wszFilter, 1) <> "|" THEN wszMarkers += "|"
DIM cbsFilter AS CBSTR = SysAllocString(wszFilter & wszMarkers)
' // Replace markers("|") with nulls
DIM pchar AS WCHAR PTR = *cbsFilter
DIM i AS LONG
FOR i = 0 TO LEN(cbsFilter) - 1
IF pchar[i] = ASC("|") THEN pchar[i] = 0
NEXT
' // If the initial directory has not been specified, assume the current directory
IF LEN(wszInitialDir) = 0 THEN wszInitialDir = CURDIR
IF LEN(wszFile) > MAX_PATH THEN wszFile = LEFT(wszFile, MAX_PATH)
DIM cbsFile AS CBSTR = SysAllocString(wszFile & "|")
' // Store the position of the marker
DIM cbPos AS LONG = LEN(cbsFile) - 1
' // Allocate room for the buffer
IF LEN(cbsFile) < MAX_PATH THEN cbsFile += SPACE(MAX_PATH - LEN(cbsFile))
' // The filename must be null terminated (replace the marker with a null)
pchar = *cbsFile
pchar[cbPos] = 0
' // Fill the members of the structure
DIM ofn AS OPENFILENAMEW
ofn.lStructSize = SIZEOF(ofn)
IF AfxWindowsVersion < 5 THEN ofn.lStructSize = 76
ofn.lpstrFilter = *cbsFilter
ofn.nFilterIndex = 1
ofn.lpstrFile = *cbsFile
ofn.nMaxFile = LEN(cbsFile)
ofn.lpstrInitialDir = @wszInitialDir
IF LEN(wszTitle) THEN ofn.lpstrTitle = @wszTitle
ofn.Flags = dwFlags OR OFN_EXPLORER
IF LEN(wszDefExt) THEN ofn.lpstrDefExt = @wszDefExt
' // Call the save filename dialog
IF GetSaveFilenameW(@ofn) = 0 THEN cbsFile = ""
' // Return the retrieved values
IF pdwFlags THEN *pdwFlags = ofn.Flags
RETURN cbsFile
END FUNCTION
' ========================================================================================
Usage examples:
DIM wszFile AS WSTRING * 260 = "*.*"
DIM wszInitialDir AS STRING * 260 = CURDIR
DIM wszFilter AS WSTRING * 260 = "BAS files (*.BAS)|*.BAS|" & "All Files (*.*)|*.*|"
DIM dwFlags AS DWORD = OFN_EXPLORER OR OFN_FILEMUSTEXIST OR OFN_HIDEREADONLY OR OFN_ALLOWMULTISELECT
DIM cbs AS CBSTR = AfxOpenFileDialog(hwnd, "", wszFile, wszInitialDir, wszFilter, "BAS", @dwFlags, NULL)
AfxMsg cbs
DIM wszFile AS WSTRING * 260 = "*.*"
DIM wszInitialDir AS STRING * 260 = CURDIR
DIM wszFilter AS WSTRING * 260 = "BAS files (*.BAS)|*.BAS|" & "All Files (*.*)|*.*|"
DIM dwFlags AS DWORD = OFN_EXPLORER OR OFN_FILEMUSTEXIST OR OFN_HIDEREADONLY OR OFN_OVERWRITEPROMPT
DIM cbs AS CBSTR = AfxSaveFileDialog(hwnd, "", wszFile, wszInitialDir, wszFilter, "BAS", @dwFlags)
AfxMsg cbs