如何用api函数实现改变桌面的图片？

Question

1、如何用api函数实现改变桌面的图片？
2、如何用api函数实现显示驱动器，及显示驱动器下文件夹与文件？

Answer 1

1.正在狂翻书....2.是用资源管理器打开文件夹吗?shell "start c:\windows"
打开windows文件夹.
shell "start {20D04FE0-3AEA-1069-A2D8-08002B30309D}"
打开我的电脑

Answer 2

1.SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "文件名", SPIF_UPDATEINIFILE)
成功返回非零值,失败返回零.会设置GetLastError.SPIF_UPDATEINIFILE表示更新配置文件.上面的打开我的电脑不对,正在寻找....

Answer 3

Option ExplicitPrivate Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As LongConst SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1'  设置Bmp图片为桌面图片,
'  FileN传递图片的路径和文件名
Private Function SetWallPaper(FileN As String) As Boolean
    Dim RS As Long
    
    RS = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, FileN, SPIF_UPDATEINIFILE)
    If RS Then
        SetWallPaper = True
    Else
        SetWallPaper = False
    End If
End Function'  清除桌面图片
Private Function ClearWallPaper() As Boolean
    Dim RS As Long
    
    RS = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "", SPIF_UPDATEINIFILE)
    If RS Then
        ClearWallPaper = True
    Else
        ClearWallPaper = False
    End If
End FunctionPrivate Sub Command1_Click()
MsgBox SetWallPaper("c:\windows\Bubbles.bmp")
  
End SubPrivate Sub Command2_Click()
    ClearWallPaper
End Sub

Answer 4

2、如何用api函数实现显示驱动器，及显示驱动器下文件夹与文件？
如果是显示驱动器下的文件，可以采用fso对象
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDrives Lib "kernel32" () As LongPrivate Const DRIVE_UNKNOWN = 0
Private Const DRIVE_NO_ROOT_DIR = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6'　　用来返回磁盘驱动器的个数
Public Function DriveCount() As Integer
    Dim BitMask As Long
    Dim j, i
    
    BitMask = GetLogicalDrives()
    For i = 0 To 24
        If BitMask And 2 ^ i Then
            j = j + 1
        End If
    Next i
    DriveCount = j
End Function'  返回驱动器的名称
Public Function LoadDrivenames(An_Array() As String) As Long
    Dim j, i
    Dim lpBuffer As String
    
    ReDim An_Array(128) As String
    lpBuffer = Space$(1024)
    '  返回当前所有逻辑驱动器的根驱动器路径
    GetLogicalDriveStrings Len(lpBuffer), lpBuffer
    j = InStr(lpBuffer, Chr$(0))
    '  存储磁盘驱动器的名称到An_Array中
    Do While j > 0
        An_Array(i) = Left$(lpBuffer, j - 1)
        i = i + 1
        lpBuffer = Mid$(lpBuffer, j + 1)
        j = InStr(lpBuffer, Chr$(0))
    Loop
    ReDim Preserve An_Array(DriveCount)
End Function'  返回磁盘驱动器的类型
Public Function Types(Optional sDrive As String) As String
    Select Case GetDriveType(sDrive)
        Case DRIVE_UNKNOWN
        Types = "不能识别"
        Case DRIVE_NO_ROOT_DIR
        Types = "不存在"
        Case DRIVE_REMOVABLE
        Types = "可移除驱动器"
        Case DRIVE_FIXED
        Types = "固定驱动器"
        Case DRIVE_REMOTE
        Types = "远程驱动器"
        Case DRIVE_CDROM
        Types = "光盘驱动器"
        Case DRIVE_RAMDISK
        Types = "随机存取磁盘"
        Case Else
        Types = "ERROR"
    End Select
End FunctionPrivate Sub Command1_Click()
    Dim DrivesN() As String
    Dim i As Integer
    
    Me.Cls
    Print "驱动器个数:" & DriveCount
    Call LoadDrivenames(DrivesN)
    For i = 0 To DriveCount - 1
        List1.AddItem DrivesN(i) & Types(DrivesN(i))
    Next i
End Sub

Answer 5

//上面的打开我的电脑不对,正在寻找....Shell "EXPLORER.EXE /n,  ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}", vbNormalFocus