Softwarová Záchrana 3/Softwarova-zachrana-3.bin/ArsClip/source.zip/UnitTWideChar.pas

Pascal/Delphi Source File | 2003-07-30 | 5KB | 241 lines

unit UnitTWideChar;
{///////////////}
{//}interface{//}
{///////////////}

uses SysUtils, Classes;

type TWideChar = class(TObject)
    private
        ms : TMemoryStream;
    protected
        procedure PositionForAppend;
    public
        constructor Create;
        destructor Destroy; override;
        procedure Append(s : string); overload;
        procedure Append(wc : TWideChar); overload;
        procedure Append(GlobalH: THandle; size : cardinal); overload;

        procedure TrimLeft(chars : cardinal);
        procedure TrimRight(chars : cardinal);
        procedure LeftStr(len : cardinal);
        procedure RightStr(len : cardinal);
        procedure Replace(find : widechar; replace : widechar; removenulls : boolean = true);

        function GetMemoryStream : TMemoryStream;
        function Memory : Pointer;
        function size : int64;
        function StrLength : int64;

        procedure Clear;
end;

{////////////////////}
{//}implementation{//}
{////////////////////}

uses UnitMisc, Windows;

{ TWideChar }

procedure TWideChar.Append(s: string);
var pwc2 : PWideChar;
    c : Cardinal;
begin
    Windows.SetLastError(ERROR_SUCCESS);
    if s = '' then EXIT;

    c := (length(s) + 1) * 2; // include null space
    GetMem(pwc2, c);

    FillChar(pwc2^, c, #0);
    StringToWideChar(s, pwc2, c);

    self.PositionForAppend;
    ms.Write(pwc2^, c);

    FreeMem(pwc2);
end;

// NOT TESTED
procedure TWideChar.Append(wc: TWideChar);
begin
    if wc.Size = 0 then EXIT;

    self.PositionForAppend;
    self.ms.Write(wc.Memory^, wc.size);
end;

procedure TWideChar.Append(GlobalH: THandle; size : cardinal);
var pwc : PWideChar;
begin
    Windows.SetLastError(ERROR_SUCCESS);
    if size = 0 then EXIT;

    pwc := Windows.GlobalLock(GlobalH);
    if (pwc <> nil) then begin
        self.PositionForAppend;
        self.ms.write(pwc^, size);
        Windows.GlobalUnlock(GlobalH);
    end;
end;

constructor TWideChar.Create;
begin
    ms := TMemoryStream.Create;
end;

destructor TWideChar.Destroy;
begin
  MyFree(ms);
  inherited;
end;

function TWideChar.GetMemoryStream: TMemoryStream;
begin
    result := self.ms;
end;

function TWideChar.StrLength: int64;
begin
    result := trunc(ms.Size / 2);
end;

function TWideChar.Memory: Pointer;
begin
    result := ms.Memory;
end;

procedure TWideChar.PositionForAppend;
begin
    if ms.Size > 0 then begin
        ms.Seek(ms.Size - 2, soFromBeginning); // get rid of null terminator
    end else begin
        ms.Seek(0, soFromBeginning);
    end;
end;

function TWideChar.size: int64;
begin
    result := ms.Size;
end;

// NOT TESTED
procedure TWideChar.TrimLeft(chars: cardinal);
var ms2 : TMemoryStream;
    pwc : PWideChar;
    c : cardinal;
begin

    if (chars > ms.Size) then begin
        ms.Clear;
    end else begin
        ms2 := TMemoryStream.Create;
        c := ms.size - (chars * 2);
        GetMem(pwc, c);
        ms.Seek(chars * 2, soFromBeginning);
        ms.Read(pwc^, c);
        ms2.Write(pwc^, c);

        MyFree(ms);
        ms := ms2;
    end;
end;

// NOT TESTED
procedure TWideChar.TrimRight(chars: cardinal);
var ms2 : TMemoryStream;
    pwc : PWideChar;
    c : cardinal;
    w : word;
begin
    chars := chars * 2;
    if (chars = ms.Size) then begin
        ms.Clear;
    end else if (chars < ms.Size) then begin
        ms2 := TMemoryStream.Create;
        c := ms.size - chars;
        GetMem(pwc, c);
        ms.Seek(0, soFromBeginning);
        ms.Read(pwc^, c);
        ms2.Write(pwc^, c);
        w := 0; // write null terminator
        ms2.Write(w,2);

        MyFree(ms);
        ms := ms2;
    end;

end;


procedure TWideChar.LeftStr(len: cardinal);
var ms2 : TMemoryStream;
    w : word;
begin
    len := len * 2;
    if (ms.Size - 2) > len then begin
        ms2 := TMemoryStream.Create;
        ms2.Write(ms.Memory^, len);
        w := 0;
        ms2.write(w, 2);
        MyFree(ms);
        ms := ms2;
    end;
end;

// NOT TESTED
procedure TWideChar.RightStr(len: cardinal);
var ms2 : TMemoryStream;
    pwc : PWideChar;
    w : word;
begin
    len := len * 2;
    if ms.Size > len then begin
        ms2 := TMemoryStream.Create;
        GetMem(pwc, len);
        ms.Seek((ms.size - len) - 2, soFromBeginning); // don't include null

        ms2.Write(ms.Memory^, len);
        w := 0;
        ms2.write(w, 2); // write null

        MyFree(ms);
        FreeMem(pwc);
        ms := ms2;
    end;
end;

procedure TWideChar.Replace(find: widechar; replace: widechar; removenulls : boolean = true);
var i : integer;
    w : word;
    ms2 : TMemoryStream;
begin
    ms.Seek(0, soFromBeginning);
    ms2 := TMemoryStream.Create;
    for i := 0 to trunc((ms.Size-1) / 2)  do begin
        ms.read(w, 2);
        if WideChar(w) <> find {little endian} then begin
            ms2.Write(w, 2);
        end else begin
            if (replace <> #0) or (not removenulls) then begin
                ms2.Write(replace, 2)
            end;
        end;
    end;
    ms.Clear;
    MyFree(ms);
    ms := ms2;

    ms.Seek(0, soFromEnd);
end;

procedure TWideChar.Clear;
begin
    self.Append(' ');
    if ms.Size <> 0 then ms.Clear;
end;

end.