文件保护，我有一文件，运行后不能被别人复制，如何处理？

Question

文件保护，我有一文件，运行后不能被别人复制，如何处理？

Answer 1

Option Explicit 
Private Sub Form_Load() 
    sFileNameLock = "1.txt"'该文件为要防止复制的文件 
    Hook Me.hwnd 
End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) 
    UnHook Me.hwnd 
End Sub 
在模块文件中写入： 
Option Explicit Public sFileNameLock As String 
Public lpPrevWndProc As Long 
Public lClipboardChain As Long 
Public Const GWL_WNDPROC = -4 
Public Const WM_DRAWCLIPBOARD = &H308 
Public Const WM_CHANGECBCHAIN = &H30D 
Public Declare Function EmptyClipboard Lib "user32" () As Long 
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long                  'SetWindowLong这个函数有许多用法，这里我只讲SubClass 的用法）可以告诉Windows，当有消息发出时通知我们以及可以在哪里通知到。使用这个API，除了要把我们的程序的句柄（等于程序的标识，以便让Windows知道向谁发消息）传给它外，还需要提供一个函数的地址，这个函数有一定的格式，Windows消息的发出就是对这个函数的参数进行改变，我们根据特定参数的值来判断这个消息是什么消息。函数的格式是:Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByValwParam As Long, ByVal lParam As Long) As Long每当有消息发生时，我们的程序就是在这个函数里得知的。下面我们一边做个示例程序一边讲解吧。新建一个工程，再添加一个标准模块，模块里除了加上SetWindowLong 的声明外，再加上： 
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long 
Public Declare Function SetClipboardViewer Lib "user32" (ByVal hwnd As Long) As Long 
Public Declare Function ChangeClipboardChain Lib "user32" (ByVal hwnd As Long, ByVal hWndNext As Long) As Long 
Public Const CF_HDROP = 15 
Public Type POINT 
  x As Long 
  y As Long 
End Type 
Public Type DROPFILES 
  pFiles As Long 
  pt As POINT 
  fNC As Long 
  fWide As Long 
End Type 
Public Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long 
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long 
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long 
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long 
Public Declare Function CloseClipboard Lib "user32" () As Long 
Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long 
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Public Sub ShowFilesOnClipboard(sFileNameLock As String) 
  Dim sFilePath As String 
  Dim lHandle As Long 
  Dim lpResults As Long 
  Dim lRet As Long 
  Dim df As DROPFILES 
  Dim strDest As String 
  Dim lBufferSize As Long 
  Dim arBuffer() As Byte 
  Dim vNames As Variant 
  Dim i As Long   If OpenClipboard(0) Then 
    lHandle = GetClipboardData(CF_HDROP) 
    ' If you don't find a CF_HDROP, you don't want to process anything 
    If lHandle > 0 Then 
      lpResults = GlobalLock(lHandle) 
      lBufferSize = GlobalSize(lpResults) 
      ReDim arBuffer(0 To lBufferSize) 
      CopyMemory df, ByVal lpResults, Len(df) 
      Call CopyMemory(arBuffer(0), ByVal lpResults + df.pFiles, (lBufferSize - Len(df))) 
      If df.fWide = 1 Then 
        ' it is wide chars--unicode 
        strDest = arBuffer 
      Else 
        strDest = StrConv(arBuffer, vbUnicode) 
      End If 
      GlobalUnlock lHandle 
      vNames = Split(strDest, vbNullChar) 
      i = 0 
      While Len(vNames(i)) > 0 
        sFilePath = vNames(i) 
        i = i + 1 
      Wend 
      If InStr(UCase(sFilePath), UCase(sFileNameLock)) Then Call EmptyClipboard'清除剪切板 
    End If 
  End If 
  CloseClipboard 
End Sub 
Public Sub Hook(hwnd As Long) 
  ' 在这里使用了 AddressOf，得到的是WindowProc 函数的地址 
  'GWL_WNDPROC告诉SetWindowLong 函数将使用SubClass 
  lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc) 
  'SubClass需要保存调用时返回的指针以便做其他处理 
  lClipboardChain = SetClipboardViewer(hwnd) 
End Sub Public Sub UnHook(hwnd As Long) 
  SetWindowLong hwnd, GWL_WNDPROC, lpPrevWndProc 
  ChangeClipboardChain hwnd, lClipboardChain 
End Sub '把WindowProc 函数完成: 
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
  Select Case uMsg 
    Case WM_DRAWCLIPBOARD 
      SendMessage lClipboardChain, WM_DRAWCLIPBOARD, 0, 0 
      '剪贴板改变时你要做什么处理就是写在这里了.这里当复制的文件为你所防止防止的文件则清除剪切板。 
      Call ShowFilesOnClipboard(sFileNameLock) 
    Case WM_CHANGECBCHAIN 
      If lClipboardChain = wParam Then 
        lClipboardChain = lParam 
      End If 
    Case Else 
      WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam) 
  End Select 
End Function 

Answer 2

参考： 
http://www.vbgood.com/viewthread.php?tid=70045&extra=page%3D1 
（从内存启动一个exe）