DESCRIPTION
Get real file type extracted from the file header itself. This script column add-in adds new 'Real Ext Header' column to a list of columns and displays the file type extracted from the file header.
FEATURES
- Tries to identify common text file (no extension given)
- Uses more efficient Directory Opus blob object to access the file contents
INSTALLATION
Use either provided script package (.osp) or attached VBScript code.
Choose the column 'Real Ext Header' from the Column --> Script submenu.
Real Header File Type Extension.osp (1.6 KB)
WHY
Extremely useful if you've lost your real file extensions or your investigating folder is full of .TMP or some other extensions-that -tell-you-nothing files. Actually, we've got this functionality by default in good old Amiga days.
HISTORY
v1.0 2017-02-10: Initial Release
v1.1 2017-02-11: Gets first position as some headers start later (like JFIF)
METHOD
The script is programmed using VBScript over powerful Directory Opus objects. This is my second Directory Opus script, but my first script add-in. All suggestions and criticisms are more than welcomed. 
SCRIPT CODE
Is heavily commented. I believe it will help you great deal if you are DOpus script beginner.
'-----------------------------------------------------------
' Real Header File Type Extension
' Get real file type from the file header itself
' This script column add in adds new 'Real Ext Header' column
' to a list of columns and displays the header file type
' Date: 2017-02-10
' Author: Dalibor Puljiz, Croatia
' Thanks:
' - Directory Opus developers for the greatest software
' - Especially @Leo for pointing me over to the Blob object
'History:
' v1.0: Initial Release
' v1.1: Gets first position as some headers start later (like JFIF)
'Forum link:
'
'Developer information:
'http://www.gpsoft.com.au/DScripts/redirect.asp?page=scripts
'-----------------------------------------------------------
Option Explicit
Function OnInit(initData)
Dim cmdAC
initData.name = "Real Header File Type Extension"
initData.version = "1.1"
initData.copyright = "(c) 2017 Dalibor Puljiz aka Rated RR"
'initData.url = "https://resource.dopus.com/t/real-file-type-extension/24870/4"
initData.desc = "Get real file type from the file header itself"
initData.default_enable = true
initData.min_version = "12.0"
Set cmdAC = initData.AddColumn()
cmdAC.name = "RealHFTExt"
cmdAC.method = "ReadRealExtensionFromHeader"
cmdAC.label = "Real Ext Header"
cmdAC.autogroup = true
cmdAC.autorefresh = true
cmdAC.justify = "center"
End Function
Function ReadRealExtensionFromHeader_FS(scriptColData)
'Classic VBScript Method using FileSystemObject
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f2read
If scriptColData.col <> "RealHFTExt" Then Exit Function
If scriptColData.item.is_dir Then scriptColData.value = ""
Set fso = CreateObject("Scripting.FileSystemObject")
Set f2read = fso.OpenTextFile(scriptColData.item.realpath, ForReading)
'The following method (below) is more smart than this simple one
'You might want to use RegExp to get rid of non-printable characters
scriptColData.value = f2read.Read(5)
End Function
Function ReadRealExtensionFromHeader(scriptColData)
Const HeaderMaxDepth = 20 'Suppose you will find your extension in the first 20 bytes of the file
Dim f2R 'DOpus file object
Dim blbB 'DOpus blob object
Dim strRE
Dim lngI
Dim lngMxBlbLen
'Initial checks so nothing would go wrong
If scriptColData.col <> "RealHFTExt" Then Exit Function
If scriptColData.item.is_dir Then Exit Function
'Determine max read depth if file size is lower than HeaderMaxDepth
Set f2R = scriptColData.item.Open
lngMxBlbLen = Iif(Clng(f2R.size) > HeaderMaxDepth, HeaderMaxDepth, f2R.size) - 2
If lngMxBlbLen < 2 Then Exit Function
f2R.Seek 0, "b"
Set blbB = f2R.Read(lngMxBlbLen)
'Determine header file type until first non printable characters show up
lngI = 0
Do While Not ((blbB(lngI) > 31 And blbB(lngI) < 127) And (lngI < lngMxBlbLen))
lngI = lngI +1
Loop
strRE = ""
Do While (blbB(lngI) > 31 And blbB(lngI) < 127) And (lngI < lngMxBlbLen)
strRE = strRE & Chr(blbB(lngI))
lngI =lngI + 1
Loop
'If CR+LF are met, suppose you are dealing with a text file
If blbB(lngI) = 13 And blbB(lngI+1) = 10 Then lngI = lngMxBlbLen
scriptColData.value = IIf(lngI = lngMxBlbLen, "", strRE)
End Function
Function IIf(blnExpression, vTrueResult, vFalseResult)
If blnExpression Then
IIf = vTrueResult
Else
IIf = vFalseResult
End If
End Function
BUGS
This program has been tested using my file collections. Currently, no known bugs have been identified.
CREDITS
- Directory Opus developers for the greatest software and extremely responsive help
- Especially @Leo for pointing me over to the Blob object
