diff --git a/mdl/m_pipe_disk.pas b/mdl/m_pipe_disk.pas new file mode 100644 index 0000000..02acc97 --- /dev/null +++ b/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.