USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  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
 


CyberWEB Network Ltda.    © Copyright 2000-2018   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página