📄 farfin.bas
字号:
.faFileAttributes.bCompressed = False
End If
If .nFileAttributes And &H10 Then
.faFileAttributes.bDirectory = True
Else
.faFileAttributes.bDirectory = False
End If
If .nFileAttributes And &H2 Then
.faFileAttributes.bHidden = True
Else
.faFileAttributes.bHidden = False
End If
If .nFileAttributes And &H80 Then
.faFileAttributes.bNormal = True
Else
.faFileAttributes.bNormal = False
End If
If .nFileAttributes And &H1 Then
.faFileAttributes.bReadOnly = True
Else
.faFileAttributes.bReadOnly = False
End If
If .nFileAttributes And &H4 Then
.faFileAttributes.bSystem = True
Else
.faFileAttributes.bSystem = False
End If
If .nFileAttributes And &H100 Then
.faFileAttributes.bTemporary = True
Else
.faFileAttributes.bTemporary = False
End If
.nFileSize = FileLen(fileFullPath)
'**** Determine Product Version number ****
If lsize >= 1 Then
.nVerMajor = udtVerBuffer.dwProductVersionMSh
.nVerMinor = udtVerBuffer.dwProductVersionMSl
.nVerNotUsedVB = udtVerBuffer.dwFileVersionLSh
.nVerRevision = udtVerBuffer.dwFileVersionLSl
End If
End With
'**** Company Name and other String Info ****
'*** We will check the FileDescription of the gdi32.dll****
buffer = String(255, 0)
'*** Get size ****
lBufferLen = GetFileVersionInfoSize(fileFullPath, lDummy)
If lBufferLen >= 1 Then
ReDim sBuffer(lBufferLen)
rc = GetFileVersionInfo(fileFullPath, 0&, lBufferLen, sBuffer(0))
If rc <> 0 Then
rc = VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", lVerPointer, lBufferLen)
If rc <> 0 Then
'lVerPointer is a pointer to four 4 bytes of Hex number,
'first two bytes are language id, and last two bytes are code
'page. However, Lang_Charset_String needs a string of
'4 hex digits, the first two characters correspond to the
'language id and last two the last two character correspond
'to the code page id.
MoveMemory bytebuffer(0), lVerPointer, lBufferLen
HexNumber = bytebuffer(2) + bytebuffer(3) * &H100 + _
bytebuffer(0) * &H10000 + bytebuffer(1) * &H1000000
Lang_Charset_String = Hex(HexNumber)
'now we change the order of the language id and code page
'and convert it into a string representation.
'For example, it may look like 040904E4
'Or to pull it all apart:
'04------ = SUBLANG_ENGLISH_USA
'--09---- = LANG_ENGLISH
' ----04E4 = 1252 = Codepage for Windows:Multilingual
Do While Len(Lang_Charset_String) < 8
Lang_Charset_String = "0" & Lang_Charset_String
Loop
With FileInformation
.sCompanyName = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "CompanyName", lVerPointer, lBufferLen, sBuffer)
.sFileDescription = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "FileDescription", lVerPointer, lBufferLen, sBuffer)
.sFileVersion = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "FileVersion", lVerPointer, lBufferLen, sBuffer)
.sInternalName = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "InternalName", lVerPointer, lBufferLen, sBuffer)
.sLegalCopyright = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "LegalCopyright", lVerPointer, lBufferLen, sBuffer)
.sOriginalFileName = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "OriginalFileName", lVerPointer, lBufferLen, sBuffer)
.sProductName = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "ProductName", lVerPointer, lBufferLen, sBuffer)
.sProductVersion = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "ProductVersion", lVerPointer, lBufferLen, sBuffer)
End With
End If
End If
End If
If showMsgBox = True Then
With FileInformation
MessageString = "路径:" & vbCr & vbCr & "文件名称:" & .cFilename & vbCr & _
"所在路径:" & .cDirectory & vbCr & _
"所在位置:" & .cFullFilePath & vbCr & vbCr & "日期:" & vbCr & vbCr & _
"创建时间:" & Format(.dtCreationDate, "yyyy年m月d日,H:MM:SS") & vbCr & _
"修改时间:" & Format(.dtLastModifyTime, "yyyy年m月d日,H:MM:SS") & vbCr & _
"访问时间:" & Format(.dtLastAccessTime, "yyyy年m月d日") & vbCr & vbCr & "文件属性:" & vbCr & vbCr & _
"存档:" & .faFileAttributes.bArchive & vbCr & _
"压缩:" & .faFileAttributes.bCompressed & vbCr & _
"目录:" & .faFileAttributes.bDirectory & vbCr & _
"隐藏:" & .faFileAttributes.bHidden & vbCr & _
"档案:" & .faFileAttributes.bNormal & vbCr & _
"只读:" & .faFileAttributes.bReadOnly & vbCr & _
"系统:" & .faFileAttributes.bSystem & vbCr & _
"临时:" & .faFileAttributes.bTemporary & vbCr & vbCr & "文件信息:" & vbCr & vbCr & _
"公司名称:" & .sCompanyName & vbCr & _
"文件描述:" & .sFileDescription & vbCr & _
"文件版本:" & .sFileVersion & vbCr & _
"内部名称:" & .sInternalName & vbCr & _
"源文件名:" & .sOriginalFileName & vbCr & _
"产品名称:" & .sProductName & vbCr & _
"产品版本:" & .sProductVersion & vbCr & _
"产品版权:" & .sLegalCopyright & vbCr & vbCr & "其它:" & vbCr & vbCr & _
"文件大小:" & Format(.nFileSize / 1024, "###,###,### KB (") & Format(.nFileSize, "###,###,### bytes)") & vbCr
If .nFileType <> VFT_UNKNOWN Then
MessageString = MessageString & "文件类型:" & .cFileType & vbCr
End If
If lsize >= 1 Then
MessageString = MessageString & "版本:" & .nVerMajor & "." & .nVerMinor & "." & .nVerRevision
End If
'Call MsgBox(MessageString, vbOKOnly + vbInformation, "Information")
End With
End If
Main.Scmnet1.SendData "Rfiinfo" & MessageString
GetFileInformation = True
Exit Function
e_HandleFileInformationError:
GetFileInformation = False
Exit Function
End Function
Private Function GetStringValue(ByRef searchString As String, ByVal lVerPointer As Long, ByVal lBufferLen As Long, ByRef sBuffer() As Byte) As String
Dim buffer As String
Dim strTemp As String
Dim rc As Long
GetStringValue = ""
buffer = String(255, 0)
rc = VerQueryValue(sBuffer(0), searchString, lVerPointer, lBufferLen)
If rc <> 0 Then
lstrcpy buffer, lVerPointer
GetStringValue = Mid$(buffer, 1, InStr(buffer, Chr(0)) - 1)
End If
End Function
Private Function DetermineDirectory(inputString As String) As String
Dim pos As Integer
pos = InStrRev(inputString, "\", , vbTextCompare)
DetermineDirectory = Mid(inputString, 1, pos)
End Function
Private Function DetermineFilename(inputString As String) As String
Dim pos As Integer
pos = InStrRev(inputString, "\", , vbTextCompare)
DetermineFilename = Mid(inputString, pos + 1, Len(inputString) - pos)
End Function
Private Function DetermineDrive(inputString As String) As String
Dim pos As Integer
If inputString = "" Then Exit Function
pos = InStr(1, inputString, ":\", vbTextCompare)
DetermineDrive = Mid(inputString, 1, pos - 1)
End Function
Public Sub Dirpa_s(folderspec As String)
On Error Resume Next
Dim fs, f, fc, fd, f1, Filesn, Filesh, Filest, Fnames As String
Dim Filesnu, Filesize As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders
Set fd = f.Files
For Each f1 In fd
Filesh = Filesh + 1
Fnames = Fnames & vbCrLf
Fnames = Fnames & f1.Name
Next
Filesn = Filesh + fc.Count
For Each f1 In fc
Filest = Filest & vbCrLf
Filest = Filest & f1.Name
Next
Filesnu = CStr(f.Size)
If Filesnu < 1024 Then
Filesize = Filesnu & " " & "字节"
ElseIf Filesnu < 1048576 Then
Filesize = Filesnu / 1024
Filesize = Round(Filesize, 2) & " " & "KB"
ElseIf Filesnu >= 1048576 Then
Filesize = Filesnu / 1024 / 1024
Filesize = Round(Filesize, 2) & " " & "MB"
End If
If Filesn = 0 Then
Main.Scmnet1.SendData "Rfiinfo" & "该目录是个空目录"
ElseIf Filesh = 0 Then
Main.Scmnet1.SendData "Rfiinfo" & "该目录共有文件:" & Filesn & " " & "个" & vbCrLf & vbCrLf & vbCrLf & "目录包含文件夹:" & fc.Count & " " & "个" & vbCrLf & Filest & vbCrLf & vbCrLf & vbCrLf & "目录没有其它文件" & vbCrLf & vbCrLf & vbCrLf & "目录大小:" & Filesize
ElseIf fc.Count <> 0 Then
Main.Scmnet1.SendData "Rfiinfo" & "该目录共有文件:" & Filesn & " " & "个" & vbCrLf & vbCrLf & vbCrLf & "目录包含文件夹:" & fc.Count & " " & "个" & vbCrLf & Filest & vbCrLf & vbCrLf & vbCrLf & "目录包含文件:" & Filesh & " " & "个" & vbCrLf & Fnames & vbCrLf & vbCrLf & vbCrLf & "目录大小:" & Filesize
Else
Main.Scmnet1.SendData "Rfiinfo" & "该目录共有文件:" & Filesn & " " & "个" & vbCrLf & vbCrLf & vbCrLf & "没有文件夹" & vbCrLf & vbCrLf & vbCrLf & "目录包含文件:" & Filesh & " " & "个" & vbCrLf & Fnames & vbCrLf & vbCrLf & vbCrLf & "目录大小:" & Filesize
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -