1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:

unit Unit2;

interface

uses Classes, SysUtils, Windows, Messages;

type

  TTestThread = class(TThread)
     constructor Create;
     destructor Destroy; override;
  private
    FNamedPipe : THandle;
    FFile : THandle;
    FEvent : THandle;
    FOverlapped : TOverlapped;

    Res : Cardinal;
  protected
    procedure Execute; override;

    procedure ShowMsg;
  end;

implementation

uses Unit1;

  constructor TTestThread.Create;
  Begin
    inherited Create(FALSE);

    // Pipe erstellen
      FNamedPipe := CreateNamedPipe('\\.\pipe\Test',
        PIPE_ACCESS_DUPLEX OR FILE_FLAG_OVERLAPPED, PIPE_TYPE_BYTE,
        1, 4096, 4096, 2000, nil);
      IF FNamedPipe = INVALID_HANDLE_VALUE then
      Begin
        MessageBox(0,'NamedPipe error',nil,0);
        Halt(1);
      end;

    // Keine Ahnung wozu ich das brauch *g* :)
        FEvent := CreateEvent(nil,False,False,nil);
        ZeroMemory(@FOverlapped,SizeOf(FOverlapped));
        FOverlapped.hEvent := FEvent;

    // damit kommt immer "Alle Pipes ausgelastet" und CPU auf 100%... ohne nur "Falscher Parameter"
{
        FFile := CreateFile( '\\.\pipe\Test',
          GENERIC_ALL,
          FILE_SHARE_WRITE OR FILE_SHARE_READ,nil,CREATE_NEW OR OPEN_EXISTING,0,0);
        IF FFile = INVALID_HANDLE_VALUE then
        Begin
          MessageBox(0,'Device error',nil,0);
          Halt(1);
        end;
}
        // subst auf das Pipe legen - funzt gut
        IF not DefineDosDevice(0,'V:','\\.\pipe\Test') THEN
        Begin
          MessageBox(0,'DosDevice error',nil,0);
          Halt(1);
        end;
  end;

  destructor TTestThread.Destroy;
  Begin
    // Laufwerk löschen
    DefineDosDevice(DDD_REMOVE_DEFINITION,'V:',nil);

    CloseHandle(FFile);
    CloseHandle(FEvent);

    IF DisconnectNamedPipe(FNamedPipe) THEN
      CloseHandle(FNamedPipe);

    inherited;
  end;

  procedure TTestThread.Execute;
  var Buff : Cardinal; //array[0..4095] of Char;
      Size : Cardinal;
  Begin
    while not Terminated do
    Begin
      begin

        // Nachtricht erhalten 
        if ConnectNamedPipe(FNamedPipe,nil) then
        Begin
          // Nachricht lesen  
          ReadFile(FNamedPipe,Buff,SizeOf(Buff),Size,nil);
          //
          Res := Buff;
          WriteFile( FNamedPipe,Buff,SizeOf(Buff),Size,nil);

          FlushFileBuffers(FNamedPipe);
          DisconnectNamedPipe(FNamedPipe);

          Synchronize(ShowMsg);
//          CloseHandle(FNamedPipe);
//          CloseHandle(FFile);
//          CloseHandle(FEvent);
        end;
      end;
    end;
  end;

  procedure TTestThread.ShowMsg;
  Begin
    Form1.Label1.Caption := IntToStr(Res);
  end;

end.