vdfsplat / AppSrc / vWin32fh.pkg
History | View | Annotate | Download (35.1 KB)
1 |
// This code is part of VDF GUIdance |
---|---|
2 |
// Visit us @ http://www.vdf-guidance.com |
3 |
// e-Mail us @ info@vdf-guidance.com |
4 |
// VDF GUIdance is a mutual project of |
5 |
// Frank Vandervelpen - Vandervelpen Systems and |
6 |
// Wil van Antwerpen - Antwise Solutions |
7 |
// All software source code should be used <<AS IS>> without any warranty. |
8 |
// |
9 |
// |
10 |
// *** Windows 32bit file handling wrapper class *** |
11 |
// |
12 |
|
13 |
// 05-09-2000 **WvA: Changed namingconvention of all classes and methods to new standard |
14 |
// This may be painfull for some of you, but it was really needed as it was |
15 |
// getting messy. The "vs" -prefix we used before was confusing and could |
16 |
// unintentionally have been interpreted as "Vdf-GUIdance String". |
17 |
// |
18 |
// The used naming-convention is: |
19 |
// - a prefix of "vWin32_" for every external function declaration |
20 |
// - a prefix of the letter "v" for the full API name for the vdf-wrapper function. |
21 |
// |
22 |
// By using this we are guarding ourselves for conflicts with variable declarations |
23 |
// of DataAccess in the future. |
24 |
// Or at least almost as the letter "v" is now also synonym for variant (duh~!) |
25 |
// |
26 |
// mm-dd-yyyy Author Description |
27 |
// |
28 |
// vSHGetFolderPath added to retrieve the new shell folders |
29 |
// vGetWindowsDirectory |
30 |
// |
31 |
// vGetTempFileName |
32 |
// vGetTempPath |
33 |
// 11-17-2001 **WvA: Removed User Interface Error popups such as Error handling. |
34 |
// This is an absolute need for WebApp. We expect you to handle the |
35 |
// error in your application anyways. Changed this for: |
36 |
// vDeleteFile, vCopyFile, vMoveFile and vRenameFile |
37 |
// 03-02-2002 **WvA: vRemoveDirectory added |
38 |
// 03-11-2002 **WvA: The parameter lpdword in the external function declaration for |
39 |
// vWin32_SHBrowsForFolder can cause compiler errors. |
40 |
// It is renamed too avoid this. |
41 |
// 11-11-2002 **WvA: Codecleanup, vcSelectFile_Dialog is now cvSelectFile_Dialog, its |
42 |
// function vSelectedFileName is now just SelectedFileName |
43 |
// Removed the local keyword in the variable declarations |
44 |
// 10-17-2003 **WvA: Cleaned up function vSelect_File and added code to destroy the dynamically |
45 |
// created file-open dialog |
46 |
// 02-12-2004 **WvA: Allan Ankerstjeme pointed me into a bug for the vCreateTempFileInPath |
47 |
// in that it didn't exactly return the correct filename of the file created. |
48 |
// This has now been taken care of. |
49 |
// 02-19-2004 **WvA: Removed all API declarations from the package itself to improve readability |
50 |
// These declarations are now included from the vWin32fh header file. |
51 |
// 02-19-2004 **WvA: Changed the default way in which the standard file handling works |
52 |
// Before today one could always undo the operation, as of now you cannot as |
53 |
// the default was a silly one using unnecessary resources (mainly diskspace) |
54 |
// Since i don't really expect someone to use that feature it has been removed. |
55 |
// One can however restore to the old way of handling by simply calling the |
56 |
// vWin32fhCompatibilityMode procedure ONE time before accessing any of the |
57 |
// filehandling operations |
58 |
// 02-19-2004 **WvA: The functions ParseFolderName, ParseFileName and ParseFileExtenstion added |
59 |
// as well as the StringFromRightOfChar function. |
60 |
// 02-19-2004 **WvA: sfoFormatDisk function added which can use to format a floppydisk |
61 |
// DISABLED now as testing shows that it does not work as advertised... |
62 |
// 02-20-2004 **WvA: The function vDDE_Error_Handler didn't pass the errornumber on to the DDE_Error_To_String function |
63 |
// Moved the hardcoded strings from vDDE_Error_Handler to define declarations for easier translation later on. |
64 |
// 09-10-2004 **WvA: Added the ToAnsi function to the fileoperations method so that |
65 |
// extended characters are treated ok too. |
66 |
// Reported by Flemming from |
67 |
// 12-17-2004 **WvA: Changed vFilePathExists to be global, reported by Peter van Mil |
68 |
// 12-28-2004 **WvA: WebApp compatibility added by introducing compiler directives |
69 |
// 03-10-2006 **WvA: Added more CSIDL types to our header file for use with the vSHGetFolderPath function |
70 |
// 01-02-2007 **WvA: Set NoChangeDir_State on vSelect_File and vSelectSaveFile to True but changed it back due to side effects. |
71 |
// Added vSelectSavefile function to create a file save dialog |
72 |
// Fixed ParseFolderName which was horribly broken (thanks for the reports) |
73 |
// Added vParentPath function to retrieve the parent "node" of a path |
74 |
// 01-04-2008 **WvA: Fixed vCreateTempFileInPath as the function wasn't working |
75 |
// 10-04-2009 **WvA: Added vshCreateDirectoryEx from Micheal Mullan, moved filedialogs to cvFileDialogs.pkg |
76 |
// 01-11-2010 **WvA: Added vWin32_APIFilesize as supplied by Renato Villa, to get the filesize of the specified file. See http://support.dataaccess.com/forums/showthread.php?t=41982 |
77 |
|
78 |
Use Case.mac |
79 |
#IFNDEF Is$WebApp |
80 |
Use File_Dlg.pkg // Contains OpenDialog class definition |
81 |
Use cvFileDialogs.pkg |
82 |
#ENDIF |
83 |
Use Seq_chnl.pkg |
84 |
|
85 |
Use windows |
86 |
//Use Dferror |
87 |
Use Dll |
88 |
Use vWin32fh.h // Header file with WinAPI declarations |
89 |
|
90 |
|
91 |
|
92 |
|
93 |
|
94 |
// |
95 |
// Gets the string from the right of the last sStopChar in sFrom |
96 |
// If sStopChar has no occurences in the string an empty string is |
97 |
// returned. |
98 |
Function StringFromRightOfChar Global String sFrom String sStopChar Returns String |
99 |
String sRetVal |
100 |
String sChar |
101 |
Integer iLength |
102 |
Integer iPos |
103 |
Boolean bStopChar |
104 |
Move "" To sRetval |
105 |
Move (Length(sFrom)) To iLength |
106 |
If ((iLength>0) And (Pos(sStopChar,sFrom) <> 0)) Begin |
107 |
Move iLength To iPos |
108 |
Move (False) To bStopChar |
109 |
While Not bStopChar |
110 |
Move (Mid(sFrom,1,iPos)) To sChar |
111 |
Decrement iPos |
112 |
If ((sChar=sStopChar) Or (iPos<1)) Begin |
113 |
Move (True) To bStopChar |
114 |
End |
115 |
Else Begin |
116 |
Move (sChar+sRetVal) To sRetVal |
117 |
End |
118 |
Loop |
119 |
End |
120 |
Function_Return sRetVal |
121 |
End_Function // StringFromRightOfChar |
122 |
|
123 |
|
124 |
// Pre: sFileName contains the complete path of the file. |
125 |
// Post: returns the complete path of the file. |
126 |
// This function is inspired on function SEQ_ExtractPathFromFileName of Sture Andersen. |
127 |
Function ParseFolderName Global String sFileName Returns String |
128 |
String sFile |
129 |
String sFolderName |
130 |
String sDirSep // this is "\" for windows, or "/" for unix |
131 |
MOve "" To sFolderName |
132 |
Move (sysconf(SYSCONF_DIR_SEPARATOR)) To sDirSep |
133 |
If sDirSep In sFileName Begin |
134 |
Move (StringFromRightOfChar(sFileName,sDirSep)) To sFile |
135 |
Move (Replace(sFile,sFileName,"")) To sFolderName |
136 |
End |
137 |
Else If ":" In sFileName Begin |
138 |
Move (StringFromRightOfChar(sFileName,":")) To sFile |
139 |
Move (Replace(sFile,sFileName,"")) To sFolderName |
140 |
End |
141 |
Function_Return sFolderName |
142 |
End_Function // ParseFolderName |
143 |
|
144 |
|
145 |
// Pre: sFileName contains the complete path of the file. |
146 |
// post: The returned filename has it's path removed, but will have a extension |
147 |
Function ParseFileName Global String sFileName Returns String |
148 |
String sFolderName |
149 |
String sDirSep // this is "\" for windows, or "/" for unix |
150 |
Move (sysconf(SYSCONF_DIR_SEPARATOR)) To sDirSep |
151 |
Get ParseFolderName sFileName To sFolderName |
152 |
If (sFolderName <> "") Move (Replace(sFolderName,sFileName,"")) To sFileName |
153 |
Move (Replace(sDirSep,sFileName,"")) To sFileName |
154 |
Function_Return sFilename |
155 |
End_Function // ParseFileName |
156 |
|
157 |
|
158 |
// Pre: sFileName may contain the complete path of the file. |
159 |
// or contain multiple dots in the filename, so temp.gif.bak will |
160 |
// return "bak" as the extension and not "gif" |
161 |
// Post: returns the extension only, this extension can be a valid unixlike extension |
162 |
// such as "html" or "java" |
163 |
Function ParseFileExtension Global String sFileName Returns String |
164 |
String sFileExtension |
165 |
Get StringFromRightOfChar sFileName "." To sFileExtension |
166 |
Function_Return sFileExtension |
167 |
End_Function // ParseFileExtension |
168 |
|
169 |
|
170 |
Define CS_DDE_ERR_UNKNOWN_LINE2 For ".\n" |
171 |
|
172 |
|
173 |
Function DDE_Error_To_String Integer iErrorID Returns String |
174 |
String sMessage |
175 |
Case Begin |
176 |
Case (iErrorID = vERROR_FILE_NOT_FOUND) |
177 |
Move CS_DDE_ERR_FILE_NOT_FOUND To sMessage |
178 |
Case Break |
179 |
Case (iErrorID = vERROR_PATH_NOT_FOUND) |
180 |
Move CS_DDE_ERR_PATH_NOT_FOUND To sMessage |
181 |
Case Break |
182 |
Case (iErrorID = vERROR_BAD_FORMAT) |
183 |
Move CS_DDE_ERR_BAD_FORMAT To sMessage |
184 |
Case Break |
185 |
Case (iErrorID = vSE_ERR_ACCESSDENIED) |
186 |
Move CS_DDE_ERR_ACCESSDENIED To sMessage |
187 |
Case Break |
188 |
Case (iErrorID = vSE_ERR_ASSOCINCOMPLETE) |
189 |
Move CS_DDE_ERR_ASSOCINCOMPLETE To sMessage |
190 |
Case Break |
191 |
Case (iErrorID = vSE_ERR_DDEBUSY) |
192 |
Move CS_DDE_ERR_DDEBUSY To sMessage |
193 |
Case Break |
194 |
Case (iErrorID = vSE_ERR_DDEFAIL) |
195 |
Move CS_DDE_ERR_DDEFAIL To sMessage |
196 |
Case Break |
197 |
Case (iErrorID = vSE_ERR_DDETIMEOUT) |
198 |
Move CS_DDE_ERR_DDETIMEOUT To sMessage |
199 |
Case Break |
200 |
Case (iErrorID = vSE_ERR_DLLNOTFOUND) |
201 |
Move CS_DDE_ERR_DLLNOTFOUND To sMessage |
202 |
Case Break |
203 |
Case (iErrorID = vSE_ERR_NOASSOC) |
204 |
Move CS_DDE_ERR_NOASSOC To sMessage |
205 |
Case Break |
206 |
Case ((iErrorID = vSE_ERR_OOM) Or (iErrorID = 0)) |
207 |
Move CS_DDE_ERR_OOM To sMessage |
208 |
Case Break |
209 |
Case (iErrorID = vSE_ERR_PNF) |
210 |
Move CS_DDE_ERR_PNF To sMessage |
211 |
Case Break |
212 |
Case (iErrorID = vSE_ERR_SHARE) |
213 |
Move CS_DDE_ERR_SHARE To sMessage |
214 |
Case Break |
215 |
Case Else |
216 |
Move CS_DDE_ERR_UNKNOWN_LINE1 To sMessage |
217 |
Move (sMessage*Trim(iErrorID)*CS_DDE_ERR_UNKNOWN_LINE2) To sMessage |
218 |
Case Break |
219 |
Case End |
220 |
Function_Return sMessage |
221 |
End_Function // DDE_Error_To_String |
222 |
|
223 |
|
224 |
Procedure vDDE_Error_Handler Integer iErrorID |
225 |
String sMessage |
226 |
Get DDE_Error_To_String iErrorID To sMessage |
227 |
Append sMessage CS_DDE_ERR_HANDL_PAKTC // "Press a key to continue..." |
228 |
Send Stop_Box sMessage CS_DDE_ERR_HANDL_CAPTION |
229 |
End_Procedure // vDDE_Error_Handler hInstance |
230 |
|
231 |
|
232 |
// Does the directory exist? - No = 0, Yes = 1 |
233 |
// This also works with UNC path encoding and wildcards |
234 |
Function vFolderExists Global String sFolderName Returns Integer |
235 |
String sFolder sTmp |
236 |
Integer bFolderExists iCh |
237 |
|
238 |
Move dfTrue To bFolderExists |
239 |
Move "dir:" To sFolder |
240 |
Append sFolder sFolderName |
241 |
Get Seq_New_Channel To iCh // get free channel for input |
242 |
Direct_Input Channel iCh sFolder |
243 |
Repeat |
244 |
Readln Channel iCh sTmp |
245 |
If (Trim(sTmp)="") Move dfFalse To bFolderExists |
246 |
Else Begin |
247 |
Move dfTrue To bFolderExists |
248 |
Indicate seqeof True // end loop |
249 |
End |
250 |
Until (seqeof) |
251 |
Close_Input Channel iCh |
252 |
Send Seq_Release_Channel iCh |
253 |
Function_Return bFolderExists |
254 |
End_Function // vFolderExists |
255 |
|
256 |
|
257 |
// returns folder name if a folder was selected, otherwise returns "" |
258 |
Function vSHBrowseForFolder Global String sDialogTitle Returns String |
259 |
String sFolder sBrowseInfo sTitle |
260 |
Pointer lpItemIdList lpsFolder lpsBrowseInfo lpsTitle |
261 |
Integer iFolderSelected iRetval |
262 |
|
263 |
// fill string variable with null characters |
264 |
ZeroType vtBrowseInfo To sBrowseInfo |
265 |
|
266 |
If (sDialogTitle<>"") Begin |
267 |
Move sDialogTitle To sTitle |
268 |
// Torben Lund suggested converting the string with toansi. Doing it like that |
269 |
// disables showing some commonly used ascii characters like ascii 137 (?) |
270 |
// These chars are correctly shown if no toansi is used. |
271 |
// I can imagine that he wanted to path to be ANSI, but as long as it isa just |
272 |
// selected it will always be valid. |
273 |
GetAddress Of sTitle To lpsTitle |
274 |
Put lpsTitle To sBrowseInfo At vtBrowseInfo.lpszTitle |
275 |
End |
276 |
|
277 |
Put vBIF_RETURNONLYFSDIRS To sBrowseInfo At vtBrowseInfo.ulFlags |
278 |
|
279 |
// Torben Lund added line below. Move handle of focus object to structure before |
280 |
// calling function. Otherwise, the folderdialog will be started as a seperate task. |
281 |
Put (window_handle(focus(desktop))) To sBrowseInfo At vtBrowseInfo.hWndOwner |
282 |
|
283 |
GetAddress Of sBrowseInfo To lpsBrowseInfo |
284 |
|
285 |
// null 128 chars into var (make space) |
286 |
Move (Repeat(Character(0), vMAX_PATH)) To sFolder |
287 |
GetAddress Of sFolder To lpsFolder |
288 |
|
289 |
// select folder |
290 |
Move (vWin32_SHBrowseForFolder(lpsBrowseInfo)) To lpItemIdList |
291 |
// get selected folder name |
292 |
Move (vWin32_SHGetPathFromIDList(lpItemIdList, lpsFolder)) To iFolderSelected |
293 |
|
294 |
// release memory resources that are used by the ItemIdList |
295 |
Move (vWin32_CoTaskMemFree(lpItemIdList)) To iRetval |
296 |
|
297 |
If (iFolderSelected<>0) Function_Return (CString(sFolder)) |
298 |
Else Function_Return "" |
299 |
End_Function // vSHBrowseForFolder |
300 |
|
301 |
|
302 |
// returns 0 if the folder is created. |
303 |
// 1 if the API-call returned an error. |
304 |
Function vCreateDirectory Global String sNewFolder Returns Integer |
305 |
String sFolder sSA |
306 |
Pointer lpsFolder lpsSecurity_Attributes lpDescriptor |
307 |
Integer iRetval bFolderCreated bInheritHandle |
308 |
|
309 |
Move (False) To bFolderCreated |
310 |
// fill string variable with null characters |
311 |
ZeroType vtSecurity_attributes To sSA |
312 |
|
313 |
// null MAX_PATH chars into var (make space) |
314 |
Move (Repeat(Character(0), vMAX_PATH)) To sFolder |
315 |
|
316 |
If (sNewFolder <> "") Begin |
317 |
|
318 |
Move dfTrue To bInheritHandle |
319 |
// Setting this to NULL is already done by the zerotype command |
320 |
// Move NULL To lpDescriptor |
321 |
Put (length(sSA)) To sSA At vtSecurity_attributes.nLength |
322 |
//Put lpDescriptor To sSA at vtSecurity_attributes.lpDescriptor |
323 |
Put bInheritHandle To sSA At vtSecurity_attributes.bInheritHandle |
324 |
|
325 |
GetAddress Of sSA To lpsSecurity_Attributes |
326 |
|
327 |
// |
328 |
Move sNewFolder To sFolder |
329 |
GetAddress Of sFolder To lpsFolder |
330 |
Move (vWin32_CreateDirectory(lpsFolder, lpsSecurity_Attributes)) To bFolderCreated |
331 |
End |
332 |
|
333 |
Ifnot bFolderCreated Move 1 To iRetVal |
334 |
Function_Return iRetVal |
335 |
End_Function // vCreateDirectory |
336 |
|
337 |
|
338 |
// **WvA: 03-02-2002 Function created. |
339 |
// With this function one can remove a directory. |
340 |
// returns 0 if the folder is removed. |
341 |
// 1 if the API-call returned an error (Use GetLastError API to get the details) |
342 |
// 2 if the folder did not exist |
343 |
// 3 if the sFolder parameter passed is equal to "" |
344 |
Function vRemoveDirectory Global String sFolder Returns Integer |
345 |
String sPath |
346 |
Pointer lpsPath |
347 |
Integer iRetval bRemoved bExists |
348 |
|
349 |
Move (False) To bRemoved |
350 |
Move 0 To iRetVal |
351 |
Move (Trim(sFolder)) To sFolder |
352 |
If (sFolder="") Begin |
353 |
Move 3 To iRetVal |
354 |
End |
355 |
If (vFolderExists(sFolder)=False) Begin |
356 |
Move 2 To iRetVal |
357 |
End |
358 |
If (iRetVal=0) Begin |
359 |
// null MAX_PATH chars into var (make space) |
360 |
Move (Repeat(Character(0), vMAX_PATH)) To sPath |
361 |
// |
362 |
Move (Insert(sFolder,sPath,1)) To sPath |
363 |
GetAddress Of sPath To lpsPath |
364 |
Move (vWin32_RemoveDirectory(lpsPath)) To bRemoved |
365 |
End |
366 |
|
367 |
If ((iRetVal=0) And (bRemoved=False)) Begin |
368 |
Move 1 To iRetVal |
369 |
End |
370 |
Function_Return iRetVal |
371 |
End_Function // vRemoveDirectory |
372 |
|
373 |
|
374 |
|
375 |
// This function informs the user that he entered a yet unknown folder and |
376 |
// asks if he/she wants to create the folder (Yes/No) |
377 |
// Choice: "Yes" - this creates the folder |
378 |
// if successful, the function returns false |
379 |
// else it will be true. |
380 |
// Choice: "No" - returns TRUE, This allows the programmer to take action |
381 |
// For example: to stop a save |
382 |
// Precondition: A foldername must be entered. We do not check for empty paths |
383 |
// This function returns a non-zero value if the folder isn't created afterwards |
384 |
Function vVerifyNewFolder Global String sFolderName Returns Integer |
385 |
Integer bIsNotValid |
386 |
Integer iUsers_Choice |
387 |
String sMessage |
388 |
|
389 |
If (vFolderExists(sFolderName) Eq 0) Begin |
390 |
Move "The folder '" To sMessage |
391 |
Append sMessage sFolderName |
392 |
Append sMessage "' does not yet exist,\n" |
393 |
Append sMessage "Do you want to create it now?" |
394 |
Get YesNo_Box sMessage "Confirm" MB_DefButton1 To iUsers_Choice |
395 |
Case Begin |
396 |
Case (iUsers_Choice = MBR_Yes) |
397 |
Move (vCreateDirectory(sFolderName)) To bIsNotValid |
398 |
If bIsNotValid Begin |
399 |
Move "An error occurred while trying to create folder '" To sMessage |
400 |
Append sMessage sFolderName "'.\n\n" |
401 |
Send Info_Box sMessage "Info" |
402 |
End |
403 |
Case Break |
404 |
Case (iUsers_Choice = MBR_No) |
405 |
Move dfTrue To bIsNotValid // Cancel the save |
406 |
Case Break |
407 |
Case End |
408 |
End |
409 |
Function_Return bIsNotValid |
410 |
End_Function // vVerifyNewFolder |
411 |
|
412 |
|
413 |
// This will perform an operation on a file (e.g. open) with the application |
414 |
// registered in the Windows Registry to open that type of file (via its extension) |
415 |
// sOperation would be "OPEN" (it could also be "PRINT" etc). |
416 |
Procedure vShellExecute global String sOperation String sDocument String sParameters String sPath |
417 |
Handle hInstance hWnd |
418 |
Pointer lpsOperation |
419 |
Pointer lpsDocument |
420 |
Pointer lpsParameters |
421 |
Pointer lpsPath |
422 |
// remove any leading/trailing spaces in the string |
423 |
Move (Trim(sDocument)) To sDocument |
424 |
Move (Trim(sPath)) To sPath |
425 |
// Make the strings readable for windows API, by converting them to null-terminated |
426 |
Append sOperation (Character(0)) |
427 |
Append sDocument (Character(0)) |
428 |
Append sParameters (Character(0)) |
429 |
Append sPath (Character(0)) |
430 |
// Connect the corresponding pointers to the strings |
431 |
GetAddress Of sOperation To lpsOperation |
432 |
GetAddress Of sDocument To lpsDocument |
433 |
GetAddress Of sParameters To lpsParameters |
434 |
GetAddress Of sPath To lpsPath |
435 |
|
436 |
Get Window_Handle To hWnd |
437 |
Move (vWin32_ShellExecute (hWnd, lpsOperation, lpsDocument, lpsParameters, lpsPath, 1)) To hInstance |
438 |
If (hInstance <= 32) Begin |
439 |
Send vDDE_Error_Handler hInstance |
440 |
End |
441 |
End_Procedure // vShellExecute |
442 |
|
443 |
|
444 |
Class cShellFileOperations Is a Array |
445 |
|
446 |
Procedure Construct_Object |
447 |
Forward Send Construct_Object |
448 |
Property Integer piDeleteFlags Public 0 |
449 |
Property Integer piCopyFlags Public 0 |
450 |
Property Integer piMoveFlags Public 0 |
451 |
Property Integer piRenameFlags Public 0 |
452 |
|
453 |
Set piDeleteFlags To (vFOF_SILENT Ior vFOF_NOCONFIRMATION) |
454 |
Set piCopyFlags To (vFOF_SILENT Ior vFOF_NOCONFIRMATION) |
455 |
Set piMoveFlags To (vFOF_SILENT Ior vFOF_NOCONFIRMATION) |
456 |
Set piRenameFlags To (vFOF_SILENT Ior vFOF_NOCONFIRMATION) |
457 |
End_Procedure // Construct_Object |
458 |
|
459 |
|
460 |
// This function uses the shell API to perform a file operation on the |
461 |
// files supplied. |
462 |
// |
463 |
Function FileOperation String sSource String sDestination Integer iOperation Integer iFlags Returns Integer |
464 |
String sShFileOp |
465 |
Pointer lpShFileOp |
466 |
Pointer lpsSource |
467 |
Pointer lpsDestination |
468 |
Integer iRetVal |
469 |
Integer bUserAbort |
470 |
|
471 |
ZeroType vtShFileOpStruct To sShFileOp |
472 |
Move (ToAnsi(sSource)+Character(0)+Character(0)) To sSource |
473 |
Move (ToAnsi(sDestination)+Character(0)+Character(0)) To sDestination |
474 |
GetAddress Of sSource To lpsSource |
475 |
If iOperation Ne vFO_DELETE Begin |
476 |
GetAddress Of sDestination To lpsDestination |
477 |
Put lpsDestination To sShFileOp At vtShFileOpStruct.pTo |
478 |
End |
479 |
|
480 |
Put iOperation To sShFileOp At vtShFileOpStruct.wFunc |
481 |
Put lpsSource To sShFileOp At vtShFileOpStruct.pFrom |
482 |
Put iFlags To sShFileOp At vtShFileOpStruct.fFlags |
483 |
|
484 |
GetAddress Of sShFileOp To lpShFileOp |
485 |
|
486 |
Move (vWin32_SHFileOperation(lpShFileOp)) To iRetVal |
487 |
GetBuff From sShFileOp At vtShFileOpStruct.fAnyOperationsAborted To bUserAbort |
488 |
If (bUserAbort <> 0) Begin |
489 |
Move 80 To iRetVal // file Operation Aborted by USER |
490 |
End |
491 |
Function_Return (iRetVal) |
492 |
End_Function // FileOperation |
493 |
|
494 |
|
495 |
Function sfoDeleteFile String sFileName Returns Integer |
496 |
Integer iRetVal |
497 |
Integer iFlags |
498 |
|
499 |
Get piDeleteFlags To iFlags |
500 |
Get FileOperation sFileName "" vFO_DELETE iFlags To iRetVal |
501 |
Function_Return iRetVal |
502 |
End_Function // sfoDeleteFile |
503 |
|
504 |
|
505 |
Function sfoCopyFile String sSource String sDestination Returns Integer |
506 |
Integer iRetVal |
507 |
Integer iFlags |
508 |
|
509 |
Get piCopyFlags To iFlags |
510 |
Get FileOperation sSource sDestination vFO_COPY iFlags To iRetVal |
511 |
Function_Return iRetVal |
512 |
End_Function // sfoCopyFile |
513 |
|
514 |
|
515 |
Function sfoMoveFile String sSource String sDestination Returns Integer |
516 |
Integer iRetVal |
517 |
Integer iFlags |
518 |
|
519 |
Get piMoveFlags To iFlags |
520 |
Get FileOperation sSource sDestination vFO_MOVE iFlags To iRetVal |
521 |
Function_Return iRetVal |
522 |
End_Function // sfoMoveFile |
523 |
|
524 |
|
525 |
// Rename a file or folder |
526 |
// Returns a nonzero value if the operation failed. |
527 |
Function sfoRenameFile String sSource String sDestination Returns Integer |
528 |
Integer iRetVal |
529 |
Integer iFlags |
530 |
|
531 |
Get piRenameFlags To iFlags |
532 |
Get FileOperation sSource sDestination vFO_RENAME iFlags To iRetVal |
533 |
Function_Return iRetVal |
534 |
End_Function // sfoRenameFile |
535 |
|
536 |
// Courtesy Of Steve Walter |
537 |
// Requires Windows 2000 and up according to msdn but it was |
538 |
// in fact available before that as an unpublished API call |
539 |
// a little google search shows that this was already available |
540 |
// in windows 95 and NT |
541 |
// |
542 |
// The format is controlled by the dialog interface. |
543 |
// That is, the user must click the OK button To actually Begin the format |
544 |
// the format cannot be started programmatically. |
545 |
// An alternative to this functionality would be to use a controlpanel |
546 |
// http://www.vdf-guidance.com/ContribPage.asp?Page=PKGCLSDFCPLAPP&ContribRecId=93 |
547 |
// |
548 |
// hWnd = The windows handle of the object from which the format Function |
549 |
// is called. |
550 |
// To Get this, |
551 |
// use: Get Window_Handle Of <object> |
552 |
// For instance, in this app, we're going to use the Report_Panel: |
553 |
// Get Window_Handle Of (Report_Panel(Main(Self))) To hWind |
554 |
// |
555 |
// sDrive = The drive letter. At this moment only A and B are valid |
556 |
// |
557 |
// iOptions = Format options. |
558 |
// SHFMT_OPT_DEFAULT = Quick format |
559 |
// SHFMT_OPT_FULL = Full Format |
560 |
// SHFMT_OPT_SYSONLY = System only |
561 |
// 3 = Full format with system. (unsupported) |
562 |
// |
563 |
// Return Values: |
564 |
// SHFMT_ERROR = Error on format or no drive specified. |
565 |
// SHFMT_CANCEL = Format cancelled by user. |
566 |
// SHFMT_NOFORMAT = Drive is not formatable. |
567 |
// |
568 |
// |
569 |
// *** ATTENTION: This function has been disabled as it doesn't |
570 |
// seem to work, i must have made a silly mistake |
571 |
// somewhere. |
572 |
// |
573 |
Function sfoFormatDisk String sDrive Integer iOptions Returns DWORD |
574 |
Handle hWnd |
575 |
Integer iObj |
576 |
DWORD dwReturnVal |
577 |
Integer iDrive |
578 |
|
579 |
Function_Return (1) // STOP HERE |
580 |
|
581 |
Move (Trim(sDrive)) To sDrive |
582 |
If ( sDrive <> '' ) Begin |
583 |
If ( sDrive Contains ':' ) Move (Replace(':',sDrive,'')) To sDrive |
584 |
If (Not( 'AB' Contains sDrive )) Function_Return (SHFMT_NOFORMAT) |
585 |
If ( sDrive = 'A' ) Move 0 To iDrive |
586 |
Else If ( sDrive = 'B' ) Move 1 To iDrive |
587 |
// Window_Handle Of Desktop equals to 0 |
588 |
|
589 |
Get focus Of desktop To iObj |
590 |
If (iObj>desktop) ; |
591 |
Get Container_Handle Of iObj To hWnd |
592 |
While (hWnd=0 And iObj<>Desktop) |
593 |
Get Parent Of iObj To iObj |
594 |
Get Container_Handle Of iObj To hWnd |
595 |
End |
596 |
|
597 |
//Showln "hWnd = " hWnd " iDrive " iDrive " iOptions " iOptions |
598 |
Move (vWin32_ShFormatDrive(hWnd, iDrive, SHFMT_ID_DEFAULT, iOptions)) To dwReturnVal |
599 |
End |
600 |
Else Begin |
601 |
Move (SHFMT_ERROR) To dwReturnVal |
602 |
End |
603 |
Function_Return dwReturnVal |
604 |
End_Function // sfoFormatDisk |
605 |
|
606 |
//Example: |
607 |
// Get sfoFormatDisk 'A' 0 To dReturnVal // Formats drive A in QuickFormat |
608 |
// mode. |
609 |
|
610 |
End_Class // cShellFileOperations |
611 |
|
612 |
|
613 |
Object oShellFileOperations Is a cShellFileOperations |
614 |
End_Object // oShellFileOperations |
615 |
|
616 |
|
617 |
// Restore to the old way of working with the shell file operations. |
618 |
// or.. to put lay man terms, allow any of the operations vDeleteFile |
619 |
// vCopyFile/vMoveFile/vRenameFile to have an UNDO |
620 |
Procedure vWin32fhCompatibilityMode |
621 |
Integer hoSFO |
622 |
Integer iFlags |
623 |
|
624 |
Move (vFOF_SILENT Ior vFOF_NOCONFIRMATION Ior vFOF_ALLOWUNDO) To iFlags |
625 |
Move (oShellFileOperations(Self)) To hoSFO |
626 |
|
627 |
Set piDeleteFlags Of hoSFO To iFlags |
628 |
Set piCopyFlags Of hoSFO To iFlags |
629 |
Set piMoveFlags Of hoSFO To iFlags |
630 |
Set piRenameFlags Of hoSFO To iFlags |
631 |
End_Procedure // vWin32fhCompatibilityMode |
632 |
|
633 |
|
634 |
Function vDeleteFile Global String sFileName Returns Integer |
635 |
Integer iRetVal |
636 |
|
637 |
Get sfoDeleteFile Of (oShellFileOperations(Self)) sFileName To iRetVal |
638 |
Function_Return iRetVal |
639 |
End_Function // vDeleteFile |
640 |
|
641 |
|
642 |
Function vCopyFile Global String sSource String sDestination Returns Integer |
643 |
Integer iRetVal |
644 |
|
645 |
Get sfoCopyFile Of (oShellFileOperations(Self)) sSource sDestination To iRetVal |
646 |
Function_Return iRetVal |
647 |
End_Function // vCopyFile |
648 |
|
649 |
|
650 |
Function vMoveFile Global String sSource String sDestination Returns Integer |
651 |
Integer iRetVal |
652 |
|
653 |
Get sfoMoveFile Of (oShellFileOperations(Self)) sSource sDestination To iRetVal |
654 |
Function_Return iRetVal |
655 |
End_Function // vMoveFile |
656 |
|
657 |
|
658 |
// Rename a file or folder |
659 |
// Returns a nonzero value if the operation failed. |
660 |
Function vRenameFile Global String sSource String sDestination Returns Integer |
661 |
Integer iRetVal |
662 |
|
663 |
Get sfoRenameFile Of (oShellFileOperations(Self)) sSource sDestination To iRetVal |
664 |
Function_Return iRetVal |
665 |
End_Function // vRenameFile |
666 |
|
667 |
|
668 |
|
669 |
Function vGetWindowsDirectory Returns String |
670 |
String sDirectory |
671 |
Pointer lpDirectory |
672 |
Integer iVoid |
673 |
|
674 |
ZeroString vMAX_PATH To sDirectory |
675 |
GetAddress Of sDirectory To lpDirectory |
676 |
|
677 |
Move (vWin32_GetWindowsDirectory(lpDirectory, vMAX_PATH)) To iVoid |
678 |
Function_Return (CString(sDirectory)) // **WvA: Changed to CString() |
679 |
End_Function // vGetWindowsDirectory |
680 |
|
681 |
|
682 |
|
683 |
|
684 |
// Courtesy of Marco Kuipers |
685 |
Function vMakeTempFile Returns String |
686 |
Integer iRetval |
687 |
String sTempPath sTempFileName sPrefixString |
688 |
Pointer lpTempPath lpTempFileName lpPrefixString |
689 |
|
690 |
Move (Repeat (Character (0), 255)) To sTempPath |
691 |
GetAddress Of sTempPath To lpTempPath |
692 |
Move (vWin32_GetTempPath (255, lpTempPath)) To iRetVal |
693 |
|
694 |
If (sTempPath = "") Begin |
695 |
Get_Current_Directory To sTempPath |
696 |
End |
697 |
Move (pad(sTempPath,vMax_Path-14)) To sTempPath // *WvA: 28-04-2005 Quote from msdn: The string cannot be longer than MAX_PATH-14 characters. |
698 |
Move (Repeat (Character (0), 255)) To sTempFileName |
699 |
GetAddress Of sTempFileName To lpTempFileName |
700 |
Move ("tmp"+character(0)) To sPrefixString // **WvA: 28-04-2005 Added a null |
701 |
GetAddress Of sPrefixString To lpPrefixString |
702 |
GetAddress Of sTempPath To lpTempPath |
703 |
Move (vWin32_GetTempFileName (lpTempPath, lpPrefixString, 0, lpTempFileName)) To iRetval |
704 |
If (iRetval = 0) Begin // **WvA: 28-04-2005 Changed condition, the api call returns 0 if an error occurs |
705 |
Move "" To sTempFileName |
706 |
End |
707 |
|
708 |
Function_Return (Cstring(sTempFileName)) // **WvA: 28-04-2005 Cstring added |
709 |
End_Function // vMakeTempFile |
710 |
|
711 |
|
712 |
// This function creates a uniquely named temporary file in folder sPath |
713 |
// The file created will have a prefix based on the first 3 characters in sPrefix |
714 |
// Note that you will have to cleanup the tempfile yourself as the function |
715 |
// does not take care of that. |
716 |
Function vCreateTempFileInPath String sPath String sPrefix Returns String |
717 |
String sTempFileName |
718 |
Integer iCnt iRetVal |
719 |
Pointer lpTempFileName |
720 |
Pointer lpPath |
721 |
Pointer lpPrefix |
722 |
|
723 |
Move (ToAnsi(sPath)+Character(0)) To sPath |
724 |
Move (ToAnsi(sPrefix)+Character(0)) To sPrefix |
725 |
Move (pad("", vMAX_PATH)) To sTempFileName |
726 |
GetAddress Of sTempFileName To lpTempFileName |
727 |
GetAddress Of sPath To lpPath |
728 |
GetAddress Of sPrefix To lpPrefix |
729 |
|
730 |
Move (vWin32_GetTempFileName(lpPath, lpPrefix, 0, lpTempFileName)) To iRetVal |
731 |
Move (Trim(Cstring(sTempFileName))) To sTempFileName |
732 |
Function_Return sTempFileName |
733 |
End_Function // vCreateTempFileInPath |
734 |
|
735 |
// |
736 |
// Get a specific shell folder for example to get the desktop folder |
737 |
// simply call this function and pass it vCSIDL_DESKTOP |
738 |
// |
739 |
Function vSHGetFolderPath Integer eFolder Returns String |
740 |
String sFolder |
741 |
Integer iVoid |
742 |
Pointer lpsFolder |
743 |
Handle hWnd |
744 |
Move (Window_Handle(focus(desktop))) To hWnd |
745 |
|
746 |
Move (Repeat(Character(0), vMAX_PATH)) To sFolder |
747 |
GetAddress Of sFolder To lpsFolder |
748 |
|
749 |
Move (vWin32_SHGetFolderPath(hWnd,eFolder, 0, 0,lpsFolder)) To iVoid |
750 |
Function_Return (CString(sFolder)) |
751 |
End_Function // vSHGetFolderPath |
752 |
|
753 |
|
754 |
|
755 |
// Courtesy Of Vincent Oorsprong |
756 |
Function vConvertFileDateTime Global Dword dwLowDateTime Dword dwHighDateTime Returns String |
757 |
String sftTime sSystemTime sFormattedTime sFormattedDate |
758 |
Pointer lpsftTime lpsSystemTime lpsFormattedTime lpsFormattedDate |
759 |
Integer iSuccess iLenCcTime iDataLength iLenCcDate |
760 |
|
761 |
ZeroType vFileTime To sftTime |
762 |
Put dwLowDateTime To sftTime At vFileTime.dwLowDateTime |
763 |
Put dwHighDateTime To sftTime At vFileTime.dwHighDateTime |
764 |
GetAddress Of sftTime To lpsftTime |
765 |
|
766 |
ZeroType vSystemTime To sSystemTime |
767 |
GetAddress Of sSystemTime To lpsSystemTime |
768 |
|
769 |
Moveint (vWin32_FileTimeToSystemTime (lpsftTime, lpsSystemTime)) To iSuccess |
770 |
If iSuccess Eq DfTrue Begin |
771 |
ZeroString 255 To sFormattedTime |
772 |
GetAddress Of sFormattedTime To lpsFormattedTime |
773 |
Length sFormattedTime To iLenCcTime |
774 |
Moveint (vWin32_GetTimeFormat (LOCALE_USER_DEFAULT, 0, lpsSystemTime, 0, ; |
775 |
lpsFormattedTime, iLenCcTime)) To iDataLength |
776 |
ZeroString 255 To sFormattedDate |
777 |
GetAddress Of sFormattedDate To lpsFormattedDate |
778 |
Length sFormattedDate To iLenCcDate |
779 |
Moveint (vWin32_GetDateFormat (LOCALE_USER_DEFAULT, 0, lpsSystemTime, 0, ; |
780 |
lpsFormattedDate, iLenCcDate)) To iDataLength |
781 |
Function_Return (Cstring (sFormattedDate) * Cstring (sFormattedTime)) |
782 |
End // iSuccess |
783 |
End_Function // vConvertFileDateTime |
784 |
|
785 |
|
786 |
// **WvA Removed, See the cFileSet class for an alternative |
787 |
//Procedure DoBrowseDir String sFilePath |
788 |
//End_Procedure // DoBrowseDir |
789 |
|
790 |
// **WvA: |
791 |
// A windows replacement for the standard function FileExists. |
792 |
// This version will also return (true) for a file when it is open by an application. |
793 |
// Note that you can apply normal windows mask-signs in the filename such as * and ? |
794 |
// Example: Get vFilePathExists "C:\config.sy?" |
795 |
// This will return true if you have a file matching these conditions. (aka config.sys) |
796 |
Function vFilePathExists Global String sFilePathMask Returns Integer |
797 |
String sWin32FindData |
798 |
String sLongFileName |
799 |
Pointer lpsFilePathMask lpsWin32FindData |
800 |
Handle hFindFile |
801 |
Integer iVoid iRetval bFound |
802 |
|
803 |
GetAddress Of sFilePathMask To lpsFilePathMask |
804 |
ZeroType vWin32_Find_Data To sWin32FindData |
805 |
GetAddress Of sWin32FindData To lpswin32FindData |
806 |
Move (vWin32_FindFirstFile (lpsFilePathMask, lpsWin32FindData)) To hFindFile |
807 |
Move (vWin32_FindClose (hFindFile)) To iVoid |
808 |
Function_Return (hFindFile <> vINVALID_HANDLE_VALUE) |
809 |
End_Function // vFilePathExists |
810 |
|
811 |
|
812 |
// **WvA |
813 |
// Formats a foldername by first trimming it and after that by sticking a |
814 |
// directory separator (/\) to the end if it doesn't have one there already. |
815 |
// The folder may contain a drive letter or UNC encoding. |
816 |
Function vFolderFormat Global String sFolderName Returns String |
817 |
String sDirSep |
818 |
Move (sysconf(SYSCONF_DIR_SEPARATOR)) To sDirSep // normally \ (backslash) |
819 |
Move (Trim(sFolderName)) To sFolderName |
820 |
If (Right(sFolderName,1)<>sDirSep) Begin |
821 |
Move (sFolderName+sDirSep) To sFolderName |
822 |
End |
823 |
Function_Return sFolderName |
824 |
End_Function // vFolderFormat |
825 |
|
826 |
// |
827 |
// Gets the parent path of the currently supplied path |
828 |
// Returns "" when we are at the root folder. |
829 |
// |
830 |
Function vParentPath Global String sPath Returns String |
831 |
String sStrip |
832 |
|
833 |
If (Right(sPath,1)="\") Begin |
834 |
Move (Left(sPath,Length(sPath)-1)) To sPath |
835 |
End |
836 |
If (Pos("\",sPath)) Begin |
837 |
Move (StringFromRightOfChar(sPath,"\")) To sStrip |
838 |
Move (Replace(sStrip,sPath,"")) To sPath |
839 |
End |
840 |
Else Begin |
841 |
Move "" To sPath |
842 |
End |
843 |
Function_Return sPath |
844 |
End_Function // vParentPath |
845 |
|
846 |
// Create the folder, including intermediate directories. |
847 |
// Don't panic if the folder already exists. |
848 |
// Michael Mullan June 2009. |
849 |
Function vshCreateDirectoryEX Global String sNewFolder Returns Integer |
850 |
String sFolder sSA |
851 |
Pointer lpsFolder lpsSecurity_Attributes |
852 |
Integer iRetval bFolderCreated bInheritHandle |
853 |
Move (False) to bFolderCreated |
854 |
// fill string variable with null characters |
855 |
ZeroType vtSecurity_attributes to sSA |
856 |
// null MAX_PATH chars into var (make space) |
857 |
Move (Repeat(Character(0), vMAX_PATH)) to sFolder |
858 |
If (sNewFolder <> "") Begin |
859 |
Move dfTrue to bInheritHandle |
860 |
// Setting this to NULL is already done by the zerotype command |
861 |
// Move NULL To lpDescriptor |
862 |
Put (length(sSA)) to sSA At vtSecurity_attributes.nLength |
863 |
//Put lpDescriptor To sSA at vtSecurity_attributes.lpDescriptor |
864 |
Put bInheritHandle to sSA At vtSecurity_attributes.bInheritHandle |
865 |
GetAddress of sSA to lpsSecurity_Attributes |
866 |
// |
867 |
Move sNewFolder to sFolder |
868 |
GetAddress of sFolder to lpsFolder |
869 |
Move (vWin32_SHCreateDirectoryEx(0,lpsFolder, lpsSecurity_Attributes)) to bFolderCreated |
870 |
End |
871 |
|
872 |
If (bFolderCreated <> 0) Begin |
873 |
Move 1 to iRetVal |
874 |
|
875 |
If (bFolderCreated = 161 ) Error DFERR_OPERATOR ("Path " + sNewFolder + " is Not Valid (ERROR_BAD_PATHNAME)") |
876 |
Else If (bFolderCreated = 206 ) Error DFERR_OPERATOR ("Path " + sNewFolder + " is Not Valid (ERROR_FILENAME_EXCED_RANGE)") |
877 |
Else If (bFolderCreated = 3 ) Error DFERR_OPERATOR ("Path " + sNewFolder + " is Not Valid (ERROR_PATH_NOT_FOUND)") |
878 |
Else If (bFolderCreated = 80 ) Move 0 to iRetval // "ERROR_FILE_EXISTS" not really an error |
879 |
Else If (bFolderCreated = 183 ) Move 0 to iRetval // "ERROR_ALREADY_EXISTS" not really an error |
880 |
Else If (bFolderCreated = 1223) Error DFERR_OPERATOR ("Path " + sNewFolder + " is Not Valid (ERROR_CANCELLED)") |
881 |
Else Error DFERR_OPERATOR ("Folder Creation Error # " + String(bfoldercreated) + "\n" + sNewFolder + "(FILE_CREATION_ERROR)") |
882 |
End |
883 |
Function_Return iRetVal |
884 |
End_Function // vshCreateDirectoryEX |
885 |
|
886 |
|
887 |
Function vWin32_APIFileSize Global string sFileName returns integer |
888 |
dWord dwFileSizeHigh dwFileSizeLow |
889 |
integer iFileSize iVoid |
890 |
handle hFindFile |
891 |
pointer lpsFilePath lpsWin32FindData |
892 |
string sWin32FindData |
893 |
|
894 |
GetAddress of sFileName to lpsFilePath |
895 |
|
896 |
ZeroType vWin32_Find_Data to sWin32FindData |
897 |
GetAddress of sWin32FindData to lpsWin32FindData |
898 |
|
899 |
move (vWin32_FindFirstFile (lpsFilePath, lpsWin32FindData)) to hFindFile |
900 |
if (hFindFile<>INVALID_HANDLE_VALUE) begin |
901 |
GetBuff From sWin32FindData At vWin32_Find_Data.nFileSizeHigh To dwFileSizeHigh |
902 |
GetBuff From sWin32FindData At vWin32_Find_Data.nFileSizeLow To dwFileSizeLow |
903 |
end |
904 |
move (vWin32_FindClose (hFindFile)) to iVoid |
905 |
|
906 |
moveInt ((dwFileSizeHigh * vMaxDword) + dwFileSizeLow) to iFileSize |
907 |
|
908 |
function_return iFileSize |
909 |
End_Function // vWin32_APIFileSize |
910 |
|
911 |
|