option explicit ' 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.version = "1.0" initData.copyright = "(c) 2017 qiuqiu" ' initData.url = "https://resource.dopus.com/viewforum.php?f=35" initData.desc = "Column Collection" initData.default_enable = true initData.min_version = "12.0" initData.config.TextFiles = ".asp.aspx.asax.ascx.ashx.bat.cmd.c.h.cs.cpp.hpp.cc.c++.css.csv.ini.inf.pas.dproj" & _ ".bdsproj.dpr.dpk.dfm.fmx.nfm.xfm.lfm.e.groovy.html.htm.shtml.hta.jsl.java.jav.jsp.js.jse.json.log.pl.pm" & _ ".plex.php.php4.phtml.ps1.py.pyw.rb.rbx.erb.resx.sql.tcl.txt.vbs.frm.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" Dim col Set col = initData.AddColumn col.name = "IsEmptyFile" col.method = "OnCompare" col.label = "Is Empty File" col.header = "空文件" 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 = "OnCompare" col.label = "Is Modified" col.header = "修改过" col.justify = "center" col.autogroup = True col.match.push_back(CStr(True)) col.match.push_back("") Set col = initData.AddColumn col.name = "Platform" col.method = "OnGetPlatform" col.label = "Platform" col.header = "运行平台" col.justify = "center" col.match.push_back("32-bit") col.match.push_back("64-bit") col.autogroup = True Set col = initData.AddColumn col.name = "Encoding" col.method = "OnGetEncoding" col.label = "Encoding" col.header = "编码" col.justify = "left" col.autogroup = True Set col = initData.AddColumn col.name = "AccessedAge" col.method = "OnGetAge" col.label = "Accessed Age" col.header = "访问于" col.justify = "Right" col.autorefresh = True col.autogroup = False Set col = initData.AddColumn col.name = "CreatedAge" col.method = "OnGetAge" col.label = "Created Age" col.header = "创建于" col.justify = "Right" col.autorefresh = True col.autogroup = False Set col = initData.AddColumn col.name = "ModifiedAge" col.method = "OnGetAge" col.label = "Modified Age" col.header = "修改于" col.justify = "Right" col.autorefresh = True col.autogroup = False End Function Function IIf(ByVal Expression, ByVal TruePart, ByVal FalsePart) If Expression Then IIf = TruePart Else IIf = FalsePart End Function Function HHex(ByVal Value) HHex = IIf(Len(Hex(Value)) Mod 2, "0" & Hex(Value), Hex(Value)) End Function Function Min(ByVal a, ByVal b) Min = IIf(a < b, a, b) End Function Function Max(ByVal a, ByVal b) Max = IIf(a > b, a, b) End Function Function GetType(ByVal path) With CreateObject("Scripting.FileSystemObject") path = .GetAbsolutePathName(path) Select Case True Case .FileExists(path) : GetType = 1 Case .FolderExists(path) : GetType = 2 Case Else : GetType = 0 End Select End With End Function Function Is_File(path) Is_File = (GetType(path) = 1) End Function Function Is_Folder(path) Is_Folder = (GetType(path) = 2) End Function Function Is_Exists(path) Is_Exists = (GetType(path) <> 0) End Function Function IsFile(ByVal FullPathName) IsFile = CBool(DOpus.FSUtil.gettype(FullPathName, "a") = "file") End Function Function IsFolder(ByVal FullPathName) IsFolder = CBool(DOpus.FSUtil.gettype(FullPathName, "a") = "dir") End Function Function IsAvailable(ByVal FullPathName) IsAvailable = CBool(DOpus.FSUtil.gettype(FullPathName, "a") <> "invalid") End Function Function PadLeft(ByVal PadStr, ByVal PadChar, ByVal PadLen) PadLeft = IIf(len(Cstr(PadStr)) < PadLen, String(PadLen - len(Cstr(PadStr)), CStr(PadChar)) & PadStr, PadStr) End Function Sub OutputBlob(ByVal BlobValue) Dim i, HexStr for i = 0 to BlobValue.size - 1 HexStr = HexStr & IIf(i = 0, PadLeft(Hex(i), 0, 8), IIf(i mod 16, " ", vbCRLF & PadLeft(Hex(i), 0, 8))) & IIf(i mod 8, "", " ") & HHex(BlobValue(i)) next Dopus.Output Trim(HexStr) End Sub Function BLng(ByVal BlobValue) Select Case BlobValue.Size Case 2 BLng = CLng(BlobValue(0) + BlobValue(1) * 2 ^ 8) Case 4 BLng = CLng(BlobValue(0) + BlobValue(1) * 2 ^ 8 + BlobValue(2) * 2 ^ 16 + BlobValue(3) * 2 ^ 24) Case Else BLng = 0 End Select 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 ' Implement the EmptyFile column Function OnCompare(CompareData) Select Case CompareData.Col Case "IsModified" If Not CompareData.Item.is_dir Then 'Is_File(CompareData.Item) If CompareData.Item.Create = CompareData.Item.Modify Then CompareData.Sort = 2 Else CompareData.value = Cstr(True) CompareData.Sort = 1 End If Else CompareData.Sort = 0 End If Case "IsEmptyFile" If Is_File(CompareData.Item) Then 'If Not CompareData.Item.is_dir Then If CompareData.Item.size = 0 Then CompareData.value = CStr(True) End If End Select End Function Function GetMachine(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, "File Is Empty", IIf(File.Size < &H3C, "Too Small", "")) If File.Error = 0 And File.Size > &H3F Then File.Read BValue, 2 If (BLng(BValue) = &H5A4D&) Then 'IMAGE_DOS_HEADER Magic number MZ File.Seek &H3C, "b" File.Read BValue, 4 File.Seek BLng(BValue), "b" File.Read BValue, 4 If BLng(BValue) = &H00004550& Then 'IMAGE_NT_HEADERS Signature PE00 File.Read BValue, 2 Machine = BLng(BValue) 'File.Read BValue, 2 'NumberOfSections = BLng(BValue) 'File.Read BValue, 4 'TimeDateStamp = BLng(BValue) ''Dopus.Output DateAdd("s", TimeDateStamp + TimeZone, #1970/01/01 00:00:00#) & " @ " & FileName 'File.Read BValue, 4 'PointerToSymbolTable = BLng(BValue) 'File.Read BValue, 4 'NumberOfSymbols = BLng(BValue) 'File.Read BValue, 2 'SizeOfOptionalHeader = BLng(BValue) 'File.Read BValue, 2 'Characteristics = BLng(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 = "Not PE File" End If End If BValue.Free File.Close End If GetMachine = Result End Function ' Implement the GetMachine column Function OnGetPlatform(PlatformColData) If Is_File(PlatformColData.Item) And (InStr(LCase(Script.config.ExeFiles + "."), LCase(PlatformColData.Item.Ext + ".")) <> 0) And (Len(PlatformColData.Item.Ext) <> 0) Then PlatformColData.value = GetMachine(PlatformColData.Item) 'IF Len(PlatformColData.value) Then PlatformColData.Group = "Other" End If End Function Function DetectBOM(ByVal FileName) 'https://en.wikipedia.org/wiki/Byte_order_mark Dim File, EnBlob, Result, i, StrBuf, MinByte, MaxByte Result = "--" Set File = DOpus.FSUtil.OpenFile(FileName) Set EnBlob = DOpus.Create.Blob() If File.Error = 0 Then If File.Size >= 2048 Then Call File.Read(EnBlob, 2048) Else Call File.Read(EnBlob) End If Else Result = "Error" File.Close Exit Function End If Select Case CBool(True) Case File.Size = 0 Result = "File is empty." Case File.Size < 3 Result = "File too 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) <> &H00) : Result = "UTF-7" Case (EnBlob(0) = &HEF And EnBlob(1) = &HBB And EnBlob(2) = &HBF And EnBlob(3) <> &H00) : Result = "UTF-8 BOM" Case (EnBlob(0) <> &H00 And EnBlob(1) = &H00 And EnBlob(2) <> &H00 And EnBlob(3) = &H00) : Result = "UTF-16LE" Case (EnBlob(0) = &H00 And EnBlob(1) <> &H00 And EnBlob(2) = &H00 And EnBlob(3) <> &H00) : Result = "UTF-16BE" Case (EnBlob(0) = &HFF And EnBlob(1) = &HFE And EnBlob(2) <> &H00 And EnBlob(3) = &H00) : Result = "UTF-16LE BOM" Case (EnBlob(0) = &HFE And EnBlob(1) = &HFF And EnBlob(2) = &H00 And EnBlob(3) <> &H00) : Result = "UTF-16BE BOM" Case (EnBlob(0) = &HFF And EnBlob(1) = &HFE And EnBlob(2) = &H00 And EnBlob(3) = &H00) : Result = "UTF-32LE BOM" Case (EnBlob(0) = &H00 And EnBlob(1) = &H00 And EnBlob(2) = &HFE And EnBlob(3) = &HFF) : Result = "UTF-32BE BOM" 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 'Dopus.Output HHex(EnBlob(0)) & " " & HHex(EnBlob(1)) & " " & HHex(EnBlob(2)) & " " & HHex(EnBlob(3)) Select Case CBool(True) Case (EnBlob(0) = &H1B And EnBlob(1) = &H28 And (EnBlob(2) = 42 Or EnBlob(2) = &H4A)) Or (EnBlob(0) = &H1B And EnBlob(1) = &H24 And (EnBlob(2) =40 Or EnBlob(2) =&H42)) Result = "ISO-2022-JP" Case (EnBlob(0) = &H1B And EnBlob(1) = &H24 And EnBlob(2) =28) Result = "ISO-2022-JP-1" Case (EnBlob(0) = &H1B And EnBlob(1) = &H24 And (EnBlob(2) = &H41 Or EnBlob(2) =&H28)) Or (EnBlob(0) = &H1B And EnBlob(1) = &H2E And (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 And (EnBlob(3) =&H41 Or EnBlob(2) =&H47)) Or (EnBlob(0) = &H1B And EnBlob(1) = &H24 And EnBlob(2) <=&H2A And EnBlob(3) =&H48) Result = "ISO-2022-CN" Case (EnBlob(0) = &H1B And EnBlob(1) = &H24 And EnBlob(2) = &H29 And EnBlob(2) =&H45) Or (EnBlob(0) = &H1B And EnBlob(1) = &H24 And EnBlob(2) = &H29 And EnBlob(2) =&H45 And (EnBlob(3) >=&H49 Or EnBlob(3) <=&H4D)) Result = "ISO-2022-CN-EXT" End Select Case Else MaxByte = EnBlob(EnBlob.Size - 1) : MinByte = EnBlob(EnBlob.Size - 1) For i = 0 to EnBlob.Size - 1 MinByte = Min(MinByte, EnBlob(i)) MaxByte = Max(MaxByte, EnBlob(i)) StrBuf = StrBuf + ChrW(EnBlob(i)) Next 'DOpus.Output FileName & " - " & "MinChar: " & IIf(MinByte = 9, "Tab",IIF(MinByte = 10, "LF",IIF(MinByte = 13, "CR",ChrW(MinByte)))) & " = " & MinByte & " " & "MaxChar: " & ChrW(MaxByte) & " = " & MaxByte Result = IIf(MaxByte < 128 And IIf(MinByte = 9, True, IIF(MinByte = 10, True, IIF(MinByte = 13, True, IIF(MinByte >=32 And MinByte < 128, True, False)))), "Prue ASCII", IIf(is_valid_utf8(StrBuf), "UTF-8", "")) End Select DetectBOM = Result End Function ' Implement the GetEncode column Function OnGetEncoding(scriptColData) If Is_File(scriptColData.item) And (InStr(LCase(Script.config.TextFiles + "."), LCase(scriptColData.item.Ext + ".")) <> 0) And (Len(scriptColData.item.Ext) <> 0) Then scriptColData.value = DetectBOM(scriptColData.item) End If End Function Function GetAge(ByVal FilePath, ByVal DType, ByVal DUnit) Dim Result(4), FileDate, DDiff, GroupText ' If IsAvailable(FilePath) Then Select Case LCase(DType) Case "a" : FileDate = DOpus.FSUtil.GetItem(FilePath).access : GroupText = "访问于 " Case "c" : FileDate = DOpus.FSUtil.GetItem(FilePath).create : GroupText = "创建于 " Case "m" : FileDate = DOpus.FSUtil.GetItem(FilePath).modify : GroupText = "修改于 " End Select Result(0) = "OK" DDiff = DateDiff("n",FileDate, Now()) Select Case LCase(Left(DUnit, 1)) Case "n" Result(1) = DDiff 'Minutes Result(2) = DDiff / 10 ^ Len(Int(DDiff)) + 0 Result(3) = GroupText & " 一小时内" Case "h" Result(1) = DDiff \ 60 'Hours Result(2) = DDiff / 10 ^ Len(Int(DDiff)) + 1 Result(3) = GroupText & " 一天以内" Case "d" Result(1) = DDiff \ 1440 'Day Result(2) = DDiff / 10 ^ Len(Int(DDiff)) + 2 Result(3) = GroupText & " 一周以内" Case "w" Result(1) = DDiff \ 10080 'Week Result(2) = DDiff / 10 ^ Len(Int(DDiff)) + 3 Result(3) = GroupText & " 一个月内" Case "m" Result(1) = DDiff \ 43200 'Month Result(2) = DDiff / 10 ^ Len(Int(DDiff)) + 4 Result(3) = GroupText & " 一年以内" Case "y" Result(1) = DDiff \ 525960 'Year Result(2) = DDiff / 10 ^ Len(Int(DDiff)) + 5 Result(3) = GroupText & " 一年以上" Case "a" 'Auto Select Case CBool(True) Case (DDiff >= 0 And DDiff < 60) ' Minutes Result(1) = DDiff & " 分钟前" 'Minutes Result(2) = DDiff / 10 ^ Len(Int(DDiff)) + 0 Result(3) = GroupText & " 一小时内" Case (DDiff >= 60 And DDiff < 1440) 'Hours Result(1) = DDiff \ 60 & " 小时前" 'Hours Result(2) = DDiff / 10 ^ Len(Int(DDiff)) + 1 Result(3) = GroupText & " 一天以内" Case (DDiff >= 1440 And DDiff < 10080) 'Day Result(1) = DDiff \ 1440 & " 天以前" 'Day Result(2) = DDiff / 10 ^ Len(Int(DDiff)) + 2 Result(3) = GroupText & " 一周以内" Case (DDiff >= 10080 And DDiff < 43200) 'Week Result(1) = DDiff \ 10080 & " 周以前" 'Week Result(2) = DDiff / 10 ^ Len(Int(DDiff)) + 3 Result(3) = GroupText & " 一个月内" Case (DDiff >= 43200 And DDiff < 525960) 'Month Result(1) = DDiff \ 43200 & " 月以前" 'Month Result(2) = DDiff / 10 ^ Len(Int(DDiff)) + 4 Result(3) = GroupText & " 一年以内" Case (DDiff >= 525960) 'Year Result(1) = DDiff \ 525960 & " 年以前" 'Year Result(2) = DDiff / 10 ^ Len(Int(DDiff)) + 5 Result(3) = GroupText & " 一年以上" End Select Case Else Result(0) = "Error" End Select ' Else ' Result(0) = "Error" ' End If GetAge = Result End Function ' Implement the Age columns Function OnGetAge(AgeColData) Dim ItemAGe Select Case AgeColData.Col Case "AccessedAge" ItemAGe = GetAge(AgeColData.Item.realpath, "a", "a") Case "CreatedAge" ItemAGe = GetAge(AgeColData.Item.realpath, "c", "a") Case "ModifiedAge" ItemAGe = GetAge(AgeColData.Item.realpath, "m", "a") End Select if ItemAGe(0) = "OK" Then AgeColData.value = ItemAGe(1) AgeColData.sort = ItemAGe(2) AgeColData.Group = ItemAGe(3) End If End Function