VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Classe_Fichier_FSO"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' utilise Microsoft Scripting Runtime
' la liaison FSO
Private fs As FileSystemObject
Private f
'Dim xChaine As clibString


Function WriteAllTextFile(fullFichier As String, Value As String) As Boolean
On Error GoTo fin:
  Const ForReading = 1
  Const ForWriting = 2
  Set fs = New FileSystemObject
  Set f = fs.OpenTextFile(fullFichier, ForWriting, True)
  
  f.Write Value
  f.Close
  WriteAllTextFile = True
  Exit Function
fin:
  WriteAllTextFile = False
End Function

Function ReadAllTextFile(fullFichier As String) As String
On Error GoTo fin:
  Const ForReading = 1
  Const ForWriting = 2
  Set fs = New FileSystemObject
  Set f = fs.OpenTextFile(fullFichier, ForReading)
  ReadAllTextFile = f.ReadAll
  f.Close
  Exit Function
fin:
  ReadAllTextFile = ""
End Function


Public Function File_DateCreated(fullFichier As String) As Date
On Error Resume Next
    Set fs = New FileSystemObject
    Set f = fs.GetFile(fullFichier)
    File_DateCreated = f.DateLastModified

End Function
Public Function File_Size(fullFichier As String) As Long
On Error Resume Next
    Set fs = New FileSystemObject
    Set f = fs.GetFile(fullFichier)
    File_Size = f.Size

End Function

Public Function File_DateLastAccessed(fullFichier As String) As Date
On Error Resume Next
    Set fs = New FileSystemObject
    Set f = fs.GetFile(fullFichier)
    File_DateLastAccessed = f.DateLastModified
End Function

Public Function File_DateLastModified(fullFichier As String) As Date
On Error Resume Next
    Set fs = New FileSystemObject
    Set f = fs.GetFile(fullFichier)
    File_DateLastModified = f.DateLastModified
End Function

Public Function Formate_File(fullFichier As String) As String
    xChaine.StrRemplace fullFichier, "/", "\"
    Formate_File = fullFichier
End Function
Public Sub Move_to(ByVal souce_FullPath As String, ByVal dest_FullPath As String)
On Error Resume Next
    Set fs = New FileSystemObject
    fs.MoveFile souce_FullPath, dest_FullPath
End Sub

Public Function FileExist(ByVal sFullPath As String) As Boolean
On Error Resume Next
    Set fs = New FileSystemObject
    FileExist = fs.FileExists(sFullPath)
End Function

Public Function getFileExtension(ByVal sFullPath As String) As String
On Error Resume Next
    Set fs = New FileSystemObject
    getFileExtension = fs.GetExtensionName(sFullPath)
End Function

Public Function getFileName(ByVal sFullPath As String) As String
On Error Resume Next
    Set fs = New FileSystemObject
    getFileName = fs.getFileName(sFullPath)
End Function

Public Function getFilePath(ByVal sFullPath As String) As String
On Error Resume Next
    Set fs = New FileSystemObject
    getFilePath = fs.GetFolder(sFullPath).Name
End Function

Public Function getShortPathName(ByVal sLongName As String) As String
On Error Resume Next
    Set f = fs.GetFile(sLongName)
    getShortPathName = f.ShortPath
End Function

Public Function GetLongPathName(ByVal sShortName As String) As String
Dim sLongName As String
Dim s As String
Dim iSlashPos As Integer
On Error GoTo ErreurGetLongPathName
    If Len(sShortName) < 1 Then Exit Function
    If Right(sShortName, 1) = "\" Then
        sShortName = Left(sShortName, Len(sShortName) - 1)
    End If
    ' Add \ to short name to prevent Instr from failing
    sShortName = sShortName & "\"
    
    ' Start from 4 to ignore the "[Drive Letter]:\" characters
    iSlashPos = InStr(4, sShortName, "\")
    
    ' Teste Adresse réseau
    'If Left(sShortName, 2) = "\\" Then
    '    MsgBox sShortName & " est un fichier réseau : Non disponible!"
    '    GetLongPathName = ""
    '    Exit Function
    'End If
    
    ' Pull out each string between \ character for conversion
    While iSlashPos
        s = Dir(Left(sShortName, iSlashPos - 1), vbNormal + vbHidden + vbSystem + vbDirectory)
        If s = "" Then ' Error 52 - Bad File Name or Number
            GetLongPathName = ""
            Exit Function
        End If
        sLongName = sLongName & "\" & s
        iSlashPos = InStr(iSlashPos + 1, sShortName, "\")
    Wend
    ' Prefix with the drive letter
    GetLongPathName = Left(sShortName, 2) & sLongName
    
Exit Function
ErreurGetLongPathName:
    GetLongPathName = ""
End Function

Public Function Effacer_fichier(Fichier As String) As Boolean
On Error Resume Next
    Set f = fs.GetFile(Fichier)
    Effacer_fichier = f.Delete
End Function

Private Sub Class_Initialize()
  '   Set fs = New FileSystemObject
  '   Set xChaine = New Dll_String.clibString
  '   Set xChaine = CreateObject("Dll_String.clibString")
  '   Set xChaine = New clibString

End Sub

Private Sub Class_Terminate()
    Set f = Nothing
    Set fs = Nothing
    Set xChaine = Nothing
End Sub


