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

107
mdl/m_fileio.pas
View File

@ -70,6 +70,7 @@ Type
TFileBufferRec = Array[0..MaxFileBufferSize - 1] of Char; TFileBufferRec = Array[0..MaxFileBufferSize - 1] of Char;
TFileBuffer = Class TFileBuffer = Class
RecSize : LongInt;
BufSize : LongInt; BufSize : LongInt;
Buffer : PFileBufferRec; Buffer : PFileBufferRec;
BufRead : LongInt; BufRead : LongInt;
@ -84,16 +85,24 @@ Type
Constructor Create (BufferSize: LongInt); Constructor Create (BufferSize: LongInt);
Destructor Destroy; Override; 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; Procedure CloseStream;
Function Read : Char; Function ReadChar : Char;
Procedure BlockRead (Var Buf; Size: LongInt; Var Count: LongInt); Overload; // Function ReadLine : String;
Procedure BlockRead (Var Buf; Size: LongInt); Overload; Procedure ReadBlock (Var Buf; Size: LongInt; Var Count: LongInt); Overload;
Procedure BlockWrite (Var Buf; Size: LongInt); Procedure ReadBlock (Var Buf; Size: LongInt); Overload;
Procedure Seek (FP : LongInt); Procedure ReadRecord (Var Buf);
Function FilePos : LongInt; Procedure SeekRecord (RP: LongInt);
Function FileSize : 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; Function EOF : Boolean;
Procedure FillBuffer; Procedure FillBuffer;
Procedure FlushBuffer; Procedure FlushBuffer;
End; End;
@ -101,7 +110,7 @@ Type
Implementation Implementation
Uses Uses
{$IFDEF WINDOWS} // FileErase (FPC Erase) hardly EVER FUCKING WORKS. {$IFDEF WINDOWS} // FileErase (FPC Erase) hardly EVER WORKS
Windows, Windows,
{$ENDIF} {$ENDIF}
DOS, DOS,
@ -558,6 +567,7 @@ Constructor TFileBuffer.Create (BufferSize: LongInt);
Begin Begin
Inherited Create; Inherited Create;
RecSize := 1;
BufSize := BufferSize; BufSize := BufferSize;
BufStart := 0; BufStart := 0;
BufEnd := 0; BufEnd := 0;
@ -574,9 +584,10 @@ Begin
If IsOpened Then CloseStream; If IsOpened Then CloseStream;
End; End;
Function TFileBuffer.OpenStream (FN: String; OpenType: TFileBufferOpenType; OpenMode: Byte) : Boolean; Function TFileBuffer.OpenStream (FN: String; RS: LongInt; OpenType: TFileBufferOpenType; OpenMode: Byte) : Boolean;
Begin Begin
Result := False; Result := False;
RecSize := RS;
If IsOpened Then CloseStream; If IsOpened Then CloseStream;
@ -618,9 +629,14 @@ Begin
IsOpened := False; IsOpened := False;
End; End;
Function TFileBuffer.FilePos : LongInt; Function TFileBuffer.FilePosRaw : LongInt;
Begin Begin
FilePos := BufStart + BufPos; Result := BufStart + BufPos;
End;
Function TFileBuffer.FilePosRecord : LongInt;
Begin
Result := (BufStart + BufPos) DIV RecSize;
End; End;
Procedure TFileBuffer.FillBuffer; Procedure TFileBuffer.FillBuffer;
@ -637,16 +653,51 @@ Begin
BufEOF := System.EOF(InFile); BufEOF := System.EOF(InFile);
End; End;
Function TFileBuffer.Read : Char; Function TFileBuffer.ReadChar : Char;
Begin Begin
If BufPos >= BufSize Then FillBuffer; If BufPos >= BufSize Then FillBuffer;
Read := Buffer^[BufPos]; Result := Buffer^[BufPos];
Inc (BufPos); Inc (BufPos);
End; 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 Var
Offset : LongInt; Offset : LongInt;
Begin Begin
@ -673,14 +724,19 @@ Begin
BufDirty := True; BufDirty := True;
End; 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 Var
Res : LongInt; Res : LongInt;
Begin Begin
BlockRead(Buf, Size, Res); Self.ReadBlock (Buf, Size, Res);
End; End;
Procedure TFileBuffer.BlockRead (Var Buf; Size: LongInt; Var Count: LongInt); Procedure TFileBuffer.ReadBlock (Var Buf; Size: LongInt; Var Count: LongInt);
Begin Begin
If BufPos + Size >= BufRead Then Begin If BufPos + Size >= BufRead Then Begin
If BufDirty Then FlushBuffer; If BufDirty Then FlushBuffer;
@ -700,7 +756,7 @@ Begin
Count := Size; Count := Size;
End; End;
Procedure TFileBuffer.Seek (FP : LongInt); Procedure TFileBuffer.SeekRaw (FP : LongInt);
Begin Begin
If (FP >= BufStart) and (FP < BufEnd) Then If (FP >= BufStart) and (FP < BufEnd) Then
BufPos := (BufEnd - (BufEnd - FP)) - BufStart BufPos := (BufEnd - (BufEnd - FP)) - BufStart
@ -715,12 +771,19 @@ End;
Function TFileBuffer.EOF : Boolean; Function TFileBuffer.EOF : Boolean;
Begin Begin
EOF := (BufStart + BufPos >= BufEnd) and BufEOF; Result := (BufStart + BufPos >= BufEnd) and BufEOF;
End; End;
Function TFileBuffer.FileSize : LongInt; Function TFileBuffer.FileSizeRaw : LongInt;
Begin 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; End;
Procedure TFileBuffer.FlushBuffer; Procedure TFileBuffer.FlushBuffer;

6
mdl/m_input_windows.pas
View File

@ -134,11 +134,17 @@ Begin
If InputRec.EventType = key_event then If InputRec.EventType = key_event then
If InputRec.Event.KeyEvent.bKeyDown then begin 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 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) = 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 If (Ord(InputRec.Event.KeyEvent.AsciiChar) = 13) and (InputRec.Event.KeyEvent.wVirtualKeyCode = VK_RETURN) Then Begin
addBuffer(#13); addBuffer(#13);
Result := True; Result := True;
Exit; 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 End Else Begin
addBuffer(#0); addBuffer(#0);
addBuffer(Chr(RemapScanCode(InputRec.Event.KeyEvent.wVirtualScanCode, InputRec.Event.KeyEvent.dwControlKeyState, InputRec.Event.KeyEvent.wVirtualKeyCode))); addBuffer(Chr(RemapScanCode(InputRec.Event.KeyEvent.wVirtualScanCode, InputRec.Event.KeyEvent.dwControlKeyState, InputRec.Event.KeyEvent.wVirtualKeyCode)));

32
mdl/m_io_sockets.pas
View File

@ -499,15 +499,16 @@ Var
Begin Begin
If FSocketHandle = -1 Then Begin If FSocketHandle = -1 Then Begin
Result := FSocketHandle; Result := FSocketHandle;
Exit; Exit;
End; End;
Flags := fpFCntl(FSocketHandle, F_GETFL); Flags := fpFCntl(FSocketHandle, F_GETFL);
If Block Then If Block Then
Flags := Flags OR O_NONBLOCK Flags := Flags AND NOT O_NONBLOCK
Else Else
Flags := Flags AND NOT O_NONBLOCK; Flags := Flags OR O_NONBLOCK;
Result := fpFCntl(FSocketHandle, F_SETFL, Flags); Result := fpFCntl(FSocketHandle, F_SETFL, Flags);
End; End;
@ -518,11 +519,12 @@ Var
Begin Begin
If FSocketHandle = -1 Then Begin If FSocketHandle = -1 Then Begin
Result := FSocketHandle; Result := FSocketHandle;
Exit; Exit;
End; End;
Data := Ord(Not Block); Data := Ord (Not Block);
Result := ioctlSocket(FSocketHandle, FIONBIO, Data); Result := ioctlSocket (FSocketHandle, FIONBIO, Data);
End; End;
{$ENDIF} {$ENDIF}
@ -537,16 +539,18 @@ Begin
T.tv_usec := TimeOut * 1000; T.tv_usec := TimeOut * 1000;
{$IFDEF UNIX} {$IFDEF UNIX}
fpFD_Zero(rFDSET); fpFD_Zero (rFDSET);
fpFD_Zero(wFDSET); fpFD_Zero (wFDSET);
fpFD_Zero(eFDSET); fpFD_Zero (eFDSET);
fpFD_Set(FSocketHandle, rFDSET); fpFD_Set (FSocketHandle, rFDSET);
Result := fpSelect(FSocketHandle + 1, @rFDSET, @wFDSET, @eFDSET, @T); Result := fpSelect(FSocketHandle + 1, @rFDSET, @wFDSET, @eFDSET, @T);
{$ELSE} {$ELSE}
FD_Zero(rFDSET); FD_Zero (rFDSET);
FD_Zero(wFDSET); FD_Zero (wFDSET);
FD_Zero(eFDSET); FD_Zero (eFDSET);
FD_Set(FSocketHandle, rFDSET); FD_Set (FSocketHandle, rFDSET);
Result := Select(FSocketHandle + 1, @rFDSET, @wFDSET, @eFDSET, @T); Result := Select(FSocketHandle + 1, @rFDSET, @wFDSET, @eFDSET, @T);
{$ENDIF} {$ENDIF}
End; End;
@ -597,13 +601,13 @@ Begin
fpSetSockOpt (FSocketHandle, SOL_SOCKET, SO_REUSEADDR, @Opt, SizeOf(Opt)); fpSetSockOpt (FSocketHandle, SOL_SOCKET, SO_REUSEADDR, @Opt, SizeOf(Opt));
SIN.sin_family := PF_INET; SIN.sin_family := PF_INET;
// SIN.sin_addr.s_addr := 0;
SIN.sin_addr := StrToNetAddr(NetInterface);
SIN.sin_port := htons(Port); SIN.sin_port := htons(Port);
SIN.sin_addr := StrToNetAddr(NetInterface);
{$IFDEF TNDEBUG} {$IFDEF TNDEBUG}
TNLOG('Attempting to bind to interface ' + NetInterface + ' (' + strI2S(SIN.sin_addr.s_addr) + ')'); TNLOG('Attempting to bind to interface ' + NetInterface + ' (' + strI2S(SIN.sin_addr.s_addr) + ')');
TNLOG('WaitInit Bind'); TNLOG('WaitInit Bind');
If fpBind(FSocketHandle, @SIN, SizeOf(SIN)) <> 0 Then If fpBind(FSocketHandle, @SIN, SizeOf(SIN)) <> 0 Then
TNLOG('WaitInit Bind Failed') TNLOG('WaitInit Bind Failed')
Else Else

1
mdl/m_output_windows.pas
View File

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

2
mdl/m_socket_server.pas
View File

@ -203,7 +203,7 @@ Begin
Status('Opening server socket on port ' + strI2S(Port)); Status('Opening server socket on port ' + strI2S(Port));
Repeat Repeat
NewClient := Server.WaitConnection; NewClient := Server.WaitConnection(0);
If NewClient = NIL Then Break; // time to shutdown the server... If NewClient = NIL Then Break; // time to shutdown the server...