Tip

Another Clstemp

Class TempDir

Private vorlagenpath As String

Declare Private Function checkDir( path As String ) As Integer
Declare Private Function CreateDir( Byval path As String ) As Integer

'**************************************************
' Property: T e m p D i r
'**************************************************
Private Property Get TempDir As String

Dim tmp As String

tmp = Environ( "TEMP" )
If tmp = "" Then
tmp = Environ( "TMP" )
If tmp = "" Then
' wenn man schon keinen Temp-Pfad ermitteln kann, dann immer auf C: schreiben
tmp = "C:"
End If
End If

TempDir = tmp

End Property

'**************************************************
' Property: T e m p F i l e n a m e
'**************************************************
Public Property Get TempFilename As String

Dim result As Variant

result = Evaluate( randomstring$ )

TempFilename = result( 0 )

End Property

'**************************************************
' Property: T e m p P a t h
'**************************************************
Public Property Get TempPath As String

Dim tmp As String

tmp = Me.TempDir + Me.vorlagenpath

' �berpr�fen
If Not Me.CheckDir( tmp ) Then
' Pfad nicht vorhanden, dann anlegen
If Not Me.CreateDir( tmp ) Then
Error CErr_NoTmpDirectory%, CErr_txt_NoTmpDirectory$
End If
End If

TempPath = tmp

End Property

'**************************************************
' Function: C h a n g e D i r
'**************************************************
Private Function ChangeDir( tmppath As String ) As Integer

ChangeDir = False

On Error Goto ErrorHandler

Chdir tmppath

ChangeDir = True

ExitFunction:

Exit Function

ErrorHandler:

Resume ExitFunction

End Function

'**************************************************
' Function: C h e c k D i r
'**************************************************
Private Function checkDir( path As String ) As Integer

On Error Resume Next

CheckDir = False

Chdrive Left( path, 1 )
Chdir path

If Curdir = path Then
CheckDir = True
End If

End Function

'**************************************************
' Function: CreateDir
'**************************************************
Private Function CreateDir( Byval path As String ) As Integer

Dim pos As Integer
Dim tmppath As String

On Error Goto ErrorHandler

CreateDir = False

path = path + ""

' Laufwerk ausw�hlen
pos = Instr( 1, path, "" )
Chdrive( Left( path, pos - 1 ) )
pos = pos + 1

While pos <> 0
pos = Instr( pos, path, "" )
If pos > 0 Then
tmpPath = Left( path, pos - 1 )
If Not Me.ChangeDir( tmppath ) Then
Mkdir tmppath
Chdir tmppath
End If
pos = pos + 1
End If
Wend

If Curdir = Left$( path, Len( path ) - 1 ) Then
CreateDir = True
End If

EndFunction:

Exit Function

ErrorHandler:

Resume EndFunction

End Function

'**************************************************
' Function: C l e a r T m p D i r
'**************************************************
Public Sub ClearTmpDir( path As String, filetype As String )

Dim filename As String

On Error Resume Next

' nur leeren, wenn es auch vorhanden ist
If Me.CheckDir( path ) Then

filename = Dir$( path + "*" + filetype )

While Not filename = ""
Kill path + "" + filename
filename = Dir$( )
Wend

End If

End Sub

'**************************************************
' Sub: New
'**************************************************
Sub New( )

 

End Sub

End Class

This was first published in November 2000

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.