Public Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Enum wAtt
ReadOnly = 1
Hidden = 2
Readonly_Hidden = 3
System = 4
Hidden_System = 6
R_H_S = 7
All = 39
End Enum
Public Function File_AttRead(ByVal PathName As String, ByVal OutAtt As wAtt) As Boolean
On Error Resume Next
If GetFileAttributes(PathName) = -1 Then
File_AttRead = False
Else
OutAtt = GetFileAttributes(PathName)
End If
End Function
Public Function File_AttWirte(ByVal PathName As String, ByVal inAtt As wAtt) As Boolean
On Error Resume Next
If GetFileAttributes(PathName) = -1 Then
File_AttWirte = False
Else
SetFileAttributes PathName, inAtt
End If
End Function
'wAtt:
' 1=Readonly
' 2=Hidden
' 3=Readonly & Hidden
' 4=System
' 6=Hidden &System
' 7=Readonly & Hidden & System
' 32=Archive
' 39=All
-------------------------------------------------------------
Option Explicit
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function WinDir() As String
Dim S As String
Dim Z As Long
Dim R As Long
S = Space(254)
Z = Len(S)
R = GetWindowsDirectory(S, Z)
WinDir = Left(S, R)
WinDir = WinDir & "\"
End Function
Public Function SysDir() As String
Dim S As String
Dim Z As Long
Dim R As Long
S = Space(254)
Z = Len(S)
R = GetSystemDirectory(S, Z)
SysDir = Left(S, R)
SysDir = SysDir & "\"
End Function
Public Function TempDir() As String
Dim S As String
Dim Z As Long
Dim R As Long
S = Space(254)
Z = Len(S)
R = GetTempPath(Z, S)
TempDir = Left(S, R)
End Function
Public Function UserName() As String
Dim S As String
Dim Z As Long
Dim R As Long
S = Space(254)
Z = Len(S)
R = GetUserName(S, Z)
UserName = S
End Function
Public Function ComputerName() As String
Dim S As String
Dim Z As Long
Dim R As Long
S = Space(254)
Z = Len(S)
R = GetComputerName(S, Z)
ComputerName = S
End Function
改变文件属性
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Dim att As Long
Private Sub Command1_Click()
Dim mreadonly As Long
Dim mhide As Long
Dim marchive As Long
Dim msystem As Long
Dim s1 As String
Dim c1 As String
c1 = Chr(13) & Chr(10)
s1 = "D:\VB archives\vb6.0手册\VB6YY.WDL"
att = GetFileAttributes(s1)
If att <> 1 Then
mreadonly = att And FILE_ATTRIBUTE_READONLY
If mreadonly <> 0 Then S = "只读文件" & c1
mhidden = att And FILE_ATTRIBUTE_HIDDEN
If mhidden <> 0 Then S = "隐藏文件" & c1
marchive = att And FILE_ATTRIBUTE_ARCHIVE
If marchive <> 0 Then S = "存档文件" & c1
msystem = att And FILE_ATTRIBUTE_SYSTEM
If msystem <> 0 Then S = "系统文件"
End If
Text1.Text = s1 & "是:" & c1 & S
End Sub
Private Sub Command2_Click()
Dim sreadonly As Long
Dim shidden As Long
Dim sarchive As Long
Dim ssystem As Long
Dim rc As Long
Dim s1 As String
s1 = "D:\VB archives\vb6.0手册\VB6YY.WDL"
If Check1.Value Then
sreadonly = Not FILE_ATTRIBUTE_READONLY
End If
If Check2.Value Then
shidden = FILE_ATTRIBUTE_HIDDEN
End If
If Check3.Value Then
sarchive = Not FILE_ATTRIBUTE_ARCHIVE
End If
If Check4.Value Then
ssystem = Not FILE_ATTRIBUTE_SYSTEM
End If
Text1.Text = ""
If sreadonly Then att = att Or FILE_ATTRIBUTE_READONLY
If shidden Then att = att Or FILE_ATTRIBUTE_HIDDEN
If sarchive Then att = att Or FILE_ATTRIBUTE_ARCHIVE
If ssystem Then att = att Or FILE_ATTRIBUTE_SYSTEM
rc = SetFileAttributes(s1, att)
' GetWindowsDirectory函数声明
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, _
ByVal nSize As Long _
) As Long
' GetSystemDirectory函数声明
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" _
(ByVal lpBuffer As String, _
ByVal nSize As Long _
) As Long
Dim S As String * 80
Dim Length As Long
Dim WinPath As String
Dim SysPath As String
Private Sub Command1_Click()
MsgBox ("Windows安装目录是:" + WinPath)
End Sub
Private Sub Command2_Click()
MsgBox ("系统所在目录是:" + SysPath)
End Sub
' 获取Windows目录和系统目录的程序代码
Private Sub Form_Load()
Length = GetWindowsDirectory(S, Len(S))
WinPath = Left(S, Length)
Length = GetSystemDirectory(S, Len(S))
SysPath = Left(S, Length)
End Sub
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Public Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Function ReadIni(AppName As String, KeyName As String, FileName As String) '/读取非系统ini
Dim Ret As String
Dim NC As Integer
Ret = String(1024, 0)
NC = GetPrivateProfileString(AppName, KeyName, "", Ret, 1024, FileName)
If NC <> 0 Then Ret = Left$(Ret, Len(Ret) - 1024 + NC) Else Ret = ""
ReadIni = Ret
End Function
Function WriteIni(AppName As String, KeyName As String, lpString As String, FileName As String) '/写入非系统ini
WritePrivateProfileString AppName, KeyName, lpString, FileName
End Function
Function ReadSystemIni(AppName As String, KeyName As String) '/读取系统ini
Dim Ret As String
Dim NC As Integer
Ret = String(1024, 0)
NC = GetProfileString(AppName, KeyName, "", Ret, 1024)
If NC <> 0 Then Ret = Left$(Ret, Len(Ret) - 1024 + NC) Else Ret = ""
ReadSystemIni = Ret
End Function
Function WriteSystemIni(AppName As String, KeyName As String, lpString As String) '/写系统ini
WriteProfileString AppName, KeyName, lpString
End Function
Function SystemPath() As String '/获得系统路径
Dim SystemDirectory As String
Dim x As Long
SystemDirectory = String(1024, 0)
x = GetSystemDirectory(SystemDirectory, 1024)
SystemPath = Left$(SystemDirectory, Len(SystemDirectory) - 1024 + x)
End Function
Function WindowsPath() As String '/获得windows路径
Dim WindowsDirectory As String
Dim x As Long
WindowsDirectory = String(1024, 0)
x = GetWindowsDirectory(WindowsDirectory, 1024)
WindowsPath = Left$(WindowsDirectory, Len(WindowsDirectory) - 1024 + x)
End Function
Function TempPath() As String '/获得临时文件路径
Dim TempDirectory As String
Dim x As Long
TempDirectory = String(1024, 0)
x = GetTempPath(1024, TempDirectory)
TempPath = Left$(TempDirectory, Len(TempDirectory) - 1024 + x)
End Function