summaryrefslogtreecommitdiff
path: root/tests/examplefiles/example.pas
diff options
context:
space:
mode:
Diffstat (limited to 'tests/examplefiles/example.pas')
-rw-r--r--tests/examplefiles/example.pas2708
1 files changed, 0 insertions, 2708 deletions
diff --git a/tests/examplefiles/example.pas b/tests/examplefiles/example.pas
deleted file mode 100644
index ab11ee67..00000000
--- a/tests/examplefiles/example.pas
+++ /dev/null
@@ -1,2708 +0,0 @@
-// 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.
View Lorry Controller Status