//*****************************************************************************************
// Copyright (c) 2000 Michael Kurz
// All rights reserved.
// If you want to use this source in your applications conatct: <MichaelKurz@gmx.at>
//
// $FileName    : mFiles.pkg
// $ProjectName : Shared Methods
// $Author      : Michael Kurz <MichaelKurz@gmx.at>
// $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 GlobalFunctionsProcedures.pkg
#IF (!@ < 200)
External_function DLLCopyFile   "CopyFileA"    kernel32.dll Pointer pQuelle Pointer pZiel Integer bFailIfExists Returns Integer
External_Function DLLDeleteFile "DeleteFileA"  kernel32.dll Pointer szSrc Returns Integer
External_Function MoveFile      "MoveFileA"    kernel32.dll Pointer pOrig Pointer pRenamed Returns Integer
#IFNDEF Get_GetTempPathEf
External_Function GetTempPathEf "GetTempPathA" kernel32.dll Integer dwBufferLen Pointer lpBuffer Returns Integer
#ENDIF
#ELSE
External_function DLLCopyFile   "CopyFileW"    kernel32.dll Pointer pQuelle Pointer pZiel Integer bFailIfExists Returns Integer
External_Function DLLDeleteFile "DeleteFileW"  kernel32.dll Pointer szSrc Returns Integer
External_Function MoveFile      "MoveFileW"    kernel32.dll Pointer pOrig Pointer pRenamed Returns Integer
#IFNDEF Get_GetTempPathEf
External_Function GetTempPathEf "GetTempPathW" kernel32.dll Integer dwBufferLen Pointer lpBuffer Returns Integer
#ENDIF
#ENDIF

// 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
  String sPart

  If sChar In sStr ;
    Move (Left(sStr,Pos(sChar,sStr)-1)) To sPart
  Else ;
    Move sStr To sPart
  Function_Return sPart
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

Function CopyFileEx Global String sQuell String sZiel Integer iMeldung Returns Integer
  Boolean bOk
  Integer iRet
  String  sMeldung sDatei
#IF (!@ < 200)
  String  sQuellFile sZielFile
#ELSE
  WString sQuellFile sZielFile
#ENDIF

  MOve (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))
#IF (!@ < 200)
  Move (ToAnsi(sQuellFile)) To sQuellFile
  Move (ToAnsi(sZielFile))  To sZielFile
#ENDIF

  Move (DLLCopyFile(AddressOf(sQuellFile),AddressOf(sZielFile),FALSE)) To iRet
  If iRet Eq 0 If iMeldung Begin
    Move ("Could not copy File "+sQuell+" to "+ sZiel+".") To sMeldung
    Send Info_Box sMeldung
    Move FALSE To bOk
  End
  Else ;
    Move TRUE To bOk
  Function_Return bOk
End_Function

Function DoDeleteFile Global String sFile Returns Integer
  Integer iRet
#IF (!@ < 200)
  String  sS1
#ELSE
  WString sS1
#ENDIF
  Move sFile         To sS1
#IF (!@ < 200)
  Move (ToAnsi(sS1)) To sS1
#ENDIF
  Move (DLLDeleteFile(AddressOf(sS1)))   To iRet
  Function_Return iRet
End_Function


// 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
  Integer iRet
  String  sMeldung sQuellPath
#IF (!@ < 200)
  String  sQuellFile sZielFile
#ELSE
  WString sQuellFile sZielFile
#ENDIF

  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))
#IF (!@ < 200)
  Move (ToAnsi(sQuellFile)) To sQuellFile
  Move (ToAnsi(sZielFile))  To sZielFile
#ENDIF

  Move (MoveFile(AddressOf(sQuellFile),AddressOf(sZielFile))) 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

Function TempDirectory Global Returns String
  Integer iRet
  String  sDir
#IF (!@ < 200)
  String  sTempDir
#ELSE
  WString sTempDir
#ENDIF

  Move "." To sDir
  Move (Repeat(Character(0),120)) To sTempDir
  Move (GetTempPathEf(120,AddressOf(sTempDir))) To iRet
  If iRet Ne 0 Begin
#IF (!@ < 200)
    Move (ToOem(sTempDir)) To sTempDir
#ENDIF
    Move (cString(sTempDir)) To sTempDir
    If (Right(sTempDir,1)) Eq "\" ;
      Move (Left(sTempDir, ( (Length(sTempDir)) -1 ))) To sTempDir
    Move sTempDir To sDir
  End
  Function_Return sDir
End_Function