Code:
' NEW FUNCTION VERSION 2.1 ' Returns: FALSE = NO ERRORS ' TRUE = one or more errors FUNCTION EditCustPath (szInFileNameExt AS ASCIIZ, cfg() AS CONFIGFileType) AS LONG ' for any config file entry with a custPath column, make that column the new file name ' which is the path specified in the cfg.szPath + szInfileNameExt ' and make sure I can write it. ' How do I allow for relative paths, which I want to convert to absolute full paths? ' GetLongPathName? that just might do it IT DOES NOT BUT Get**FULL**Pathname works good ' I think I will call this with some prompts as a test program. LOCAL sz AS ASCIIZ * %MAX_PATH LOCAL szFullPath AS ASCIIZ * %MAX_PATH LOCAL dwAddr AS DWORD LOCAL iRET AS LONG LOCAL iVF AS LONG LOCAL swChar AS STRING LOCAL LE AS LONG LOCAL iCfg AS LONG ' GETFULLPATHNAME works perfectly even with multiple nodes!!! ' See also PathResolve() LOCAL bErr AS LONG ' set to true as soon as any error occurs FOR iCfg = LBOUND(cfg,1) TO UBOUND (cfg,1) sz = Cfg(icfg).szPath ' what was loaded from config file STDOUT USING$ ("Checking config File entry # _, Path is '&'", iCfg +1&, sz) IF LStrLen(sz) THEN ' if one was found ' get the fully-qualified name, we need that for multiple purposes ' Is it a valid folder? RESET szFullPath iRet = GetFullpathName ( sz, SIZEOF(szFullPath), szFullPath, dwAddr) ' returns TRUE on success LE = getLastError IF ISTRUE iREt THEN ' we got the full name back iRet = %ERROR_SUCCESS ' what we use later STDOUT USING$ (" Fully Qualified Path is '&'", szFullPath) ' is this an existing valid folder? ivf = IsValidFolder (szFullPath) IF ISTRUE ivf THEN STDOUT " This is an existing folder" ELSE STDOUT " Folder not found; will attempt to create it." swChar = UCODE$(szFullPath) & CHR$(0,0) ' make sure it's Unicode terminated iRet = ShCreateDirectory (GetDesktopWindow(), BYVAL STRPTR(swChar)) ' returns 0 ERROR_SUCCESS IF iRet = %ERROR_SUCCESS THEN STDOUT " Folder successfully created" ELSE STDOUT USING$(" Could not create folder '&'", szFullPath) STDOUT " See STDERR for details" STDERR2 USING$(" Error message is &", SystemErrorMessageText(iRet)) bErr = %TRUE END IF END IF ELSE STDOUT USING$(" Could not get full-qualified path name for '&'", sz) STDOUT USING$(" Error message is &", SystemErrorMEssageText(LE)) bERR = %TRUE END IF IF ISFALSE Iret THEN ' everyting was OK ' make the cfg entry = path + Input file name cfg(iCfg).szpath = szFullPath & "\" & szInFileNameExt STDOUT USING$ (" Set Customer file name to '&'", cfg(iCfg).szPath) END IF END IF ' if customer even had a path entry in the config file NEXT iCfg ' ** LOGIcAL END OF FUNCTION ** FUNCTION = bErr #IF 0 THIS IS TEST CODE ONLY ' change cfg entry to be input file DO STDOUT USING$ ("CURDIR$==>'&'", CURDIR$) ' does not return trailing slash LINE INPUT "Enter cust Path to convert", sz IF LEN (sz) THEN RESET szFullPath IF ISFALSE IVF THEN s = sz STDOUT USING$("Pathnames for path &", PATHNAME$(PATH, s)) STDOUT USING$ (" Creating folder '&'", s) ' sWChar = UCODE$(s) & CHR$(0,0) ' this needs fully-qualified path MKDIR s ' fails with multiple nodes.Ok wioth A\DAta as long as A exists. 'STDOUT "Create Folder Returns " & SystemErrorMEssageText(iret) END IF ELSE EXIT FUNCTION END IF LOOP #ENDIF END FUNCTION
MCM
Leave a comment: