CISA FotoGallery

Statistiche

Tot. visite contenuti : 928372
Home Articoli tecnici Classi Classe per gestire Log File

Classe per gestire Log File


CODICE DELLA CLASSE

Option Compare Database
Option Explicit

'Gestione di un File di LOG per memorizzare dati

'Proprietà in SCRITTURA: Property LET

'.Path = Imposta la Path del File
' DEFAULT=CurrentDb_Path

'.NomeFile = Imposta il Nome del File da Creare
' DEFAULT="Default_Log.Log"

'.Utente = Eventuale Nome Utente Connesso
' DEFAULT=NomeComputer/UserName

'.Note = Esempio il Nome della Form ecc...

'.Delimitatore = Imposta il Carattere di DELIMITAZIONE
' DEFAULT=vbTab
' Accetta solo: Tab Spazio ; ,

'.Data_Mode = Definisce il formato di DATA
' 1 gg/mm/aa hh.mm.ss
' 2 gg/mm/aa
' 3 hh.mm.ss
' 4 None

'.Messaggio = Testo del Messaggio Es.: Errore Rilevato

'Proprietà il LETTURA: Property GET

'.UserName = Restituisce il Nome dell'Utente Connesso

'.ComputerName = Restituisce il Nome della Macchina(Computer)

'.FileExist = Restituisce True se esiste il File .LOG

'Metodi

'.Action_WriteOut = Azione di Scrittura

'.Kill_File = Elimina il File.LOG se esiste

'================================================
' START CLASS MODULE
'================================================
'=== Chiamate API per recuperare Current_USER e Computer_NAME ===


Private Declare Function wu_GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long
Private Declare Function wu_GetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long
'================================================

'============= Dichiarazioni Variabili Private ==============


Private clsNomeFile As String 'NOME del File di LOG
Private clsPath As String 'PATH del File di LOG

Private clsDelimiter As String 'Carattere di DELIMITAZIONE

Private clsData As String 'Stringa con il RIF.:DATA in base al Mode
Private clsUtente As String 'NOME utente
Private clsNote As String 'NOTE messaggio
Private clsMsg As String 'MESSAGGIO

Private FileNumber As Integer 'Numero FREEFILE

'================================================
'========== Inizio Proprietà e Metodi Della CLASSE ============
'================================================


Private Sub Class_Initialize()
clsNomeFile = "Default_Log.Log"
clsPath = GetPathPart(CurrentDb.Name)
clsData = DataMode(1)
clsMsg = "None"
clsUtente = CStr(ap_GetComputerName) & "/" & ap_GetUserName
clsNote = vbNullString
clsDelimiter = vbTab
End Sub

Property Let NomeFile(Valore As String)
clsNomeFile = Valore
End Property

Property Get NomeFile() As String
NomeFile = clsNomeFile
End Property

Property Let Path(Percorso As String)
clsPath = Percorso
End Property

Property Get Path() As String
Path = clsPath
End Property

Property Let Data_Mode(Valore As Byte)
clsData = DataMode(Valore)
End Property

Property Let Note(Valore As String)
clsNote = Valore
End Property

Property Let Utente(Valore As String)
clsUtente = Valore
End Property

Property Get UserName() As String
UserName = ap_GetUserName
End Property

Property Get ComputerName()
ComputerName = ap_GetComputerName
End Property

Property Let messaggio(Valore As String)
clsMsg = Valore
End Property

Property Get FileExist() As Boolean
FileExist = isFileExist
End Property

Property Let Delimitatore(Valore As String)
If Valore = vbTab _
Or Valore = " " _
Or Valore = Chr(44) _
Or Valore = Chr(59) Then
clsDelimiter = Valore
End If
End Property

Function Action_WriteOut() As Boolean
Dim strOut As String
If FileNumber = 0 Then FileNumber = FreeFile
strOut = vbNullString

If Not IsNothing(clsData) Then strOut = clsData & clsDelimiter
If Not IsNothing(clsUtente) Then strOut = strOut & clsUtente & clsDelimiter
If Not IsNothing(clsNote) Then strOut = strOut & clsNote & clsDelimiter
If Not IsNothing(clsMsg) Then strOut = strOut & clsMsg

Open clsPath & clsNomeFile For Append As #FileNumber
Print #FileNumber, strOut
Close #FileNumber

End Function

Function Kill_File() As Boolean
On Error GoTo Error_Kill
If FileExist Then
'Cancella file
Kill clsPath & clsNomeFile
Kill_File = True
End If
Exit_Here:
Exit Function
Error_Kill:
Kill_File = False
Resume Exit_Here
End Function

Private Sub Class_Terminate()
Close #FileNumber
End Sub

'================================================
'=============== Funzioni e Sub Private ==================
'================================================


Private Function isFileExist() As Boolean
On Error Resume Next
isFileExist = Len(Dir(clsPath & clsNomeFile)) > 0
End Function

Private Function IsNothing(varToTest As Variant) As Boolean
IsNothing = True
Select Case VarType(varToTest)
Case vbEmpty
Exit Function
Case vbNull
Exit Function
Case vbBoolean
If varToTest Then IsNothing = False
Case vbByte, vbInteger, vbLong, vbSingle, vbDouble, vbCurrency
If varToTest <> 0 Then IsNothing = False
Case vbDate
IsNothing = False
Case vbString
If (Len(varToTest) <> 0 And varToTest <> " ") Then IsNothing = False
End Select
End Function

Private Function GetPathPart(strPath As String) As String
Dim intCounter As Integer
For intCounter = Len(strPath) To 1 Step -1
If Mid$(strPath, intCounter, 1) = "\" Then
Exit For
End If
Next intCounter
GetPathPart = Left$(strPath, intCounter)
End Function

Private Function ap_GetComputerName() As Variant
Dim strComputerName As String
Dim lngLength As Long
Dim lngResult As Long
Dim NullPos As Integer
'-- Set up buffer.
strComputerName = String$(255, 0)
lngLength = 255
'-- Make the call.
lngResult = wu_GetComputerName(strComputerName, lngLength)
'-- Clean up and assign the value.
NullPos = InStr(strComputerName, Chr(0))
ap_GetComputerName = Left(strComputerName, NullPos - 1)
End Function

Private Function ap_GetUserName() As String
Dim strUserName As String
Dim lngLength As Long
Dim lngResult As Long
Dim NullPos As Integer
'-- Set up the buffer
strUserName = String$(255, 0)
lngLength = 255
'-- Make the call
lngResult = wu_GetUserName(strUserName, lngLength)
NullPos = InStr(strUserName, Chr(0))
'-- Assign the value
ap_GetUserName = Left$(strUserName, NullPos - 1)
End Function
Private Function DataMode(Mode As Byte) As String
Select Case Mode
Case 1:
DataMode = CStr(Format$(Now(), "General Date"))
Case 2:
DataMode = CStr(Format$(Date, "General Date"))
Case 3:
DataMode = CStr(Format$(Time, "General Date"))
Case 4:
DataMode = vbNullString
Case Else:
DataMode = vbNullString
End Select
End Function


'===============================================
'=============== Fine MODULO di CLASSE =============
'===============================================


Alessandro Baraldi

Attachments:
Download this file (517.zip)Allegato48 Kb