DirCount()

Calcula o número de subpastas, arquivos e o espaço total em uma pasta.
Retorna uma array contendo os seguintes dados:
Array(0) => Número de subpastas
Array(1) => Número de arquivos
Array(2) => Espaço total em disco

Function DirCount(ByVal DirName)

On Error Resume Next

If Mid(DirName, 2, 1) <> ":" Then
DirName = Server.MapPath(DirName)
End If
If Err Then Err.Clear

On Error GoTo 0

Dim FSO, D, El
Dim Arr(2), Aux

Set FSO = Server.CreateObject("Scripting.FileSystemObject")

On Error Resume Next

Set D = FSO.GetFolder(DirName)
If Err Then
Err.Clear
Set FSO = Nothing
DirCount = Null
On Error GoTo 0
Exit Function
End If

On Error GoTo 0

Arr(0) = 0
Arr(1) = 0
Arr(2) = 0

For Each El In D.Files
Arr(1) = Arr(1) + 1
Arr(2) = Arr(2) + El.Size
Next

For Each El In D.SubFolders
Arr(0) = Arr(0) + 1
Aux = DirCount(El.Path)
Arr(0) = Arr(0) + Aux(0)
Arr(1) = Arr(1) + Aux(1)
Arr(2) = Arr(2) + Aux(2)
Next

Set D = Nothing
Set FSO = Nothing
DirCount = Arr

End Function

DeleteFolder()

Deleta uma pasta.
O DirName pode ser um caminho absoluto ou relativo.

Sub DeleteFolder(ByVal DirName)
On Error Resume Next

If Mid(DirName, 2, 1) <> ":" Then
DirName = Server.MapPath(DirName)
End If

If Err Then Err.Clear

On Error GoTo 0

Dim FSO
Set FSO = Server.CreateObject("Scripting.FileSystemObject")

On Error Resume Next
If FSO.FolderExists(DirName) Then
FSO.DeleteFolder DirName
End If
On Error GoTo 0

Set FSO = Nothing

End Sub

DeleteFile()

Deleta um arquivo.
O Filename pode ser um caminho absoluto ou relativo.

Sub DeleteFile(ByVal FileName)
On Error Resume Next
If Mid(FileName, 2, 1) <> ":" Then
FileName = Server.MapPath(FileName)
End If

If Err Then Err.Clear
On Error GoTo 0

Dim FSO
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FileName) Then
FSO.DeleteFile FileName
End If

Set FSO = Nothing

End Sub

DateFormat()

Formata uma expressão de data em uma string
Formata uma data. As máscaras suportadas são:
yy Ano com 2 dígitos
yyyy Ano com 4 dígitos
mm Mês de 01 a 12
dd Dia de 01 a 31
hh Hora de 00 a 23
ii Minuto de 00 a 59
ss Segundo de 00 a 59


Function DateFormat(ByVal Format, ByVal dtVariant)

Dim y2, y4, m, d
Dim h, i, s
dtVariant = CDate(dtVariant)

y4 = Year(dtVariant) & ""
m = Month(dtVariant) & ""
d = Day(dtVariant) & ""
h = Hour(dtVariant) & ""
i = Minute(dtVariant) & ""
s = Second(dtVariant) & ""

y2 = Right(y4, 2)
If Len(m) = 1 Then m = "0" & m
If Len(d) = 1 Then d = "0" & d
If Len(h) = 1 Then h = "0" & h
If Len(i) = 1 Then i = "0" & i
If Len(s) = 1 Then s = "0" & s

Format = Replace(Format, "yyyy", y4)
Format = Replace(Format, "yy", y2)
Format = Replace(Format, "mm", m)
Format = Replace(Format, "dd", d)
Format = Replace(Format, "hh", h)
Format = Replace(Format, "ii", i)
Format = Replace(Format, "ss", s)

DateFormat = Format

End Function

DateCheck()

Verifica se uma expressão de data é válida.

Function DateCheck(ByVal Data)
If Not IsDate(Data) Then
DateCheck = False
Exit Function
End If

Dim Ano, Mes, Dia
Dim Hora, Minuto, Segundo
Dim AnoAtual

Ano = Year(Data)
Mes = Month(Data)
Dia = Day(Data)
Hora = Hour(Data)
Minuto = Minute(Data)
Segundo = Second(Data)
AnoAtual = Year(Date)

If Ano < (AnoAtual - 100) Or Ano > (AnoAtual + 100) Then
DateCheck = False
Exit Function
End If


If Mes < 1 Or Mes > 12 Then
DateCheck = False
Exit Function
End If


If Dia < 1 Or Dia > 31 Then
DateCheck = False
Exit Function
End If


If Hora < 0 Or Hora > 23 Then
DateCheck = False
Exit Function
End If

If Minuto < 0 Or Minuto > 59 Then
DateCheck = False
Exit Function
End If


If Segundo < 0 Or Segundo > 59 Then
DateCheck = False
Exit Function
End If


If Mes = 2 Then
If Ano Mod 4 = 0 Then
If Dia > 29 Then
DateCheck = False
Exit Function
End If
ElseIf Dia > 28 Then
DateCheck = False
Exit Function
End If
End If


DateCheck = True
End Function

Botão direito

Função em JavaScript que bloqueia o botão direito do mouse nas páginas e as teclas Ctrl + N não permitindo o usuário criar nova página.

function onKeyDown(e) {
if (document.all) { // caso seja IE
var pressedKey = String.fromCharCode(event.keyCode).toLowerCase();
if (event.ctrlKey && (pressedKey == "n")) {
return false;
}
} else { // do contrário deve ser Mozilla
var pressedKey = String.fromCharCode(e.charCode).toLowerCase();
if (e.ctrlKey && (pressedKey == "n")) {
return false;
}
}
}

document.oncontextmenu = function desabilita() { return false };

if(document.all) {
document.onkeydown = onKeyDown; // IE
} else {
document.addEventListener('keypress', onKeyDown, false); // Mozilla
}

CurrentFolder()

Função que retorna o caminho físico da pasta atual.

Function CurrentFolder()
Dim f
f = AspSelf()
f = Left(f, InStrRev(f, "/") -1)
CurrentFolder = Server.MapPath(f)
End Function

CreateFolder()

Função em VBScript para criar uma pasta, o DirName pode ser um caminho absoluto ou relativo.

Public Function CreateFolder(ByVal DirName)
On Error Resume Next
If Mid(DirName, 2, 1) <> ":" Then
DirName = Server.MapPath(DirName)
End If
If Err Then Err.Clear
On Error GoTo 0

Dim FSO
Set FSO = Server.CreateObject("Scripting.FileSystemObject")

On Error Resume Next
If FSO.FolderExists(DirName) Then
FSO.DeleteFolder DirName
End If

If Err Then
On Error GoTo 0
CreateFolder = False
Set FSO = Nothing
Exit Function
End If

FSO.CreateFolder DirName
If Err Then
On Error GoTo 0
CreateFolder = False
Set FSO = Nothing
Exit Function
End If

On Error GoTo 0
Set FSO = Nothing
CreateFolder = True
End Function

AspSelf()

Função bem simples em VBScript, só para iniciar as coisas, logo teram mais.

'Retorna o caminho relativo do script atual.
Function AspSelf()
    AspSelf = Request.ServerVariables("SCRIPT_NAME")
End Function