Initial import

mdl/m_pipe_disk.pas

@@ -0,0 +1,240 @@
+Unit m_Pipe_Disk;
+
+{$I M_OPS.PAS}
+
+Interface
+
+Uses
+  m_DateTime,
+  m_FileIO,
+  m_Strings;
+
+Const
+  PipeClientResetTimer = 6000;  //  60 seconds
+  PipeServerTimeout    = 9000;  //  90 seconds
+
+  PipeInFileName  = '__mys_in.';
+  PipeOutFileName = '__mys_out.';
+  PipeCmdFileName = '__mys_cmd.';
+
+Type
+  TPipeDiskBuffer = Array[0..8 * 1024 - 1] of Char;
+
+  TPipeDisk = Class
+    PipeID     : Word;
+    PipeInput  : File;
+    PipeOutput : File;
+    Connected  : Boolean;
+    ResetTimer : LongInt;
+    IsClient   : Boolean;
+    PipeDir    : String;
+
+    Constructor Create       (Dir: String; Client: Boolean; ID: Word);
+    Destructor  Destroy;     Override;
+    // Server functions
+    Function    CreatePipe   : Boolean;
+    Function    WaitForPipe  (Secs: LongInt) : Boolean;
+    // Client functions
+    Function    ConnectPipe  (Secs: LongInt) : Boolean;
+    // General functions
+    Procedure   DeleteFiles;
+    Procedure   SendToPipe   (Var Buf; Len: Longint);
+    Procedure   ReadFromPipe (Var Buf; Len: LongInt; Var bRead: LongInt);
+    Procedure   Disconnect;
+  End;
+
+Implementation
+
+Procedure TPipeDisk.DeleteFiles;
+Begin
+  If IsClient Then
+    FileErase (PipeDir + PipeCmdFileName + strI2S(PipeID))
+  Else Begin
+    FileErase (PipeDir + PipeInFileName  + strI2S(PipeID));
+    FileErase (PipeDir + PipeOutFileName + strI2S(PipeID));
+  End;
+End;
+
+Constructor TPipeDisk.Create (Dir: String; Client: Boolean; ID: Word);
+Begin
+  Connected  := False;
+  IsClient   := Client;
+  ResetTimer := 0;
+  PipeDir    := DirSlash(Dir);
+  FileMode   := 66;
+  PipeID     := ID;
+
+  DeleteFiles;
+End;
+
+Destructor TPipeDisk.Destroy;
+Begin
+  If Connected Then Disconnect;
+
+  DeleteFiles;
+
+  Inherited Destroy;
+End;
+
+Function TPipeDisk.CreatePipe : Boolean;
+Begin
+  Result   := False;
+  FileMode := 66;
+  IsClient := False;
+
+  Assign  (PipeInput,  PipeDir + PipeInFileName + strI2S(PipeID));
+  ReWrite (PipeInput, 1);
+
+  If IoResult <> 0 Then Exit;
+
+  Assign  (PipeOutput, PipeDir + PipeOutFileName + strI2S(PipeID));
+  ReWrite (PipeOutput, 1);
+
+  If IoResult <> 0 Then Begin
+    Close (PipeInput);
+    Exit;
+  End;
+
+  Result := True;
+End;
+
+Procedure TPipeDisk.SendToPipe (Var Buf; Len: LongInt);
+Var
+  bWrite : LongInt;
+Begin
+  If Not Connected Then Exit;
+
+  FileMode := 66;
+
+  If Not IsClient Then Begin
+    If FilePos(PipeInput) <> FileSize(PipeInput) Then Begin
+      ReWrite (PipeOutput, 1);
+      Seek    (PipeInput, FileSize(PipeInput));
+
+      ResetTimer := TimerSet(PipeServerTimeout);
+    End;
+
+    If TimerUp(ResetTimer) Then Begin
+      Disconnect;
+      Exit;
+    End;
+  End;
+
+  If Len = 0 Then Exit;
+
+  BlockWrite (PipeOutput, Buf, Len, bWrite);
+End;
+
+Procedure TPipeDisk.ReadFromPipe (Var Buf; Len: LongInt; Var bRead: LongInt);
+Var
+  Buffer  : TPipeDiskBuffer Absolute Buf;
+  Ch      : Char;
+  OldSize : LongInt;
+Begin
+  bRead := 0;
+
+  If Not Connected Then Exit;
+
+  FileMode := 66;
+
+  BlockRead (PipeInput, Buffer[0], Len, bRead);
+
+  If IsClient And TimerUp(ResetTimer) Then Begin
+    Ch := #1;
+
+    SendToPipe(Ch, 1);
+
+    OldSize := FileSize(PipeInput);
+
+    Close (PipeInput);
+
+    Repeat
+      WaitMS(100);
+
+      Assign (PipeInput, PipeDir + PipeOutFileName + strI2S(PipeID));
+      Reset  (PipeInput, 1);
+    Until FileSize(PipeInput) < OldSize;
+
+    ResetTimer := TimerSet(PipeClientResetTimer);
+  End;
+End;
+
+Function TPipeDisk.WaitForPipe (Secs: LongInt) : Boolean;
+Var
+  TimeOut : LongInt;
+Begin
+  Result   := Connected;
+  FileMode := 66;
+
+  If Connected Then Exit;
+
+  TimeOut := TimerSet(Secs);
+
+  While Not TimerUp(TimeOut) Do Begin
+    If FileExist(PipeDir + PipeCmdFileName + strI2S(PipeID)) Then Begin
+      Connected  := True;
+      ResetTimer := TimerSet(PipeServerTimeout);
+      Break;
+    End;
+
+    WaitMS(100);
+  End;
+
+  Result := Connected;
+End;
+
+Function TPipeDisk.ConnectPipe (Secs: LongInt) : Boolean;
+Var
+  TempStr : String;
+  TimeOut : LongInt;
+Begin
+  Result    := False;
+  Connected := False;
+  TimeOut   := TimerSet(Secs);
+  FileMode  := 66;
+  IsClient  := True;
+
+  While Not TimerUp(TimeOut) Do Begin
+    Assign  (PipeInput, PipeDir + PipeCmdFileName + strI2S(PipeID));
+    ReWrite (PipeInput, 1);
+    Close   (PipeInput);
+
+    Assign (PipeInput, PipeDir + PipeOutFileName + strI2S(PipeID));
+    Reset  (PipeInput, 1);
+
+    If IoResult <> 0 Then Begin
+      WaitMS(100);
+      Continue;
+    End;
+
+    Assign (PipeOutput, PipeDir + PipeInFileName + strI2S(PipeID));
+    Reset  (PipeOutput, 1);
+
+    If IoResult <> 0 Then Begin
+      Close (PipeInput);
+      WaitMS (100);
+      Continue;
+    End Else Begin
+      Connected  := True;
+      ResetTimer := TimerSet(PipeClientResetTimer);
+
+      Break;
+    End;
+  End;
+
+  Result := Connected;
+End;
+
+Procedure TPipeDisk.Disconnect;
+Begin
+  If Not Connected Then Exit;
+
+  Connected := False;
+
+  Close (PipeInput);
+  Close (PipeOutput);
+
+  DeleteFiles;
+End;
+
+End.