eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Begin A35

This commit is contained in:
mysticbbs 2013-05-20 05:35:24 -04:00
parent 0c51254202
commit 44b3b33001
5 changed files with 118 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
mdl/m_fileio.pas
View File

@ -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;

6
mdl/m_input_windows.pas
View File

@ -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)));

38
mdl/m_io_sockets.pas
View File

@ -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

1
mdl/m_output_windows.pas
View File

@ -309,6 +309,7 @@ Begin
While Count <= Length(Text) Do Begin
Buf[Count].Attributes := A;
Buf[Count].UnicodeChar := Text[Count];
Inc (Count);
End;

2
mdl/m_socket_server.pas
View File

@ -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...