for programs, an x32 / x64 column would be helpful
Is that so?
You are able to make a custom column that would do this.
I found this stackoverflow answer, that indicates a method by checking the exe file how-to-check-if-a-binary-is-32-or-64-bit-on-windows.
For how to do that as a dopus custom column you can check this script that does something similar. real-header-file-type-extension
If you link your account someone might do it for you.
is this
option explicit
'const SecsPerDay = 86400
' Column Collection
' (c) 2017 qiuqiu
' This is a script for Directory Opus.
' See http://www.gpsoft.com.au/DScripts/redirect.asp?page=scripts for development information.
' Called by Directory Opus to initialize the script
Function OnInit(initData)
initData.name = "Column Collection"
initData.desc = GetResString("ScriptDesc")
initData.copyright = "qiuqiu"
initData.version = "1.1.6"
initData.min_version = "12.0"
initData.default_enable = True
initData.config.Debug = True
initData.config.TextFiles = ".asp.aspx.asax.ascx.ashx.bat.cmd.c.h.cs.cpp.hpp.cc" & vbCRLF & _
".c++.css.csv.ini.inf.pas.dproj.bdsproj.dpr.dpk.dfm" & vbCRLF & _
".fmx.nfm.xfm.lfm.e.groovy.html.htm.shtml.hta.inc" & vbCRLF & _
".jsl.java.jav.jsp.js.jse.json.log.pl.pm.plex.php" & vbCRLF & _
".php4.phtml.ps1.py.pyw.rb.rbx.erb.resx.sql.tcl.txt" & vbCRLF & _
".vbs.cls.vb.bas.xml.dtd.xhtml.xsl.xslt.wpl.xsd.xs"
initData.config.ExeFiles = ".exe.dll.ocx.cpl.8be.8bi.apl.8bf.8li.8bx.8ba.8me.bpl.lld"
initData.config.SiLength = 5
initData.config.AgeUnit = DOpus.Create.Vector(0,GetResString("UnitAuto"), GetResString("UnitMinutes"), GetResString("UnitHours"), GetResString("UnitDays"), GetResString("UnitWeeks"), GetResString("UnitMonths"), GetResString("UnitYear"))
initData.config_groups = DOpus.Create.Map("TextFiles", GetResString("TextFilesDesc"), "ExeFiles", GetResString("PEFilesDesc"), "Ageunit", GetResString("AgeUnitDesc"), _
"Debug", GetResString("DebugDesc"), "SiLength", GetResString("Other"))
initData.config_desc = DOpus.Create.Map("SiLength", GetResString("SiLength"))
Dim col
Set col = initData.AddColumn
col.name = "IsEmptyFile"
col.method = "OnGetCol"
col.label = GetResString("IsEmptyFile")
col.justify = "center"
col.autogroup = True
col.match.push_back(CStr(True))
col.match.push_back("")
Set col = initData.AddColumn
col.name = "IsModified"
col.method = "OnGetCol"
col.label = GetResString("IsModified")
col.justify = "center"
col.grouporder = "Never Modified;Modified"
'col.autogroup = False
col.match.push_back(CStr(True))
col.match.push_back("")
Set col = initData.AddColumn
col.name = "Platform"
col.method = "OnGetCol"
col.label = GetResString("Platform")
col.justify = "center"
col.autogroup = True
col.match.push_back("32-bit")
col.match.push_back("64-bit")
Set col = initData.AddColumn
col.name = "TextEncode"
col.method = "OnGetCol"
col.label = GetResString("TextEncode")
col.justify = "left"
col.autogroup = True
Col.defwidth = 70
' Set col = initData.AddColumn
' col.name = "AccessAge"
' col.method = "OnGetAge"
' col.label = GetResString("AccessAt")
' col.justify = "Right"
' Col.defwidth = 70
' col.autorefresh = True
' col.autogroup = False
Set col = initData.AddColumn
col.name = "CreateAge"
col.method = "OnGetAge"
col.label = GetResString("CreateAt")
col.justify = "Right"
Col.defwidth = 70
col.autorefresh = True
' col.autogroup = False
Set col = initData.AddColumn
col.name = "ModifyAge"
col.method = "OnGetAge"
col.label = GetResString("ModifyAt")
col.justify = "Right"
Col.defwidth = 70
col.autorefresh = True
col.autogroup = False
'Signature
Set col = initData.AddColumn
col.name = "Signature"
col.method = "OnGetCol"
col.label = GetResString("Signature")
col.justify = "Left"
col.autorefresh = True
End Function
Sub LogMsg(ByVal Message)
If Script.Config.Debug Then DOpus.Output(Message)
'DOpus.Output(Message)
End Sub
Function GetResString(ByVal ResName)
GetResString = DOpus.Strings.Get(ResName)
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function: FormatMessage
' Purpose: Slot-based string formatting function.
' Example:
' Dim str
' str = FormatMessage ("Hello, Mr. %1%, today is %2%.", Array("McNeel", Date))
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function FormatMessage(strMessage, arrArguments)
Dim strResult, i
strResult = strMessage
For i = 0 To UBound(arrArguments)
strResult = Replace(strResult, "%" & CStr(i+1) & "%", CStr(arrArguments(i)))
Next
strResult = Replace(strResult, "\n", VbCrLf)
strResult = Replace(strResult, "\t", vbTab)
FormatMessage = strResult
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function: Printf
' Purpose: Works like the printf-function in C/C++.
' Arguments: A string with format characters, and an array to expand.
' The format characters are always "%x", independent of the type.
' Example:
' Dim str
' str = Printf("Hello, Mr. %x, today is %x.", Array("McNeel", Date))
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Printf(strMessage, arrArguments)
Dim strResult, intPosition, i
strResult = ""
intPosition = 0
For i = 1 To Len(strMessage)
If Mid(strMessage, i, 1) = "%" Then
If i < Len(strMessage) Then
If Mid(strMessage, i + 1, 1) = "%" Then
strResult = strResult & "%"
i = i + 1
ElseIf Mid(strMessage, i + 1, 1) = "x" Then
strResult = strResult & CStr(arrArguments(intPosition))
intPosition = intPosition + 1
i = i + 1
End If
End If
Else
strResult = strResult & Mid(strMessage, i, 1)
End If
Next
Printf = strResult
End Function
'*******************************************************************************
'* Shl(AnyNumber, BitsToShiftBy)
'* Returns a new number with bits shifted. 0's are shifted in from the
'* right, bits will fall off on the left.
'*******************************************************************************
Function Shl(Number, Bits)
Dim Result, tmpValue, i
tmpValue = Number
For i = 1 to Bits
Select Case VarType(Number)
Case vbLong
Result = (tmpValue And "&H3FFFFFFF") * 2
If tmpValue And "&H40000000" Then Result = Result Or "&H80000000"
Result = CLng(Result)
Case vbInteger
Result = (tmpValue And "&H3FFF") * 2
If tmpValue And "&H4000" Then Result = Result Or "&H8000"
Result = CInt("&H"+ Hex(Result))
Case vbByte
Result = CByte((tmpValue And "&H7F") * 2)
Case Else: Result = 0 ' Not a supported type
End Select
tmpValue = Result
Next
Shl = Result
End Function
'*******************************************************************************
'* Shr(AnyNumber, BitsToShiftBy)
'* Returns a new number with bits shifted
'* 0's are shifted in from the left. Bits will fall off on the right.
'*******************************************************************************
Function Shr(Number, Bits)
Dim Result, tmpValue, i
tmpValue = Number
For i = 1 to Bits
Select Case VarType(Number)
Case vbLong
Result = Int((tmpValue And "&H7FFFFFFF") / 2)
If tmpValue And "&H80000000" Then Result = Result Or "&H40000000"
Result = CLng(Result)
Case vbInteger
Result = Int((tmpValue And "&H7FFF") / 2)
If tmpValue And "&H8000" Then Result = Result Or "&H4000"
Result = CInt(Result)
Case vbByte
Result = CByte(tmpValue / 2)
Case Else: Result = 0 ' Not a supported type
End Select
tmpValue = Result
Next
Shr = tmpValue
End Function
' Add a function to show file sizes in short string form
Function FormatFileSize(Size)
Dim Mult, Exp, Denom
' Windows supports files of up to 16EB.
Mult = Array("B","KB","MB","GB","TB","PB","EB")
Exp = 0 :Denom = 1
While (Size >= Denom * 1024) AND (Exp < UBound(Mult))
Denom = Denom * 1024
Exp = Exp + 1
WEnd
FormatFileSize = (Size / Denom) & " " & Mult(Exp)
End Function
Function IsBlank(Value)
'Returns True if Empty or NULL or Zero
If IsEmpty(Value) or IsNull(Value) Then
IsBlank = True
ElseIf IsNumeric(Value) Then
If Value = 0 Then IsBlank = True 'Special Case Change to suit your needs
ElseIf IsObject(Value) Then
If Value Is Nothing Then IsBlank = True
ElseIf VarType(Value) = vbString Then
If Value = "" Then IsBlank = True
Else IsBlank = False
End If
End Function
Function IIf(ByVal Expression, ByVal TruePart, ByVal FalsePart)
If Expression Then
If IsObject(TruePart) Then Set IIf = TruePart Else IIf = TruePart
Else
If IsObject(FalsePart) Then Set IIf = FalsePart Else IIf = FalsePart
End If
End Function
Function HHex(ByVal Value)
If Len(Hex(Value)) Mod 2 Then HHex = "0" & Hex(Value) Else HHex = Hex(Value)
End Function
Function CHex(Number, Bits)
Dim strChars, intSign
strChars = "0123456789ABCDEF"
intSign = Sgn(Number)
Number = Fix(Abs(CDbl(Number)))
If (Number = 0) Then
CHex = Right(String(Bits, "0"), Bits)
Exit Function
End If
While (Number > 0)
CHex = Mid(strChars, 1 + (Number - 16 * Fix(Number / 16)), 1) & CHex
Number = Fix(Number / 16)
Wend
If Len(CHex) < Bits Then CHex = Right(String(Bits, "0") & CHex, Bits)
If (intSign = -1) Then CHex = "-" & CHex
End Function
Function CRoman(intNumber)
Dim v, w, x, y, arrOnes, arrTens, arrHund, arrThou
arrOnes = Array("","I","II","III","IV","V","VI","VII","VIII","IX")
arrTens = Array("","X","XX","XXX","XL","L","LX","LXX","LXXX","XC")
arrHund = Array("","C","CC","CCC","CD","D","DC","DCC","DCCC","CM")
arrThou = Array("","M","MM","MMM","MMMM","MMMMM")
v = ((intNumber - (intNumber Mod 1000)) / 1000)
intNumber = (intNumber Mod 1000)
w = ((intNumber - (intNumber Mod 100)) / 100)
intNumber = (intNumber Mod 100)
x = ((intNumber - (intNumber Mod 10)) / 10)
y = (intNumber Mod 10)
CRoman = arrThou(v) & arrHund(w) & arrTens(x) & arrOnes(y)
End Function
Function CUnRoman(strRoman)
Dim intvalue, strChar, i
intValue = 0
If InStr(strRoman, "CM") Then
intValue = intValue + 900
strRoman = Replace(strRoman, "CM", vbBinaryCompare)
End If
If InStr(strRoman, "CD") Then
intValue = intValue + 400
strRoman = Replace(strRoman, "CD", vbBinaryCompare)
End If
If InStr(strRoman, "XC") Then
intValue = intValue + 90
strRoman = Replace(strRoman, "XC", vbBinaryCompare)
End If
If InStr(strRoman, "XL") Then
intValue = intValue + 40
strRoman = Replace(strRoman, "XL", vbBinaryCompare)
End If
If InStr(strRoman, "IX") Then
intValue = intValue + 9
strRoman = Replace(strRoman, "IX", vbBinaryCompare)
End If
If InStr(strRoman, "IV") Then
intValue = intValue + 4
strRoman = Replace(strRoman, "IV", vbBinaryCompare)
End If
For i = 1 To Len(strRoman)
strChar = Mid(strRoman, i, 1)
Select Case strChar
Case "I" intValue = intValue + 1
Case "V" intValue = intValue + 5
Case "X" intValue = intValue + 10
Case "L" intValue = intValue + 50
Case "C" intValue = intValue + 100
Case "D" intValue = intValue + 500
Case "M" intValue = intValue + 1000
End Select
Next
CUnRoman = intValue
End Function
Function IsArrayDimmed(arr)
IsArrayDimmed = False
If IsArray(arr) Then
On Error Resume Next
Dim ub : ub = UBound(arr)
If (Err.Number = 0) And (ub >= 0) Then IsArrayDimmed = True
End If
End Function
Function Min(ByVal a, ByVal b)
If a < b Then Min = a Else Min = b
End Function
Function Max(ByVal a, ByVal b)
If a > b Then Max = a Else Max = b
End Function
Function PadLeft(ByVal PadStr, ByVal PadChar, ByVal PadLen)
PadLeft = Left(PadStr & String(PadLen, CStr(PadChar)), PadLen)
End Function
Function PadRight(ByVal PadStr, ByVal PadChar, ByVal PadLen)
PadRight = Right(String(PadLen, CStr(PadChar)) & PadStr, PadLen)
End Function
Function BlobToHex(ByVal BlobValue, ByVal Spaced) 'Spaced = 1, 2, 4, 8, 16
If DOpus.Typeof(BlobValue) = "object.Blob" Then
Dim i, Result
If Spaced = 1 Or Spaced = 2 Or Spaced = 4 Or Spaced = 8 Or Spaced = 16 Then Spaced = Spaced Else Spaced = 1
for i = 0 to BlobValue.size - 1
Result = Result & IIf(i = 0, PadRight(Hex(i), 0, 8), IIf(i mod 16, "", vbCRLF & PadRight(Hex(i), 0, 8))) & IIf(i=0, " ", IIF(i mod Spaced, "", " ")) & HHex(BlobValue(i))
next
BlobToHex = Trim(Result)
Else
BlobToHex = ""
End If
End Function
Sub OutputBlob(ByVal BlobValue, ByVal Spaced)
If DOpus.Typeof(BlobValue) = "object.Blob" Then Dopus.Output BlobToHex(BlobValue, Spaced)
End Sub
Function BlobToNumber(ByVal BlobValue)
If DOpus.Typeof(BlobValue) = "object.Blob" Then
Select Case BlobValue.Size
Case 1 BlobToNumber = CByte(BlobValue(0))
Case 2 BlobToNumber = CLng(BlobValue(0) + BlobValue(1) * 2 ^ 8)
Case 4 BlobToNumber = CLng(BlobValue(0) + BlobValue(1) * 2 ^ 8 + BlobValue(2) * 2 ^ 16 + BlobValue(3) * 2 ^ 24)
Case Else BlobToNumber = 0
End Select
Else
BlobToNumber = 0
End If
End Function
'StringFormat("At {0} in {1}, the temperature was {2} degrees.", Array(123, "adc", 789))
Function FormatString(ByVal Format, ByVal Args)
Dim RegExp, Result
Result = Format
Set RegExp = New RegExp
With RegExp
.Pattern = "\{(\d{1,2})\}"
.IgnoreCase = False
.Global = True
End With
Set matches = RegExp.Execute(Result)
For Each match In matches
dim index
index = CInt(Mid(match.Value, 2, Len(match.Value) - 2))
Result = Replace(Result, match.Value, Args(index))
Next
Set matches = nothing
Set RegExp = nothing
FormatString = Result
End Function
Function ReadTextFile(ByVal FilePath, ByVal FCharset)
Dim FStream, Result
Set FStream = CreateObject("ADODB.Stream")
FStream.Type = adTypeText
FStream.Mode = adModeRead
If Len(FCharset) > 0 Then
On Error Resume Next
FStream.Charset = FCharset
If Err.number <> 0 Then
FStream.Charset = "_autodetect_all"
End If
On Error Goto 0
End If
FStream.Open
FStream.LoadFromFile sFilePath
Result = FStream.ReadText
FStream.Close
Set FStream = Nothing
ReadTextFile = Result
End Function
Function GetType(ByVal Path)
With CreateObject("Scripting.FileSystemObject")
Path = .GetAbsolutePathName(Path)
Select Case True
Case .FileExists(Path) : GetType = 1
Case .FolderExists(Path) : If .GetFolder(Path).IsRootFolder Then GetType = 3 Else GetType = 2
Case Else : GetType = 0
End Select
End With
End Function
Function Is_Exists(ByVal Path)
Is_Exists = GetType(Path) <> 0
End Function
Function Is_File(ByVal Path)
Is_File = GetType(Path) = 1
End Function
Function Is_Folder(ByVal Path)
Is_Folder = GetType(Path) = 2 Or GetType(Path) = 3
End Function
Function Is_Root(ByVal Path)
Is_Root = GetType(Path) = 3
End Function
'Author: Demon
'Date: 2011/11/10
'Website: http://demon.tw
Function is_valid_utf8(ByRef input) 'ByRef以提高效率
Dim s, re
Set re = New Regexp
s = "[\xC0-\xDF]([^\x80-\xBF]|$)"
s = s & "|[\xE0-\xEF].{0,1}([^\x80-\xBF]|$)"
s = s & "|[\xF0-\xF7].{0,2}([^\x80-\xBF]|$)"
s = s & "|[\xF8-\xFB].{0,3}([^\x80-\xBF]|$)"
s = s & "|[\xFC-\xFD].{0,4}([^\x80-\xBF]|$)"
s = s & "|[\xFE-\xFE].{0,5}([^\x80-\xBF]|$)"
s = s & "|[\x00-\x7F][\x80-\xBF]"
s = s & "|[\xC0-\xDF].[\x80-\xBF]"
s = s & "|[\xE0-\xEF]..[\x80-\xBF]"
s = s & "|[\xF0-\xF7]...[\x80-\xBF]"
s = s & "|[\xF8-\xFB]....[\x80-\xBF]"
s = s & "|[\xFC-\xFD].....[\x80-\xBF]"
s = s & "|[\xFE-\xFE]......[\x80-\xBF]"
s = s & "|^[\x80-\xBF]"
re.Pattern = s
is_valid_utf8 = (Not re.Test(input))
End Function
Function IsAscii(ByVal TextIn)
Dim vRegExp
Set vRegExp = New RegExp
With vRegExp
.IgnoreCase = False
.Global = True
.Pattern = "[\x09-\x0D\x20-\x7E]"
IsAscii = (.Replace(TextIn, "") = "")
End With
Set vRegExp = Nothing
End Function
Function IsAnsi(ByVal TextIn)
Dim vRegExp
Set vRegExp = New RegExp
With vRegExp
.IgnoreCase = False
.Global = True
.Pattern = "[\x00-\x08\x0E-\x1F\x7F]"
IsAnsi = (TextIn = .Replace(TextIn, ""))
End With
Set vRegExp = Nothing
End Function
Function GetMachine(ByVal FileName)
'https://msdn.microsoft.com/en-us/library/windows/desktop/ms680313(v=vs.85).aspx
Dim File, Result, BValue
'IMAGE_FILE_HEADER
Dim Machine', NumberOfSections, TimeDateStamp, PointerToSymbolTable, NumberOfSymbols, SizeOfOptionalHeader, Characteristics
Set File = DOpus.FSUtil.OpenFile(FileName)
Set BValue = DOpus.Create.Blob()
Result = IIf(File.Size = 0, GetResString("Empty"), IIf(File.Size < &H40, GetResString("Small"), ""))
If File.Error = 0 And File.Size > &H3F Then
File.Read BValue, 2
If (BlobToNumber(BValue) = &H5A4D&) Then 'IMAGE_DOS_HEADER Magic number MZ
File.Seek &H3C, "b"
File.Read BValue, 4
File.Seek BlobToNumber(BValue), "b"
File.Read BValue, 4
If BlobToNumber(BValue) = &H00004550& Then 'IMAGE_NT_HEADERS Signature PE00
File.Read BValue, 2
Machine = BlobToNumber(BValue)
'File.Read BValue, 2
'NumberOfSections = BlobToNumber(BValue)
'File.Read BValue, 4
'TimeDateStamp = BlobToNumber(BValue)
''Dopus.Output DateAdd("s", TimeDateStamp + TimeZone, #1970/01/01 00:00:00#) & " @ " & FileName
'File.Read BValue, 4
'PointerToSymbolTable = BlobToNumber(BValue)
'File.Read BValue, 4
'NumberOfSymbols = BlobToNumber(BValue)
'File.Read BValue, 2
'SizeOfOptionalHeader = BlobToNumber(BValue)
'File.Read BValue, 2
'Characteristics = BlobToNumber(BValu)
Select Case Machine
Case &H014C& Result = "32-bit"
Case &H0200& Result = "64-bit(IA64)"
Case &H8664& Result = "64-bit"
Case Else Result = "Unknown"
End Select
Else
Result = GetResString("NotPE")
End If
End If
BValue.Free
File.Close
Set BValue = Nothing : Set File = Nothing
End If
GetMachine = Result
End Function
Function DetectBOM(ByVal FileName)
'https://en.wikipedia.org/wiki/Byte_order_mark
Dim File, EnBlob, Result, i, StrBuf, ArrBuf
Result = "--"
Set File = DOpus.FSUtil.OpenFile(FileName)
'Set EnBlob = DOpus.Create.Blob()
If File.Error = 0 Then
If File.Size >= 2048 Then
Set EnBlob = File.Read(2048)
Else
Set EnBlob = File.Read
End If
File.Close
Set File = Nothing
Else
Result = "Error" ' GetResString("Error")
File.Close
DetectBOM = Result
Set File = Nothing
Exit Function
End If
Select Case CBool(True)
Case (EnBlob.Size = 0) Result = GetResString("Empty")
Case (EnBlob.Size < 3) Result = GetResString("Small")
Case (EnBlob(0) = &HF7 And EnBlob(1) = &H64 And EnBlob(2) = &H4C) Result = "UTF-1"
Case (EnBlob(0) = &H2B And EnBlob(1) = &H2F And EnBlob(2) = &H76 And (EnBlob(3) = &H38 Or EnBlob(3) = &H39 Or EnBlob(3) = &H2B Or EnBlob(3) = &H2F)) Result = "UTF-7"
Case (EnBlob(0) = &HEF And EnBlob(1) = &HBB And EnBlob(2) = &HBF And EnBlob(3) <> &H00) Result = "UTF-8"
Case (EnBlob(0) <> &H00 And EnBlob(1) = &H00 And EnBlob(2) <> &H00 And EnBlob(3) = &H00) Result = "UTF-16LE NO-BOM"
Case (EnBlob(0) = &H00 And EnBlob(1) <> &H00 And EnBlob(2) = &H00 And EnBlob(3) <> &H00) Result = "UTF-16BE NO-BOM"
Case (EnBlob(0) = &HFF And EnBlob(1) = &HFE And EnBlob(2) <> &H00) Result = "UTF-16LE"
Case (EnBlob(0) = &HFE And EnBlob(1) = &HFF) Result = "UTF-16BE"
Case (EnBlob(0) = &HFF And EnBlob(1) = &HFE And EnBlob(2) = &H00 And EnBlob(3) = &H00) Result = "UTF-32LE"
Case (EnBlob(0) = &H00 And EnBlob(1) = &H00 And EnBlob(2) = &HFE And EnBlob(3) = &HFF) Result = "UTF-32BE"
Case (EnBlob(0) = &H84 And EnBlob(1) = &H31 And EnBlob(2) = &H95 And EnBlob(3) = &H33) Result = "GB-18030"
Case (EnBlob(0) = &HFB And EnBlob(1) = &HEE And EnBlob(2) = &H28) Result = "BOCU-1"
Case (EnBlob(0) = &H0E And EnBlob(1) = &HFE And EnBlob(2) = &HFF) Result = "SCSU"
Case (EnBlob(0) = &H00 And EnBlob(1) = &H00 And EnBlob(2) = &HFF And EnBlob(3) = &HFE) Result = "UCS-2143"
Case (EnBlob(0) = &HFE And EnBlob(1) = &HFF And EnBlob(2) = &H00 And EnBlob(3) = &H00) Result = "UCS-3412"
Case (EnBlob(0) = &HDD And EnBlob(1) = &H73 And EnBlob(2) = &H66 And EnBlob(3) = &H73) Result = "UTF-EBCDIC"
Case (EnBlob(0) = &H1B) ' https://en.wikipedia.org/wiki/ISO/IEC_2022
Select Case CBool(True)
Case (EnBlob(0) = &H1B And (EnBlob(1) = &H28 Or EnBlob(1) = &H24) And (EnBlob(2) = 40 Or EnBlob(2) = 42 Or EnBlob(2) = &H4A)) Result = "ISO-2022-JP"
Case (EnBlob(0) = &H1B And EnBlob(1) = &H24 And EnBlob(2) = &H28) Result = "ISO-2022-JP-1"
Case (EnBlob(0) = &H1B And (EnBlob(1) = &H24 Or EnBlob(1) = &H2E) And (EnBlob(2) = &H28 Or EnBlob(2) =&H41 Or EnBlob(2) =&H46)) Result = "ISO-2022-JP-2"
Case (EnBlob(0) = &H1B And EnBlob(1) = &H28 And EnBlob(2) = &H49) Or (EnBlob(0) = &H1B And EnBlob(1) = &H24 And EnBlob(2) = &H28 And (EnBlob(3) = &H4F Or EnBlob(3) = &H50)) Result = "ISO-2022-JP-3"
Case (EnBlob(0) = &H1B And EnBlob(1) = &H24 And EnBlob(2) =&H28 And EnBlob(2) =&H51) Result = "ISO-2022-JP-2004"
Case (EnBlob(0) = &H1B And EnBlob(1) = &H24 And EnBlob(2) =&H29 And EnBlob(3) =&H43) Result = "ISO-2022-KR"
Case (EnBlob(0) = &H1B And EnBlob(1) = &H24 And (EnBlob(2) = &H29 Or EnBlob(2) = &H2A) And (EnBlob(3) = &H41 Or EnBlob(3) = &H47 Or EnBlob(3) = &H48)) Result = "ISO-2022-CN"
Case (EnBlob(0) = &H1B And EnBlob(1) = &H24 And (EnBlob(2) = &H29 Or EnBlob(2) = &H2B) And (EnBlob(3) = &H45 Or (EnBlob(3) >= &H49 And EnBlob(3) <= &H4D))) Result = "ISO-2022-CN-EXT"
End Select
Case Else
ArrBuf = Join(EnBlob.ToVBArray)
For i = 0 to EnBlob.Size - 1
StrBuf = StrBuf + ChrW(EnBlob(i))
Next
If CBool(InStr(1, ArrBuf, " 13 0 10 0 ")) Or CBool(InStr(1, ArrBuf, " 32 0 ")) Then
Result = "UTF-16LE NO-BOM"
ElseIf CBool(InStr(1, ArrBuf, " 0 13 0 10 ")) Or CBool(InStr(1, ArrBuf, " 0 32 ")) Then
Result = "UTF-16BE NO-BOM"
Else
Result = IIf(IsAscii(StrBuf), "ASCII", IIf(is_valid_utf8(StrBuf), "UTF-8 NO-BOM", "")) 'MaxByte <= 126 And IIf(MinByte = 9, True, IIf(MinByte = 10, True, IIf(MinByte = 13, True, IIf(MinByte >=32 And MinByte < 128, True, False))))
End If
End Select
Set EnBlob = Nothing
DetectBOM = Result
End Function
' Implement the Age columns
Function OnGetAge(AgeColData)
Dim DDiff, ItemDate, GroupText
If Is_Exists(AgeColData.Item.Realpath) Then
'If DOpus.FSUtil.Exists(AgeColData.Item.Realpath) Then
Select Case AgeColData.Col
' Case "AccessAge"
' ItemDate = AgeColData.Item.access : GroupText = GetResString("AccessAt")
Case "CreateAge"
ItemDate = AgeColData.Item.create : GroupText = GetResString("CreateAt")
Case "ModifyAge"
ItemDate = AgeColData.Item.modify : GroupText = GetResString("ModifyAt")
'LogMsg AgeColData.Item & Chr(9) & " modify date time: " & ItemDate
End Select
if ItemDate >= #1970/01/01 00:00:00# And ItemDate <= Now() Then
DDiff = DateDiff("n",ItemDate, Now())
Select Case LCase(Script.Config.AgeUnit)
Case "0" 'Auto
Select Case CBool(True)
Case (DDiff >= 0 And DDiff < 60) ' Minutes
AgeColData.value = DDiff & GetResString("minutes")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 0
AgeColData.Group = GroupText & GetResString("g-minutes")
Case (DDiff >= 60 And DDiff < 1440) 'Hours
AgeColData.value = DDiff \ 60 & GetResString("hours")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 1
AgeColData.Group = GroupText & GetResString("g-hours")
Case (DDiff >= 1440 And DDiff < 10080) 'Day
AgeColData.value = DDiff \ 1440 & GetResString("days")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 2
AgeColData.Group = GroupText & GetResString("g-days")
Case (DDiff >= 10080 And DDiff < 43200) 'Week
AgeColData.value = DDiff \ 10080 & GetResString("weeks")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 3
AgeColData.Group = GroupText & GetResString("g-weeks")
Case (DDiff >= 43200 And DDiff < 525960)
AgeColData.value = DDiff \ 43200 & GetResString("months")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 4
AgeColData.Group = GroupText & GetResString("g-months")
Case (DDiff >= 525960) 'Year
AgeColData.value = DDiff \ 525960 & GetResString("years")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 5
AgeColData.Group = GroupText & GetResString("g-years")
End Select
Case "1" 'Minutes
AgeColData.value = DDiff & GetResString("minutes")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 0
AgeColData.Group = GroupText & GetResString("g-minutes")
Case "2" 'Hours
AgeColData.value = DDiff \ 60 & GetResString("hours")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 1
AgeColData.Group = GroupText & GetResString("g-hours")
Case "3" 'Day
AgeColData.value = DDiff \ 1440 & GetResString("days")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 2
AgeColData.Group = GroupText & GetResString("g-days")
Case "4" 'Week
AgeColData.value = DDiff \ 10080 & GetResString("weeks")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 3
AgeColData.Group = GroupText & GetResString("g-weeks")
Case "5" 'Month
AgeColData.value = DDiff \ 43200 & GetResString("months")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 4
AgeColData.Group = GroupText & GetResString("g-months")
Case "6" 'Year
AgeColData.value = DDiff \ 525960 & GetResString("years")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 5
AgeColData.Group = GroupText & GetResString("g-years")
End Select
Else
AgeColData.value = GetResString("Error")
AgeColData.sort = CDbl(DDiff / 10 ^ 9) + 6
AgeColData.Group = GroupText & GetResString("g-Error")
End If
End If
End Function
Function OnGetCol(GetColData)
If Is_Exists(GetColData.Item.Realpath) Then
Select Case GetColData.Col
Case "IsModified" ' Implement the IsModified column
If Is_File(GetColData.Item.Realpath) Then 'Is_File(GetColData.Item)
If GetColData.Item.Create = GetColData.Item.Modify Then
GetColData.Sort = 2
GetColData.Group = "Never Modified"
Else
GetColData.value = Cstr(True)
GetColData.Sort = 1
GetColData.Group = "Modified"
End If
Else
GetColData.Sort = 0
GetColData.Group = "Folder"
End If
Case "IsEmptyFile" ' Implement the EmptyFile column
If Is_File(GetColData.Item.Realpath) Then GetColData.value = CStr(Not CBool(GetColData.Item.size)) 'And GetColData.Item.size = 0
Case "Platform" ' Implement the Platform column
If Is_File(GetColData.Item.Realpath) And (InStr(LCase(Script.Config.ExeFiles + "."), LCase(GetColData.Item.Ext + ".")) <> 0) And (Len(GetColData.Item.Ext) <> 0) Then
GetColData.value = GetMachine(GetColData.Item)
End If
Case "TextEncode" ' Implement the Encoding column
If Is_File(GetColData.Item.Realpath) And (InStr(LCase(Replace(Script.Config.TextFiles, vbCRLF, "") + "."), LCase(GetColData.item.Ext + ".")) <> 0) And (Len(GetColData.item.Ext) <> 0) Then
GetColData.value = DetectBOM(GetColData.item)
End If
Case "Signature" ' Implement the Signature column
If Is_File(GetColData.Item.Realpath) Then
Dim i, arrSig, arrString
If CBool(GetColData.Item.size) Then
arrSig = DOpus.FSUtil.OpenFile(GetColData.Item.Realpath).Read(5).ToVBArray
For i = 0 To UBound(arrSig)
GetColData.value = GetColData.value & Right("0" & Hex(arrSig(i)), 2) & " "
If (arrSig(i) >= 33) And (arrSig(i) <= 126) Then arrString = arrString & ChrW(arrSig(i)) Else arrString = arrString & ChrW(32)
Next
GetColData.value = "[" & Trim(GetColData.value) & "] [" & arrString & "]"
End If
End If
End Select
End If
End Function
==SCRIPT RESOURCES
<resources>
<resource type = "strings">
<strings lang = "chs">
<string id = "ScriptDesc" text = "自定义列合集" />
<string id = "IsEmptyFile" text = "空文件" />
<string id = "IsModified" text = "修改过" />
<string id = "Platform" text = "运行平台" />
<string id = "TextEncode" text = "文本编码" />
<string id = "AccessAt" text = "访问于" />
<string id = "CreateAt" text = "创建于" />
<string id = "ModifyAt" text = "修改于" />
<string id = "Signature" text = "文件签名" />
<string id = "Empty" text = "文件为空" />
<string id = "Small" text = "文件太小" />
<string id = "NotPe" text = "非 PE 格式文件" />
<string id = "minutes" text = " 分钟前" />
<string id = "hours" text = " 小时前" />
<string id = "days" text = " 天以前" />
<string id = "weeks" text = " 周以前" />
<string id = "months" text = " 月以前" />
<string id = "years" text = " 年以前" />
<string id = "G-minutes" text = " 一小时内" />
<string id = "G-hours" text = " 一天以内" />
<string id = "G-days" text = " 一周以内" />
<string id = "G-weeks" text = " 一月以内" />
<string id = "G-months" text = " 一年以内" />
<string id = "G-years" text = " 一年以上" />
<string id = "Error" text = " " />
<string id = "G-Error" text = " 日期错误" />
<string id = "UnitAuto" text = "自动" />
<string id = "UnitMinutes" text = "分钟" />
<string id = "UnitHours" text = "小时" />
<string id = "UnitDays" text = "天" />
<string id = "UnitWeeks" text = "周" />
<string id = "UnitMonths" text = "月" />
<string id = "UnitYear" text = "年" />
<string id = "AgeUnitDesc" text = "文件时间列单位" />
<string id = "DebugDesc" text = "脚本调试开关" />
<string id = "PEFilesDesc" text = "PE 文件扩展名" />
<string id = "TextFilesDesc" text = "文本文件扩展名" />
<string id = "SiLength" text = "读取文件签名长度" />
<string id = "Other" text = "其它" />
</strings>
<strings lang = "english">
<string id = "ScriptDesc" text = "Customize the set of columns." />
<string id = "IsEmptyFile" text = "Is Empty File" />
<string id = "IsModified" text = "Is Modified" />
<string id = "Platform" text = "Platform" />
<string id = "TextEncode" text = "Encoding" />
<string id = "AccessAt" text = "Access At" />
<string id = "CreateAt" text = "Create At" />
<string id = "ModifyAt" text = "Modify At" />
<string id = "Signature" text = "Signature" />
<string id = "Empty" text = "File is empty." />
<string id = "Small" text = "File too small." />
<string id = "NotPe" text = "Not PE file." />
<string id = "minutes" text = " minutes ago" />
<string id = "hours" text = " hours ago " />
<string id = "days" text = " days ago " />
<string id = "weeks" text = " weeks ago " />
<string id = "months" text = " months ago " />
<string id = "years" text = " years ago " />
<string id = "Error" text = " date error" />
<string id = "G-minutes" text = " within one hours"/>
<string id = "G-hours" text = " within one days"/>
<string id = "G-Days" text = " within one weeks"/>
<string id = "G-Weeks" Text = " within one months"/>
<string id = "G-months" text = " within one years"/>
<string id = "G-Years" Text = " More than one years"/>
<string id = "G-Error" text = " Date error" />
<string id = "UnitAuto" text = " Auto" />
<string id = "UnitMinutes" text = " Minute" />
<string id = "UnitHours" text = " Hour" />
<string id = "UnitDays" text = " Day" />
<string id = "UnitWeeks" text = " Week" />
<string id = "UnitMonths" text = " Month" />
<string id = "UnitYear" text = " Year" />
<string id = "AgeUnitDesc" text = "File age column unit." />
<string id = "DebugDesc" text = "Script debug switch." />
<string id = "PEFilesDesc" text = "PE file extensions." />
<string id = "TextFilesDesc" text = "Text file extensions." />
<string id = "SiLength" text = "Read the file signature length" />
<string id = "Other" text = "Other" />
</strings>
</resource>
</resources>
that script needs its own thread.
The Description column includes this information for .exe files.
2 Likes
I might update the column script for .exe files once I free myself some more time. Thanks for the Stackoverflow link.
Folks, pls advise how the above script,
that has resources embedded
can be successfully deployed,
thx
