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;
}
Este blog é originalmente para ser um banco de funções e procedimentos públicas de qualquer linguagem, como a minha especialidade é liguagens Microsoft® vou me ater a elas, mas caso haja pessoas interessadas em passar funções ou procedimentos de outras linguagens, sintam-se a vontade para envia-las a mim.
quinta-feira, 27 de dezembro de 2007
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
}
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
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
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
'Retorna o caminho relativo do script atual.
Function AspSelf()
AspSelf = Request.ServerVariables("SCRIPT_NAME")
End Function
Assinar:
Postagens (Atom)