From 44b3b330014851936a12a2bd7c276ffecb262c2b Mon Sep 17 00:00:00 2001 From: mysticbbs Date: Mon, 20 May 2013 05:35:24 -0400 Subject: [PATCH] Begin A35 --- mdl/m_fileio.pas | 115 ++++++++++++++++++++++++++++++--------- mdl/m_input_windows.pas | 6 ++ mdl/m_io_sockets.pas | 38 +++++++------ mdl/m_output_windows.pas | 1 + mdl/m_socket_server.pas | 2 +- 5 files changed, 118 insertions(+), 44 deletions(-) diff --git a/mdl/m_fileio.pas b/mdl/m_fileio.pas index 38d15d3..b2b556a 100644 --- a/mdl/m_fileio.pas +++ b/mdl/m_fileio.pas @@ -70,6 +70,7 @@ Type TFileBufferRec = Array[0..MaxFileBufferSize - 1] of Char; TFileBuffer = Class + RecSize : LongInt; BufSize : LongInt; Buffer : PFileBufferRec; BufRead : LongInt; @@ -84,16 +85,24 @@ Type Constructor Create (BufferSize: LongInt); Destructor Destroy; Override; - Function OpenStream (FN: String; OpenType: TFileBufferOpenType; OpenMode: Byte) : Boolean; + Function OpenStream (FN: String; RS: LongInt; OpenType: TFileBufferOpenType; OpenMode: Byte) : Boolean; Procedure CloseStream; - Function Read : Char; - Procedure BlockRead (Var Buf; Size: LongInt; Var Count: LongInt); Overload; - Procedure BlockRead (Var Buf; Size: LongInt); Overload; - Procedure BlockWrite (Var Buf; Size: LongInt); - Procedure Seek (FP : LongInt); - Function FilePos : LongInt; - Function FileSize : LongInt; - Function EOF : Boolean; + Function ReadChar : Char; +// Function ReadLine : String; + Procedure ReadBlock (Var Buf; Size: LongInt; Var Count: LongInt); Overload; + Procedure ReadBlock (Var Buf; Size: LongInt); Overload; + Procedure ReadRecord (Var Buf); + Procedure SeekRecord (RP: LongInt); + Procedure SeekRaw ( FP : LongInt); + Procedure WriteBlock (Var Buf; Size: LongInt); + Procedure WriteRecord (Var Buf); + + Function FilePosRaw : LongInt; + Function FilePosRecord : LongInt; + Function FileSizeRaw : LongInt; + Function FileSizeRecord : LongInt; + Function EOF : Boolean; + Procedure FillBuffer; Procedure FlushBuffer; End; @@ -101,7 +110,7 @@ Type Implementation Uses - {$IFDEF WINDOWS} // FileErase (FPC Erase) hardly EVER FUCKING WORKS. + {$IFDEF WINDOWS} // FileErase (FPC Erase) hardly EVER WORKS Windows, {$ENDIF} DOS, @@ -110,8 +119,8 @@ Uses m_DateTime; Const - ioRetries = 20; - ioWaitTime = 100; + ioRetries = 20; + ioWaitTime = 100; Function ioReset (Var F: File; RecSize: Word; Mode: Byte) : Boolean; Var @@ -558,6 +567,7 @@ Constructor TFileBuffer.Create (BufferSize: LongInt); Begin Inherited Create; + RecSize := 1; BufSize := BufferSize; BufStart := 0; BufEnd := 0; @@ -574,9 +584,10 @@ Begin If IsOpened Then CloseStream; End; -Function TFileBuffer.OpenStream (FN: String; OpenType: TFileBufferOpenType; OpenMode: Byte) : Boolean; +Function TFileBuffer.OpenStream (FN: String; RS: LongInt; OpenType: TFileBufferOpenType; OpenMode: Byte) : Boolean; Begin - Result := False; + Result := False; + RecSize := RS; If IsOpened Then CloseStream; @@ -618,9 +629,14 @@ Begin IsOpened := False; End; -Function TFileBuffer.FilePos : LongInt; +Function TFileBuffer.FilePosRaw : LongInt; Begin - FilePos := BufStart + BufPos; + Result := BufStart + BufPos; +End; + +Function TFileBuffer.FilePosRecord : LongInt; +Begin + Result := (BufStart + BufPos) DIV RecSize; End; Procedure TFileBuffer.FillBuffer; @@ -637,16 +653,51 @@ Begin BufEOF := System.EOF(InFile); End; -Function TFileBuffer.Read : Char; +Function TFileBuffer.ReadChar : Char; Begin If BufPos >= BufSize Then FillBuffer; - Read := Buffer^[BufPos]; + Result := Buffer^[BufPos]; Inc (BufPos); End; -Procedure TFileBuffer.BlockWrite (Var Buf; Size: LongInt); +(* +Function TFileBuffer.ReadLine : String; +Var + Ch : Char; +Begin + Result := ''; + + While Not Self.EOF Do Begin + Ch := Self.ReadChar; + + If LineEnding[1] = Ch Then Begin + If Length(LineEnding) = 1 Then Break; + + Ch := Self.ReadChar; + + If LineEnding[2] = Ch Then Break; + + Result := Result + LineEnding[1]; + End; + + Result := Result + Ch; + End; +End; +*) + +Procedure TFileBuffer.ReadRecord (Var Buf); +Begin + Self.ReadBlock (Buf, RecSize); +End; + +Procedure TFileBuffer.SeekRecord (RP: LongInt); +Begin + Self.SeekRaw (RP * RecSize); +End; + +Procedure TFileBuffer.WriteBlock (Var Buf; Size: LongInt); Var Offset : LongInt; Begin @@ -673,14 +724,19 @@ Begin BufDirty := True; End; -Procedure TFileBuffer.BlockRead (Var Buf; Size: LongInt); +Procedure TFileBuffer.WriteRecord (Var Buf); +Begin + Self.WriteBlock (Buf, RecSize); +End; + +Procedure TFileBuffer.ReadBlock (Var Buf; Size: LongInt); Var Res : LongInt; Begin - BlockRead(Buf, Size, Res); + Self.ReadBlock (Buf, Size, Res); End; -Procedure TFileBuffer.BlockRead (Var Buf; Size: LongInt; Var Count: LongInt); +Procedure TFileBuffer.ReadBlock (Var Buf; Size: LongInt; Var Count: LongInt); Begin If BufPos + Size >= BufRead Then Begin If BufDirty Then FlushBuffer; @@ -700,7 +756,7 @@ Begin Count := Size; End; -Procedure TFileBuffer.Seek (FP : LongInt); +Procedure TFileBuffer.SeekRaw (FP : LongInt); Begin If (FP >= BufStart) and (FP < BufEnd) Then BufPos := (BufEnd - (BufEnd - FP)) - BufStart @@ -715,12 +771,19 @@ End; Function TFileBuffer.EOF : Boolean; Begin - EOF := (BufStart + BufPos >= BufEnd) and BufEOF; + Result := (BufStart + BufPos >= BufEnd) and BufEOF; End; -Function TFileBuffer.FileSize : LongInt; +Function TFileBuffer.FileSizeRaw : LongInt; Begin - FileSize := System.FileSize(InFile); + If BufDirty Then FlushBuffer; + Result := System.FileSize(InFile); +End; + +Function TFileBuffer.FileSizeRecord : LongInt; +Begin + If BufDirty Then FlushBuffer; + Result := System.FileSize(InFile) DIV RecSize; End; Procedure TFileBuffer.FlushBuffer; diff --git a/mdl/m_input_windows.pas b/mdl/m_input_windows.pas index 6e183f5..e8a98fe 100644 --- a/mdl/m_input_windows.pas +++ b/mdl/m_input_windows.pas @@ -134,11 +134,17 @@ Begin If InputRec.EventType = key_event then If InputRec.Event.KeyEvent.bKeyDown then begin If not(InputRec.Event.KeyEvent.wVirtualKeyCode in [VK_SHIFT, VK_MENU, VK_CONTROL, VK_CAPITAL, VK_NUMLOCK, VK_SCROLL]) then begin + If (Ord(InputRec.Event.KeyEvent.AsciiChar) = 0) or (InputRec.Event.KeyEvent.dwControlKeyState and (LEFT_ALT_PRESSED or ENHANCED_KEY or RIGHT_ALT_PRESSED) > 0) Then Begin If (Ord(InputRec.Event.KeyEvent.AsciiChar) = 13) and (InputRec.Event.KeyEvent.wVirtualKeyCode = VK_RETURN) Then Begin addBuffer(#13); Result := True; Exit; + End Else + If ((InputRec.Event.KeyEvent.dwControlKeyState AND (RIGHT_ALT_PRESSED OR LEFT_CTRL_PRESSED)) = (RIGHT_ALT_PRESSED OR LEFT_CTRL_PRESSED)) and (Ord(InputRec.Event.KeyEvent.AsciiChar) <> 0) Then Begin + AddBuffer(Chr(Ord(InputRec.Event.KeyEvent.AsciiChar))); + Result := True; + Exit; End Else Begin addBuffer(#0); addBuffer(Chr(RemapScanCode(InputRec.Event.KeyEvent.wVirtualScanCode, InputRec.Event.KeyEvent.dwControlKeyState, InputRec.Event.KeyEvent.wVirtualKeyCode))); diff --git a/mdl/m_io_sockets.pas b/mdl/m_io_sockets.pas index a341085..aae156e 100644 --- a/mdl/m_io_sockets.pas +++ b/mdl/m_io_sockets.pas @@ -499,15 +499,16 @@ Var Begin If FSocketHandle = -1 Then Begin Result := FSocketHandle; + Exit; End; Flags := fpFCntl(FSocketHandle, F_GETFL); If Block Then - Flags := Flags OR O_NONBLOCK + Flags := Flags AND NOT O_NONBLOCK Else - Flags := Flags AND NOT O_NONBLOCK; + Flags := Flags OR O_NONBLOCK; Result := fpFCntl(FSocketHandle, F_SETFL, Flags); End; @@ -518,35 +519,38 @@ Var Begin If FSocketHandle = -1 Then Begin Result := FSocketHandle; + Exit; End; - Data := Ord(Not Block); - Result := ioctlSocket(FSocketHandle, FIONBIO, Data); + Data := Ord (Not Block); + Result := ioctlSocket (FSocketHandle, FIONBIO, Data); End; {$ENDIF} Function TIOSocket.WaitForData (TimeOut: LongInt) : LongInt; Var - T : TTimeVal; + T : TTimeVal; rFDSET, wFDSET, - eFDSET : TFDSet; + eFDSET : TFDSet; Begin T.tv_sec := 0; T.tv_usec := TimeOut * 1000; {$IFDEF UNIX} - fpFD_Zero(rFDSET); - fpFD_Zero(wFDSET); - fpFD_Zero(eFDSET); - fpFD_Set(FSocketHandle, rFDSET); + fpFD_Zero (rFDSET); + fpFD_Zero (wFDSET); + fpFD_Zero (eFDSET); + fpFD_Set (FSocketHandle, rFDSET); + Result := fpSelect(FSocketHandle + 1, @rFDSET, @wFDSET, @eFDSET, @T); {$ELSE} - FD_Zero(rFDSET); - FD_Zero(wFDSET); - FD_Zero(eFDSET); - FD_Set(FSocketHandle, rFDSET); + FD_Zero (rFDSET); + FD_Zero (wFDSET); + FD_Zero (eFDSET); + FD_Set (FSocketHandle, rFDSET); + Result := Select(FSocketHandle + 1, @rFDSET, @wFDSET, @eFDSET, @T); {$ENDIF} End; @@ -596,14 +600,14 @@ Begin fpSetSockOpt (FSocketHandle, SOL_SOCKET, SO_REUSEADDR, @Opt, SizeOf(Opt)); - SIN.sin_family := PF_INET; -// SIN.sin_addr.s_addr := 0; + SIN.sin_family := PF_INET; + SIN.sin_port := htons(Port); SIN.sin_addr := StrToNetAddr(NetInterface); - SIN.sin_port := htons(Port); {$IFDEF TNDEBUG} TNLOG('Attempting to bind to interface ' + NetInterface + ' (' + strI2S(SIN.sin_addr.s_addr) + ')'); TNLOG('WaitInit Bind'); + If fpBind(FSocketHandle, @SIN, SizeOf(SIN)) <> 0 Then TNLOG('WaitInit Bind Failed') Else diff --git a/mdl/m_output_windows.pas b/mdl/m_output_windows.pas index 90b1c4a..055c9ab 100644 --- a/mdl/m_output_windows.pas +++ b/mdl/m_output_windows.pas @@ -309,6 +309,7 @@ Begin While Count <= Length(Text) Do Begin Buf[Count].Attributes := A; Buf[Count].UnicodeChar := Text[Count]; + Inc (Count); End; diff --git a/mdl/m_socket_server.pas b/mdl/m_socket_server.pas index c077cc9..9839808 100644 --- a/mdl/m_socket_server.pas +++ b/mdl/m_socket_server.pas @@ -203,7 +203,7 @@ Begin Status('Opening server socket on port ' + strI2S(Port)); Repeat - NewClient := Server.WaitConnection; + NewClient := Server.WaitConnection(0); If NewClient = NIL Then Break; // time to shutdown the server...