www.pudn.com > VBSendText.zip > frmSendFile.frm

VERSION 5.00 
Begin VB.Form frmFileMapping  
   BorderStyle     =   1  'Fixed Single 
   Caption         =   "SendFile" 
   ClientHeight    =   3975 
   ClientLeft      =   45 
   ClientTop       =   330 
   ClientWidth     =   5175 
   LinkTopic       =   "Form3" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   3975 
   ScaleWidth      =   5175 
   StartUpPosition =   3  '窗口缺省 
   Begin VB.TextBox Text2  
      Height          =   3015 
      Left            =   120 
      MultiLine       =   -1  'True 
      ScrollBars      =   2  'Vertical 
      TabIndex        =   2 
      Top             =   480 
      Width           =   4935 
   End 
   Begin VB.TextBox Text1  
      Height          =   375 
      Left            =   360 
      TabIndex        =   0 
      Text            =   "Text1" 
      Top             =   4080 
      Width           =   4695 
   End 
   Begin VB.Label Label2  
      Caption         =   "请再起动一个实例看看。" 
      Height          =   255 
      Left            =   120 
      TabIndex        =   3 
      Top             =   120 
      Width           =   3135 
   End 
   Begin VB.Label Label1  
      Caption         =   "实际应用中可将控制文本框放在FORM的可视区外。" 
      Height          =   255 
      Left            =   360 
      TabIndex        =   1 
      Top             =   3720 
      Visible         =   0   'False 
      Width           =   4695 
   End 
End 
Attribute VB_Name = "frmFileMapping" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
 
'******************************************************* 
' Form Module Name: frmFileMapping 
' Created By: AdamBear 熊超       2002-2-2 1:37 
' Purpose: 
' 此程序用来演示如何使用内存文件映射来传递大块数据 
'       通知消息的方法见SendText工程。 
' NOTE: 程序必须用VB6编译才能正常运行 
'********************************************************* 
 
Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long 
Private Const strCaption As String = "SendFile"  '窗口的Caption 
Private Const strOrg As String = "Text1"         '文本框的初始值 
Private strShare As New CSharedString 
 
 
Private Sub Form_Load() 
' 
    Dim childTxtHwnd As Long, frmHwnd As Long 
    Me.Caption = "" 
    strShare.Create "AdamBear2002"    '建立有名共享内存 
    '通过SPY++得到FORM的ClassName为ThunderRT6FormDC,从而得到其句柄，注意其在不同版本或调试环境中不同 
    frmHwnd = FindWindow("ThunderRT6FormDC", strCaption) 
    If frmHwnd <> 0 Then 
        '通过SPY++得到TEXT1的ClassName为ThunderRT6TextBox 
        childTxtHwnd = FindWindowEx(frmHwnd, 0, "ThunderRT6TextBox", strOrg) 
        If childTxtHwnd = 0 Then ApiRaise Err.LastDllError 
        'NOTE:注意，我在贴子上说错了，SetWindowText只能在同一进程中使用，所以下面这样做是行不通的 
        '害我调试了半天，不过可以考虑用VC做个DLL，在DLL里收别消息，再用SetWindowText来通知VB 
        'SetWindowText childTxtHwnd, "Data Changed" 
        Me.Visible = False 
        If strShare = "" Then Err.Raise BasicError(1000), "Form_Load", "共享内存不能为空" 
        Dim strTmp As String 
        strTmp = GetFileStr("readme.txt") 
        strShare = strTmp     '往共享内存写入新数据 
        Dim strMsg As String 
        strMsg = "file is dirty" '此处传递通知消息 
 
'下面被注释掉的东西是为了制成Null结尾的ANSI字串，多余，只需在SendMessage的声明上动动 
'    就可以了，老的坏习惯，要改！ 
'        Dim abMsg() As Byte 
'        abMsg = StrConv(strMsg, vbFromUnicode) & vbNullChar 
'        Dim c As Long 
'        c = UBound(abMsg) 
'        SendMessage childTxtHwnd, WM_SETTEXT, 0, abMsg(0) 
        SendMessageStr childTxtHwnd, WM_SETTEXT, 0, strMsg 
        Unload Me 
 
        Exit Sub 
    End If 
    Me.Caption = strCaption 
    Text1 = strOrg 
    Text2 = GetFileStr("readfirst.txt") 
    strShare = Text2 
End Sub 
 
Private Sub Text1_Change() 
' 
 
    If Text1 = strOrg Then 
        Exit Sub             '使此文本框除初值外不能人为更改，且不会引起层叠。见本子程序最后 
    ElseIf Text1 = "file is dirty" Then 
        Me.SetFocus 
        Text2 = strShare            '简单输出变化的内容。 
        MsgBox "数据已更新" 
    End If 
    Me.SetFocus 
    Text1.Text = strOrg        '还原，以使文本框句柄可被找到。 
End Sub 
 
 
Private Function GetFileStr(FileName As String) As String 
    Dim fnum As Integer, isOpen As Boolean 
    On Error GoTo Error_Handler 
    fnum = FreeFile() 
    Open FileName For Binary As #fnum 
    isOpen = True 
    GetFileStr = Input(LOF(fnum), fnum) 
     
Error_Handler: 
    If isOpen Then Close #fnum 
    If Err Then Err.Raise Err.Number, , Err.Description 
 
End Function