Solved

vb6 ascertaining file type without fso

Posted on 2014-10-09
6
142 Views
Last Modified: 2014-10-15
hi experts

the following code retrieves the name and type of the file - ie "Text File" ... words of that ilk ...

Sub ShowFileSize(filespec)
    Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(filespec)
    s = UCase(f.Name) & " is a " & f.Type 
    MsgBox s, 0, "File Size Info"
End Sub

Open in new window


How do I find the files type using API ?

MTIA

DWE
0
Comment
Question by:dwe0608
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
6 Comments
 
LVL 17

Expert Comment

by:vb_elmar
ID: 40370437
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpfilename As String) As Long

Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Sub Form_Load()
    MsgBox myFunc("c:\autoexec.bat") = FILE_ATTRIBUTE_ARCHIVE
End Sub

Public Function myFunc(sPathName) As Long
    myFunc = GetFileAttributes(sPathName)
End Function

Open in new window

0
 
LVL 17

Expert Comment

by:vb_elmar
ID: 40370460
Here is a function :
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpfilename As String) As Long

Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Sub Form_Load()
    Dim tmp As String, zzz As String, a As Long
    tmp = "C:\autoexec.bat"
    a = myFunc(tmp)
    If (a And FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE Then zzz = zzz & "archive" & vbCrLf
    If (a And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then zzz = zzz & "directory" & vbCrLf
    If (a And FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN Then zzz = zzz & "hidden" & vbCrLf
    If (a And FILE_ATTRIBUTE_NORMAL) = FILE_ATTRIBUTE_NORMAL Then zzz = zzz & "normal" & vbCrLf
    If (a And FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY Then zzz = zzz & "readonly" & vbCrLf
    If (a And FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM Then zzz = zzz & "system" & vbCrLf
    If (a And FILE_ATTRIBUTE_TEMPORARY) = FILE_ATTRIBUTE_TEMPORARY Then zzz = zzz & "temporary" & vbCrLf
    MsgBox tmp & " is a Type :" & vbCrLf & zzz, 0, "File Size Info"
End Sub

Public Function myFunc(sPathName) As Long
    myFunc = GetFileAttributes(sPathName)
End Function

Open in new window

0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 40370523
You mention both Visual Basic and VB Script in your question.  Not sure which exactly you are using.  If you have access to using the windows libraries, you can use the solution posted above.  If you are truly using vbscript, you may need to use something like this:

Option Explicit

Dim strFile, strMsg
Dim objWMIService, strComputer, colFiles, objFile

strComputer = "."
strFile = "C:\\test.txt"   ' Use \\ instead of \
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _
    ("Select * from CIM_Datafile Where name = '" & strFile & "'")
For Each objFile in colFiles
    strMsg = "Access mask: " & objFile.AccessMask & vbCrlf
    strMsg = strMsg & "Archive: " & objFile.Archive & vbCrlf
    strMsg = strMsg & "Compressed: " & objFile.Compressed & vbCrlf
    strMsg = strMsg & "Compression method: " & objFile.CompressionMethod & vbCrlf
    strMsg = strMsg & "Creation date: " & objFile.CreationDate & vbCrlf
    strMsg = strMsg & "Computer system name: " & objFile.CSName & vbCrlf
    strMsg = strMsg & "Drive: " & objFile.Drive & vbCrlf
    strMsg = strMsg & "8.3 file name: " & objFile.EightDotThreeFileName & vbCrlf
    strMsg = strMsg & "Encrypted: " & objFile.Encrypted & vbCrlf
    strMsg = strMsg & "Encryption method: " & objFile.EncryptionMethod & vbCrlf
    strMsg = strMsg & "Extension: " & objFile.Extension & vbCrlf
    strMsg = strMsg & "File name: " & objFile.FileName & vbCrlf
    strMsg = strMsg & "File size: " & objFile.FileSize & vbCrlf
    strMsg = strMsg & "File type: " & objFile.FileType & vbCrlf
    strMsg = strMsg & "File system name: " & objFile.FSName & vbCrlf
    strMsg = strMsg & "Hidden: " & objFile.Hidden & vbCrlf
    strMsg = strMsg & "Last accessed: " & objFile.LastAccessed & vbCrlf
    strMsg = strMsg & "Last modified: " & objFile.LastModified & vbCrlf
    strMsg = strMsg & "Manufacturer: " & objFile.Manufacturer & vbCrlf
    strMsg = strMsg & "Name: " & objFile.Name & vbCrlf
    strMsg = strMsg & "Path: " & objFile.Path & vbCrlf
    strMsg = strMsg & "Readable: " & objFile.Readable & vbCrlf
    strMsg = strMsg & "System: " & objFile.System & vbCrlf
    strMsg = strMsg & "Version: " & objFile.Version & vbCrlf
    strMsg = strMsg & "Writeable: " & objFile.Writeable & vbCrlf
Next

Wscript.Echo strMsg

Open in new window

0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 46

Expert Comment

by:aikimark
ID: 40371346
Do you need to know the program with which a file is associated, just the file extension (what comes after the last period), or something else?

Since FSO gives you what you need, why not use it?
0
 
LVL 1

Author Comment

by:dwe0608
ID: 40372070
Hi guys

Maybe I didnt ask the question very succinctly ... but what I was/am after is the API to retrieve the correct file type - similar to the fso object file type property ...

The answer to my question seems to be that the relevant API for retrieving the file type is SHGetFileInfo, which takes a SHFILEINFO structure and fills it with the relevant file information.

Please confirm my code example below is correct  ....

Private Const MAX_PATH = 260

Private Type SHFILEINFO
   hIcon As Long                       
   iIcon As Long                       
   dwAttributes As Long                
   szDisplayName As String * MAX_PATH    '  out: display name (or path)
   szTypeName As String * 80                        '  out: type name
End Type

Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long


Private Function returnFileType(lpsFile as string)
   Dim sfi As SHFILEINFO
   dim retVal as long

   retval = SHGetFileInfo(Path & FileName, 0&, sfi, Len(sfi),  SHGFI_TYPENAME)

   msgbox "The file type is : " & sfi.szTypeName

end function

Open in new window

0
 
LVL 17

Accepted Solution

by:
vb_elmar earned 500 total points
ID: 40372179
Const SHGFI_DISPLAYNAME = &H200
Const SHGFI_TYPENAME = &H400
Const MAX_PATH = 260

Private Type SHFILEINFO
    hIcon As Long                       'icon
    iIcon As Long                       'icon index
    dwAttributes As Long                'SFGAO_ flags
    szDisplayName As String * MAX_PATH  'display name(or path)
    szTypeName As String * 80           'type name
End Type

Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long

Private Sub Command1_Click()
    Dim sfi As SHFILEINFO
    'Get file info
    SHGetFileInfo "c:\autoexec.bat", 0, sfi, Len(sfi), SHGFI_DISPLAYNAME Or SHGFI_TYPENAME
    MsgBox "Typename: " + Left22(sfi.szTypeName)
    MsgBox "Displayname: " + Left22(sfi.szDisplayName)
End Sub

'strip all unnecessary chr$(0)
Function Left22(sInput As String) As String
    Dim ZeroPos As Integer
    'Search position of the first chr$(0)
    ZeroPos = InStr(1, sInput, vbNullChar)
    If ZeroPos > 0 Then
        Left22 = Left$(sInput, ZeroPos - 1)
    Else
        Left22 = sInput
    End If
End Function

Open in new window

0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses
Course of the Month10 days, 10 hours left to enroll

628 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question