quinta-feira, 27 de dezembro de 2007

BrowserInfo()

Pega informações sobre o browser do usuário.

Exemplo:
var b = new BrowserInfo();
alert(b.version);


function BrowserInfo()
{

this.name = navigator.appName;

this.codename = navigator.appCodeName;

this.version = navigator.appVersion.substring(0,4);

this.platform = navigator.platform;

this.javaEnabled = navigator.javaEnabled();

this.screenWidth = screen.width;

this.screenHeight = screen.height;

}

quarta-feira, 26 de dezembro de 2007

NumberFormat()

Formata um número para SQL

Function NumberFormat(ByVal sExpr)

sExpr = sExpr & ""
If ereg("^[0-9]{1,2}/[0-9]{1,2}/[0-9]{4}$", sExpr) Then
sExpr = CDbl(CDate(sExpr)) & ""
ElseIf Not IsNumeric(sExpr) Then
NumberFormat = "0"
Exit Function
End If

sExpr = Replace(sExpr, ",", ".")
NumberFormat = sExpr

End Function

quarta-feira, 19 de dezembro de 2007

MapRoot()

Mapeia o caminho relativo para a raiz do site a partir da pasta atual.

Function MapRoot()

Dim MyPath, MyRoot
Dim MyArray
Dim i, j

MyPath = AspSelf()
MyRoot = ""
MyArray = Split(MyPath, "/")
j = UBound(MyArray) - 2

For i = j To 0 Step -1
MyRoot = MyRoot & "../"
Next

MapRoot = MyRoot

End Function

quinta-feira, 13 de dezembro de 2007

Hex2Int()

Converte uma string hexadecimal em número

Function Hex2Int(ByVal hStr)

If Not eregi("^[a-f0-9]*$", hStr) Then
Err.Raise 1002, "ASP Util Library", "Hex2Int: Invalid argument: " & hStr
End If

Dim h, D, i
Dim c, ln

h = 0
ln = Len(hStr)
Set D = Server.CreateObject("Scripting.Dictionary")

For i = 0 To 9
D.Add i & "", i
Next
For i = 65 To 70
D.Add Chr(i), i - 55
Next

For i = ln To 1 Step -1
c = UCase(Mid(hStr, i, 1))
h = h + ( D(c) * ( 16 ^ (ln - i) ) )
Next

Set D = Nothing
Hex2Int = h

End Function

terça-feira, 11 de dezembro de 2007

GetRelativePath()

Mapeia o caminho relativo para um arquivo a partir da pasta atual.

Function GetRelativePath(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 a, b, a1, b1
Dim i, Str, j

a = Server.MapPath(AspSelf())
b = FileName
a = Split(a, "\")
b = Split(b, "\")
a1 = UBound(a)
b1 = UBound(b)

i = 0
Str = ""

Do While i <= a1 And i <= b1
If LCase(a(i)) <> LCase(b(i)) Then
For j = 0 To a1 - i - 1
Str = Str & "../"
Next
For j = i To b1
Str = Str & b(j)
If j <> b1 Then Str = Str & "/"
Next
GetRelativePath = Str
Exit Function
End If
i = i + 1
Loop

While i <= b1
Str = Str & b(i)
If i < str =" Str">
i = i + 1
Wend

If Str = "" Then Str = a(a1)
GetRelativePath = Str

End Function

sexta-feira, 7 de dezembro de 2007

GetFolder()

Obtém uma pasta e retorna um objeto Folder.
O FolderName pode ser um caminho absoluto e relativo.

Function GetFolder(ByVal FolderName)

On Error Resume Next

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

On Error GoTo 0

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

On Error Resume Next

Set GetFolder = FSO.GetFolder(FolderName)
If Err Then
Err.Clear
Set GetFolder = Nothing
End If

On Error GoTo 0
Set FSO = Nothing

End Function

quarta-feira, 5 de dezembro de 2007

GetFileProps()

Obtém as propriedades de um arquivo e retorna
um objeto dicionário. Não esquecer de liberar o objeto depois de usá-lo.

Function GetFileProps(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, F, D
Set FSO = Server.CreateObject("Scripting.FileSystemObject")

On Error Resume Next

Set F = FSO.GetFile(FileName)

If Err Then
Err.Clear
Set FSO = Nothing
FileStats = Null
On Error GoTo 0
Exit Function
End If

On Error GoTo 0

Set D = Server.CreateObject("Scripting.Dictionary")

D.Add "DateCreated", F.DateCreated
D.Add "DateLastAccessed", F.DateLastAccessed
D.Add "DateLastModified", F.DateLastModified
D.Add "Size", F.Size
D.Add "Name", F.Name

Set F = Nothing
Set FSO = Nothing
Set GetFileProps = D
Set D = Nothing

End Function

quinta-feira, 29 de novembro de 2007

GetFileName()

Retorna o nome de arquivo em um caminho.

Function GetFileName(ByVal Path)
Path = Replace(Path, "/", "\")
GetFileName = Right(Path, Len(Path) - InStrRev(Path, "\"))
End Function

segunda-feira, 26 de novembro de 2007

GetFileExt()

Retorna a extensão do arquivo em um caminho.

Function GetFileExt(ByVal p)
GetFileExt = Right(p, Len(p) - InStrRev(p, "."))
End Function

sexta-feira, 23 de novembro de 2007

GetFile()

Obtém um arquivo e retorna um objeto File.
O FileName pode ser um caminho absoluto ou relativo.

Function GetFile(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")

On Error Resume Next

Set GetFile = FSO.GetFile(FileName)
If Err Then
Err.Clear
Set GetFile = Nothing
End If

On Error GoTo 0

Set FSO = Nothing

End Function

quinta-feira, 22 de novembro de 2007

FolderExists()

Checa se uma pasta existe.
O DirName pode ser um caminho absoluto ou relativo.

Function FolderExists(ByVal DirName)

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

Dim fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
FolderExists = fso.FolderExists(DirName)
Set fso = Nothing

End Function

quarta-feira, 21 de novembro de 2007

FileExists()

Checa se um arquivo existe.
O FileName pode ser um caminho absoluto ou relativo.

Function FileExists(ByVal FileName)

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

Dim fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
FileExists = fso.FileExists(FileName)
Set fso = Nothing

End Function

terça-feira, 20 de novembro de 2007

FileCountLines()

Conta o número de linhas em um arquivo.

Function FileCountLines(ByVal FileName)

Dim sStream
Dim iLines
Dim i, j, k

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

i = 1
j = 1
iLines = 0
k = Len(sStream)

Do While i <= k
i = InStr(i, sStream, vbCrLf)
If i = 0 Then Exit Do
iLines = iLines + 1
i = i + 2
Loop

If iLines > 0 Then iLines = iLines + 1

FileCountLines = iLines

End Function

segunda-feira, 19 de novembro de 2007

ereg_replace()

Substituição de expressão regular não sensível a caixa.

Function
ereg_replace(ByVal Expr, ByVal Subs, ByVal Varn)
Dim Regex
Set Regex = New RegExp
Regex.Pattern = Expr
Regex.IgnoreCase = False
Regex.Global = True
ereg_replace = Regex.Replace(Varn, Subs)
Set Regex = Nothing
End Function

quarta-feira, 7 de novembro de 2007

eregi_replace()

Substituição por expressão regular sensível a caixa.

Function eregi_replace(ByVal Expr, ByVal Subs, ByVal Varn)
Dim Regex
Set Regex = New RegExp
Regex.Pattern = Expr
Regex.IgnoreCase = True
Regex.Global = True
eregi_replace = Regex.Replace(Varn, Subs)
Set Regex = Nothing
End Function

terça-feira, 6 de novembro de 2007

eregi()

Teste de expressão regular não sensível a caixa

Function
eregi(ByVal Expr, ByVal Varn)

Dim Regex
Set Regex = New RegExp
Regex.Pattern = Expr
Regex.IgnoreCase = True
Regex.Global = True
eregi = Regex.Test(Varn)
Set Regex = Nothing
End Function

quinta-feira, 1 de novembro de 2007

ereg()

Teste de expressão regular sensível a caixa.

Function ereg(ByVal Expr, ByVal Varn)
Dim Regex
Set Regex = New RegExp
Regex.Pattern = Expr
Regex.IgnoreCase = False
Regex.Global = True
ereg = Regex.Test(Varn)
Set Regex = Nothing
End Function

sexta-feira, 26 de outubro de 2007

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

terça-feira, 23 de outubro de 2007

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

segunda-feira, 22 de outubro de 2007

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

sexta-feira, 19 de outubro de 2007

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

quinta-feira, 18 de outubro de 2007

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

quarta-feira, 17 de outubro de 2007

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

terça-feira, 16 de outubro de 2007

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

segunda-feira, 15 de outubro de 2007

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