|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Arquivos/Diretórios)
|
|
 |
Título da Dica: Pegar a extensão correta de um arquivo
|
 |
|
|
|
Postada em 20/4/2007 por ¨Hennyere¨
Public Function GetFileType(xFile As String) As String
On Error Resume Next
Dim ID As String * 300
If Dir$(xFile) = "" Then
GetFileType = "Não encontrado"
Exit Function
End If
Open xFile For Binary Access Read As #1
Get #1, 1, ID
Close #1
If Left(ID, 2) = "MZ" Or Left(ID, 2) = "ZM" Then
GetFileType = "Executável"
Exit Function
ElseIf Left(ID, 1) = "[" And InStr(1, Left(ID, 100), "]") > 0 Then
GetFileType = "INI"
Exit Function
ElseIf Mid(ID, 9, 8) = "AVI LIST" Then
GetFileType = "AVI"
Exit Function
ElseIf Left(ID, 4) = "RIFF" Then
GetFileType = "WAV"
Exit Function
ElseIf Left(ID, 4) = Chr(208) & Chr(207) & Chr(17) & Chr(224) Then
GetFileType = "DOC"
Exit Function
ElseIf Mid(ID, 5, 15) = "Standard Jet DB" Then
GetFileType = "MDB"
Exit Function
ElseIf Left(ID, 3) = "GIF" Or InStr(1, ID, "GIF89") > 0 Then
GetFileType = "GIF"
Exit Function
ElseIf Left(ID, 1) = Chr(255) And Mid(ID, 5, 1) = Chr(0) Then
GetFileType = "MP3"
Exit Function
ElseIf Left(ID, 2) = "BM" Then
GetFileType = "BMP"
Exit Function
ElseIf Left(ID, 3) = "II*" Then
GetFileType = "TIFF"
Exit Function
ElseIf Left(ID, 2) = "PK" Then
GetFileType = "ZIP"
Exit Function
ElseIf InStr(1, LCase(ID), "<html>") > 0 Or InStr(1, LCase(ID), "<!doctype") > 0 Then
GetFileType = "HTML"
Exit Function
ElseIf UCase(Left(ID, 3)) = "RAR" Then
GetFileType = "RAR"
Exit Function
ElseIf Left(ID, 2) = Chr(96) & Chr(234) Then
GetFileType = "ARJ"
Exit Function
ElseIf Left(ID, 3) = Chr(255) & Chr(216) & Chr(255) Then
GetFileType = "JPEG"
Exit Function
ElseIf InStr(1, ID, "Type=") > 0 And InStr(1, ID, "Reference=") > 0 Then
GetFileType = "Projeto do Visual Basic"
Exit Function
ElseIf Left(ID, 8) = "VBGROUP " Then
GetFileType = "Grupo de projeto do Visual Basic"
Exit Function
ElseIf Left(ID, 8) = "VERSION " & InStr(1, ID, vbCrLf & "Begin") > 0 Then
GetFileType = "Form do Visual Basic"
Exit Function
Else
If InStr(1, ID, Chr$(255)) > 0 Or InStr(1, ID, Chr$(1)) > 0 Or InStr(1, ID, Chr$(2)) > 0 Or InStr(1, ID, Chr$(3)) > 0 Then
GetFileType = "Arquivo binário indefinido"
Else
GetFileType = "Arquivo de texto indefinido"
End If
Exit Function
End If
End Function
|
|
|
|
|
