前言

昨天群里有个朋友问，有没有一个程序，在文件夹中右击菜单，选择剪切板，会自动把剪切板中的文字或者图片复制到当前目录，一般情况下会新建一个文本，然后打开，再Ctrl+V，但是图片的话，像微信都有保存到指定路径功能，好像没多大用，但是人家有需求，而且这个也不难实现，所以就给他做了一个。

他其实找到了一个实现，java版本的，还给我了个链接

blog.csdn.net/qq_33466466…

但是里面下载链接好像失效了，下载不了，所以才会问。

但是这么个小功能，用java这种级别的吨位实现，有些麻烦了吧。

所在再C#、VB、C中挑了一个简单的VB，其实使用C#更好实现，但是Visual Studio过期了，也不经常搞，所以就用了VB。

下载

github.com/houxinlin/r…

实现

操作剪切板使用到的函数有OpenClipboard、GetClipboardData、等，但是返回值都是一个地址，需要从这个地址中提取处字符串，或者图片。

OpenClipboard用来打开剪切板，为后续做准备，参数是窗口句柄，可以为0。

GetClipboardData用来获取剪切板中数据，参数是数据格式，如果是文本的话，则是CF_TEXT，如果是图片的话，则传CF_BITMAP，那么就需要有个函数来判断当前剪切板中是哪种格式，所以就有了IsClipboardFormatAvailable，当调用他传入指定数据格式，如果是，则返回1，相当于一个test函数。

获取字符串

下面是从地址中转为字符串。

Function GetTextClipboard()
Dim hTxtPtr As Long
Dim hDataPtr As Long
Dim sClipboardText As String

Dim iCliboardSize As Long
Dim bTextData() As Byte
If (OpenClipboard(0)) Then
    If (IsClipboardFormatAvailable(CF_TEXT)) Then
        hTxtPtr = GetClipboardData(CF_TEXT)
        Call CopyMemory(hDataPtr, ByVal hTxtPtr, &H4)
        iCliboardSize = lstrlen(hTxtPtr)
        If iCliboardSize > 0 Then
            ReDim bTextData(0 To CLng(iCliboardSize) - CLng(1)) As Byte
            CopyMemory bTextData(0), ByVal GlobalLock(hTxtPtr), iCliboardSize
            sClipboardText = StrConv(bTextData, vbUnicode)
        Else
            MsgBox "无数据", vbOKOnly, "提示"
            MsgBox GetClipBoard
            
        End If
    End If
Call CloseClipboard
End If

GetTextClipboard = sClipboardText
End Function

获取图片

下面是获取图片。

Function GetImageClipBoard() As Long
    Dim hClipBoard As Long
    Dim hBitmap As Long
    hBitmap = GetClipboardData(2)
    If hBitmap = 0 Then GoTo exit_error
        GetImageClipBoard = hBitmap
        Exit Function
exit_error:
    GetImageClipBoard = -1
End Function

但是难在如何把内存中的图片保存成一个文件，因为上面函数只能获取到内存中的Bitmap句柄，但是不幸的是，这块知识早忘了，因为也不常做这方面，知识盲区，但是突然翻到以前收藏下的一个GDI+的模块，这时候就派上用场了。

GDI+是GDI的升级版，更容易操作图像，记得以前保存内存中的图像时，还用到WriteFile，只记得很繁琐，但是用GDI+函数就不一样了，GDI+里面有一个GdipSaveImageToFile函数，可以直接保存内存中的图像，而这个模块提供的函数SaveImageToPNG用来把内存中图片保存成png格式，关于GDI+这里就不说了。

Public Function WriteBitmapToFile(ByVal sPath As String)
    Dim mBitmap As Long
    OpenClipboard 0
    mGdip.InitGDIPlus
    mGdip.GdipCreateBitmapFromHBITMAP GetImageClipBoard, 0, mBitmap
    mGdip.SaveImageToPNG mBitmap, sPath
    CloseClipboard
End Function

但是还有注册表，因为要添加一个右键菜单，上面那位仁兄是在这个路径下操作的。

\HKEY_CLASSES_ROOT\Directory\Background\shell

但是这个路径普通程序是没权限读写的，而下面这个路径是上面路径的一个”映射”，在这个路径下读写会反应到上面路径中。

HKEY_CURRENT_USER\Software\Classes\Directory\Background\Shell\

接着就是用以前写的一个注册表操作模块，写这个路径了，写完之后，右击文件夹，就会出现一个剪切板，单机后，执行的程序在command路径默认的REG_SZ的中。 %V”是参数，表示把当前路径传递给我们的程序。

Public Sub WriteRegister()
Dim sAppPath As String

sAppPath = App.Path & "\" & App.EXEName & ".exe" Dim reg As New Regidit reg.CreateKey "HKEY_CURRENT_USER\Software\Classes\Directory\Background\Shell\剪切板", "command" reg.SetKeyValueREG_SZ "HKEY_CURRENT_USER\Software\Classes\Directory\Background\Shell\剪切板\command", "", sAppPath & " %V" End Sub 

接着在启动时候检测当前剪切板中的是什么类型的值，调用上面不同函数，通过command函数获取启动参数，拼接一个文件名。

Private Sub Form_Load()

Call WriteRegister
If Command = "" Then
    MsgBox "生成右键菜单成功", vbOKCancel, "提示"
End
End If
If IsString() Then
     Call WriteToTextFile(CreateTextFileName(Command), GetTextClipboard())
ElseIf IsClipboardFormatAvailable(CF_BITMAP) = 1 Then
    Call WriteBitmapToFile(CreateImageFileName(Command))
End If
End
End Sub


Private Function CreateTextFileName(ByVal sRoot As String)
CreateTextFileName = CreateFileName(sRoot, ".txt")
End Function
Private Function CreateImageFileName(ByVal sRoot As String)
CreateImageFileName = CreateFileName(sRoot, ".png")
End Function

Private Function CreateFileName(ByVal sRoot As String, ByVal sType As String) As String
Dim sName As String
sName = sRoot & "\" & Replace(Date, "/", "-") & "-" & Replace(Time, ":", "-")

If Dir(sName & ".txt") = "" Then
    CreateFileName = sName & sType
Else
    Dim iCount As Integer
    Do
        iCount = iCount + 1
    Loop While Dir(sName & "(" & iCount & ")" & sType) <> ""
    CreateFileName = sName & "(" & iCount & ")" & sType
End If

End Function