unit uROStreamUtils;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library                                      }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Provided by Nico Schoemaker (nico.schoemaker@teamro.remobjects.com)        }
{                                                                            }
{ Using this code requires a valid license of the RemObjects SDK             }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I RemObjects.inc}

interface

uses Classes, SysUtils;

// String support routines for streams

function  Strm_HasHeader(aHeader: String; aStream: TStream): Boolean;
function  Strm_PosFirst(aSubstr: string; aStream: TStream): Integer;
function  Strm_PosLast(aSubstr: string; aStream: TStream): Integer;
function  Strm_StrCount(aSubstr: string; aStream: TStream): Integer;
function  Strm_StrRangeCount(aSubstr: string; StartPos,EndPos: Integer; aStream: TStream): Integer;
function  Strm_StrAtPos(aSubstr: string; aPos: Integer; aStream: TStream): Boolean;
procedure Strm_InsertStr(aSubstr: string; aPos: Integer; aStream: TStream);
function  Strm_StreamToStr(aStream: TStream): String;
function  Strm_StreamRangeToStr(aStream: TStream; StartPos,EndPos: Integer): String;
function  Strm_ReadPattern(aStream: TStream;aStartTag,aEndTag,aSeperator: String): TStringList;

implementation

uses
  uROClasses;

function Strm_HasHeader(aHeader: String;aStream: TStream): Boolean;
var Buffer: Char;
    Cntr: Integer;
    BufferS: String;
    OldPos: Integer;
begin
  result := false;

  if aHeader = '' then
    Exit;
  if not(Assigned(aStream)) then
    Exit;
  if Length(aHeader) > aStream.Size then
    Exit;

  OldPos := aStream.Position;
  aStream.Position := 0;
  BufferS := '';

  // Read the first x bytes from the string and compare against the headertag
  for Cntr := 1 to Length(aHeader) do
  begin
    aStream.Read(Buffer,1);
    BufferS := BufferS + Buffer;
  end;
  result := BufferS = aHeader;

  aStream.Position := OldPos;
end;

function Strm_PosFirst(aSubstr: string; aStream: TStream): Integer;
var Buffer: Char;
    BufS:   String;
    i,x:    Integer;
    pos:    Integer;
    oldpos: Integer;
    lenS:   Integer;
begin
  result := -1;

  if aSubstr = '' then
    Exit;
  if not(Assigned(aStream)) then
    Exit;

  lenS := Length(aSubstr);

  if lenS > aStream.Size then
    Exit;

  oldpos := aStream.Position;
  aStream.Position := 0;
  pos := 0;

  for i := 0 to aStream.Size-1 do
  begin

    // Avoid reading beyond the stream size
    if (aStream.Position+lenS) > aStream.Size then
      Break;

    BufS := '';

    // Read x bytes at once into the buffer to make a compare
    for x := 1 to lenS do
    begin
      aStream.Read(Buffer,1);
      BufS := BufS + Buffer;
    end;

    if UpperCase(BufS) = UpperCase(aSubstr) then
    begin
      result := pos;
      break;
    end;

    inc(pos);
    aStream.Position := pos;
  end;

  aStream.Position := oldpos;
end;

function  Strm_PosLast(aSubstr: string; aStream: TStream): Integer;
var lenS:   Integer;
    spos:   Integer;
begin
  result := -1;

  if aSubstr = '' then
    Exit;
  if not(Assigned(aStream)) then
    Exit;

  lenS := Length(aSubstr);
  spos := Strm_PosFirst(aSubstr,aStream);

  if spos <> -1 then
  begin
    result := spos + lenS-1;
  end;
end;

function Strm_StrAtPos(aSubstr: string; aPos: Integer; aStream: TStream): Boolean;
var Buffer: Char;
    BufS: String;
    OldPos: Integer;
    i: Integer;
    lenS: Integer;
begin
  result := false;

  if not(Assigned(aStream)) then
    Exit;
  if aSubstr = '' then
    Exit;
  lenS := Length(aSubstr);
  if (aPos < 0) or ((aPos+lenS) > (aStream.Size)) then
    Exit;
  if lenS > aStream.Size then
    Exit;

  oldpos := aStream.Position;
  aStream.Position := aPos;

  for i := 1 to lenS do
  begin
    aStream.Read(Buffer,1);
    BufS := BufS + Buffer;
  end;

  result := UpperCase(BufS) = UpperCase(aSubstr);

  aStream.Position := OldPos;
end;

function Strm_StrCount(aSubstr: string; aStream: TStream): Integer;
var OldPos: Integer;
    i: Integer;
    lenS: Integer;
begin
  result := 0;

  if not(Assigned(aStream)) then
    Exit;
  if aSubstr = '' then
    Exit;
  lenS := Length(aSubstr);
  if lenS > aStream.Size then
    Exit;

  oldpos := aStream.Position;

  for i := 0 to aStream.Size-1 do
  begin
    if (aStream.Position+lenS) > (aStream.Size) then
      Break;

    aStream.Position := i;
    if Strm_StrAtPos(aSubstr, aStream.Position, aStream) then
      Inc(Result);
  end;

  aStream.Position := OldPos;
end;


function Strm_StrRangeCount(aSubstr: string; StartPos,EndPos: Integer; aStream: TStream): Integer;
var OldPos: Integer;
    i: Integer;
    lenS: Integer;
begin
  result := 0;

  if not(Assigned(aStream)) then
    Exit;
  if aSubstr = '' then
    Exit;

  lenS := Length(aSubstr);
  if lenS > aStream.Size then
    Exit;

  if (StartPos < 0) or ((StartPos+lenS) > (aStream.Size)) then
    Exit;
  if (EndPos < 0) or ((EndPos+lenS) > (aStream.Size)) then
    Exit;
  if (EndPos < StartPos) or (EndPos = StartPos) then
    Exit;
  if (StartPos+(lenS-1)) >= EndPos then
    Exit;

  oldpos := aStream.Position;

  for i := StartPos to EndPos do
  begin
    aStream.Position := i;
    if Strm_StrAtPos(aSubstr,i,aStream) then
      Inc(Result);
    if (i+(lenS-1)) > EndPos then
      Break;
  end;

  aStream.Position := OldPos;
end;

function  Strm_ReadPattern(aStream: TStream;aStartTag,aEndTag,aSeperator: String): TStringList;
var Buffer: Char;
    BufS: String;
    OldPos: Integer;
    lenST,PosST: Integer;
    lenET,PosET: Integer;
    lenSP: Integer;
begin
  result := TStringList.Create;

  if not(Assigned(aStream)) then
    Exit;

  if aStartTag = '' then
    Exit;
  if aEndTag = '' then
    Exit;
  if aSeperator = '' then
    Exit;


  oldpos := aStream.Position;
  lenST := Length(aStartTag);
  lenET := Length(aEndTag);
  lenSP := Length(aSeperator);

  PosST := Strm_PosFirst(aStartTag,aStream);
  if (PosST+lenST+lenSP+lenET) >= aStream.Size then
    Exit;

  PosET := Strm_PosFirst(aEndTag,aStream);
  if (PosET < PosST+lenST+lenSP) then
    Exit;

  // Start 1 byte after the starttag, include start of endtag
  aStream.Position := (PosST+lenST);
  BufS := '';
  while aStream.Position < PosET do
  begin
    if Strm_StrAtPos(aSeperator,aStream.Position,aStream) then
    begin
      // advance position 1 byte after the seperator
      aStream.Position := aStream.Position + lenSP;
      if BufS <> '' then
      begin
        Result.Add(BufS);
        BufS := '';
      end;
    end;

    if Strm_StrAtPos(aEndTag,aStream.Position,aStream) then
      Break;

    aStream.Read(Buffer,1);
    BufS := BufS + Buffer;
  end;


  aStream.Position := OldPos;
end;

function  Strm_StreamToStr(aStream: TStream): String;
var OldPos: Integer;
begin
  result := '';
  if not(Assigned(aStream)) then
    Exit;

  OldPos := aStream.Position;
  aStream.Position := 0;

  SetLength(result, aStream.Size);
  if (aStream.Size>0)
    then aStream.Read(result[1], aStream.Size);

  aStream.Position := OldPos;
end;

function  Strm_StreamRangeToStr(aStream: TStream; StartPos,EndPos: Integer): String;
var Buffer: Char;
    OldPos: Integer;
    i: Integer;
begin
  result := '';

  if not(Assigned(aStream)) then
    Exit;

  OldPos := aStream.Position;

  if (StartPos < 0) or (StartPos >= EndPos) then
    Exit;
  if (StartPos >= aStream.Size-1) or (EndPos > aStream.Size-1) then
    Exit;

  aStream.Position := 0;

  for i := StartPos to EndPos do
  begin
    aStream.Read(buffer,1);
    Result := Result + Buffer;
  end;

  aStream.Position := OldPos;
end;


procedure Strm_InsertStr(aSubstr: string; aPos: Integer; aStream: TStream);
var Buffer: Char;
    BufS: String;
    OldPos: Integer;
    i: Integer;
begin
  if not(Assigned(aStream)) then
    Exit;
  if aSubstr = '' then
    Exit;

  if (aPos > (aStream.Size-1)) then
    raise EROException.Create('Strm_InsertStr: invalid position '+IntToStr(aPos));

  oldpos := aStream.Position;
  BufS := Strm_StreamToStr(aStream);
  Insert(aSubstr,BufS,aPos+1);
  aStream.Position := 0;

  for i := 1 to Length(BufS) do
  begin
    buffer := BufS[i];
    aStream.Write(buffer,1);
  end;

  aStream.Position := OldPos;
end;

end.