File Mapping Example

Share your advanced PureBasic knowledge/code with the community.
dmoc
Enthusiast
Enthusiast
Posts: 739
Joined: Sat Apr 26, 2003 12:40 am

File Mapping Example

Post by dmoc »

For anyone who may be interested in this type of stuff. I converted this from a post on the French forum. Since me no speak French (I just about manage English :P ) I have changed var names. Hope they make sense. Don't thank me, thank Nico.

Yer need two processes for obvious reasons so below is code for P1 then P2. Not a lot of difference between them but I thought I would post both for us lazy bas...

Code: Select all

; Converted from french forums
; http://purebasic.hmt-forum.com/viewtopic.php?t=716

; Swap mouse coords between two processes using file mapping
; This is Process # 1 (top string gadget)

Enumeration
  #Window
  #sgP1
  #sgP2
EndEnumeration
   
Structure sdataT
	p1x.l: p1y.l
	p2x.l: p2y.l
EndStructure

#WM_NEWMESSAGE=111

Global *sdata.sdataT

Procedure WindowCallback(WindowID,Message,wParam,lParam)
  Protected r.l
  
	r=#PB_ProcessPureBasicEvents
	Select Message
		Case #WM_NEWMESSAGE
			If wParam=1 And lParam=1
				SetGadgetText(#sgP2,"x= "+Str(*sdata\p2x)+"    y= "+Str(*sdata\p2y))
			EndIf
	EndSelect
	ProcedureReturn r
EndProcedure

Procedure main()
  Protected e.l, f.l, hFMO.l, hWnd.l
  
  f=#PB_Window_SystemMenu|#PB_Window_ScreenCentered
  If OpenWindow(#Window,0,0,160,160,f,"Process 1")=0
    Debug "ERROR: PB Window failed!"
    ProcedureReturn
  EndIf
  
  CreateGadgetList(WindowID(#Window))
  StringGadget(#sgP1,10, 10,100,20,"")
  StringGadget(#sgP2,10, 32,100,20,"")
  
  ;HANDLE CreateFileMapping(
  ;    HANDLE hFile,	                                // handle to file to map 
  ;    LPSECURITY_ATTRIBUTES lpFileMappingAttributes,	// optional security attributes 
  ;    DWORD flProtect,	                              // protection for mapping object 
  ;    DWORD dwMaximumSizeHigh,	                      // high-order 32 bits of object size  
  ;    DWORD dwMaximumSizeLow,	                      // low-order 32 bits of object size  
  ;    LPCTSTR lpName 	                              // name of file-mapping object 
  ;   );
  hFMO=CreatefileMapping_($FFFFFFFF, #Null, #PAGE_READWRITE, 0, SizeOf(sdataT), "Mapping")
  If hFMO=0: Debug "ERROR: Mapping failed!": ProcedureReturn: EndIf
   
  ;LPVOID MapViewOfFile(
  ;    HANDLE hFileMappingObject,	// file-mapping object to map into address space  
  ;    DWORD dwDesiredAccess,	    // access mode 
  ;    DWORD dwFileOffsetHigh,	  // high-order 32 bits of file offset 
  ;    DWORD dwFileOffsetLow,	    // low-order 32 bits of file offset 
  ;    DWORD dwNumberOfBytesToMap // number of bytes to map 
  ;   );
  *sdata=MapViewOfFile_(hFMO, #FILE_MAP_WRITE, 0, 0, 0)
 
  SetWindowCallback(@WindowCallback())
 
  Repeat
    e=WaitWindowEvent()
    Select e
      Case  #WM_MOUSEMOVE
        hWnd=FindWindow_(0,"Process 2")
        *sdata\p1x=WindowMouseX(): *sdata\p1y=WindowMouseY()
        SetGadgetText(#sgP1,"x= "+Str(*sdata\p1x)+"    y= "+Str(*sdata\p1y))
        If hWnd: SendMessage_(hWnd, #WM_NEWMESSAGE, 1, 1): EndIf
       
      Case #WM_CLOSE
        Quit=1
    EndSelect
  Until Quit=1
  
EndProcedure

main()
...and P2...

Code: Select all

; Converted from french forums
; http://purebasic.hmt-forum.com/viewtopic.php?t=716

; Swap mouse coords between two processes using file mapping
; This is Process # 2 (bottom string gadget)

Enumeration
	#Window
  #sgP1
  #sgP2
EndEnumeration
   
Structure sdataT
	p1x.l: p1y.l
	p2x.l: p2y.l
EndStructure

#WM_NEWMESSAGE=111

Global *sdata.sdataT

Procedure WindowCallback(WindowID,Message,wParam,lParam)
  Protected r.l
  
	r=#PB_ProcessPureBasicEvents
	Select Message 
		Case #WM_NEWMESSAGE
			If wParam=1 And lParam=1
				SetGadgetText(#sgP1,"x= "+Str(*sdata\p1x)+"    y= "+Str(*sdata\p1y))
			EndIf
	EndSelect
	ProcedureReturn r
EndProcedure

Procedure main()
  Protected e.l, f.l, hFMO.l, hWnd.l
  
  f=#PB_Window_SystemMenu|#PB_Window_ScreenCentered
  If OpenWindow(#Window,0,0,160,160,f,"Process 2")=0
    Debug "ERROR: PB Window failed!"
    ProcedureReturn
  EndIf
  
  CreateGadgetList(WindowID(#Window))
  StringGadget(#sgP1,10, 10,100,20,"")
  StringGadget(#sgP2,10, 32,100,20,"")
  
  ;HANDLE CreateFileMapping(
  ;    HANDLE hFile,	// handle to file to map 
  ;    LPSECURITY_ATTRIBUTES lpFileMappingAttributes,	// optional security attributes 
  ;    DWORD flProtect,	// protection for mapping object 
  ;    DWORD dwMaximumSizeHigh,	// high-order 32 bits of object size  
  ;    DWORD dwMaximumSizeLow,	// low-order 32 bits of object size  
  ;    LPCTSTR lpName 	// name of file-mapping object 
  ;   );
  hFMO=CreatefileMapping_($FFFFFFFF, #Null, #PAGE_READWRITE, 0, SizeOf(sdataT), "Mapping")
  If hFMO=0: Debug "ERROR: Mapping failed!": ProcedureReturn: EndIf
  
  ;LPVOID MapViewOfFile(
  ;    HANDLE hFileMappingObject,	// file-mapping object to map into address space  
  ;    DWORD dwDesiredAccess,	// access mode 
  ;    DWORD dwFileOffsetHigh,	// high-order 32 bits of file offset 
  ;    DWORD dwFileOffsetLow,	// low-order 32 bits of file offset 
  ;    DWORD dwNumberOfBytesToMap 	// number of bytes to map 
  ;   );
  *sdata=MapViewOfFile_(hFMO, #FILE_MAP_WRITE, 0, 0, 0)

  SetWindowCallback(@WindowCallback())
  
  Repeat
    e=WaitWindowEvent()
    Select e
      Case  #WM_MOUSEMOVE
        hWnd=FindWindow_(0,"Process 1")
        *sdata\p2x=WindowMouseX(): *sdata\p2y=WindowMouseY()
        SetGadgetText(#sgP2,"x= "+Str(*sdata\p2x)+"    y= "+Str(*sdata\p2y))
        If hWnd: SendMessage_(hWnd, #WM_NEWMESSAGE, 1, 1): EndIf
        
      Case #WM_CLOSE
        Quit=1
    EndSelect
  Until Quit=1
EndProcedure

main()
dmoc
Enthusiast
Enthusiast
Posts: 739
Joined: Sat Apr 26, 2003 12:40 am

Post by dmoc »

PS: Anyone know why Nico has chosen 111 for the win msg?
Nico
Enthusiast
Enthusiast
Posts: 274
Joined: Sun Jan 11, 2004 11:34 am
Location: France

Post by Nico »

Hi, dmoc

I chose "111" because it does not seem to be to use by Window but another one will make affair !

I test Lparam and Wparam to be sure that it is my message, You can change values if you want.


I thank you for having translated it, good! :D
dmoc
Enthusiast
Enthusiast
Posts: 739
Joined: Sat Apr 26, 2003 12:40 am

Post by dmoc »

OK, that's what I suspected so I've modified mine in this way:

Code: Select all

...
Enumeration #WM_USER
  #WM_NEWMESSAGE
EndEnumeration
...
...which is safer and leaves scope for expansion.

Glad you like the translation :D If you have any other juicy code please post here (or at least a link). Who knows I may learn some French :P
Nico
Enthusiast
Enthusiast
Posts: 274
Joined: Sun Jan 11, 2004 11:34 am
Location: France

Post by Nico »

There is a link on the creation of pipe named, If that interests you:

http://purebasic.hmt-forum.com/viewtopi ... sc&start=0

:)
dmoc
Enthusiast
Enthusiast
Posts: 739
Joined: Sat Apr 26, 2003 12:40 am

Post by dmoc »

Thanks for the link :D Here's my conversion but failed so far on Win98SE because ConnectNamedPipe_() in threadClient() does not seem to be waiting and simply returns. This quickly leads to a stack overflow, hence threadClient(hPipe) being commented-out for now. Any suggestions welcome and thanks again for the concise example.

pipe-svr.pb

Code: Select all

#PIPE_ACCESS_DUPLEX=3
#Gadget=0

Global bufWrite.s, bufRead.s

bufWrite = Space(100)
bufRead  = Space(100)

Procedure threadClient(hPipe.l)
  Protected pcf.l
  
  pcf = ConnectNamedPipe_(hPipe, #Null)
  If pcf=0
    Debug "ERROR: Could not connect to pipe!"
  Else
    Debug "Pipe connected!"
    
    AddGadgetItem(#Gadget, -1, "Client connected.")
    
    ReadFile_(hPipe, @bufRead, Len(bufRead), @rbytes.l, 0)
    AddGadgetItem(#Gadget, -1, bufRead)
    
    bufWrite="Server says bye bye!"
    WriteFile_(hPipe, bufWrite, Len(bufWrite), @wbytes.l, 0)
    FlushFileBuffers_(hPipe)
    
    If DisconnectNamedPipe_(hPipe)
      AddGadgetItem(#Gadget, -1, "Server awaits client")
    EndIf
  EndIf
  
  ;threadClient(hPipe) ; Start another client thread
EndProcedure

Procedure main()
  Protected f.l, e.l, q.l, t.l, hPipe.l
  
  f = #PB_Window_SystemMenu|#PB_Window_ScreenCentered
  If OpenWindow(0,0,0,300,200,f,"Pipe Server") And CreateGadgetList(WindowID(0))

    EditorGadget (#Gadget,10,10,280,160,#PB_Container_Raised)
    
    If CreateMenu(0, WindowID())
      MenuTitle("Action")
      MenuItem( 1, "Create Pipe")
      MenuItem( 2, "Quit")
    EndIf
  
    Repeat
      e = WaitWindowEvent()
      
      Select e
        Case #PB_EventMenu
          Select EventMenuID()
            Case 1
              ;HANDLE CreateNamedPipe(
              ;    LPCTSTR lpName,	      // pointer to pipe name 
              ;    DWORD dwOpenMode,	    // pipe open mode 
              ;    DWORD dwPipeMode,	    // pipe-specific modes 
              ;    DWORD nMaxInstances,	  // maximum number of instances  
              ;    DWORD nOutBufferSize,	// output buffer size, in bytes 
              ;    DWORD nInBufferSize,	  // input buffer size, in bytes 
              ;    DWORD nDefaultTimeOut,	// time-out time, in milliseconds 
              ;    LPSECURITY_ATTRIBUTES lpSecurityAttributes 	// pointer to security attributes structure 
              ;   );
              hPipe=CreateNamedPipe_("\\.\pipe\TestPipe", #PIPE_ACCESS_DUPLEX, #PIPE_TYPE_MESSAGE | #PIPE_READMODE_MESSAGE, 1, 100, 100, 3000, #Null)
              If hPipe=0
                Debug "ERROR: Could not create pipe!"
              Else
                AddGadgetItem(#Gadget, -1, "Server awaits client.")
                t = CreateThread(@threadClient(), hPipe)
              EndIf
              
            Case 2: q=1
              
          EndSelect
        
        Case #PB_Event_CloseWindow
          KillThread(t)
          CloseHandle_(hPipe)
          q=1
      EndSelect
      
    Until q
  EndIf
EndProcedure

main()

pipe-client.pb

Code: Select all

#Gadget=0

Global hPipe.l
Global bufWrite.s,bufRead.s

bufWrite = Space(100)
bufRead  = Space(100)

Procedure CallServer(pipe.s, msg.s)
  If WaitNamedPipe_(pipe, 3000)=0
    Debug "ERROR: Pipe not available!"
  Else
    hPipe  = CreateFile_(pipe, #GENERIC_READ |#GENERIC_WRITE, 0, #Null, #OPEN_EXISTING,0, #Null)
  
    If hPipe=0
      Debug "ERROR: Could not open pipe!"
    Else
      bufWrite = msg
      WriteFile_(hPipe, bufWrite, @Len(bufWrite), @wbytes, 0)
      FlushFileBuffers_(hPipe)
  
      ReadFile_(hPipe, @bufRead, Len(bufRead), @rbytes, 0)
      AddGadgetItem(#Gadget, -1, bufRead) 
      
      CloseHandle_(hPipe)
    EndIf
  EndIf
EndProcedure

Procedure main()
  Protected f.l, e.l, q.l
  
  f = #PB_Window_SystemMenu|#PB_Window_ScreenCentered
  If OpenWindow(0,0,0,600,200,f,"Client Pipe") And CreateGadgetList(WindowID(0))

    EditorGadget(#Gadget,10,60,580,120,#PB_Container_Raised)
    StringGadget(1,10, 36,400,20,"Client: Type Msg Here") 
    ButtonGadget(2, 460, 36, 100, 20, "Write")
    StringGadget(3,10, 10,400,20,"\\.\pipe\TestPipe")
    TextGadget(4, 420, 10,180,20,"Name  of Server (local)")

    Repeat
      e = WaitWindowEvent()
      
      Select e
        Case #PB_EventGadget
          Select EventGadgetID()
            Case 2: CallServer(GetGadgetText(3), GetGadgetText(1))
          EndSelect
      
        Case #PB_Event_CloseWindow: q=1
      EndSelect
      
    Until q
  EndIf
EndProcedure

main()
User avatar
a_carignan
User
User
Posts: 81
Joined: Sat Feb 21, 2009 2:01 am
Location: Canada

Re: File Mapping Example

Post by a_carignan »

Hello, The mapping example does not work, since opening the map returns an empty pointer. :(
On the other hand, the example of passing data in Pipe mode works very well. Thanks for the Pipe examples. :D
Post Reply