//***************************************************************************************** // Copyright (c) 2000 Michael Kurz // All rights reserved. // If you want to use this source in your applications conatct: // // $FileName : mFiles.pkg // $ProjectName : Shared Methods // $Author : Michael Kurz // $Created : 01-25-2001 @ 19:00 // // Contents: // Some useful functions for filehandling. // -RTrimBackSlah // Removes all "\" at the end of a path. (String) // -FileFromPath // FileName without path from a complete path // -PathFromPath // PathName form a complete path without FileName // // // $Rev History // //***************************************************************************************** //Use mWinAPIErrorText.pkg // Removes all "\" characters from the right side of a string... Function RTrimBackSlash Global String sDir Returns String Move (Trim(sDir)) To sDir While ((Right(sDir,1)) Eq "\") // Removes all "\" from the end... Move (Left(sDir,Length(sDir)-1)) To sDir End Function_Return sDir End_Function // Gives the part of the string that is found after the right most "\" // character. Function FileFromPath Global String sDir Returns String Move (RTrimBackSlash(sDir)) To sDir // Removes all "\" from the right hand side! While ((Pos("\",sDir)) Ne 0) // Remove all path parts... Move (Right(sDir, Length(sDir)-Pos("\",sDir))) To sDir End Function_Return sDir End_Function // Complement to FileFromPath: Returns everything except the string that // is found after the right most "\" character. Function PathFromPath Global String sDir Returns String String sPath sTmp Move (RTrimBackSlash(sDir)) To sDir // Removes all "\" from the right hand side! While ((Pos("\",sDir)) Ne 0) // Removes the file part (must be here or a directory part will be removed!) Move (Left(sDir,Pos("\",sDir))) To sTmp Move (Replace(sTmp,sDir,"")) To sDir Append sPath sTmp End If (Right(sPath,1)) Eq "\" Move (Left(sPath,Length(sPath)-1)) To sPath // No "\" at the right hand Function_Return sPath End_Function //*********************************** // A few casual string functions // // // Returns the position of a substring in a host string // but not from left but from right! Function PosR Global String sChar String sStr Returns Integer String sTmp sSubst Integer iPos Move (Repeat("@",Length(sChar))) To sSubst If sSubst Eq sChar Move (Repeat(" ",Length(sChar))) To sSubst Move sStr To sTmp While (sTmp Contains sChar) Move (Pos(sChar,sTmp)) To iPos Move (Replace(sChar,sTmp,sSubst)) To sTmp End If iPos Le 0 Move 0 To iPos Else Move (Length(sStr)-iPos+1) To iPos Function_Return iPos End_Function // Liefert den linken Teil eines Strings der von eine Substring // begrenzt wird! (wenn der String gar nicht enthalten ist wird // der Gesamte String geliefert! Function PartL Global String sChar String sStr Returns String If sChar In sStr Function_Return (Left(sStr,Pos(sChar,sStr)-1)) Else Function_Return sStr End_Function // Liefert den rechten Teil eines Strings der von eine Substring // begrenzt wird! (wenn der String gar nicht enthalten ist wird // der Gesamte String geliefert! Function PartR Global String sChar String sStr Returns String If sChar In sStr Function_Return (Right(sStr,PosR(sChar,sStr)-1)) Else Function_Return sStr End_Function // Liefert den X-Ten Teil aus einem durch Trennzeichen geteilten String! Function PartX Global Integer iNr String sChar String sStr Returns String Integer iC String sPart For iC From 1 To iNr Move (PartL(sChar,sStr)) To sPart // Den Linkenteil des Strings holen Move (Replace(sPart,sStr,"")) To sStr // Diesen Teil aus dem String entfernen Move (Replace(sChar,sStr,"")) To sStr // das Trennzeichen entfernen Loop Function_Return sPart End_Function // CopyFileEx: Copy FirstFile to SecondFile and (optional) gives a MsgBox if copy failed // Added 18.05.01 Bernhard External_Function DLLCopyFile "CopyFileA" KERNEL32.DLL Pointer pQuelle Pointer pZiel Integer bFailIfExists Returns Integer Function CopyFileEx GLOBAL String sQuell String sZiel Integer iMeldung Returns Integer String sQuellFile sZielFile sMeldung sDatei sZielDatei Pointer pQuellFile pZielFile Integer iRet trim sZiel To sZiel If (Right(sZiel,1)) In "\:" Begin Move sQuell To sDatei Repeat Move (Replace((Left(sDatei,Pos("\",sDatei))),sDatei,"")) To sDatei Until (Not(sDatei Contains "\")) Append sZiel sDatei End Move sQuell To sQuellFile Move sZiel To sZielFile Append sQuellFile (Character(0)) Append sZielFile (Character(0)) getaddress Of sQuellFile To pQuellFile getaddress Of sZielFile To pZielFile Move (oemToAnsi(pQuellFile,pQuellFile)) To iRet Move (oemtoAnsi(pZielFile,pZielFile)) To iRet Move (DLLCopyFile(pQuellFile,pZielFile,FALSE)) To iRet If iRet Eq 0 If iMeldung Begin Move ("Could not copy File "+sQuell+" to "+ sZiel+".") To sMeldung Send info_box sMeldung End If (iRet) Function_Return TRUE Else Function_Return FALSE End_Function external_function DLLDeleteFile "DeleteFileA" KERNEL32.DLL Pointer szSrc Returns Integer Function DoDeleteFile Global String sFile Returns Integer String sS1 Pointer pS1 Integer iRet Move sFile To sS1 GetAddress Of sS1 To pS1 Move (OemToAnsi(pS1,pS1)) To iRet Move (DLLDeleteFile(pS1)) To iRet Function_Return iRet End_Function external_Function MoveFile "MoveFileA" kernel32.dll Pointer pOrig Pointer pRenamed Returns Integer // Fixed a bug if renaming a file that is not in the current directory // 19.2.02 Bernhard Procedure RenameFileEx GLOBAL String sQuell String sZiel Integer iMeldung String sQuellFile sZielFile sMeldung sDatei sZielDatei sQuellPath Pointer pQuellFile pZielFile Integer iRet Move sQuell To sQuellFile Move sZiel To sZielFile If (Pos("\",sZielFile)) Eq 0 Begin Move (PathFromPath(sQuellFile)) To sQuellPath Move (sQuellPath + "\" + sZielFile) To sZielFile End Get DoDeleteFile sZielFile To iRet Append sQuellFile (Character(0)) Append sZielFile (Character(0)) getaddress Of sQuellFile To pQuellFile getaddress Of sZielFile To pZielFile Move (oemToAnsi(pQuellFile,pQuellFile)) To iRet Move (oemtoAnsi(pZielFile,pZielFile)) To iRet Move (MoveFile(pQuellFile,pZielFile)) To iRet If iRet Eq 0 If iMeldung Begin Move ("Could not rename File "+sQuell+" to "+ sZiel+".") To sMeldung Send info_box sMeldung End End_Procedure // TempDirectory: Returns the Temp-Directory of Windows. If the API-Call fails, the current-directory "." is returned // Added 19.02.02 Bernhard external_function GetTempPathEf "GetTempPathA" kernel32.dll Integer dwBufferLen Pointer lpBuffer Returns Integer Function TempDirectory GLOBAL Returns String String sTempDir Pointer pTempDir Integer iRet Move (Repeat(Character(0),120)) To sTempDir getaddress Of sTempDir To pTempDir Move (GetTempPathEf(120,pTempDir)) To iRet If iRet Ne 0 Begin Move (AnsiToOem(pTempDir,pTempDir)) To iRet Move (cString(sTempDir)) To sTempDir If (Right(sTempDir,1)) Eq "\" Left sTempDir To sTempDir ( (length(sTempDir)) -1 ) Function_Return sTempDir End Function_Return "." End_Function