├── .gitignore ├── Client.dpr ├── Client.dproj ├── DelphiIPC.groupproj ├── IPC.Demo.Types.pas ├── IPC.pas ├── README.md ├── Server.dpr ├── Server.dproj ├── Unit_Client.dfm ├── Unit_Client.pas ├── Unit_Server.dfm └── Unit_Server.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | -------------------------------------------------------------------------------- /Client.dpr: -------------------------------------------------------------------------------- 1 | program Client; 2 | 3 | uses 4 | Forms, 5 | Unit_Client in 'Unit_Client.pas' {Form1}, 6 | IPC.Demo.Types in 'IPC.Demo.Types.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | ReportMemoryLeaksOnShutdown := True; 12 | Application.Initialize; 13 | Application.MainFormOnTaskbar := True; 14 | Application.CreateForm(TForm1, Form1); 15 | Application.Run; 16 | end. 17 | 18 | -------------------------------------------------------------------------------- /Client.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {A38310C9-430B-4F00-AA4B-9620CE32B3B9} 4 | Client.dpr 5 | True 6 | Debug 7 | 1 8 | Application 9 | VCL 10 | 18.6 11 | Win32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | true 44 | Cfg_2 45 | true 46 | true 47 | 48 | 49 | false 50 | false 51 | false 52 | false 53 | false 54 | 00400000 55 | Client 56 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 57 | 1033 58 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 59 | 60 | 61 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 62 | Debug 63 | true 64 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 65 | $(BDS)\bin\default_app.manifest 66 | $(BDS)\bin\delphi_PROJECTICON.ico 67 | true 68 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 69 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 70 | 71 | 72 | Client_Icon.ico 73 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 74 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 75 | 76 | 77 | RELEASE;$(DCC_Define) 78 | 0 79 | false 80 | 0 81 | 82 | 83 | true 84 | PerMonitorV2 85 | true 86 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 87 | 88 | 89 | DEBUG;$(DCC_Define) 90 | false 91 | true 92 | 93 | 94 | true 95 | PerMonitorV2 96 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 97 | true 98 | 99 | 100 | 101 | MainSource 102 | 103 | 104 | 105 | 106 | 107 | 108 | Cfg_2 109 | Base 110 | 111 | 112 | Base 113 | 114 | 115 | Cfg_1 116 | Base 117 | 118 | 119 | 120 | Delphi.Personality.12 121 | 122 | 123 | 124 | 125 | Client.dpr 126 | 127 | 128 | Microsoft Office 2000 Sample Automation Server Wrapper Components 129 | Microsoft Office XP Sample Automation Server Wrapper Components 130 | 131 | 132 | 133 | True 134 | False 135 | 136 | 137 | 138 | 139 | Client.exe 140 | true 141 | 142 | 143 | 144 | 145 | 1 146 | 147 | 148 | Contents\MacOS 149 | 1 150 | 151 | 152 | 0 153 | 154 | 155 | 156 | 157 | classes 158 | 1 159 | 160 | 161 | 162 | 163 | res\xml 164 | 1 165 | 166 | 167 | 168 | 169 | library\lib\armeabi-v7a 170 | 1 171 | 172 | 173 | 174 | 175 | library\lib\armeabi 176 | 1 177 | 178 | 179 | 180 | 181 | library\lib\mips 182 | 1 183 | 184 | 185 | 186 | 187 | library\lib\armeabi-v7a 188 | 1 189 | 190 | 191 | 192 | 193 | res\drawable 194 | 1 195 | 196 | 197 | 198 | 199 | res\values 200 | 1 201 | 202 | 203 | 204 | 205 | res\values-v21 206 | 1 207 | 208 | 209 | 210 | 211 | res\drawable 212 | 1 213 | 214 | 215 | 216 | 217 | res\drawable-xxhdpi 218 | 1 219 | 220 | 221 | 222 | 223 | res\drawable-ldpi 224 | 1 225 | 226 | 227 | 228 | 229 | res\drawable-mdpi 230 | 1 231 | 232 | 233 | 234 | 235 | res\drawable-hdpi 236 | 1 237 | 238 | 239 | 240 | 241 | res\drawable-xhdpi 242 | 1 243 | 244 | 245 | 246 | 247 | res\drawable-small 248 | 1 249 | 250 | 251 | 252 | 253 | res\drawable-normal 254 | 1 255 | 256 | 257 | 258 | 259 | res\drawable-large 260 | 1 261 | 262 | 263 | 264 | 265 | res\drawable-xlarge 266 | 1 267 | 268 | 269 | 270 | 271 | 1 272 | 273 | 274 | Contents\MacOS 275 | 1 276 | 277 | 278 | 0 279 | 280 | 281 | 282 | 283 | Contents\MacOS 284 | 1 285 | .framework 286 | 287 | 288 | Contents\MacOS 289 | 1 290 | .framework 291 | 292 | 293 | 0 294 | 295 | 296 | 297 | 298 | 1 299 | .dylib 300 | 301 | 302 | 1 303 | .dylib 304 | 305 | 306 | 1 307 | .dylib 308 | 309 | 310 | Contents\MacOS 311 | 1 312 | .dylib 313 | 314 | 315 | Contents\MacOS 316 | 1 317 | .dylib 318 | 319 | 320 | 0 321 | .dll;.bpl 322 | 323 | 324 | 325 | 326 | 1 327 | .dylib 328 | 329 | 330 | 1 331 | .dylib 332 | 333 | 334 | 1 335 | .dylib 336 | 337 | 338 | Contents\MacOS 339 | 1 340 | .dylib 341 | 342 | 343 | Contents\MacOS 344 | 1 345 | .dylib 346 | 347 | 348 | 0 349 | .bpl 350 | 351 | 352 | 353 | 354 | 0 355 | 356 | 357 | 0 358 | 359 | 360 | 0 361 | 362 | 363 | 0 364 | 365 | 366 | Contents\Resources\StartUp\ 367 | 0 368 | 369 | 370 | Contents\Resources\StartUp\ 371 | 0 372 | 373 | 374 | 0 375 | 376 | 377 | 378 | 379 | 1 380 | 381 | 382 | 1 383 | 384 | 385 | 1 386 | 387 | 388 | 389 | 390 | 1 391 | 392 | 393 | 1 394 | 395 | 396 | 1 397 | 398 | 399 | 400 | 401 | 1 402 | 403 | 404 | 1 405 | 406 | 407 | 1 408 | 409 | 410 | 411 | 412 | 1 413 | 414 | 415 | 1 416 | 417 | 418 | 1 419 | 420 | 421 | 422 | 423 | 1 424 | 425 | 426 | 1 427 | 428 | 429 | 1 430 | 431 | 432 | 433 | 434 | 1 435 | 436 | 437 | 1 438 | 439 | 440 | 1 441 | 442 | 443 | 444 | 445 | 1 446 | 447 | 448 | 1 449 | 450 | 451 | 1 452 | 453 | 454 | 455 | 456 | 1 457 | 458 | 459 | 460 | 461 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 462 | 1 463 | 464 | 465 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 466 | 1 467 | 468 | 469 | 470 | 471 | 1 472 | 473 | 474 | 1 475 | 476 | 477 | 478 | 479 | ..\ 480 | 1 481 | 482 | 483 | ..\ 484 | 1 485 | 486 | 487 | 488 | 489 | 1 490 | 491 | 492 | 1 493 | 494 | 495 | 1 496 | 497 | 498 | 499 | 500 | 1 501 | 502 | 503 | 1 504 | 505 | 506 | 1 507 | 508 | 509 | 510 | 511 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 512 | 1 513 | 514 | 515 | 516 | 517 | ..\ 518 | 1 519 | 520 | 521 | ..\ 522 | 1 523 | 524 | 525 | 526 | 527 | Contents 528 | 1 529 | 530 | 531 | Contents 532 | 1 533 | 534 | 535 | 536 | 537 | Contents\Resources 538 | 1 539 | 540 | 541 | Contents\Resources 542 | 1 543 | 544 | 545 | 546 | 547 | library\lib\armeabi-v7a 548 | 1 549 | 550 | 551 | 1 552 | 553 | 554 | 1 555 | 556 | 557 | 1 558 | 559 | 560 | 1 561 | 562 | 563 | Contents\MacOS 564 | 1 565 | 566 | 567 | Contents\MacOS 568 | 1 569 | 570 | 571 | 0 572 | 573 | 574 | 575 | 576 | 1 577 | 578 | 579 | 1 580 | 581 | 582 | 583 | 584 | Assets 585 | 1 586 | 587 | 588 | Assets 589 | 1 590 | 591 | 592 | 593 | 594 | Assets 595 | 1 596 | 597 | 598 | Assets 599 | 1 600 | 601 | 602 | 603 | 604 | 605 | 606 | 607 | 608 | 609 | 610 | 611 | 612 | 613 | 12 614 | 615 | 616 | 617 | 618 | 619 | -------------------------------------------------------------------------------- /DelphiIPC.groupproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {73B6280D-7FC6-4D9F-AEB2-D80998DE0418} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | Default.Personality.12 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 | -------------------------------------------------------------------------------- /IPC.Demo.Types.pas: -------------------------------------------------------------------------------- 1 | unit IPC.Demo.Types; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows; 7 | 8 | const 9 | MAX_LENGTH = 1024; 10 | 11 | type 12 | TData = packed record 13 | ProcessId: DWORD; 14 | Text: array[0..MAX_LENGTH] of WideChar; 15 | procedure SetText(const AValue: string); 16 | end; 17 | 18 | type 19 | TResponseData = packed record 20 | Text: array[0..MAX_LENGTH] of WideChar; 21 | end; 22 | 23 | type 24 | PResponseData = ^TResponseData; 25 | 26 | implementation 27 | 28 | { TData } 29 | 30 | procedure TData.SetText(const AValue: string); 31 | begin 32 | lstrcpynW(Text, PWideChar(AValue), MAX_LENGTH); 33 | end; 34 | 35 | end. 36 | 37 | -------------------------------------------------------------------------------- /IPC.pas: -------------------------------------------------------------------------------- 1 | unit IPC; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, 7 | System.SysUtils, 8 | System.Classes; 9 | 10 | type 11 | TServerRecieveIpcDataEvent = procedure(Sender: TObject; var ClientName: 12 | WideString; var ClientWaitingForResponse: Boolean; var Data: Pointer) of object; 13 | 14 | TClientRecieveResponseIpcDataEvent = procedure(Sender: TObject; var Data: Pointer) of object; 15 | 16 | TIPCServer = class; 17 | 18 | TIPCClient = class; 19 | 20 | TServerThread = class; 21 | 22 | TIPCServer = class(TComponent) 23 | private 24 | FServerHandle: THandle; 25 | FServerThread: TServerThread; 26 | FOnRecieveIpcData: TServerRecieveIpcDataEvent; 27 | FServerThreadEnabled: Boolean; 28 | FLastError: Integer; 29 | protected 30 | function ReadData(var ClientName: WideString; var ClientWaitingForResponse: 31 | Boolean; var Data: Pointer): Boolean; 32 | public 33 | constructor Create(AOwner: TComponent); override; 34 | destructor Destroy; override; 35 | function CreateServer(ServerName: WideString): Boolean; 36 | function FreeServer: Boolean; 37 | function SendIpcData(ClientName: WideString; Data: Pointer; DataSize: DWORD): Boolean; 38 | public 39 | property OnRecieveIpcData: TServerRecieveIpcDataEvent read FOnRecieveIpcData 40 | write FOnRecieveIpcData; 41 | property LastError: Integer read FLastError; 42 | end; 43 | 44 | TServerThread = class(TThread) 45 | private 46 | FThreadOwner: TIPCServer; 47 | protected 48 | procedure DoReadData; 49 | procedure Execute; override; 50 | public 51 | constructor Create(AThreadOwner: TIPCServer); 52 | destructor Destroy; override; 53 | end; 54 | 55 | TIPCClient = class(TComponent) 56 | private 57 | FClientName: WideString; 58 | FResponseServerHandle: THandle; 59 | FOnRecieveIpcData: TClientRecieveResponseIpcDataEvent; 60 | FLastError: Integer; 61 | protected 62 | function ReadData(ServerHandle: THandle; var ClientName: WideString; var 63 | Data: Pointer): Boolean; 64 | public 65 | constructor Create(AOwner: TComponent); override; 66 | destructor Destroy; override; 67 | function CreateClient(ClientName: WideString): Boolean; 68 | function FreeClient: Boolean; 69 | function Send(ServerName: WideString; Data: T; WaitForResponse: Boolean; 70 | ResponseTimeout: ULONG; var ResponseData: Pointer): Boolean; 71 | public 72 | property OnRecieveResponseIpcData: TClientRecieveResponseIpcDataEvent read 73 | FOnRecieveIpcData write FOnRecieveIpcData; 74 | property LastError: Integer read FLastError; 75 | end; 76 | 77 | type 78 | TClientNameData = packed record 79 | ClientName: array[0..255] of WideChar; 80 | ClientWaitingForResponse: Boolean; 81 | end; 82 | 83 | implementation 84 | 85 | type 86 | TConvertStringSecurityDescriptorToSecurityDescriptorW = function(StringSecurityDescriptor: 87 | LPCWSTR; StringSDRevision: DWORD; var SecurityDescriptor: Pointer; 88 | SecurityDescriptorSize: PULONG): BOOL; stdcall; 89 | 90 | var 91 | OSVersion: DWORD; 92 | ConvertStringSecurityDescriptorToSecurityDescriptorW: 93 | TConvertStringSecurityDescriptorToSecurityDescriptorW; 94 | 95 | function GetOSVersion: DWORD; 96 | begin 97 | Result := (TOSVersion.Major.ToString + TOSVersion.Minor.ToString).ToInteger; 98 | end; 99 | 100 | constructor TIPCServer.Create(AOwner: TComponent); 101 | begin 102 | inherited Create(AOwner); 103 | FServerHandle := 0; 104 | end; 105 | 106 | destructor TIPCServer.Destroy; 107 | begin 108 | FreeServer; 109 | inherited; 110 | end; 111 | 112 | const 113 | LOW_INTEGRITY_SDDL_SACL = 'D:' + '(A;OICI;GRGW;;;AU)' + '(A;OICI;GRGW;;;BA)' + 114 | '(A;OICI;GRGW;;;AN)' + '(A;OICI;GRGW;;;BG)' + 'S:(ML;;NW;;;LW)'; 115 | SDDL_REVISION_1 = 1; 116 | 117 | function TIPCServer.CreateServer(ServerName: WideString): Boolean; 118 | var 119 | SecurityAttributes: TSecurityAttributes; 120 | SecurityDescriptor: TSecurityDescriptor; 121 | SecurityDescriptor_V: PSECURITY_DESCRIPTOR; 122 | BufferSize: DWORD; 123 | begin 124 | Result := False; 125 | try 126 | if GetMailslotInfo(FServerHandle, nil, BufferSize, nil, nil) then 127 | begin 128 | FLastError := ERROR_ALREADY_EXISTS; 129 | Exit; 130 | end; 131 | 132 | if OSVersion >= 60 then 133 | begin 134 | FillChar(SecurityDescriptor_V, SizeOf(PSECURITY_DESCRIPTOR), 0); 135 | 136 | if not ConvertStringSecurityDescriptorToSecurityDescriptorW(LOW_INTEGRITY_SDDL_SACL, 137 | SDDL_REVISION_1, SecurityDescriptor_V, nil) then 138 | begin 139 | FLastError := GetLastError; 140 | Exit; 141 | end; 142 | 143 | SecurityAttributes.nLength := SizeOf(TSecurityAttributes); 144 | SecurityAttributes.lpSecurityDescriptor := SecurityDescriptor_V; 145 | SecurityAttributes.bInheritHandle := True; 146 | 147 | end 148 | else if (OSVersion >= 50) and (OSVersion < 60) then 149 | begin 150 | FillChar(SecurityDescriptor, SECURITY_DESCRIPTOR_MIN_LENGTH, 0); 151 | if InitializeSecurityDescriptor(@SecurityDescriptor, SECURITY_DESCRIPTOR_REVISION) then 152 | begin 153 | if SetSecurityDescriptorDacl(@SecurityDescriptor, True, nil, False) then 154 | begin 155 | SecurityAttributes.nLength := SizeOf(TSecurityAttributes); 156 | SecurityAttributes.lpSecurityDescriptor := @SecurityDescriptor; 157 | SecurityAttributes.bInheritHandle := True; 158 | end; 159 | end; 160 | end; 161 | 162 | FServerHandle := CreateMailslotW(PWideChar('\\.\mailslot\' + ServerName), 0, 163 | 0, @SecurityAttributes); 164 | 165 | if FServerHandle = INVALID_HANDLE_VALUE then 166 | begin 167 | FLastError := GetLastError; 168 | Exit; 169 | end; 170 | 171 | if (FServerThreadEnabled = False) then 172 | begin 173 | FServerThread := TServerThread.Create(Self); 174 | FServerThreadEnabled := True; 175 | end; 176 | 177 | Result := True; 178 | FLastError := ERROR_SUCCESS; 179 | except 180 | end; 181 | end; 182 | 183 | function TIPCServer.FreeServer: Boolean; 184 | begin 185 | Result := False; 186 | try 187 | if FServerThreadEnabled = True then 188 | begin 189 | FServerThread.Terminate; 190 | end; 191 | 192 | if FServerHandle <> 0 then 193 | begin 194 | CloseHandle(FServerHandle); 195 | FServerHandle := 0; 196 | end; 197 | 198 | FLastError := ERROR_SUCCESS; 199 | Result := True; 200 | except 201 | end; 202 | end; 203 | 204 | function TIPCServer.ReadData(var ClientName: WideString; var 205 | ClientWaitingForResponse: Boolean; var Data: Pointer): Boolean; 206 | var 207 | BufferSize, NumberOfBytesWritten: DWORD; 208 | MemoryStream: TMemoryStream; 209 | ClientNameData: TClientNameData; 210 | DataBuffer, ClientDataBuffer: PVOID; 211 | ReadStatus: Boolean; 212 | begin 213 | Result := False; 214 | try 215 | if GetMailslotInfo(FServerHandle, nil, BufferSize, nil, nil) then 216 | begin 217 | if BufferSize <> MAILSLOT_NO_MESSAGE then 218 | begin 219 | GetMem(DataBuffer, BufferSize); 220 | GetMem(ClientDataBuffer, BufferSize); 221 | GetMem(Data, BufferSize); 222 | try 223 | if (DataBuffer <> nil) and (ClientDataBuffer <> nil) and (Data <> nil) then 224 | begin 225 | ReadStatus := ReadFile(FServerHandle, DataBuffer^, BufferSize, 226 | NumberOfBytesWritten, nil); 227 | if ReadStatus then 228 | begin 229 | MemoryStream := TMemoryStream.Create; 230 | try 231 | MemoryStream.Write(DataBuffer^, BufferSize); 232 | MemoryStream.Position := 0; 233 | MemoryStream.Read(ClientDataBuffer^, BufferSize - SizeOf(TClientNameData)); 234 | CopyMemory(Data, ClientDataBuffer, BufferSize - SizeOf(TClientNameData)); 235 | MemoryStream.Position := BufferSize - SizeOf(TClientNameData); 236 | MemoryStream.Read(ClientNameData, SizeOf(TClientNameData)); 237 | ClientName := WideString(ClientNameData.ClientName); 238 | ClientWaitingForResponse := ClientNameData.ClientWaitingForResponse; 239 | finally 240 | MemoryStream.Free; 241 | end; 242 | Result := True; 243 | end; 244 | end; 245 | finally 246 | FreeMem(Data); 247 | FreeMem(ClientDataBuffer); 248 | FreeMem(DataBuffer); 249 | end; 250 | end; 251 | end; 252 | except 253 | end; 254 | end; 255 | 256 | function TIPCServer.SendIpcData(ClientName: WideString; Data: Pointer; DataSize: DWORD): Boolean; 257 | var 258 | MemoryStream: TMemoryStream; 259 | NumberOfBytesWritten: DWORD; 260 | ClientData: TClientNameData; 261 | Buffer: Pointer; 262 | ServerHandle: THandle; 263 | begin 264 | Result := False; 265 | try 266 | ServerHandle := CreateFileW(PWideChar('\\.\mailslot\' + ClientName), 267 | GENERIC_WRITE, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); 268 | if ServerHandle = INVALID_HANDLE_VALUE then 269 | begin 270 | FLastError := GetLastError; 271 | Exit; 272 | end; 273 | try 274 | lstrcpynW(ClientData.ClientName, PWideChar(ClientName), 255); 275 | MemoryStream := TMemoryStream.Create; 276 | try 277 | MemoryStream.Write(Data^, DataSize); 278 | MemoryStream.Write(ClientData, SizeOf(TClientNameData)); 279 | MemoryStream.Position := 0; 280 | GetMem(Buffer, MemoryStream.Size); 281 | try 282 | MemoryStream.Read(Buffer^, MemoryStream.Size); 283 | if WriteFile(ServerHandle, Buffer^, MemoryStream.Size, NumberOfBytesWritten, nil) then 284 | begin 285 | FLastError := ERROR_SUCCESS; 286 | Result := True; 287 | end 288 | else 289 | FLastError := GetLastError; 290 | finally 291 | FreeMem(Buffer); 292 | end; 293 | finally 294 | MemoryStream.Free; 295 | end; 296 | finally 297 | CloseHandle(ServerHandle); 298 | end; 299 | except 300 | end; 301 | end; 302 | 303 | procedure TServerThread.DoReadData; 304 | var 305 | Data: Pointer; 306 | ClientName: WideString; 307 | ClientWaitResponse: Boolean; 308 | begin 309 | try 310 | Data := nil; 311 | if FThreadOwner.ReadData(ClientName, ClientWaitResponse, Data) then 312 | begin 313 | if Data <> nil then 314 | begin 315 | if Assigned(FThreadOwner.FOnRecieveIpcData) then 316 | FThreadOwner.FOnRecieveIpcData(Self, ClientName, ClientWaitResponse, Data); 317 | end; 318 | end; 319 | except 320 | end; 321 | end; 322 | 323 | procedure TServerThread.Execute; 324 | begin 325 | while not Terminated do 326 | begin 327 | Sleep(10); 328 | SYNCHRONIZE(DoReadData); 329 | end; 330 | FThreadOwner.FServerThreadEnabled := False; 331 | end; 332 | 333 | constructor TServerThread.Create(AThreadOwner: TIPCServer); 334 | begin 335 | inherited Create(False); 336 | FThreadOwner := AThreadOwner; 337 | FreeOnTerminate := True; 338 | case GetThreadPriority(GetCurrentThread) of 339 | THREAD_PRIORITY_ABOVE_NORMAL: 340 | Priority := tpHigher; 341 | THREAD_PRIORITY_BELOW_NORMAL: 342 | Priority := tpLower; 343 | THREAD_PRIORITY_HIGHEST: 344 | Priority := tpHighest; 345 | THREAD_PRIORITY_IDLE: 346 | Priority := tpIdle; 347 | THREAD_PRIORITY_LOWEST: 348 | Priority := tpLowest; 349 | THREAD_PRIORITY_NORMAL: 350 | Priority := tpNormal; 351 | THREAD_PRIORITY_TIME_CRITICAL: 352 | Priority := tpTimeCritical; 353 | end; 354 | end; 355 | 356 | destructor TServerThread.Destroy; 357 | begin 358 | inherited; 359 | end; 360 | 361 | // Client 362 | constructor TIPCClient.Create(AOwner: TComponent); 363 | begin 364 | inherited Create(AOwner); 365 | FResponseServerHandle := 0; 366 | end; 367 | 368 | destructor TIPCClient.Destroy; 369 | begin 370 | FreeClient; 371 | inherited; 372 | end; 373 | 374 | function TIPCClient.CreateClient(ClientName: WideString): Boolean; 375 | var 376 | SecurityAttributes: TSecurityAttributes; 377 | SecurityDescriptor: TSecurityDescriptor; 378 | SecurityDescriptor_V: PSECURITY_DESCRIPTOR; 379 | BufferSize: DWORD; 380 | begin 381 | Result := False; 382 | try 383 | if GetMailslotInfo(FResponseServerHandle, nil, BufferSize, nil, nil) then 384 | begin 385 | FLastError := ERROR_ALREADY_EXISTS; 386 | Exit; 387 | end; 388 | 389 | if OSVersion >= 60 then 390 | begin 391 | FillChar(SecurityDescriptor_V, SizeOf(PSECURITY_DESCRIPTOR), 0); 392 | 393 | if not ConvertStringSecurityDescriptorToSecurityDescriptorW(LOW_INTEGRITY_SDDL_SACL, 394 | SDDL_REVISION_1, SecurityDescriptor_V, nil) then 395 | begin 396 | FLastError := GetLastError; 397 | Exit; 398 | end; 399 | 400 | SecurityAttributes.nLength := SizeOf(TSecurityAttributes); 401 | SecurityAttributes.lpSecurityDescriptor := SecurityDescriptor_V; 402 | SecurityAttributes.bInheritHandle := True; 403 | end 404 | else if (OSVersion >= 50) and (OSVersion < 60) then 405 | begin 406 | FillChar(SecurityDescriptor, SECURITY_DESCRIPTOR_MIN_LENGTH, 0); 407 | if InitializeSecurityDescriptor(@SecurityDescriptor, SECURITY_DESCRIPTOR_REVISION) then 408 | begin 409 | if SetSecurityDescriptorDacl(@SecurityDescriptor, True, nil, False) then 410 | begin 411 | SecurityAttributes.nLength := SizeOf(TSecurityAttributes); 412 | SecurityAttributes.lpSecurityDescriptor := @SecurityDescriptor; 413 | SecurityAttributes.bInheritHandle := True; 414 | end; 415 | end; 416 | end; 417 | 418 | FResponseServerHandle := CreateMailslotW(PWideChar('\\.\mailslot\' + 419 | ClientName), 0, 0, @SecurityAttributes); 420 | 421 | if FResponseServerHandle = INVALID_HANDLE_VALUE then 422 | begin 423 | FLastError := GetLastError; 424 | Exit; 425 | end; 426 | 427 | Result := True; 428 | FClientName := ClientName; 429 | FLastError := ERROR_SUCCESS; 430 | except 431 | end; 432 | end; 433 | 434 | function TIPCClient.FreeClient: Boolean; 435 | begin 436 | Result := False; 437 | try 438 | if FResponseServerHandle <> 0 then 439 | begin 440 | CloseHandle(FResponseServerHandle); 441 | FResponseServerHandle := 0; 442 | end; 443 | FLastError := ERROR_SUCCESS; 444 | Result := True; 445 | except 446 | end; 447 | end; 448 | 449 | function TIPCClient.ReadData(ServerHandle: THandle; var ClientName: WideString; 450 | var Data: Pointer): Boolean; 451 | var 452 | BufferSize, NumberOfBytesWritten: DWORD; 453 | MemoryStream: TMemoryStream; 454 | ClientNameData: TClientNameData; 455 | DataBuffer, ClientDataBuffer: Pointer; 456 | begin 457 | Result := False; 458 | try 459 | if GetMailslotInfo(ServerHandle, nil, BufferSize, nil, nil) then 460 | begin 461 | if BufferSize <> MAILSLOT_NO_MESSAGE then 462 | begin 463 | GetMem(DataBuffer, BufferSize); 464 | GetMem(ClientDataBuffer, BufferSize); 465 | GetMem(Data, BufferSize); 466 | 467 | try 468 | if (DataBuffer <> nil) and (ClientDataBuffer <> nil) and (Data <> nil) then 469 | begin 470 | if ReadFile(ServerHandle, DataBuffer^, BufferSize, NumberOfBytesWritten, nil) then 471 | begin 472 | MemoryStream := TMemoryStream.Create; 473 | try 474 | MemoryStream.Write(DataBuffer^, BufferSize); 475 | 476 | MemoryStream.Position := 0; 477 | 478 | MemoryStream.Read(ClientDataBuffer^, BufferSize - SizeOf(TClientNameData)); 479 | 480 | CopyMemory(Data, ClientDataBuffer, BufferSize - SizeOf(TClientNameData)); 481 | 482 | MemoryStream.Position := BufferSize - SizeOf(TClientNameData); 483 | 484 | MemoryStream.Read(ClientNameData, SizeOf(TClientNameData)); 485 | 486 | ClientName := WideString(ClientNameData.ClientName); 487 | finally 488 | MemoryStream.Free; 489 | end; 490 | Result := True; 491 | end; 492 | end; 493 | finally 494 | FreeMem(Data); 495 | FreeMem(ClientDataBuffer); 496 | FreeMem(DataBuffer); 497 | end; 498 | end; 499 | end; 500 | except 501 | end; 502 | end; 503 | 504 | function TIPCClient.Send(ServerName: WideString; Data: T; WaitForResponse: 505 | Boolean; ResponseTimeout: ULONG; var ResponseData: Pointer): Boolean; 506 | var 507 | MemoryStream: TMemoryStream; 508 | i, NumberOfBytesWritten: DWORD; 509 | ClientNameData: TClientNameData; 510 | Buffer: Pointer; 511 | ServerHandle: THandle; 512 | ClientName: WideString; 513 | BufferSize: DWORD; 514 | begin 515 | Result := False; 516 | try 517 | ServerHandle := CreateFileW(PWideChar('\\.\mailslot\' + ServerName), 518 | GENERIC_WRITE, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); 519 | if ServerHandle = INVALID_HANDLE_VALUE then 520 | begin 521 | FLastError := GetLastError; 522 | Exit; 523 | end; 524 | 525 | try 526 | lstrcpynW(ClientNameData.ClientName, PWideChar(FClientName), 255); 527 | ClientNameData.ClientWaitingForResponse := WaitForResponse; 528 | 529 | MemoryStream := TMemoryStream.Create; 530 | try 531 | MemoryStream.Write(Data, SizeOf(Data) {DataSize}); 532 | MemoryStream.Write(ClientNameData, SizeOf(TClientNameData)); 533 | MemoryStream.Position := 0; 534 | 535 | GetMem(Buffer, MemoryStream.Size); 536 | try 537 | MemoryStream.Read(Buffer^, MemoryStream.Size); 538 | if not WriteFile(ServerHandle, Buffer^, MemoryStream.Size, NumberOfBytesWritten, nil) then 539 | begin 540 | FLastError := GetLastError; 541 | Exit; 542 | end; 543 | finally 544 | FreeMem(Buffer); 545 | end; 546 | finally 547 | MemoryStream.Free; 548 | end; 549 | finally 550 | CloseHandle(ServerHandle); 551 | end; 552 | 553 | FLastError := ERROR_SUCCESS; 554 | Result := True; 555 | 556 | if (WaitForResponse = True) and (ResponseTimeout > 0) then 557 | begin 558 | 559 | try 560 | i := 0; 561 | while True do 562 | begin 563 | 564 | if ReadData(FResponseServerHandle, ClientName, ResponseData) then 565 | begin 566 | if ResponseData <> nil then 567 | begin 568 | if ClientName = FClientName then 569 | begin 570 | if Assigned(FOnRecieveIpcData) then 571 | FOnRecieveIpcData(Self, ResponseData); 572 | Exit; 573 | end; 574 | end; 575 | end; 576 | 577 | Inc(i); 578 | Sleep(1); 579 | if i >= ResponseTimeout then 580 | begin 581 | Exit; 582 | end; 583 | end; 584 | except 585 | Exit; 586 | end; 587 | end; 588 | except 589 | end; 590 | end; 591 | 592 | procedure _Initialize; 593 | var 594 | hLibrary: HMODULE; 595 | begin 596 | OSVersion := GetOSVersion; 597 | hLibrary := LoadLibrary('advapi32.dll'); 598 | if (hLibrary <> 0) and (OSVersion >= 60) then 599 | begin 600 | @ConvertStringSecurityDescriptorToSecurityDescriptorW := GetProcAddress(hLibrary, 601 | 'ConvertStringSecurityDescriptorToSecurityDescriptorW'); 602 | end; 603 | end; 604 | 605 | initialization 606 | _Initialize; 607 | 608 | end. 609 | 610 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Delphi-Inter-Process-Communication 2 | Автор Зорков Игорь. 3 | -------------------------------------------------------------------------------- /Server.dpr: -------------------------------------------------------------------------------- 1 | program Server; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit_Server in 'Unit_Server.pas' {Form1}, 6 | IPC.Demo.Types in 'IPC.Demo.Types.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | ReportMemoryLeaksOnShutdown := True; 12 | Application.Initialize; 13 | Application.MainFormOnTaskbar := True; 14 | Application.CreateForm(TForm1, Form1); 15 | Application.Run; 16 | end. 17 | 18 | -------------------------------------------------------------------------------- /Server.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {CF6DECE9-D6C8-4631-B15A-A1AEE4B5243D} 4 | Server.dpr 5 | True 6 | Debug 7 | 1 8 | Application 9 | VCL 10 | 18.6 11 | Win32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | true 44 | Cfg_2 45 | true 46 | true 47 | 48 | 49 | false 50 | false 51 | false 52 | false 53 | false 54 | 00400000 55 | Server 56 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 57 | 1033 58 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 59 | 60 | 61 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 62 | Debug 63 | true 64 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 65 | $(BDS)\bin\default_app.manifest 66 | $(BDS)\bin\delphi_PROJECTICON.ico 67 | true 68 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 69 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 70 | 71 | 72 | $(BDS)\bin\default_app.manifest 73 | Server_Icon.ico 74 | true 75 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 76 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 77 | 78 | 79 | RELEASE;$(DCC_Define) 80 | 0 81 | false 82 | 0 83 | 84 | 85 | true 86 | PerMonitorV2 87 | true 88 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 89 | 90 | 91 | DEBUG;$(DCC_Define) 92 | false 93 | true 94 | 95 | 96 | true 97 | PerMonitorV2 98 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 99 | true 100 | 101 | 102 | 103 | MainSource 104 | 105 | 106 | 107 | 108 | 109 | 110 | Cfg_2 111 | Base 112 | 113 | 114 | Base 115 | 116 | 117 | Cfg_1 118 | Base 119 | 120 | 121 | 122 | Delphi.Personality.12 123 | 124 | 125 | 126 | 127 | Server.dpr 128 | 129 | 130 | Microsoft Office 2000 Sample Automation Server Wrapper Components 131 | Microsoft Office XP Sample Automation Server Wrapper Components 132 | 133 | 134 | 135 | True 136 | False 137 | 138 | 139 | 140 | 141 | Server.exe 142 | true 143 | 144 | 145 | 146 | 147 | 1 148 | 149 | 150 | Contents\MacOS 151 | 1 152 | 153 | 154 | 0 155 | 156 | 157 | 158 | 159 | classes 160 | 1 161 | 162 | 163 | 164 | 165 | res\xml 166 | 1 167 | 168 | 169 | 170 | 171 | library\lib\armeabi-v7a 172 | 1 173 | 174 | 175 | 176 | 177 | library\lib\armeabi 178 | 1 179 | 180 | 181 | 182 | 183 | library\lib\mips 184 | 1 185 | 186 | 187 | 188 | 189 | library\lib\armeabi-v7a 190 | 1 191 | 192 | 193 | 194 | 195 | res\drawable 196 | 1 197 | 198 | 199 | 200 | 201 | res\values 202 | 1 203 | 204 | 205 | 206 | 207 | res\values-v21 208 | 1 209 | 210 | 211 | 212 | 213 | res\drawable 214 | 1 215 | 216 | 217 | 218 | 219 | res\drawable-xxhdpi 220 | 1 221 | 222 | 223 | 224 | 225 | res\drawable-ldpi 226 | 1 227 | 228 | 229 | 230 | 231 | res\drawable-mdpi 232 | 1 233 | 234 | 235 | 236 | 237 | res\drawable-hdpi 238 | 1 239 | 240 | 241 | 242 | 243 | res\drawable-xhdpi 244 | 1 245 | 246 | 247 | 248 | 249 | res\drawable-small 250 | 1 251 | 252 | 253 | 254 | 255 | res\drawable-normal 256 | 1 257 | 258 | 259 | 260 | 261 | res\drawable-large 262 | 1 263 | 264 | 265 | 266 | 267 | res\drawable-xlarge 268 | 1 269 | 270 | 271 | 272 | 273 | 1 274 | 275 | 276 | Contents\MacOS 277 | 1 278 | 279 | 280 | 0 281 | 282 | 283 | 284 | 285 | Contents\MacOS 286 | 1 287 | .framework 288 | 289 | 290 | Contents\MacOS 291 | 1 292 | .framework 293 | 294 | 295 | 0 296 | 297 | 298 | 299 | 300 | 1 301 | .dylib 302 | 303 | 304 | 1 305 | .dylib 306 | 307 | 308 | 1 309 | .dylib 310 | 311 | 312 | Contents\MacOS 313 | 1 314 | .dylib 315 | 316 | 317 | Contents\MacOS 318 | 1 319 | .dylib 320 | 321 | 322 | 0 323 | .dll;.bpl 324 | 325 | 326 | 327 | 328 | 1 329 | .dylib 330 | 331 | 332 | 1 333 | .dylib 334 | 335 | 336 | 1 337 | .dylib 338 | 339 | 340 | Contents\MacOS 341 | 1 342 | .dylib 343 | 344 | 345 | Contents\MacOS 346 | 1 347 | .dylib 348 | 349 | 350 | 0 351 | .bpl 352 | 353 | 354 | 355 | 356 | 0 357 | 358 | 359 | 0 360 | 361 | 362 | 0 363 | 364 | 365 | 0 366 | 367 | 368 | Contents\Resources\StartUp\ 369 | 0 370 | 371 | 372 | Contents\Resources\StartUp\ 373 | 0 374 | 375 | 376 | 0 377 | 378 | 379 | 380 | 381 | 1 382 | 383 | 384 | 1 385 | 386 | 387 | 1 388 | 389 | 390 | 391 | 392 | 1 393 | 394 | 395 | 1 396 | 397 | 398 | 1 399 | 400 | 401 | 402 | 403 | 1 404 | 405 | 406 | 1 407 | 408 | 409 | 1 410 | 411 | 412 | 413 | 414 | 1 415 | 416 | 417 | 1 418 | 419 | 420 | 1 421 | 422 | 423 | 424 | 425 | 1 426 | 427 | 428 | 1 429 | 430 | 431 | 1 432 | 433 | 434 | 435 | 436 | 1 437 | 438 | 439 | 1 440 | 441 | 442 | 1 443 | 444 | 445 | 446 | 447 | 1 448 | 449 | 450 | 1 451 | 452 | 453 | 1 454 | 455 | 456 | 457 | 458 | 1 459 | 460 | 461 | 462 | 463 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 464 | 1 465 | 466 | 467 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 468 | 1 469 | 470 | 471 | 472 | 473 | 1 474 | 475 | 476 | 1 477 | 478 | 479 | 480 | 481 | ..\ 482 | 1 483 | 484 | 485 | ..\ 486 | 1 487 | 488 | 489 | 490 | 491 | 1 492 | 493 | 494 | 1 495 | 496 | 497 | 1 498 | 499 | 500 | 501 | 502 | 1 503 | 504 | 505 | 1 506 | 507 | 508 | 1 509 | 510 | 511 | 512 | 513 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 514 | 1 515 | 516 | 517 | 518 | 519 | ..\ 520 | 1 521 | 522 | 523 | ..\ 524 | 1 525 | 526 | 527 | 528 | 529 | Contents 530 | 1 531 | 532 | 533 | Contents 534 | 1 535 | 536 | 537 | 538 | 539 | Contents\Resources 540 | 1 541 | 542 | 543 | Contents\Resources 544 | 1 545 | 546 | 547 | 548 | 549 | library\lib\armeabi-v7a 550 | 1 551 | 552 | 553 | 1 554 | 555 | 556 | 1 557 | 558 | 559 | 1 560 | 561 | 562 | 1 563 | 564 | 565 | Contents\MacOS 566 | 1 567 | 568 | 569 | Contents\MacOS 570 | 1 571 | 572 | 573 | 0 574 | 575 | 576 | 577 | 578 | 1 579 | 580 | 581 | 1 582 | 583 | 584 | 585 | 586 | Assets 587 | 1 588 | 589 | 590 | Assets 591 | 1 592 | 593 | 594 | 595 | 596 | Assets 597 | 1 598 | 599 | 600 | Assets 601 | 1 602 | 603 | 604 | 605 | 606 | 607 | 608 | 609 | 610 | 611 | 612 | 613 | 614 | 615 | 12 616 | 617 | 618 | 619 | 620 | 621 | -------------------------------------------------------------------------------- /Unit_Client.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 258 3 | Top = 128 4 | Caption = 'IPC Client' 5 | ClientHeight = 234 6 | ClientWidth = 561 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -14 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poDesktopCenter 15 | OnCreate = FormCreate 16 | OnDestroy = FormDestroy 17 | DesignSize = ( 18 | 561 19 | 234) 20 | PixelsPerInch = 120 21 | TextHeight = 17 22 | object Button1: TButton 23 | Left = 10 24 | Top = 201 25 | Width = 146 26 | Height = 33 27 | Anchors = [akLeft, akBottom] 28 | Caption = 'Send IPC Data' 29 | TabOrder = 1 30 | OnClick = Button1Click 31 | end 32 | object Memo1: TMemo 33 | Left = 10 34 | Top = 10 35 | Width = 548 36 | Height = 178 37 | Anchors = [akLeft, akTop, akRight, akBottom] 38 | ScrollBars = ssVertical 39 | TabOrder = 0 40 | end 41 | object CheckBox1: TCheckBox 42 | Left = 174 43 | Top = 207 44 | Width = 152 45 | Height = 22 46 | Anchors = [akLeft, akBottom] 47 | Caption = 'Wait For Response' 48 | TabOrder = 2 49 | end 50 | end 51 | -------------------------------------------------------------------------------- /Unit_Client.pas: -------------------------------------------------------------------------------- 1 | unit Unit_Client; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, 7 | Winapi.Messages, 8 | System.SysUtils, 9 | System.Variants, 10 | System.Classes, 11 | Vcl.Graphics, 12 | Vcl.Controls, 13 | Vcl.Forms, 14 | Vcl.Dialogs, 15 | Vcl.StdCtrls, 16 | Vcl.ExtCtrls, 17 | Vcl.ComCtrls, 18 | IPC; 19 | 20 | type 21 | TForm1 = class(TForm) 22 | Button1: TButton; 23 | Memo1: TMemo; 24 | CheckBox1: TCheckBox; 25 | procedure Button1Click(Sender: TObject); 26 | procedure FormCreate(Sender: TObject); 27 | procedure FormDestroy(Sender: TObject); 28 | private 29 | { Private declarations } 30 | FIPCClient: TIPCClient; 31 | public 32 | { Public declarations } 33 | procedure ClientRecieveResponseIpcData(Sender: TObject; var ResponseData: Pointer); 34 | end; 35 | 36 | var 37 | Form1: TForm1; 38 | 39 | implementation 40 | 41 | uses 42 | IPC.Demo.Types; 43 | {$R *.dfm} 44 | 45 | procedure TForm1.ClientRecieveResponseIpcData(Sender: TObject; var ResponseData: Pointer); 46 | begin 47 | // MessageBoxW(0, TResponseData(ResponseData^).Text, 'IPC Client', 0); 48 | end; 49 | 50 | procedure TForm1.Button1Click(Sender: TObject); 51 | var 52 | Data: TData; 53 | ResponseData: Pointer; 54 | begin 55 | ResponseData := nil; 56 | Data.ProcessId := GetCurrentProcessId; 57 | Data.SetText(Memo1.Text); 58 | if not FIPCClient.Send('IPC Server', Data, CheckBox1.Checked, 1000, ResponseData) then 59 | Memo1.Lines.Add('Error send IPC data - ' + SysErrorMessage(FIPCClient.LastError)); 60 | if ResponseData <> nil then 61 | begin 62 | MessageBeep(0); 63 | MessageBoxW(0, TResponseData(ResponseData^).Text, 'IPC Client', 0); 64 | end; 65 | end; 66 | 67 | procedure TForm1.FormCreate(Sender: TObject); 68 | begin 69 | FIPCClient := TIPCClient.Create(nil); 70 | if not FIPCClient.CreateClient('IPCClient_' + IntToStr(GetCurrentProcessId)) then 71 | Memo1.Lines.Add('Error create client "' + 'IPC Client' + '" - ' + SysErrorMessage(FIPCClient.LastError)); 72 | FIPCClient.OnRecieveResponseIpcData := ClientRecieveResponseIpcData; 73 | end; 74 | 75 | procedure TForm1.FormDestroy(Sender: TObject); 76 | begin 77 | FIPCClient.Free; 78 | end; 79 | 80 | end. 81 | 82 | -------------------------------------------------------------------------------- /Unit_Server.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 260 3 | Top = 127 4 | Caption = 'IPC Server' 5 | ClientHeight = 343 6 | ClientWidth = 877 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -14 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnClose = FormClose 15 | OnCreate = FormCreate 16 | DesignSize = ( 17 | 877 18 | 343) 19 | PixelsPerInch = 120 20 | TextHeight = 17 21 | object Button1: TButton 22 | Left = 10 23 | Top = 311 24 | Width = 144 25 | Height = 33 26 | Anchors = [akLeft, akBottom] 27 | Caption = 'Create Server' 28 | TabOrder = 0 29 | OnClick = Button1Click 30 | end 31 | object Button2: TButton 32 | Left = 162 33 | Top = 311 34 | Width = 144 35 | Height = 33 36 | Anchors = [akLeft, akBottom] 37 | Caption = 'Free Server' 38 | Enabled = False 39 | TabOrder = 1 40 | OnClick = Button2Click 41 | end 42 | object Memo1: TMemo 43 | Left = 10 44 | Top = 10 45 | Width = 865 46 | Height = 253 47 | Anchors = [akLeft, akTop, akRight, akBottom] 48 | ScrollBars = ssVertical 49 | TabOrder = 2 50 | end 51 | object Edit1: TEdit 52 | Left = 10 53 | Top = 275 54 | Width = 865 55 | Height = 25 56 | Anchors = [akLeft, akRight, akBottom] 57 | TabOrder = 3 58 | Text = 'This is response text from server ' 59 | end 60 | object Button3: TButton 61 | Left = 777 62 | Top = 311 63 | Width = 98 64 | Height = 33 65 | Anchors = [akRight, akBottom] 66 | Caption = 'Clear' 67 | TabOrder = 4 68 | OnClick = Button3Click 69 | end 70 | end 71 | -------------------------------------------------------------------------------- /Unit_Server.pas: -------------------------------------------------------------------------------- 1 | unit Unit_Server; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, 7 | Winapi.Messages, 8 | System.SysUtils, 9 | System.Variants, 10 | System.Classes, 11 | Vcl.Graphics, 12 | Vcl.Controls, 13 | Vcl.Forms, 14 | Vcl.Dialogs, 15 | Vcl.StdCtrls, 16 | Vcl.ExtCtrls, 17 | Vcl.ComCtrls, 18 | IPC; 19 | 20 | type 21 | TForm1 = class(TForm) 22 | Button1: TButton; 23 | Button2: TButton; 24 | Memo1: TMemo; 25 | Edit1: TEdit; 26 | Button3: TButton; 27 | procedure FormCreate(Sender: TObject); 28 | procedure Button1Click(Sender: TObject); 29 | procedure Button2Click(Sender: TObject); 30 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 31 | procedure Button3Click(Sender: TObject); 32 | private 33 | { Private declarations } 34 | FIPCServer: TIPCServer; 35 | public 36 | { Public declarations } 37 | procedure ServerRecieveIpcData(Sender: TObject; var ClientName: WideString; 38 | var ClientWaitingForResponse: Boolean; var Data: Pointer); 39 | end; 40 | 41 | var 42 | Form1: TForm1; 43 | 44 | implementation 45 | 46 | uses 47 | IPC.Demo.Types; 48 | {$R *.dfm} 49 | 50 | procedure TForm1.ServerRecieveIpcData(Sender: TObject; var ClientName: 51 | WideString; var ClientWaitingForResponse: Boolean; var Data: Pointer); 52 | var 53 | ResponseData: TResponseData; 54 | begin 55 | Form1.Memo1.Lines.Add(ClientName + ': ' + TData(Data^).Text); 56 | if ClientWaitingForResponse then 57 | begin 58 | lstrcpynW(ResponseData.Text, PWideChar(Edit1.Text), MAX_LENGTH); 59 | if not FIPCServer.SendIpcData(ClientName, @ResponseData, SizeOf(TResponseData)) then 60 | Form1.Memo1.Lines.Add('Error send response - ' + SysErrorMessage(FIPCServer.LastError)); 61 | end; 62 | end; 63 | 64 | procedure TForm1.Button1Click(Sender: TObject); 65 | begin 66 | if not FIPCServer.CreateServer('IPC Server') then 67 | Form1.Memo1.Lines.Add('Error create server "' + 'IPC Server' + '" - ' + SysErrorMessage(FIPCServer.LastError)) 68 | else 69 | begin 70 | Button1.Enabled := False; 71 | Button2.Enabled := True; 72 | end; 73 | end; 74 | 75 | procedure TForm1.Button2Click(Sender: TObject); 76 | begin 77 | if FIPCServer.FreeServer then 78 | begin 79 | Button1.Enabled := True; 80 | Button2.Enabled := False; 81 | end; 82 | end; 83 | 84 | procedure TForm1.Button3Click(Sender: TObject); 85 | begin 86 | Memo1.Clear; 87 | end; 88 | 89 | procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 90 | begin 91 | FIPCServer.Free; 92 | end; 93 | 94 | procedure TForm1.FormCreate(Sender: TObject); 95 | begin 96 | FIPCServer := TIPCServer.Create(nil); 97 | FIPCServer.OnRecieveIpcData := ServerRecieveIpcData; 98 | Button1.Click; 99 | end; 100 | 101 | end. 102 | 103 | --------------------------------------------------------------------------------