Le portail francophone de la géomatique

'*******************************
'          *********
'     Diana2DCarto.vbp
'
'
'Module de classe
'Nomfichier
' 2004-2005
' Normalisation : Septembre 2005
' Author    : Christophe Vergon : Diana2D.dev
'*******************************
'
' Purpose   : "NomFichier" manage of file by name
'
' Descritif : Gestion des fichiers par leur nom
'
'*****************************************
'Do not use without author agreement
'Ne pas utiliser sans l'accord de l'auteur
'Diana2D.dev CopyRights 2005
'*****************************************





Option Explicit

Private mChemin As String
Private mNom As String
Private mNomComplet As String
Private mDateCreation As String
Private mextention As String * 3
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long



Public Property Get Chemin() As String
Chemin = mChemin
End Property

Public Property Let Chemin(ByVal vNewValue As String)
If vNewValue <> "" Then

If Mid$(vNewValue, Len(vNewValue), 1) <> "\" Then
vNewValue = vNewValue & "\"
End If

End If

mChemin = vNewValue
End Property
Public Property Get nomfichier() As String
nomfichier = mNom
End Property
Public Property Let nomfichier(ByVal vNewValue As String)
mNom = vNewValue
End Property
Public Property Get extention() As String
extention = mextention
End Property

Public Property Let extention(ByVal vNewValue As String)
mextention = vNewValue
End Property

Public Function existe() As Boolean

On Error Resume Next
existe = ((GetAttr(mChemin & mNom & "." & mextention) And vbDirectory) = 0)

On Error GoTo 0
End Function
Public Function CheminExiste() As Boolean
On Error Resume Next
CheminExiste = ((GetAttr(mChemin) And vbDirectory) = 16)
On Error GoTo 0
End Function
Public Function CreateChemin()

MkDir mChemin
End Function

Public Sub renomme(NewName As String)
Name mChemin & mNom & "." & mextention As mChemin & NewName & "." & mextention
End Sub

Public Sub deplace(newpath As String)
If Mid$(newpath, Len(newpath), 1) <> "\" Then
newpath = newpath & "\"
End If
Name mChemin & mNom & "." & mextention As newpath & mNom & "." & mextention
End Sub


Public Sub Copie(newcompletename As String)
Dim oldname As String
Dim dummy&

oldname = mChemin & mNom & "." & mextention
Err.clear
On Error Resume Next
dummy& = CopyFile(oldname, newcompletename, 0)
If Err.Number <> 0 Then
MsgBox ("Erreur Copie Fichier" & Str(Err.Number))
End If
End Sub

Public Sub CopieEtRenomme(NewName As String, ext As String)
   
Dim oldname As String
Dim newcompletename As String
   On Error GoTo CopieEtRenomme_Error



oldname = mChemin & mNom & "." & mextention
newcompletename = mChemin & NewName & "." & ext
FileCopy oldname, newcompletename

   On Error GoTo 0
   Exit Sub

CopieEtRenomme_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CopieEtRenomme of Module de classe Nomfichier"

End Sub
Public Sub efface()
Dim n As String
n = mChemin & mNom & "." & mextention
Kill (n)
End Sub

Public Sub ReplaceSpace()
Dim i&
Dim a$
Dim b$

b$ = ""
For i& = 1 To Len(mNom)
a$ = Mid$(mNom, i&, 1)

If a$ = " " Then a$ = "_"

b$ = b$ & a$
Next i&

mNom = b$

End Sub



Public Property Get nomcomplet() As String

    nomcomplet = mChemin & mNom & "." & mextention

End Property



Public Property Get DateCreation() As String
If existe Then
mDateCreation = FileDateTime(nomcomplet)
Else
mDateCreation = "*"
End If
DateCreation = mDateCreation
End Property