pygments.rb-jruby 0.5.4

data/vendor/pygments-main/tests/examplefiles/example.ns2

@@ -0,0 +1,69 @@
+Newsqueak2
+'Langexplr
+'
+
+class ShapesExperiment usingLib: platform = (
+"A small experiment for using Hopscotch shape classes ."
+|
+	CanvasDependent = platform CanvasDependent.
+	Presenter = platform HPresenter.
+	Subject = platform Subject.
+	EllipseShape = platform EllipseShape.
+	Color = platform Color.
+|
+)
+(
+
+class ShapesExperimentSubject = Subject(
+"Subject for shapes experiment"
+|
+
+|
+)
+('as yet unclassified'
+createPresenter = (
+	^ShapesExperimentPresenter new subject: self.
+)
+
+)
+
+class ShapesExperimentPresenter = Presenter (
+"A presenter for a small experiment of using shape classes"
+|
+|
+)
+('as yet unclassified'
+controlPoint = (
+	^ControlPoint new.
+)
+
+definition = (
+	^ column: {
+          canvas: {
+               at: 10 @ 10 display: controlPoint. 
+               at: 15 @ 10 display: controlPoint.
+          }
+      }
+)
+
+)
+
+class ControlPoint = CanvasDependent(
+"A class that represents a small point in the screen"
+|
+|
+)
+('as yet unclassified'
+addVisualsTo: container = (
+	container add: visual.
+      updateLayout.
+)
+
+createVisual = (
+     | s |
+     s:: EllipseShape new size: 5@5 .
+     s color: Color red.
+     ^ s
+)
+
+))

data/vendor/pygments-main/tests/examplefiles/example.p

@@ -0,0 +1,34 @@
+{include.i}
+{nested.i {include.i}}
+
+&SCOPED-DEFINE MY_NAME "Abe"
+
+DEF VAR i AS INT NO-UNDO.
+i = 0xABE + 1337 / (1 * 1.00)
+
+def var clowercasetest as char no-undo.
+DEF VAR vardashtest AS DATETIME-TZ NO-UNDO.
+
+DEFINE TEMP-TABLE ttNames NO-UNDO
+  FIELD cName AS CHAR
+  INDEX IXPK_ttNames IS PRIMARY UNIQUE cName.
+
+/* One-line comment */
+/* Two-line
+   Comment  */
+/*
+  Nested
+  /*
+    Multiline
+    /*
+      Comment
+    */
+  */
+*/
+
+CREATE ttNames.
+ASSIGN ttNames.cName = {&MY_NAME}.
+
+FOR EACH ttNames:
+  MESSAGE "Hello, " + ttNames.cName + '!' VIEW-AS ALERT-BOX.
+END.

data/vendor/pygments-main/tests/examplefiles/example.pas

@@ -0,0 +1,2708 @@
+// vim:ft=pascal
+
+unit YTools;
+
+{===============================================================================
+
+   cYcnus.YTools 1.0.3 Beta for Delphi 4+
+   by licenser and Murphy
+
+   �2000-2003 by cYcnus
+   visit www.cYcnus.de
+
+   licenser@cYcnus.de (Heinz N. Gies)
+   murphy@cYcnus.de (Kornelius Kalnbach)
+   
+   this unit is published under the terms of the GPL
+
+===============================================================================}
+
+interface
+
+uses
+  Windows, SysUtils, Classes, YTypes;
+
+const
+  BackSpace = #8;
+  Tab = #9;
+  LF = #10; //Line Feed
+  CR = #13; //Carriage Return
+  Space = #32;
+  EOLChars = [CR, LF];
+{$IFNDEF VER140}
+  sLineBreak = #13#10;
+  SwitchChars = ['/', '-'];
+{$ENDIF}
+  EOL = sLineBreak;
+  MaxCard = High(Cardinal);
+  AllChars = [#0..#255];
+  Alphabetical = ['A'..'Z', 'a'..'z'];
+  DecimalChars = ['0'..'9'];
+  AlphaNumerical = Alphabetical + DecimalChars;
+  StrangeChars = [#0..#31, #127, #129, #141..#144, #157, #158];
+
+  HexadecimalChars = DecimalChars + ['A'..'F', 'a'..'f'];
+  OctalChars = ['0'..'7'];
+  BinaryChars = ['0', '1'];
+
+  QuoteChars = ['''', '"'];
+  WildCards = ['*', '?'];
+  FileNameEnemies = WildCards + ['\', '/', ':', '<', '>', '|'];
+
+  HexChar: array[THex] of Char = (
+    '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
+  LowerHexChar: array[THex] of Char = (
+    '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f');
+  BaseNChar: array[TBaseN] of Char = (
+    '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','G','H',
+    'I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
+
+  cYcnusOverlayColor = $050001;
+
+  faFindEveryFile = faReadOnly + faHidden + faSysFile + faArchive;
+
+  platWin9x = [VER_PLATFORM_WIN32s, VER_PLATFORM_WIN32_WINDOWS];
+
+
+{ Debugging }
+procedure ClearReport(const ReportName: string);
+procedure Report(const ReportName, Text: string);
+procedure ReportFmt(const ReportName, Fmt: string; const Args: array of const);
+
+{ Params }
+procedure GetParams(Strings: TStrings); overload;
+function GetParams(const Separator: string = ' '): string; overload;
+
+function ParamNum(const S: string): Integer;
+function ParamPrefixNum(const Prefix: string): Integer;
+function Param(const S: string): Boolean;
+function ParamPrefix(const Prefix: string): Boolean;
+
+function Switch(const Switch: string; const PrefixChars: TCharSet = SwitchChars;
+  IgnoreCase: Boolean = True): Boolean;
+function GetParam(const Prefix: string = ''; const Default: string = ''): string;
+
+{ Dirs & UserName}
+function GetMyDir(FullPath: Boolean = False): string;
+function WinDir: string;
+function SysDir: string;
+function UserName: string;
+
+{ Strings & Chars}
+function FirstChar(const S: string): Char;
+function LastChar(const S: string): Char;
+
+function CharPos(C: Char; const S: string; Offset: Integer = 1): Integer; overload;
+function CharPos(C: TCharSet; const S: string; Offset: Integer = 1): Integer; overload;
+function CharPosR(C: Char; const S: string; Offset: Integer = -1): Integer;
+function PosEx(const SubStr, S: string; Offset: Integer = 1): Integer;
+function PosExText(const SubStr, S: string; Offset: Integer = 1): Integer;
+function PosExAnsiText(const SubStr, S: string; Offset: Integer = 1): Integer;
+
+function UntilChar(const S: string; Brake: Char): string; overload;
+function UntilChar(const S: string; Brake: TCharSet): string; overload;
+function UntilLastChar(const S: string; Brake: Char;
+  IgnoreNoBrake: Boolean = True): string;
+
+function FromChar(const S: string; Brake: Char): string; overload;
+function FromChar(const S: string; Brake: TCharSet): string; overload;
+function FromLastChar(const S: string; Brake: Char;
+  IgnoreNoBrake: Boolean = False): string;
+
+function BetweenChars(const S: string; Start, Finish: Char;
+  Inclusive: Boolean = False): string;
+
+function UntilStr(const S: string; Brake: string): string;
+function FromStr(const S: string; Brake: string): string;
+
+function StringWrap(const S: string; Width: Integer; const LineEnd: string = EOL): string;
+
+{ Splitting & Combining }
+function Split(const S, Separator: string; IgnoreMultiSep: Boolean = True;
+  MinCount: Integer = 0): TStrA; overload;
+procedure Split(const S, Separator: string; Strings: TStrings;
+  IgnoreMultiSep: Boolean = True); overload;
+function Split(const S: string; Separators: TCharSet;
+  IgnoreMultiSep: Boolean = True; MinCount: Integer = 0): TStrA; overload;
+
+procedure TileStr(const S: string; BrakeStart: Integer; BrakeEnd: Integer;
+  out Left, Right: string);
+
+function Join(Strings: TStrings; Separator: string = ' '): string; overload;
+function Join(StrA: TStrA; Separator: string = ' '): string; overload;
+
+function MulStr(const S: string; Count: Integer): string;
+
+{ Strings ausrichten }
+function AlignR(const S: string; Width: Integer; Filler: Char = ' '): string;
+function MaxStr(const S: string; MaxLen: Integer): string;
+
+{ Stringing }
+function TrimAll(const S: string): string;
+
+function ControlChar(C: Char): Boolean;
+function FriendlyChar(C: Char): Char;
+
+function FriendlyStr(const S: string): string; overload;
+function FriendlyStr(a: TByteA): string; overload;
+
+function Quote(const S: string; Quoter: Char = '"'): string;
+function UnQuote(const S: string): string;
+function DeQuote(const S: string): string;
+
+function StrNumerus(const Value: Integer; const Singular, Plural: string;
+  const Zero: string = '0'): string;
+
+function MakeStr(const Items: array of const; Separator: string = ''): string;
+procedure ShowText(const Items: array of const; Separator: string = '');
+
+{ Delete }
+function DeleteChars(const S: string; C: Char): string; overload;
+function DeleteChars(const S: string; C: TCharSet): string; overload;
+function ExtractChars(const S: string; C: TCharSet): string;
+
+{ Find }
+function CharCount(const S: string; C: Char): Integer;
+
+function CharIn(const S: string; C: Char): Boolean; overload;
+function CharIn(const S: string; C: TCharSet): Boolean; overload;
+
+function StrAtPos(const S: string; Pos: Integer; const Str: string): Boolean;
+function StrAtBegin(const S, Str: string): Boolean;
+function StrIn(const S, SubStr: string): Boolean; overload;
+function StrIn(A: TStrA; const S: string): Boolean; overload;
+function StrIn(SL: TStrings; const S: string): Boolean; overload;
+function StrIndex(A: TStrA; const S: string): Integer; overload;
+function StrIndex(SL: TStrings; const S: string): Integer; overload;
+
+function TextAtPos(const S: string; Pos: Integer; const Text: string): Boolean;
+function TextAtBegin(const S, Text: string): Boolean;
+function TextIn(const S, Text: string): Boolean; overload;
+function TextIn(A: TStrA; const Text: string): Boolean; overload;
+function TextIn(SL: TStrings; const Text: string): Boolean; overload;
+function TextIndex(A: TStrA; const Text: string): Integer; overload;
+function TextIndex(SL: TStrings; const Text: string): Integer; overload;
+
+{ Replace }
+function ReplaceChars(const S: string; Old, New: Char): string; overload;
+function ReplaceChars(const S: string; Old: TCharSet; New: Char): string; overload;
+
+function Replace(const S, Old, New: string): string;
+
+{ TStrings }
+function SLOfFile(const FileName: string): TStringList;
+function ContainsEmptyLines(SL: TStrings): Boolean;
+procedure DeleteEmptyLines(SL: TStrings);
+procedure DeleteCommentLines(SL: TStrings; const CommentSign: string = '//');
+procedure WriteSL(Strings: TStrings; const Prefix: string = '';
+  const Suffix: string = '');
+
+function FindLine(SL: TStrings; const S: string): Integer;
+
+procedure QuickSortSL(SL: TStringList);
+
+{ TStrA }
+function IncStrA(StrA: TStrA): Integer;
+
+{ TByteA }
+function StrOfByteA(a: TByteA): string;
+function ByteAOfStr(const S: string): TByteA;
+function ByteAOfInt(i: Integer): TByteA;
+function IntOfByteA(A: TByteA): Integer;
+function ByteAOfHex(const Hex: string): TByteA;
+
+function SameByteA(const A, B: TByteA): Boolean;
+function Reverse(a: TByteA): TByteA;
+function SaveByteA(Data: TByteA; const FileName: string; Overwrite: Boolean = True): Boolean;
+function LoadByteA(const FileName: string): TByteA;
+
+function Endian(i: Integer): Integer;
+
+{ Files }
+function SizeOfFile(const FileName: string): Integer;
+function FileEx(const FileName: string; AllowFolders: Boolean = False): Boolean;
+function LWPSolve(const Dir: string): string;
+function LWPSlash(const Dir: string): string;
+
+function ExtractDrive(const FileName: string): string;
+function ExtractPath(const FileName: string): string;
+function ExtractPrefix(const FileName: string): string;
+function ExtractSuffix(const FileName: string): string;
+
+function IsValidFileName(const FileName: string): Boolean;
+function MakeValidFileName(FileName: string; const Default: string = 'File'): string;
+
+{ Converting }
+function IsValidInteger(const S: string): Boolean;
+function IsValidCardinal(const S: string): Boolean;
+
+function StrOfBool(flag: Boolean; const TrueStr: string = 'True';
+  const FalseStr: string = 'False'): string;
+function StrOfInt(i: Integer): string;
+function CardOfStr(const S: string): Cardinal;
+
+function HexOrd(Hex: Char): THex;
+function ByteOfHex(Hex: THexByteStr): Byte;
+
+function DecOfHex(const Hex: string): string;
+function HexOfByte(b: Byte): THexByteStr;
+function HexOfCard(i: Cardinal): string; overload;
+function HexOfCard(i: Cardinal; Digits: Integer): string; overload;
+
+function PascalHexArray(a: TByteA; Name: string): string;
+
+function HexOfByteA(a: TByteA; Blocks: Integer = 1;
+  const Splitter: string = ' '): string;
+function BinOfByteA(a: TByteA; Blocks: Integer = 4;
+  const Splitter: string = ' '): string;
+
+function CardOfHex(Hex: string): Cardinal;
+function IntOfBin(Bin: string): Cardinal;
+
+function BinOfIntFill(n: cardinal; MinCount: Integer = 8): string;
+function BinOfInt(n: cardinal): string;
+
+function BaseNOfInt(I: Cardinal; B: TBaseN): string;
+function IntOfBaseN(V: string; B: TBaseN): Cardinal;
+
+{ Ranges }
+function KeepIn(i, Bottom, Top: Variant): Variant;
+function InRange(Value, Bottom, Top: Variant): Boolean;
+function InStrictRange(Value, Bottom, Top: Variant): Boolean;
+function Min(const A, B: Integer): Integer; overload;
+function Min(const A: TIntA): Integer; overload;
+function Max(const A, B: Integer): Integer; overload;
+function Max(const A: TIntA): Integer; overload;
+
+const
+  RangesSeparator = ',';
+  RangeInnerSeparator = '-';
+  RangeInfinite = '*';
+  RangeSpecialChars = [RangesSeparator, RangeInnerSeparator, RangeInfinite];
+
+function RangesOfStr(const S: string): TRanges;
+function InRanges(Ranges: TRanges; TestValue: Cardinal): Boolean;
+
+function Success(Res: Integer; ResultOnSuccess: Integer = ERROR_SUCCESS): Boolean;
+function Failure(Res: Integer; ResultOnSuccess: Integer = ERROR_SUCCESS): Boolean;
+
+function ExpandString(const S: string): string;
+
+{ Files }
+procedure DeleteFiles(const Mask: string; ScanSubDirs: Boolean = True;
+  Attributes: Integer = faFindEveryFile);
+procedure FileNew(const FileName: string);
+function DateTimeOfFileTime(const FileTime: TFileTime): TDateTime;
+
+{ FileNames }
+function GetFileNew(FileName: string; NoFloppyDrives: Boolean = True): string;
+
+{ Finding Files }
+function FindAll(Strings: TStrings; const Mask: string;
+  ScanSubDirs: Boolean = True; Attributes: Integer = faFindEveryFile;
+  FileReturn: TFileNameFunc = nil): Boolean;
+function FindAllFirst(const Mask: string; ScanSubDirs: Boolean = True;
+  Attributes: Integer = faFindEveryFile): string;
+
+function FullOSInfo: string;
+function Win32PlatformStr: string;
+function Win9x: Boolean;
+function WinNT: Boolean;
+function Win2000: Boolean;
+function WinXP: Boolean;
+
+var
+  MyDir: string = '';
+  LastSuccessRes: Integer = 0;
+  
+{ Backward compatibility }
+{$IFNDEF VER130}
+function SameText(const S1, S2: string): Boolean;
+{$ENDIF}
+
+implementation
+{$IFNDEF VER140}
+uses FileCtrl;
+{$ENDIF}
+
+{$IFNDEF VER130}
+function SameText(const S1, S2: string): Boolean;
+begin
+  Result := CompareText(S1, S2) = 0;
+end;
+{$ENDIF}
+
+procedure Report(const ReportName, Text: string);
+var
+  F: TextFile;
+  FileName: string;
+begin
+  FileName := MyDir + ReportName + '.rep';
+  Assign(F, FileName);
+  try
+    if not FileExists(FileName) then
+      Rewrite(F)
+    else
+      Append(F);
+    WriteLn(F, Text);
+  finally
+    Close(F);
+  end;
+end;
+
+procedure ClearReport(const ReportName: string);
+var
+  FileName: string;
+begin
+  FileName := MyDir + ReportName + '.rep';
+  DeleteFile(FileName);
+end;
+
+procedure ReportFmt(const ReportName, Fmt: string; const Args: array of const);
+begin
+  Report(ReportName, Format(Fmt, Args));
+end;
+
+procedure GetParams(Strings: TStrings);
+var
+  P: PChar;
+  Param: string;
+
+  function GetParamStr(var P: PChar; var Param: string): Boolean;
+  var
+    Quoted: Boolean;
+  begin
+    Param := '';
+
+    repeat
+      while (P[0] <> #0) and (P[0] <= ' ') do
+        Inc(P);
+
+      Quoted := False;
+      while P[0] <> #0 do begin
+        if P[0] = '"' then begin
+          Quoted := not Quoted;
+          Inc(P);
+        Continue; end;
+        if (P[0] <= ' ') and not Quoted then
+          Break;
+        Param := Param + P[0];
+        Inc(P);
+      end;
+    until (Param <> '') or (P[0] = #0);
+
+    Result := Param <> '';
+  end;
+
+begin
+  Strings.Clear;
+  P := GetCommandLine;
+  GetParamStr(P, Param);
+  while GetParamStr(P, Param) do
+    Strings.Add(Param);
+end;
+
+function GetParams(const Separator: string = ' '): string;
+var
+  SL: TStringList;
+begin
+  SL := TStringList.Create;
+  GetParams(SL);
+  Result := Join(SL, Separator);
+  SL.Free;
+end;
+
+function Switch(const Switch: string; const PrefixChars: TCharSet = SwitchChars;
+  IgnoreCase: Boolean = True): Boolean;
+//= SysUtils.FindCmdLineSwitch
+var
+  i: Integer;
+  s: string;
+begin
+  Result := True;
+
+  for i := 1 to ParamCount do begin
+    s := ParamStr(i);
+
+    if (s <> '') and (s[1] in PrefixChars) then begin
+    //i know that always s <> '', but this is saver
+      s := Copy(s, 2, MaxInt);
+      if (s = Switch) or (IgnoreCase and (0=AnsiCompareText(s, Switch))) then
+        Exit;
+    end;
+  end;
+
+  Result := False;
+end;
+
+function ParamNum(const S: string): Integer;
+begin
+  for Result := 1 to ParamCount do
+    if 0=AnsiCompareText(ParamStr(Result), S) then
+      Exit;
+
+  Result := 0;
+end;
+
+function ParamPrefixNum(const Prefix: string): Integer;
+var
+  Len: Integer;
+begin
+  Len := Length(Prefix);
+  for Result := 1 to ParamCount do
+    if 0=AnsiCompareText(Copy(ParamStr(Result), 1, Len), Prefix) then
+      Exit;
+
+  Result := 0;
+end;
+
+function Param(const S: string): Boolean;
+begin
+  Result := ParamNum(S) > 0;
+end;
+
+function ParamPrefix(const Prefix: string): Boolean;
+begin
+  Result := ParamPrefixNum(Prefix) > 0;
+end;
+
+function GetParam(const Prefix: string = ''; const Default: string = ''): string;
+var
+  i: Integer;
+begin
+  Result := Default;
+
+  if Prefix = '' then begin
+    Result := ParamStr(1);
+  Exit; end;
+
+  i := ParamPrefixNum(Prefix);
+  if i > 0 then
+    Result := Copy(ParamStr(i), Length(Prefix) + 1, MaxInt);
+end;
+
+function GetMyDir(FullPath: Boolean = False): string;
+var
+  Buffer: array[0..260] of Char;
+begin
+  Result := '';
+  SetString(Result, Buffer, GetModuleFileName(0, Buffer, SizeOf(Buffer)));
+  if FullPath then
+    Result := GetFileNew(Result);
+  Result := ExtractPath(Result);
+end;
+
+function WinDir: string;
+var
+  Res: PChar;
+begin
+  Result := '\';
+  GetMem(Res, MAX_PATH);
+  GetWindowsDirectory(Res, MAX_PATH);
+  Result := Res + '\';
+  FreeMem(Res, MAX_PATH);
+end;
+
+function SysDir: string;
+var
+  Res: PChar;
+begin
+  Result := '\';
+  GetMem(Res, MAX_PATH);
+  GetSystemDirectory(Res, MAX_PATH);
+  Result := Res + '\';
+  FreeMem(Res, MAX_PATH);
+end;
+
+function UserName: string;
+var
+  Len: Cardinal;
+  Res: PChar;
+begin
+  Result := '';
+  GetMem(Res, MAX_PATH);
+  Len := MAX_PATH;
+  GetUserName(Res, Len);
+  Result := Res;
+  FreeMem(Res, MAX_PATH);
+end;
+
+function FirstChar(const S: string): Char;
+begin
+  if s = '' then
+    Result := #0
+  else
+    Result := s[1];
+end;
+
+function LastChar(const S: string): Char;
+begin
+  if s = '' then
+    Result := #0
+  else
+    Result := s[Length(s)];
+end;
+
+function CharPos(C: Char; const S: string; Offset: Integer = 1): Integer;
+var
+  MaxPosToSearch: Integer;
+begin
+  Result := Offset;
+  MaxPosToSearch := Length(S);
+
+  while Result <= MaxPosToSearch do begin
+    if S[Result] = C then
+      Exit;
+    Inc(Result);
+  end;
+
+  Result := 0;
+end;
+
+function CharPos(C: TCharSet; const S: string; Offset: Integer = 1): Integer;
+var
+  MaxPosToSearch: Integer;
+begin
+  Result := Offset;
+  MaxPosToSearch := Length(S);
+
+  while Result <= MaxPosToSearch do begin
+    if S[Result] in C then
+      Exit;
+    Inc(Result);
+  end;
+
+  Result := 0;
+end;
+
+function CharPosR(C: Char; const S: string; Offset: Integer = -1): Integer;
+begin
+  if Offset < 0 then
+    Result := Length(S) + 1 - Offset
+  else
+    Result := Offset;
+  if Result > Length(S) then
+    Result := Length(S);
+
+  while Result > 0 do begin
+    if S[Result] = C then
+      Exit;
+    Dec(Result);
+  end;
+end;
+
+function PosEx(const SubStr, S: string; Offset: Integer = 1): Integer;
+var
+  MaxPosToSearch, LenSubStr, i: Integer;
+begin
+  if SubStr = '' then begin
+    Result := 0;
+  Exit; end;
+
+  if Offset < 1 then
+    Result := 1
+  else
+    Result := Offset;
+
+  LenSubStr := Length(SubStr);
+  MaxPosToSearch := Length(S) - LenSubStr + 1;
+
+  while Result <= MaxPosToSearch do begin
+    if S[Result] = SubStr[1] then begin
+      i := 1;
+
+      while (i < LenSubStr)
+       and (S[Result + i] = SubStr[i + 1]) do
+        Inc(i);
+
+      if i = LenSubStr then
+        Exit;
+    end;
+    Inc(Result);
+  end;
+
+  Result := 0;
+end;
+
+function PosExText(const SubStr, S: string; Offset: Integer = 1): Integer;
+var
+  MaxPosToSearch, LenSubStr, i: Integer;
+
+  function SameChar(a, b: Char): Boolean;
+  begin
+    Result := UpCase(a) = UpCase(b)
+  end;
+
+begin
+  if SubStr = '' then begin
+    Result := 0;
+  Exit; end;
+
+  if Offset < 1 then
+    Result := 1
+  else
+    Result := Offset;
+
+  LenSubStr := Length(SubStr);
+  MaxPosToSearch := Length(S) - LenSubStr + 1;
+
+  while Result <= MaxPosToSearch do begin
+    if SameChar(S[Result], SubStr[1]) then begin
+      i := 1;
+
+      while (i < LenSubStr)
+       and (SameChar(S[Result + i], SubStr[i + 1])) do
+        Inc(i);
+
+      if i = LenSubStr then
+        Exit;
+    end;
+    Inc(Result);
+  end;
+
+  Result := 0;
+end;
+
+function PosExAnsiText(const SubStr, S: string; Offset: Integer = 1): Integer;
+var
+  MaxPosToSearch, LenSubStr, i: Integer;
+
+  function SameChar(a, b: Char): Boolean;
+  begin
+    Result := CharLower(PChar(a)) = CharLower(PChar(b));
+  end;
+
+begin
+  if SubStr = '' then begin
+    Result := 0;
+  Exit; end;
+
+  if Offset < 1 then
+    Result := 1
+  else
+    Result := Offset;
+
+  LenSubStr := Length(SubStr);
+  MaxPosToSearch := Length(S) - LenSubStr + 1;
+
+  while Result <= MaxPosToSearch do begin
+    if SameChar(S[Result], SubStr[1]) then begin
+      i := 1;
+
+      while (i < LenSubStr)
+       and (SameChar(S[Result + i], SubStr[i + 1])) do
+        Inc(i);
+
+      if i = LenSubStr then
+        Exit;
+    end;
+    Inc(Result);
+  end;
+
+  Result := 0;
+end;
+
+function UntilChar(const S: string; Brake: Char): string;
+var
+  p: Integer;
+begin
+  p := CharPos(Brake, S);
+
+  if p > 0 then
+    Result := Copy(S, 1, p - 1)
+  else
+    Result := S;
+end;
+
+function UntilChar(const S: string; Brake: TCharSet): string;
+var
+  p: Integer;
+begin
+  Result := '';
+  p := CharPos(Brake, S);
+
+  if p > 0 then
+    Result := Copy(S, 1, p - 1)
+  else
+    Result := S;
+end;
+
+function UntilLastChar(const S: string; Brake: Char;
+  IgnoreNoBrake: Boolean = True): string;
+var
+  p: Integer;
+begin
+  Result := '';
+  p := CharPosR(Brake, S);
+
+  if p > 0 then
+    Result := Copy(S, 1, p - 1)
+  else if IgnoreNoBrake then
+    Result := S;
+end;
+
+function FromChar(const S: string; Brake: Char): string;
+var
+  p: Integer;
+begin
+  Result := '';
+  p := CharPos(Brake, S);
+
+  if p > 0 then
+    Result := Copy(S, p + 1, Length(S) - p);
+end;
+
+function FromChar(const S: string; Brake: TCharSet): string;
+var
+  p: Integer;
+begin
+  Result := '';
+  p := CharPos(Brake, S);
+
+  if p > 0 then
+    Result := Copy(S, p + 1, Length(S) - p);
+end;
+
+function FromLastChar(const S: string; Brake: Char;
+  IgnoreNoBrake: Boolean = False): string;
+var
+  p: Integer;
+begin
+  Result := '';
+  p := CharPosR(Brake, S);
+
+  if p > 0 then
+    Result := Copy(S, p + 1, Length(S) - p)
+  else if IgnoreNoBrake then
+    Result := S;
+end;
+
+function BetweenChars(const S: string; Start, Finish: Char;
+  Inclusive: Boolean = False): string;
+var
+  p, fin: Integer;
+begin
+  Result := '';
+
+  p := CharPos(Start, S);
+  if p = 0 then
+    Exit;
+
+  fin := CharPos(Finish, S, p + 1);
+  if fin = 0 then
+    Exit;
+
+  if not Inclusive then begin
+    Inc(p);
+    Dec(fin);
+  end;
+
+  Result := Copy(S, p, fin - p + 1);
+end;
+
+function UntilStr(const S: string; Brake: string): string;
+var
+  p: Integer;
+begin
+  if Length(Brake) = 1 then begin
+    Result := UntilChar(S, Brake[1]);
+  Exit; end;
+
+  p := PosEx(Brake, S);
+
+  if p > 0 then
+    Result := Copy(S, 1, p - 1)
+  else
+    Result := S;
+end;
+
+function FromStr(const S: string; Brake: string): string;
+var
+  p: Integer;
+begin
+  if Length(Brake) = 1 then begin
+    Result := FromChar(S, Brake[1]);
+  Exit; end;
+
+  Result := '';
+  p := PosEx(Brake, s);
+
+  if p > 0 then begin
+    Inc(p, Length(Brake));
+    Result := Copy(S, p, Length(S) - p + 1);
+  end;
+end;
+
+function StringWrap(const S: string; Width: Integer; const LineEnd: string = EOL): string;
+var
+  i: Integer;
+begin
+  Result := '';
+  if (S = '') or (Width < 1) then
+    Exit;
+
+  i := 1;
+  while True do begin
+    Result := Result + Copy(S, i, Width);
+    Inc(i, Width);
+    if i <= Length(S) then
+      Result := Result + LineEnd
+    else
+      Exit;
+  end;
+end;
+
+function Split(const S, Separator: string; IgnoreMultiSep: Boolean = True;
+  MinCount: Integer = 0): TStrA;
+var
+  p, fin, SepLen: Integer;
+
+  procedure Add(const S: string);
+  begin
+    if IgnoreMultiSep and (S = '') then
+      Exit;
+    SetLength(Result, Length(Result) + 1);
+    Result[High(Result)] := S;
+  end;
+
+begin
+  if S = '' then begin
+    if Length(Result) < MinCount then
+      SetLength(Result, MinCount);
+  Exit; end;
+
+  Result := nil;
+  SepLen := Length(Separator);
+
+  p := 1;
+  fin := PosEx(Separator, S);
+  while fin > 0 do begin
+    Add(Copy(S, p, fin - p));
+    p := fin + SepLen;
+    fin := PosEx(Separator, S, p);
+  end;
+  Add(Copy(S, p, Length(S) - p + 1));
+
+  if Length(Result) < MinCount then
+    SetLength(Result, MinCount);
+end;
+
+procedure Split(const S, Separator: string; Strings: TStrings;
+  IgnoreMultiSep: Boolean = True); 
+var
+  p, fin, SepLen: Integer;
+
+  procedure Add(const S: string);
+  begin
+    if IgnoreMultiSep and (S = '') then
+      Exit;
+    Strings.Add(S);
+  end;
+
+begin
+  if S = '' then
+    Exit;
+
+  Strings.BeginUpdate;
+  SepLen := Length(Separator);
+  p := 1;
+  fin := PosEx(Separator, S);
+  while fin > 0 do begin
+    Add(Copy(S, p, fin - p));
+    p := fin + SepLen;
+    fin := PosEx(Separator, S, p);
+  end;
+  Add(Copy(S, p, Length(S) - p + 1));
+  Strings.EndUpdate;
+end;
+
+function Split(const S: string; Separators: TCharSet;
+  IgnoreMultiSep: Boolean = True; MinCount: Integer = 0): TStrA;
+var
+  p, fin: Integer;
+
+  procedure Add(const S: string);
+  begin
+    if IgnoreMultiSep and (S = '') then
+      Exit;
+    SetLength(Result, Length(Result) + 1);
+    Result[High(Result)] := S;
+  end;
+
+begin
+  if S = '' then begin
+    if Length(Result) < MinCount then
+      SetLength(Result, MinCount);
+  Exit; end;
+
+  Result := nil;
+
+  p := 1;
+  fin := CharPos(Separators, S);
+  while fin > 0 do begin
+    Add(Copy(S, p, fin - p));
+    p := fin + 1;
+    fin := CharPos(Separators, S, p);
+  end;
+  Add(Copy(S, p, Length(S) - p + 1));
+
+  if Length(Result) < MinCount then
+    SetLength(Result, MinCount);
+end;
+
+procedure TileStr(const S: string; BrakeStart: Integer; BrakeEnd: Integer;
+  out Left, Right: string);
+begin
+  Left := Copy(S, 1, BrakeStart-1);
+  Right := Copy(S, BrakeEnd + 1, MaxInt);
+end;
+
+function Join(Strings: TStrings; Separator: string = ' '): string;
+var
+  i, imax: Integer;
+begin
+  Result := '';
+  imax := Strings.Count-1;
+  for i := 0 to imax do begin
+    Result := Result + Strings[i];
+    if i < imax then
+      Result := Result + Separator;
+  end;
+end;
+
+function Join(StrA: TStrA; Separator: string = ' '): string; overload;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 0 to High(StrA) do begin
+    Result := Result + StrA[i];
+    if i < High(StrA) then
+      Result := Result + Separator;
+  end;
+end;
+
+function MulStr(const S: string; Count: Integer): string;
+var
+  P: PChar;
+  Len, i: Integer;
+begin
+  Result := '';
+  if Count = 0 then
+    Exit;
+
+  Len := Length(S);
+  SetLength(Result, Len * Count);
+
+  P := Pointer(Result);
+  for i := 1 to Count do begin
+    Move(Pointer(S)^, P^, Len);
+    Inc(P, Len);
+  end;
+end;
+
+function AlignR(const S: string; Width: Integer; Filler: Char = ' '): string;
+begin
+  Result := MulStr(Filler, Width - Length(S)) + S;
+end;
+
+function MaxStr(const S: string; MaxLen: Integer): string;
+var
+  Len: Integer;
+begin
+  Len := Length(S);
+  if Len <= MaxLen then begin
+    Result := S;
+  Exit end;
+
+  Result := Copy(S, 1, MaxLen - 3) + '...';
+end;
+
+function TrimAll(const S: string): string;
+var
+  i: Integer;
+begin
+  for i := 1 to Length(S) do
+    if S[i] > #32 then
+      Result := Result + S[i];
+end;
+
+function ControlChar(C: Char): Boolean;
+begin
+  Result := C in StrangeChars;
+end;
+
+function FriendlyChar(C: Char): Char;
+begin
+  case C of
+    #0: Result := '.';
+    #1..#31: Result := '?';
+    #255: Result := '#';
+  else
+    Result := C;
+  end;
+end;
+
+function FriendlyStr(const S: string): string;
+var
+  i: Integer;
+begin
+  SetLength(Result, Length(S));
+  for i := 1 to Length(S) do
+    Result[i] := FriendlyChar(S[i]);
+end;
+
+function FriendlyStr(a: TByteA): string;
+var
+  i: Integer;
+begin
+  SetLength(Result, Length(a));
+  for i := 0 to High(a) do
+    Result[i + 1] := FriendlyChar(Char(a[i]));
+end;
+
+function Quote(const S: string; Quoter: Char = '"'): string;
+begin
+  Result := S;
+
+  if FirstChar(S) <> Quoter then
+    Result := Quoter + Result;
+
+  if LastChar(S) <> Quoter then
+    Result := Result + Quoter;
+end;
+
+function DeQuote(const S: string): string;
+begin
+  Result := '';
+  if Length(S) > 2 then
+    Result := Copy(S, 2, Length(S) - 2);
+end;
+
+function UnQuote(const S: string): string;
+var
+  Start, Len: Integer;
+begin
+  Start := 1;
+  Len := Length(S);
+
+  if (S <> '') and (S[1] in ([#0..#32] + QuoteChars)) then begin
+    if (LastChar(S) = S[1]) then
+      Dec(Len);
+    Inc(Start);
+  end;
+
+  Result := Copy(S, Start, Len - Start + 1);
+end;
+
+function StrNumerus(const Value: Integer; const Singular, Plural: string;
+  const Zero: string = '0'): string;
+begin
+  if Abs(Value) = 1 then
+    Result := IntToStr(Value) + ' ' + Singular
+  else if Value = 0 then
+    Result := Zero + ' ' + Plural
+  else
+    Result := IntToStr(Value) + ' ' + Plural;
+end;
+
+function MakeStr(const Items: array of const; Separator: string = ''): string;
+const
+  BoolStrings: array[Boolean] of string = ('False', 'True');
+
+var
+  i: Integer;
+
+  function StrOfP(P: Pointer): string;
+  begin
+    if P = nil then
+      Result := '[nil]'
+    else
+      Result := '[' + IntToStr(Cardinal(P)) + ']';
+  end;
+
+  procedure Add(const S: string);
+  begin
+    Result := Result + s + Separator;
+  end;
+
+begin
+  Result := '';
+  for i := 0 to High(Items) do
+    with Items[i] do
+      case VType of
+        vtString:     Add(VString^);
+        vtInteger:    Add(IntToStr(VInteger));
+        vtBoolean:    Add(BoolStrings[VBoolean]);
+        vtChar:       Add(VChar);
+        vtPChar:      Add(VPChar);
+        vtExtended:   Add(FloatToStr(VExtended^));
+        vtObject:     if VObject is TComponent then
+                        Add(TComponent(VObject).Name)
+                      else
+                        Add(VObject.ClassName);
+        vtClass:      Add(VClass.ClassName);
+        vtAnsiString: Add(string(VAnsiString));
+        vtCurrency:   Add(CurrToStr(VCurrency^));
+        vtInt64:      Add(IntToStr(VInt64^));
+        vtVariant:    Add(string(VVariant^));
+
+        vtWideChar:   Add(VWideChar);
+        vtPWideChar:  Add(VPWideChar);
+        vtInterface:  Add(StrOfP(VInterface));
+        vtPointer:    Add(StrOfP(VPointer));
+        vtWideString: Add(WideString(VWideString));
+      end;
+  if Result <> '' then
+    SetLength(result, Length(Result) - Length(Separator));
+end;
+
+procedure ShowText(const Items: array of const; Separator: string = '');
+var
+  Text: string;
+begin
+  Text := MakeStr(Items, Separator);
+
+  MessageBox(0, PChar(Text), 'Info', MB_OK and MB_APPLMODAL);
+end;
+
+function DeleteChars(const S: string; C: Char): string;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 1 to Length(S) do
+    if S[i] <> C then
+      Result := Result + S[i];
+end;
+
+function DeleteChars(const S: string; C: TCharSet): string;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 1 to Length(S) do
+    if not (S[i] in C) then
+      Result := Result + S[i];
+end;
+
+function ExtractChars(const S: string; C: TCharSet): string;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 1 to Length(S) do
+    if S[i] in C then
+      Result := Result + S[i];
+end;
+
+function CharCount(const S: string; C: Char): Integer;
+var
+  i: Integer;
+begin
+  Result := 0;
+  for i := 1 to Length(S) do
+    if S[i] = C then
+      Inc(Result);
+end;
+
+function StrAtPos(const S: string; Pos: Integer; const Str: string): Boolean;
+begin
+  Result := (Str <> '') and (Str = Copy(S, Pos, Length(Str)));
+end;
+
+function TextAtPos(const S: string; Pos: Integer; const Text: string): Boolean;
+begin
+  Result := (Text <> '') and SameText(Text, Copy(S, Pos, Length(Text)));
+end;
+
+function StrAtBegin(const S, Str: string): Boolean;
+begin
+  Result := StrAtPos(S, 1, Str);
+end;
+
+function TextAtBegin(const S, Text: string): Boolean;
+begin
+  Result := TextAtPos(S, 1, Text);
+end;
+
+function CharIn(const S: string; C: Char): Boolean;
+var
+  i: Integer;
+begin
+  Result := True;
+  for i := 1 to Length(S) do
+    if S[i] = C then Exit;
+  Result := False;
+end;
+
+function CharIn(const S: string; C: TCharSet): Boolean;
+var
+  i: Integer;
+begin
+  Result := False;
+  for i := 1 to Length(S) do begin
+    Result := S[i] in C;
+    if Result then
+      Exit;
+  end;
+end;
+
+function StrIn(const S, SubStr: string): Boolean;
+begin
+  Result := PosEx(SubStr, S) > 0;
+end;
+
+function StrIn(SL: TStrings; const S: string): Boolean;
+var
+  i: Integer;
+begin
+  Result := False;
+  for i := 0 to SL.Count-1 do begin
+    Result := (S = SL[i]);
+    if Result then
+      Exit;
+  end;
+end;
+
+function StrIn(A: TStrA; const S: string): Boolean;
+var
+  i: Integer;
+begin
+  Result := False;
+  for i := Low(A) to High(A) do begin
+    Result := (S = A[i]);
+    if Result then
+      Exit;
+  end;
+end;
+
+function TextIn(const S, Text: string): Boolean;
+begin
+  Result := PosExText(Text, S) > 0;
+end;
+
+function TextIn(SL: TStrings; const Text: string): Boolean;
+var
+  i: Integer;
+begin
+  Result := False;
+  for i := 0 to SL.Count-1 do begin
+    Result := SameText(Text, SL[i]);
+    if Result then
+      Exit;
+  end;
+end;
+
+function TextIn(A: TStrA; const Text: string): Boolean;
+var
+  i: Integer;
+begin
+  Result := False;
+  for i := Low(A) to High(A) do begin
+    Result := SameText(Text, A[i]);
+    if Result then
+      Exit;
+  end;
+end;
+
+function StrIndex(SL: TStrings; const S: string): Integer;
+begin
+  for Result := 0 to SL.Count-1 do
+    if S = SL[Result] then
+      Exit;
+  Result := -1;
+end;
+
+function StrIndex(A: TStrA; const S: string): Integer;
+begin
+  for Result := Low(A) to High(A) do
+    if S = A[Result] then
+      Exit;
+  Result := -1;
+end;
+
+function TextIndex(SL: TStrings; const Text: string): Integer;
+begin
+  for Result := 0 to SL.Count-1 do
+    if SameText(Text, SL[Result]) then
+      Exit;
+  Result := -1;
+end;
+
+function TextIndex(A: TStrA; const Text: string): Integer;
+begin
+  for Result := Low(A) to High(A) do
+    if SameText(Text, A[Result]) then
+      Exit;
+  Result := -1;
+end;
+
+function ReplaceChars(const S: string; Old, New: Char): string;
+var
+  i: Integer;
+begin
+  Result := S;
+  for i := 1 to Length(Result) do
+    if Result[i] = Old then
+      Result[i] := New;
+end;
+
+function ReplaceChars(const S: string; Old: TCharSet; New: Char): string;
+var
+  i: Integer;
+begin
+  Result := S;
+  for i := 1 to Length(Result) do
+    if Result[i] in Old then
+      Result[i] := New;
+end;
+
+function Replace(const S, Old, New: string): string;
+var
+  oldp, ps: Integer;
+begin
+  ps := 1;
+  Result := '';
+  while True do begin
+    oldp := ps;
+    ps := PosEx(Old, S, oldp);
+    if ps = 0 then begin
+      Result := Result + Copy(S, oldp, Length(S) - oldp + 1);
+    Exit; end;
+    Result := Result + Copy(S, oldp, ps - oldp) + New;
+    Inc(ps, Length(Old));
+  end;
+end;
+
+function SLOfFile(const FileName: string): TStringList;
+begin
+  Result := TStringList.Create;
+  if FileExists(FileName) then
+    Result.LoadFromFile(FileName);
+end;
+
+function ContainsEmptyLines(SL: TStrings): Boolean;
+begin
+  Result := StrIn(SL, '');
+end;
+
+procedure DeleteEmptyLines(SL: TStrings);
+var
+  i: Integer;
+begin
+  i := 0;
+  while i < SL.Count do begin
+    if SL[i] = '' then
+      SL.Delete(i)
+    else
+      Inc(i);
+  end;
+end;
+
+procedure DeleteCommentLines(SL: TStrings; const CommentSign: string = '//');
+var
+  i: Integer;
+begin
+  i := 0;
+  while i < SL.Count do begin
+    if (SL[i] = '') or (StrAtBegin(TrimLeft(SL[i]), CommentSign)) then
+      SL.Delete(i)
+    else
+      Inc(i);
+  end;
+end;
+
+function FindLine(SL: TStrings; const S: string): Integer;
+begin
+  for Result := 0 to SL.Count-1 do
+    if TextAtBegin(SL[Result], S) then
+      Exit;
+  Result := -1;
+end;
+
+procedure QuickSortSL(SL: TStringList);
+
+  procedure Sort(l, r: Integer);
+  var
+    i,j: Integer;
+    z,x: string;
+  begin
+    i := l;
+    j := r;
+    x := SL[(j + i) div 2];
+    repeat
+      while SL[i] < x do Inc(i);
+      while SL[j] > x do Dec(j);
+      if i <= j then begin
+        z := SL[i];
+        SL[i] := SL[j];
+        SL[j] := z;
+        Inc(i); Dec(j);
+      end;
+    until i > j;
+    if j > l then Sort(l, j);
+    if i < r then Sort(i, r);
+  end;
+
+begin
+  if SL.Count > 0 then
+    Sort(0, SL.Count-1);
+end;
+
+function IncStrA(StrA: TStrA): Integer;
+begin
+  SetLength(StrA, Length(StrA) + 1);
+  Result := High(StrA);
+end;
+
+function StrOfByteA(a: TByteA): string;
+begin
+  Result := string(Copy(a, 0, Length(a)));
+end;
+
+function ByteAOfStr(const S: string): TByteA;
+begin
+  Result := TByteA(Copy(S, 1, Length(s)));
+end;
+
+function ByteAOfInt(i: Integer): TByteA;
+begin
+  SetLength(Result, SizeOf(Integer));
+  Move(i, Pointer(Result)^, SizeOf(Integer));
+end;
+
+function IntOfByteA(A: TByteA): Integer;
+begin
+  Result := 0;
+  Move(Pointer(A)^, Result, Min(Length(A), SizeOf(Integer)));
+end;
+
+function ByteAOfHex(const Hex: string): TByteA;
+var
+  i: Integer;
+  h: string;
+begin
+  h := ExtractChars(Hex, HexadecimalChars);
+  SetLength(Result, Length(h) div 2);
+  for i := 0 to High(Result) do
+    Result[i] := ByteOfHex(Copy(h, (i shl 1) + 1, 2));
+end;
+
+function SizeOfFile(const FileName: string): Integer;
+var
+  F: file;
+begin
+  AssignFile(F, FileName);
+  {$I-}Reset(F, 1);{$I+}
+  if IOResult = 0 then begin
+    Result := FileSize(F);
+    CloseFile(F);
+  end else
+    Result := 0;
+end;
+
+function FileEx(const FileName: string; AllowFolders: Boolean = False): Boolean;
+var
+  FindData: TWin32FindData;
+begin
+  if FileName = '' then begin
+    Result := False;
+  Exit; end;
+
+  Result := (AllowFolders and DirectoryExists(FileName)) or
+    (FindFirstFile(PChar(FileName), FindData) <> INVALID_HANDLE_VALUE);
+  Result := Result and not CharIn(FileName, WildCards);
+  Result := Result and (AllowFolders
+    or ((FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0));
+end;
+
+function LWPSolve(const Dir: string): string;
+begin
+  if (Dir <> '') and (Dir[Length(Dir)] = '\') then begin
+    Result := Copy(Dir, 1, Length(Dir) - 1);
+  end else
+    Result := Dir;
+end;
+
+function LWPSlash(const Dir: string): string;
+begin
+  if (Dir <> '') and (Dir[Length(Dir)] = '\') then begin
+    Result := Copy(Dir, 1, Length(Dir));
+  end else
+    Result := Dir + '\';
+end;
+
+function ExtractDrive(const FileName: string): string;
+begin
+  Result := '';
+  if (Length(FileName) >= 2) and (FileName[2] = ':') then
+    Result := UpperCase(FileName[1] + ':\');
+end;
+
+function ExtractPath(const FileName: string): string;
+var
+  p: Integer;
+begin
+  p := CharPosR('\', FileName);
+  if P > 0 then
+    Result := Copy(FileName, 1, p)
+  else
+    Result := FileName;
+end;
+
+function ExtractPrefix(const FileName: string): string;
+begin
+  Result := UntilLastChar(ExtractFileName(FileName), '.');
+end;
+
+function ExtractSuffix(const FileName: string): string;
+begin
+  Result := FromLastChar(ExtractFileName(FileName), '.');
+end;
+
+function SameByteA(const A, B: TByteA): Boolean;
+begin
+  Result := (A = B) or ((Length(A) = Length(B)) and CompareMem(A, B, Length(A)));
+end;
+
+function Reverse(A: TByteA): TByteA;
+var
+  i: Integer;
+begin
+  SetLength(Result, Length(A));
+
+  for i := 0 to High(A) do
+    Result[High(Result) - i] := A[i];
+end;
+
+function Endian(i: Integer): Integer;
+type
+  EndianArray = packed array[0..3] of Byte;
+var
+  a, b: EndianArray;
+begin
+  a := EndianArray(i);
+  b[0] := a[3];
+  b[1] := a[2];
+  b[2] := a[1];
+  b[3] := a[0];
+  Result := Integer(b);
+end;
+
+function SaveByteA(Data: TByteA; const FileName: string;
+  Overwrite: Boolean = True): Boolean;
+var
+  F: file;
+begin
+  if FileExists(FileName) and not Overwrite then begin
+    Result := False;
+  Exit end;
+
+  AssignFile(F, FileName);
+  {$I-}Rewrite(F, 1);{$I+}
+  if IOResult = 0 then begin
+    if Length(Data) > 0 then
+      BlockWrite(F, Data[0], Length(Data));
+    CloseFile(F);
+    Result := True;
+  end else
+    Result := False;
+end;
+
+function LoadByteA(const FileName: string): TByteA;
+var
+  F: file;
+begin
+  AssignFile(F, FileName);
+  {$I-}Reset(F, 1);{$I+}
+  if IOResult = 0 then begin
+    SetLength(Result, FileSize(F));
+    if Length(Result) > 0 then
+      BlockRead(F, Result[0], FileSize(F));
+    CloseFile(F);
+  end else
+    SetLength(Result, 0);
+end;
+
+function IsValidFileName(const FileName: string): Boolean;
+begin
+  Result := (FileName <> '') and not CharIn(FileName, FileNameEnemies)
+    and CharIn(Trim(FileName), AllChars - ['.']);
+end;
+
+function MakeValidFileName(FileName: string; const Default: string = 'File'): string;
+begin
+  if FileName = '' then
+    FileName := Default;
+
+  if CharIn(FileName, FileNameEnemies) then
+    Result := ReplaceChars(FileName, FileNameEnemies, '_')
+  else if not CharIn(Trim(FileName), AllChars - ['.']) then
+    Result := Default
+  else
+    Result := FileName;
+end;
+
+function IsValidInteger(const S: string): Boolean;
+{const
+  LowInt = '2147483648';
+  HighInt = '2147483647';
+var
+  len, RealLen, i, o: Integer;
+  c: Char;
+begin
+  Result := False;
+  if S = '' then
+    Exit;
+
+  len := Length(S);
+  o := 1;
+  
+  if S[1] = '-' then begin
+    if len = 1 then
+      Exit;
+    Inc(o);
+    while (o <= len) and (S[o] = '0') do
+      Inc(o);
+    if o > len then
+      Exit;
+    if o < len then begin
+      RealLen := len - o + 1;
+      if RealLen > Length(LowInt) then
+        Exit
+      else if RealLen = Length(LowInt) then begin
+        for i := 1 to Length(LowInt) do begin
+          c := S[i + o - 1];
+          if (c < '0') or (c > LowInt[i]) then
+            Exit;
+          if c in ['0'..Char((Byte(LowInt[i])-1))] then
+            Break;
+        end;
+        Inc(o, i);
+      end;
+    end;
+  end else begin
+    while (o <= len) and (S[o] = '0') do
+      Inc(o);
+    if o <= len then begin
+      RealLen := len - o + 1;
+      if RealLen > Length(HighInt) then
+        Exit
+      else if RealLen = Length(HighInt) then begin
+        for i := 1 to Length(HighInt) do begin
+          c := S[i + o - 1];
+          if (c < '0') or (c > HighInt[i]) then
+            Exit;
+          if c in ['0'..Char((Byte(HighInt[i])-1))] then
+            Break;
+        end;
+        Inc(o, i);
+      end;
+    end;
+  end;
+
+  for i := o to len do
+    if not (S[i] in ['0'..'9']) then
+      Exit;
+
+  Result := True;  }
+var
+  i: Int64;
+begin
+  i := StrToInt64Def(S, High(Int64));
+  Result := (i >= Low(Integer)) and (i <= High(Integer));
+end;
+
+function IsValidCardinal(const S: string): Boolean;
+{const
+  HighCard = '4294967295';
+var
+  len, RealLen, i, o: Integer;
+begin
+  Result := False;
+  if S = '' then
+    Exit;
+
+  len := Length(S);
+  o := 1;
+  
+  while (o <= len) and (S[o] = '0') do
+    Inc(o);
+  if o <= len then begin
+    RealLen := len - o + 1;
+    if RealLen > Length(HighCard) then
+      Exit
+    else if RealLen = Length(HighCard) then begin
+      for i := 1 to Length(HighCard) do begin
+        if S[i + o - 1] > HighCard[i] then
+          Exit;
+        if S[i + o - 1] in ['0'..Char((Byte(HighCard[i])-1))] then
+          Break;
+      end;
+      Inc(o, i);
+    end;
+  end;
+
+  for i := o to len do
+    if not (S[i] in ['0'..'9']) then
+      Exit;
+
+  Result := True;  }
+var
+  i: Int64;
+begin
+  i := StrToInt64Def(S, -1);
+  Result := (i >= 0) and (i <= High(Cardinal));
+end;
+
+function StrOfBool(flag: Boolean; const TrueStr: string = 'True';
+  const FalseStr: string = 'False'): string;
+begin
+  if Flag then
+    Result := TrueStr
+  else
+    Result := FalseStr;
+end;
+
+function StrOfInt(i: Integer): string;
+begin
+{  if i = 0 then begin
+    Result := '0';
+  Exit end;
+
+  while i > 0 do begin
+    Result := Char(Byte('0') + (i mod 10)) + Result;
+    i := i div 10;
+  end;}
+  Result := IntToStr(i);
+end;
+
+function CardOfStr(const S: string): Cardinal;
+var
+  Res: Int64;
+begin
+  Res := StrToInt64Def(S, -1);
+  if Res > High(Cardinal) then
+    Res := High(Cardinal)
+  else if Res < 0 then
+    Res := 0;
+  Result := Cardinal(Res);
+end;
+
+function HexOrd(Hex: Char): THex;
+begin
+  case Hex of
+    '0'..'9':
+      Result := Byte(Hex) - 48;
+    'A'..'F':
+      Result := Byte(Hex) - 55;
+    'a'..'f':
+      Result := Byte(Hex) - 87;
+    else
+      Result := 0;
+  end;
+end;
+
+function ByteOfHex(Hex: THexByteStr): Byte;
+begin
+  Result := (HexOrd(Hex[1]) shl 4) + HexOrd(Hex[2]);
+end;
+
+function DecOfHex(const Hex: string): string;
+begin
+  Result := IntToStr(CardOfHex(Hex));
+end;
+
+function HexOfByte(b: Byte): THexByteStr;
+begin
+  Result := HexChar[(b and $F0) shr 4]
+          + HexChar[ b and $0F       ];
+end;
+
+{function HexOfCard2(c: Cardinal): string;
+var
+  Data: array[0..(1 shl 4) - 1] of Char;
+  i: Integer;
+begin
+  for i := 0 to (1 shl 4) - 1 do
+    if i < 10 then
+      Data[i] := Char(Ord('0') + i)
+    else
+      Data[i] := Char(Ord('A') + i - 10);
+
+  Result := Data[(c and (((1 shl (1 shl 2)) - 1) shl (7 shl 2))) shr (7 shl 2)]
+          + Data[(c and (((1 shl (1 shl 2)) - 1) shl (6 shl 2))) shr (6 shl 2)]
+          + Data[(c and (((1 shl (1 shl 2)) - 1) shl (5 shl 2))) shr (5 shl 2)]
+          + Data[(c and (((1 shl (1 shl 2)) - 1) shl (4 shl 2))) shr (4 shl 2)]
+          + Data[(c and (((1 shl (1 shl 2)) - 1) shl (3 shl 2))) shr (3 shl 2)]
+          + Data[(c and (((1 shl (1 shl 2)) - 1) shl (2 shl 2))) shr (2 shl 2)]
+          + Data[(c and (((1 shl (1 shl 2)) - 1) shl (1 shl 2))) shr (1 shl 2)]
+          + Data[(c and (((1 shl (1 shl 2)) - 1) shl (0 shl 2))) shr (0 shl 2)];
+end; }
+
+function HexOfCard(i: Cardinal): string;
+var
+  a: Cardinal;
+begin
+  Result := '';
+  while i > 0 do begin
+    a := i and $F;
+    Result := HexChar[a] + Result;
+    i := i shr 4;
+  end;
+end;
+
+function HexOfCard(i: Cardinal; Digits: Integer): string;
+var
+  a: Cardinal;
+begin
+  Result := '';
+  while i > 0 do begin
+    a := i and $F;
+    Result := HexChar[a] + Result;
+    i := i shr 4;
+  end;
+  Result := MulStr('0', Digits - Length(Result)) + Result;
+end;
+
+function PascalHexArray(a: TByteA; Name: string): string;
+var
+  i, len: Integer;
+begin
+  Result := 'const' + EOL +
+    '  ' + Name + ': array[0..' + IntToStr(High(a)) + '] of Byte = (';
+
+  len := Length(a);
+  for i := 0 to len-1 do begin
+    if (i mod 19) = 0 then
+      Result := Result + EOL + '  ' + '  ';
+    Result := Result + '$' + HexOfByte(a[i]);
+    if i < len-1 then
+      Result := Result + ',';
+  end;
+  Result := Result + EOL + '  );';
+end;
+
+function HexOfByteA(a: TByteA; Blocks: Integer = 1;
+  const Splitter: string = ' '): string;
+var
+  i: Integer;
+begin
+  Result := '';
+
+  if Blocks > 0 then
+    for i := 0 to High(a) do begin
+      Result := Result + HexOfByte(a[i]);
+      if i < High(a) then
+        if ((i+1) mod Blocks) = 0 then
+          Result := Result + Splitter;
+    end
+  else
+    for i := 0 to High(a) do
+      Result := Result + HexOfByte(a[i]);
+end;
+
+function BinOfByteA(a: TByteA; Blocks: Integer = 4;
+  const Splitter: string = ' '): string;
+var
+  i, max: Integer;
+  Bit: Boolean;
+begin
+  Result := '';
+
+  if Blocks > 0 then begin
+    max := 8 * (High(a)) + 7;
+    for i := 0 to max do begin
+      Bit := 7-(i mod 8) in TBitSet(a[i div 8]);
+      Result := Result + Char(Byte('0') + Byte(Bit));
+      if i < max then
+        if ((i+1) mod Blocks) = 0 then
+          Result := Result + Splitter;
+    end;
+  end else
+    for i := 0 to High(a) do
+      Result := Result + Char(Byte('0') + a[i] shr (i and 8));
+end;
+
+function CardOfHex(Hex: string): Cardinal;
+var
+  i: Integer;
+begin
+  Result := 0;
+  Hex := Copy(ExtractChars(Hex, HexadecimalChars), 1, 8);
+
+  for i := 1 to Length(Hex) do
+    if Hex[i] <> '0' then
+      Inc(Result, HexOrd(Hex[i]) shl ((Length(Hex) - i) shl 2));
+end;
+
+function IntOfBin(Bin: string): Cardinal;
+var
+  i: Integer;
+begin
+  Result := 0;
+  Bin := Copy(ExtractChars(Bin, BinaryChars), 1, 32);
+
+  for i := Length(Bin) downto 1 do
+    if Bin[i] = '1' then
+      Inc(Result, 1 shl (Length(Bin) - i));
+end;
+
+function BinOfInt(n: Cardinal): string;
+var
+  a: Integer;
+begin
+  if n = 0 then begin
+    Result := '0';
+  exit; end;
+
+  Result := '';
+  while n > 0 do begin
+    a := n and 1;
+    Result := Char(a + Byte('0')) + Result;
+    n := n shr 1;
+  end;
+end;
+
+function BinOfIntFill(n: Cardinal; MinCount: Integer = 8): string;
+var
+  a: Integer;
+begin
+  if n = 0 then begin
+    Result := MulStr('0', MinCount);
+  Exit; end;
+
+  Result := '';
+  while n > 0 do begin
+    a := n and 1;
+    Result := Char(a + Byte('0')) + Result;
+    n := n shr 1;
+  end;
+  Result := MulStr('0', MinCount - Length(Result)) + Result;
+end;
+
+function BaseNOfInt(I: Cardinal; B: TBaseN): string;
+var
+  a: Integer;
+begin
+  if (B < 2) or (i = 0) then begin
+    Result := '0';
+  Exit; end;
+
+  Result := '';
+  while i > 0 do begin
+    a := i mod B;
+    Result := BaseNChar[a] + Result;
+    i := i div B;
+  end;
+end;
+
+function IntOfBaseN(V: string; B: TBaseN): Cardinal;
+var
+  i: Integer;
+  F: Cardinal;
+  c: Byte;
+begin
+  Result := 0;
+  V := TrimAll(V);
+  F := 1;
+  for i := Length(V) downto 1 do begin
+    c := Byte(UpCase(V[i]));
+    case Char(c) of
+      '0'..'9': c := c - 48;
+      'A'..'Z': c := c - 55;
+    end;
+    if c < B then
+      Result := Result + Byte(c) * F;
+    F := F * B;
+  end;
+end;
+
+function KeepIn(i, Bottom, Top: Variant): Variant;
+begin
+  Result := i;
+  if Result > Top then
+    Result := Top
+  else if Result < Bottom then
+    Result := Bottom;
+end;
+
+function InRange(Value, Bottom, Top: Variant): Boolean;
+begin
+  Result := (Value >= Bottom) and (Value <= Top);
+end;
+
+function InStrictRange(Value, Bottom, Top: Variant): Boolean;
+begin
+  Result := (Value > Bottom) and (Value < Top);
+end;
+
+function Min(const A, B: Integer): Integer;
+begin
+  if A < B then
+    Result := A
+  else
+    Result := B;
+end;
+
+function Min(const A: TIntA): Integer;
+var
+  i: Integer;
+begin
+  Result := 0;
+  if Length(A) = 0 then
+    Exit;
+
+  Result := A[0];
+  for i := 1 to High(A) do
+    if A[i] < Result then
+      Result := A[i];
+end;
+
+function Max(const A, B: Integer): Integer;
+begin
+  if A > B then
+    Result := A
+  else
+    Result := B;
+end;
+
+function Max(const A: TIntA): Integer;
+var
+  i: Integer;
+begin
+  Result := 0;
+  if Length(A) = 0 then
+    Exit;
+
+  Result := A[0];
+  for i := 1 to High(A) do
+    if A[i] > Result then
+      Result := A[i];
+end;
+
+function RangesOfStr(const S: string): TRanges;
+var
+  SL: TStringList;
+  r, b, t: string;
+  i, p: Integer;
+
+  function TryStrToCard(const S: string; out Value: Cardinal): Boolean;
+  var
+    E: Integer;
+  begin
+    Val(S, Value, E);
+    Result := E = 0;
+  end;
+
+begin
+  Result := nil;
+  SL := TStringList.Create;
+  try
+    Split(S, RangesSeparator, SL);
+    SetLength(Result, SL.Count);
+    for i := 0 to SL.Count-1 do begin
+      r := SL[i];
+      with Result[i] do begin
+        p := CharPos(RangeInnerSeparator, r);
+        Simple := p = 0; // no '-' found
+        if Simple then begin
+          if r = RangeInfinite then begin // * --> *-*
+            Simple := False;
+            Bottom := Low(Bottom);
+            Top := High(Top);
+          end else if not TryStrToCard(r, Value) then
+            Break;
+
+        end else begin
+          TileStr(r, p, p, b, t);
+
+          if b = RangeInfinite then
+            Bottom := Low(Bottom)
+          else if not TryStrToCard(b, Bottom) then
+            Break;
+
+          if t = RangeInfinite then
+            Top := High(Top)
+          else if not TryStrToCard(t, Top) then
+            Break;
+          if Bottom > Top then begin
+            p := Bottom; Bottom := Top; Top := p;
+          end;
+        end;
+      end;
+    end;
+
+    if i <> SL.Count then
+      Result := nil;
+
+  finally
+    SL.Free;
+  end;
+end;
+
+function InRanges(Ranges: TRanges; TestValue: Cardinal): Boolean;
+var
+  i: Integer;
+begin
+  Result := True;
+
+  for i := 0 to High(Ranges) do
+    with Ranges[i] do
+      if Simple then begin
+        if TestValue = Value then
+          Exit;
+      end else begin
+        if InRange(TestValue, Bottom, Top) then
+          Exit;
+      end;
+
+  Result := False;
+end;
+
+procedure WriteSL(Strings: TStrings; const Prefix: string = '';
+  const Suffix: string = '');
+var
+  i: Integer;
+begin
+  for i := 0 to Strings.Count-1 do
+    WriteLn(Prefix + Strings[i] + Suffix);
+end;
+
+function Success(Res: Integer; ResultOnSuccess: Integer = ERROR_SUCCESS): Boolean;
+begin
+  Result := (Res = ResultOnSuccess);
+  LastSuccessRes := Res;
+end;
+
+function Failure(Res: Integer; ResultOnSuccess: Integer = ERROR_SUCCESS): Boolean;
+begin
+  Result := not Success(Res, ResultOnSuccess);
+end;
+
+function ExpandString(const S: string): string;
+var
+  Len: Integer;
+  P, Res: PChar;
+begin
+  Result := '';
+  P := PChar(S);
+  Len := ExpandEnvironmentStrings(P, nil, 0);
+  if Len = 0 then
+    Exit;
+
+  GetMem(Res, Len);
+  ExpandEnvironmentStrings(P, Res, Len);
+
+  Result := Res;
+  FreeMem(Res, Len);
+end;
+
+function FindAll(Strings: TStrings; const Mask: string;
+  ScanSubDirs: Boolean = True; Attributes: Integer = faFindEveryFile;
+  FileReturn: TFileNameFunc = nil): Boolean;
+var
+  Path, FileName: string;
+
+  procedure ScanDir(const Path, FileName: string);
+  var
+    PSR: TSearchRec;
+    Res: Integer;
+
+    procedure Add(const S: string);
+    begin
+      if S <> '' then
+        Strings.Add(S);
+    end;
+
+  begin
+    Res := FindFirst(Path + FileName, Attributes, PSR);
+    while Success(Res, 0) do begin
+      if Assigned(FileReturn) then
+        Add(FileReturn(Path + PSR.Name))
+      else
+        Add(Path + PSR.Name);
+      Res := FindNext(PSR);
+    end;
+    FindClose(PSR);
+    if not ScanSubDirs then
+      Exit;
+
+    Res := FindFirst(Path + '*', faDirectory, PSR);
+    while Success(Res, 0) do begin
+      if (PSR.Attr and faDirectory > 0)
+       and (PSR.Name <> '.') and (PSR.Name <> '..') then
+        ScanDir(Path + PSR.Name + '\', FileName);
+      Res := FindNext(PSR);
+    end;
+    FindClose(PSR);
+  end;
+
+begin
+  Strings.Clear;
+  Path := ExtractPath(Mask);
+  FileName := ExtractFileName(Mask);
+  ScanDir(Path, FileName);
+  Result := Strings.Count > 0;
+end;
+
+function FindAllFirst(const Mask: string; ScanSubDirs: Boolean = True;
+  Attributes: Integer = faFindEveryFile): string;
+var
+  Path, FileName: string;
+
+  function ScanDir(const Path, FileName: string): Boolean;
+  var
+    PSR: TSearchRec;
+    Res: Integer;
+  begin
+    Result := False;
+    if Success(FindFirst(Path + FileName, Attributes, PSR), 0) then begin
+      FindAllFirst := Path + PSR.Name;
+      Result := True;
+      FindClose(PSR);
+    Exit; end;
+    if not ScanSubDirs then
+      Exit;
+
+    Res := FindFirst(Path + '*', faDirectory, PSR);
+    while not Result and Success(Res, 0) do begin
+      if (PSR.Attr and faDirectory > 0)
+       and (PSR.Name <> '.') and (PSR.Name <> '..') then
+        Result := ScanDir(Path + PSR.Name + '\', FileName);
+      Res := FindNext(PSR);
+    end;
+    FindClose(PSR);
+  end;
+begin
+  Result := '';
+  Path := ExtractPath(Mask);
+  FileName := ExtractFileName(Mask);
+  ScanDir(Path, FileName);
+end;
+
+procedure DeleteFiles(const Mask: string; ScanSubDirs: Boolean = True;
+  Attributes: Integer = faFindEveryFile);
+var
+  Path, FileName: string;
+
+  procedure ScanDir(const Path, FileName: string);
+  var
+    PSR: TSearchRec;
+    Res: Integer;
+
+    procedure TryDeleteFile(const FileName: string);
+    begin
+      try
+        DeleteFile(Path + PSR.Name);
+      except
+      end;
+    end;
+
+  begin
+    Res := FindFirst(Path + FileName, Attributes, PSR);
+    while Success(Res, 0) do begin
+      TryDeleteFile(Path + PSR.Name);
+      Res := FindNext(PSR);
+    end;
+    FindClose(PSR);
+    if not ScanSubDirs then
+      Exit;
+
+    Res := FindFirst(Path + '*', faDirectory, PSR);
+    while Success(Res, 0) do begin
+      if (PSR.Attr and faDirectory > 0)
+       and (PSR.Name <> '.') and (PSR.Name <> '..') then begin
+        ScanDir(Path + PSR.Name + '\', FileName);
+        TryDeleteFile(Path + PSR.Name);
+      end;
+      Res := FindNext(PSR);
+    end;
+    FindClose(PSR);
+  end;
+begin
+  Path := ExtractPath(Mask);
+  FileName := ExtractFileName(Mask);
+  ScanDir(Path, FileName);
+end;
+
+function GetFileNew(FileName: string; NoFloppyDrives: Boolean = True): string;
+var
+  Drive: string;
+  pf, pd, Len: Integer;
+  PSR: TSearchRec;
+begin
+  Result := '';
+  FileName := Trim(FileName);
+  if Length(FileName) < 2 then
+    Exit;
+
+  Drive := ExtractDrive(FileName);
+  if not DirectoryExists(Drive) then
+    Exit;
+
+  if NoFloppyDrives and (Drive[1] in ['A', 'B']) then
+    Exit;
+
+  Len := Length(FileName);
+  Result := Drive;
+  pf := Length(Drive) + 1;
+  while pf <= Len do begin
+    if FileName[pf] = '\' then begin
+      Result := Result + '\';
+      Inc(pf);
+    Continue; end;
+
+    pd := CharPos('\', FileName, pf);
+    if pd = 0 then begin
+      if 0=FindFirst(Result + Copy(FileName, pf, MaxInt), faFindEveryFile, PSR) then begin
+        Result := Result + PSR.Name;
+      Break; end else begin
+        FindClose(PSR);
+        if 0=FindFirst(Result + Copy(FileName, pf, MaxInt), faDirectory, PSR) then
+          Result := Result + PSR.Name + '\'
+        else
+          Result := '';
+        FindClose(PSR);
+        if Result = '' then
+          Break;
+      end;
+    end;
+
+    if 0=FindFirst(Result + Copy(FileName, pf, pd - pf), faDirectory, PSR) then
+      Result := Result + PSR.Name + '\'
+    else
+      Result := '';
+    FindClose(PSR);
+    if Result = '' then
+      Break;
+
+    pf := pd + 1;
+  end;
+
+  if (Result <> '') and not FileEx(Result, True) then
+    Result := '';
+end;
+
+function DateTimeOfFileTime(const FileTime: TFileTime): TDateTime;
+var
+  LocalFileTime: TFileTime;
+  Res: Integer;
+begin
+  Result := 0;
+
+  FileTimeToLocalFileTime(FileTime, LocalFileTime);
+  if not FileTimeToDosDateTime(LocalFileTime, LongRec(Res).Hi,
+   LongRec(Res).Lo) then
+    Res := -1;
+
+  if (Res = -1) or (Res = 0) then
+    Exit;
+  try
+    Result := FileDateToDateTime(Res);
+  except
+  end;
+end;
+
+procedure FileNew(const FileName: string);
+var
+  Handle: Integer;
+begin
+  Handle := FileCreate(FileName);
+  FileClose(Handle);
+end;
+
+function Win32PlatformStr: string;
+const
+  PlatformStrings: array[VER_PLATFORM_WIN32s..VER_PLATFORM_WIN32_NT] of string =
+    ('VER_PLATFORM_WIN32s', 'VER_PLATFORM_WIN32_WINDOWS', 'VER_PLATFORM_WIN32_NT');
+begin
+  Result := PlatformStrings[Win32Platform];
+end;
+
+function FullOSInfo: string;
+begin
+  Result := Format(
+    'Platform: %s' + EOL +
+    'Version: %d.%d Build %d' + EOL +
+    'CSD: %s',
+    [
+      Win32PlatformStr,
+      Win32MajorVersion, Win32MinorVersion, Win32BuildNumber,
+      Win32CSDVersion
+    ]
+  );
+end;
+
+function Win9x: Boolean;
+begin
+  Result := Win32Platform = VER_PLATFORM_WIN32_WINDOWS;
+end;
+
+function WinNT: Boolean;
+begin
+  Result := Win32Platform = VER_PLATFORM_WIN32_NT;
+end;
+
+function Win2000: Boolean;
+begin
+  Result := (Win32Platform = VER_PLATFORM_WIN32_NT)
+            and (Win32MajorVersion = 4);
+end;
+
+function WinXP: Boolean;
+begin
+  Result := Win32MajorVersion >= 5;
+end;
+
+initialization
+  MyDir := GetMyDir;
+
+end.
+
+unit FifoStream;
+
+interface
+
+uses Classes, windows, Dialogs;
+
+const
+  DefaultChunksize = 32768; // 32kb per chunk as default.
+
+type
+  PMemChunk = ^TMemChunk;
+  TMemChunk = record
+    Filled: Longword;
+    Read: Longword;
+    Data: pointer;
+  end;
+
+  TFifo = class
+  private
+    FBuffers: TList;
+    FChunksize: Longword;
+    FCritSect: TRTLCriticalSection;
+    FIsWinNT: boolean;
+    FBytesInFifo: LongWord;
+  protected
+    function GetBytesInFifo: LongWord;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Write(Data: pointer; Size: LongWord);
+    procedure Read(Buff: pointer; var ReqSize: LongWord);
+    procedure PeekData(Buff: pointer; var ReqSize: LongWord);
+  published
+    property BytesInFifo: LongWord read FBytesInFifo;
+  end;
+
+implementation
+
+constructor TFifo.Create;
+begin
+  inherited;
+  FBuffers := TList.Create;
+  // set default chunksize...
+  FChunksize := DefaultChunksize;
+  InitializeCriticalSection(FCritSect);
+end;
+
+destructor TFifo.Destroy;
+var
+  I: Integer;
+begin
+  EnterCriticalSection(FCritSect);
+  for I := 0 to FBuffers.count - 1 do
+  begin
+    FreeMem(PMemChunk(Fbuffers[I]).Data);
+    Dispose(PMemChunk(Fbuffers[I]));
+  end;
+  FBuffers.Clear;
+  FBuffers.Free;
+  LeaveCriticalSection(FCritSect);
+
+  DeleteCriticalSection(FCritSect);
+  inherited;
+end;
+
+function TFifo.GetBytesInFifo: LongWord;
+begin
+  Result := 0;
+  if FBuffers.Count = 0 then
+  begin
+    exit;
+  end
+  else
+  begin
+    if FBuffers.Count > 1 then
+      Inc(Result, (FBuffers.Count - 1) * FChunkSize);
+    Inc(Result, PMemChunk(FBuffers[Fbuffers.Count - 1]).Filled);
+    Dec(Result, PMemChunk(FBuffers[0]).Read);
+  end;
+end;
+
+procedure TFifo.Write(Data: pointer; Size: LongWord);
+var
+  Privpointer: pointer;
+  PrivSize: LongWord;
+  Chunk: PMemChunk;
+  PosInChunk: pointer;
+begin
+  if LongWord(Data) = 0 then
+  begin
+    // null pointer? somebody is trying to fool us, get out...
+    Exit;
+  end;
+  EnterCriticalSection(FCritSect);
+  PrivPointer := Data;
+  PrivSize := 0;
+  // are already buffers there?
+  if FBuffers.count > 0 then
+  begin
+    // is the last one of them not completely filled?
+    if PMemChunk(FBuffers[FBuffers.count - 1]).filled < FChunksize then
+      // not completely filled, so fill up the buffer.
+    begin
+      Chunk := PMemChunk(FBuffers[FBuffers.count - 1]);
+      // fetch chunkdata.
+      PosInChunk := Chunk.Data;
+      // move to current fill pos...
+      Inc(LongWord(PosInChunk), Chunk.Filled);
+      // can we fill the chunk completely?
+      if Size > FChunksize - Chunk.Filled then
+      begin
+        // yes we can.
+        Move(PrivPointer^, PosInChunk^, FChunksize - Chunk.Filled);
+        Inc(PrivSize, FChunksize - Chunk.Filled);
+        Inc(LongWord(PrivPointer), FChunksize - Chunk.Filled);
+        Chunk.Filled := FChunkSize;
+      end
+      else
+        // we have to less data for filling the chunk completely,
+        // just put everything in.
+      begin
+        Move(PrivPointer^, PosInChunk^, Size);
+        Inc(PrivSize, Size);
+        Inc(Chunk.Filled, Size);
+      end;
+    end;
+  end;
+  // as long as we have remaining stuff put it into new chunks.
+  while (PrivSize < Size) do
+  begin
+    new(Chunk);
+    GetMem(Chunk.Data, FChunksize);
+    Chunk.Read := 0;
+    // can we fill an entire chunk with the remaining data?
+    if Privsize + FChunksize < Size then
+    begin
+      // yes we can, so put the stuff in.
+      Move(Privpointer^, Chunk.Data^, FChunksize);
+      Inc(LongWord(PrivPointer), FChunksize);
+      Inc(PrivSize, FChunksize);
+      Chunk.Filled := FChunksize;
+    end
+    else // we have to less data to fill the entire chunk, just put the remaining stuff in.
+    begin
+      Move(Privpointer^, Chunk.Data^, Size - Privsize);
+      Chunk.Filled := Size - Privsize;
+      Inc(PrivSize, Size - Privsize);
+    end;
+    Fbuffers.Add(Chunk);
+  end;
+  if Size <> Privsize then
+    Showmessage('miscalculation in TFifo.write');
+  FBytesInFifo := GetBytesInFifo;
+  LeaveCriticalSection(FCritSect);
+end;
+
+procedure TFifo.Read(Buff: pointer; var ReqSize: LongWord);
+var
+  PrivSize: Integer;
+  Privpos: pointer;
+  Chunk: PMemChunk;
+  ChunkPos: pointer;
+begin
+  if LongWord(Buff) = 0 then
+  begin
+    // null pointer? somebody is trying to fool us, get out...
+    Exit;
+  end;
+  EnterCriticalSection(FCritSect);
+  PrivSize := 0;
+  Privpos := Buff;
+  while FBuffers.Count > 0 do
+  begin
+    Chunk := PMemChunk(FBuffers[0]);
+    ChunkPos := Chunk.data;
+    Inc(LongWord(ChunkPos), Chunk.Read);
+    // does the remaining part of the chunk fit into the buffer?
+    if PrivSize + (Chunk.Filled - Chunk.read) < ReqSize then
+    begin // yep, it fits
+      Move(ChunkPos^, Privpos^, Chunk.Filled - Chunk.read);
+      Inc(PrivSize, Chunk.Filled - Chunk.read);
+      FreeMem(Chunk.Data);
+      Dispose(Chunk);
+      FBuffers.Delete(0);
+    end
+    else // remaining part didn't fit, get as much as we can and increment the
+      // read attribute.
+    begin
+      Move(ChunkPos^, Privpos^, ReqSize - PrivSize);
+      Inc(Chunk.read, ReqSize - PrivSize);
+      Inc(PrivSize, ReqSize - PrivSize);
+      // as we filled the buffer, we'll have to break here.
+      break;
+    end;
+  end;
+  FBytesInFifo := GetBytesInFifo;
+  LeaveCriticalSection(FCritSect);
+  ReqSize := PrivSize;
+end;
+
+// read Data from Stream without removing it from the Stream...
+
+procedure TFifo.PeekData(Buff: pointer; var ReqSize: LongWord);
+var
+  PrivSize: Integer;
+  Privpos: pointer;
+  Chunk: PMemChunk;
+  ChunkPos: pointer;
+  ChunkNr: Integer;
+begin
+  if LongWord(Buff) = 0 then
+  begin
+    // null pointer? somebody is trying to fool us, get out...
+    Exit;
+  end;
+  EnterCriticalSection(FCritSect);
+  PrivSize := 0;
+  Privpos := Buff;
+  ChunkNr := 0;
+  while FBuffers.Count > ChunkNr do
+  begin
+    Chunk := PMemChunk(FBuffers[ChunkNr]);
+    ChunkPos := Chunk.data;
+    Inc(LongWord(ChunkPos), Chunk.Read);
+    // does the remaining part of the chunk fit into the buffer?
+    if PrivSize + (Chunk.Filled - Chunk.read) < ReqSize then
+    begin // yep, it fits
+      Move(ChunkPos^, Privpos^, Chunk.Filled - Chunk.read);
+      Inc(PrivSize, Chunk.Filled - Chunk.read);
+      Inc(ChunkNr);
+    end
+    else // remaining part didn't fit, get as much as we can and increment the
+      // read attribute.
+    begin
+      Move(ChunkPos^, Privpos^, ReqSize - PrivSize);
+      Inc(PrivSize, ReqSize - PrivSize);
+      // as we filled the buffer, we'll have to break here.
+      break;
+    end;
+  end;
+  LeaveCriticalSection(FCritSect);
+  ReqSize := PrivSize;
+end;
+
+end.