PureBoard

Code: Alles auswählen

Global g_hMutexAppRunning

Procedure AppInstanceExists()
   
  Protected bAppRunning = FALSE;
  
  ; Create a Global mutex. Use a unique name, For example 
  ; incorporating your company And application name.
  
  g_hMutexAppRunning = CreateMutex_( #Null, #Null, "Global\MyApplication1");
  ; Check If the mutex object already exists, indicating an
  ; existing application instance
  If (g_hMutexAppRunning <> #Null) And (GetLastError_() = #ERROR_ALREADY_EXISTS)
    ; Close the mutex For this application instance. This assumes
    ; the application will inform the user that it is 
    ; about To terminate 
    CloseHandle_( g_hMutexAppRunning );
    g_hMutexAppRunning = #Null;
    ; Return False If a new mutex was created, 
    ; As this means it's the first app instance
  EndIf
  If g_hMutexAppRunning
    ProcedureReturn #False;
  Else
    ProcedureReturn #True
  EndIf

EndProcedure


;- Konstanten

Enumeration
  #Window
EndEnumeration

Enumeration
  #Menu
EndEnumeration

Enumeration
  #Menu_Exit
EndEnumeration

Enumeration
  #StatusBar
EndEnumeration

Enumeration
  #Gadget
EndEnumeration

;- Variablen

Global Exit, WinStyle

Procedure UpdateWindow()

  Protected x, y, dx, dy, menu, status

  menu = MenuHeight()
  status = StatusBarHeight(#StatusBar)
  x = 0
  y = 0
  dx = WindowWidth(#Window)
  dy = WindowHeight(#Window) - menu - status
  ResizeGadget(#Gadget, x, y, dx, dy)
  
EndProcedure

;- Main

If AppInstanceExists()
  MessageRequester("Info", "Programm läuft bereit")
  End
EndIf

WinStyle = #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget

If OpenWindow(#Window, #PB_Ignore, #PB_Ignore, 800, 500, "Window", WinStyle)

  If CreateMenu(#Menu, WindowID(#Window))
    MenuTitle("&Datei")
    MenuItem(#Menu_Exit, "Be&enden")
  EndIf
  
  If CreateStatusBar(#StatusBar, WindowID(#Window))
    
  EndIf
  
  If CreateGadgetList(WindowID(#Window))
    ListViewGadget(#Gadget, 0,0,0,0)
  EndIf
  
  exit = 0
  
  Repeat
    event = WaitWindowEvent()
    Select event
    
    Case #PB_Event_Menu
      Select EventMenu()
        Case #Menu_Exit
          exit = 1
      EndSelect
      
    Case #PB_Event_SizeWindow
      UpdateWindow()
      
    Case #PB_Event_CloseWindow
      exit = 1
      
    EndSelect
    
  Until exit
EndIf

; !!! NICHT VERGESSEN !!! - Global Mutex wieder freigeben
CloseHandle_(g_hMutexAppRunning)

Code: Alles auswählen

;-TOP
; Kommentar     : Multithreaded Pipe Server (Übersetzt aus MSDN)
; Author        : mk-soft
; Second Author : 
; Datei         : PipeServer.pb
; Version       : 1.01
; Erstellt      : 10.02.2007
; Geändert      : 28.03.2009
; 
; Compilermode  :
;
; ***************************************************************************************

#BUFSIZE = 4096
 
Declare InstanceThread(lpvParam.l); 
Declare GetAnswerToRequest(chRequest.s, *chReply.s, *pchBytes.l); 
 
Procedure main() 

   Protected fConnected.l ; BOOL
   Protected dwThreadId.l ; DWORD 
   Protected hPipe.l, hThread.l ; HANDLE 
   Protected lpszPipename.s = "\\.\pipe\mynamedpipe" ; LPTSTR 
 
;// The main loop creates an instance of the named pipe And 
;// then waits For a client To connect To it. When the client 
;// connects, a thread is created To handle communications 
;// With that client, And the loop is repeated. 
 
   Repeat 
   ;{ 
      Debug "Create Pipe"
      hPipe = CreateNamedPipe_(lpszPipename, #PIPE_ACCESS_DUPLEX, #PIPE_TYPE_MESSAGE | #PIPE_READMODE_MESSAGE | #PIPE_WAIT, #PIPE_UNLIMITED_INSTANCES, #BUFSIZE, #BUFSIZE, 0, #Null)

      If (hPipe = #INVALID_HANDLE_VALUE) 
      ;{
          Debug ("CreatePipe failed")
          ProcedureReturn 0
      ;}
      EndIf
      ;// Wait For the client To connect; if it succeeds, 
      ;// the function returns a nonzero value. If the function returns 
      ;// zero, GetLastError returns ERROR_PIPE_CONNECTED. 
      Debug "Wait for Connect"
      fConnected = ConnectNamedPipe_(hPipe, #Null) 
      
      ; ? TRUE : (GetLastError() == ERROR_PIPE_CONNECTED); 
      If fConnected = 0
        If GetLastError_() = #ERROR_PIPE_CONNECTED
          fConnected = #True
        EndIf
      EndIf
      
      If fConnected
      ;{ 
      ;// Create a thread For this client. 
         Debug "Connect Client"
         Debug "hPipe: " +Str(hPipe)
         ;hThread = CreateThread(@InstanceThread(), hPipe)
         hThread = CreateThread_(#Null, 0, @InstanceThread(), hPipe, 0, @dwThreadId)

          If (hThread = #Null) 
         ;{
            Debug ("CreateThread failed"); 
            ProcedureReturn 0;
         ;}
         Else
          Debug "Create Thread Ok"
         EndIf
      ;} 
      Else 
        ;// The client could Not connect, so close the pipe. 
         CloseHandle_(hPipe); 
      EndIf
   ;}
   ForEver
     
   ProcedureReturn 1;
    
EndProcedure 
 
 
Procedure InstanceThread(lpvParam.l) 
;{ 
   Protected chRequest.s{#BUFSIZE}; CHAR 
   Protected chReply.s{#BUFSIZE}; CHAR
   Protected cbBytesRead.l, cbReplyBytes.l, cbWritten.l; DWORD
   Protected fSuccess.l; BOOL
   Protected hPipe; HANDLE
 
;// The thread's parameter is a handle to a pipe instance. 
 
   hPipe = lpvParam; 
   While (1) 
   ;{ 
   ;// Read client requests from the pipe. 
      fSuccess = ReadFile_(hPipe, @chRequest, #BUFSIZE, @cbBytesRead, #Null)

      If (fSuccess = 0); | (cbBytesRead = 0) 
         Break; 
      EndIf
      
      chReply = "Echo: " + chRequest
      cbReplyBytes = Len(chReply) 
   ;// Write the reply To the pipe. 
      fSuccess = WriteFile_(hPipe, @chReply, cbReplyBytes, @cbWritten, #Null)

      If (fSuccess = 0) | (cbReplyBytes <> cbWritten) 
        Break; 
      EndIf
  ;}
  Wend 
 
;// Flush the pipe To allow the client To Read the pipe's contents 
;// before disconnecting. Then disconnect the pipe, And close the 
;// handle To this pipe instance. 
 
   FlushFileBuffers_(hPipe); 
   DisconnectNamedPipe_(hPipe); 
   CloseHandle_(hPipe); 
;}
EndProcedure


;- Main
Main()

Code: Alles auswählen

; Test PipeServer

Procedure.s FormatMessage(ErrorNumber.l)

  Protected len
  
  len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,ErrorNumber,0,@Buffer,0,0)
  If len
    ProcedureReturn PeekS(Buffer, len - 2)
    LocalFree_(Buffer)
  Else
    ProcedureReturn "Errorcode: " + Hex(ErrorNumber)
  EndIf
  
EndProcedure



Pipe.s = "\\.\pipe\mynamedpipe"

send.s = "Hallo Welt"
recv.s = Space(1000)

If CallNamedPipe_(@Pipe, send, Len(send) + 1, recv, 1000, @cb, 1000)
  Debug recv
Else
  Debug FormatMessage(GetLastError_())
EndIf