gptextfile.pas

Advanced Data Import Component Suite for Borland Delphi and C++ Builder allows you to import your da

  @returns True if file is Unicode.
}
function TGpTextFile.IsUnicode: boolean;
begin
  Result := (cfUnicode in tfCFlags);
end; { TGpTextFile.IsUnicode }

{:Checks if codepage is one of supported Unicode codepages.
  @since   2006-02-06
}
function TGpTextFile.IsUnicodeCodepage(codepage: word): boolean;
begin
  Result := (codepage = CP_UTF8) or (codepage = CP_UNICODE) or (codepage = CP_UNICODE32);
end; { TGpTextFile.IsUnicodeCodepage }

{:Locate next delimiter (starting from tfReadlnBufPos) and return its position
  and size. If delimiter is not found, return tfReadlnBufSize+1 and 0.
  @since   2002-10-11
}
procedure TGpTextFile.LocateDelimiter(var delimPos, delimLen: cardinal);
var
  i  : cardinal;
  pb0: PByte;
  pb1: PByte;
  pb2: PByte;
  pb3: PByte;
  pb4: PByte;
  pb5: PByte;
  pb6: PByte;
  pb7: PByte;
begin
  delimPos := tfReadlnBufSize+1;
  delimLen := 0;
  pb0 := @tfReadlnBuf[tfReadlnBufPos];
  pb1 := pb0; Inc(pb1, 1);
  if IsUnicode and (Codepage = CP_UNICODE) then begin
    pb2 := pb0; Inc(pb2, 2);
    pb3 := pb0; Inc(pb3, 3);
    for i := 0 to (tfReadlnBufSize-tfReadlnBufPos) div 2 do begin
      if ((AcceptedDelimiters = []) or (ld000D000A in AcceptedDelimiters)) and
         ((pb0^ = $0D) and (pb1^ = $00) and
          (pb2^ = $0A) and (pb3^ = $00)) then
      begin
        delimPos := tfReadlnBufPos+2*i;
        delimLen := 4;
        break; //for i
      end
      else if ((AcceptedDelimiters = []) or (ld2028 in AcceptedDelimiters)) and
              ((pb0^ = $28) and (pb1^ = $20)) then
      begin
        delimPos := tfReadlnBufPos+2*i;
        delimLen := 2;
        break; //for i
      end;
      Inc(pb0, 2);
      Inc(pb1, 2);
      Inc(pb2, 2);
      Inc(pb3, 2);
    end; //for
  end
  else if IsUnicode and (Codepage = CP_UNICODE32) then begin
    pb2 := pb0; Inc(pb2, 2);
    pb3 := pb0; Inc(pb3, 3);
    pb4 := pb0; Inc(pb4, 4);
    pb5 := pb0; Inc(pb5, 5);
    pb6 := pb0; Inc(pb6, 6);
    pb7 := pb0; Inc(pb7, 7);
    for i := 0 to (tfReadlnBufSize-tfReadlnBufPos) div 2 do begin
      if ((AcceptedDelimiters = []) or (ld000D000A in AcceptedDelimiters)) and
         ((pb0^ = $0D) and (pb1^ = $00) and (pb2^ = $00) and(pb3^ = $00) and
          (pb4^ = $0A) and (pb5^ = $00) and (pb6^ = $00) and (pb7^ = $00)) then
      begin
        delimPos := tfReadlnBufPos+2*i;
        delimLen := 8;
        break; //for i
      end
      else if ((AcceptedDelimiters = []) or (ld2028 in AcceptedDelimiters)) and
              ((pb0^ = $28) and (pb1^ = $20) and (pb3^ = $00) and (pb4^ = $00)) then
      begin
        delimPos := tfReadlnBufPos+2*i;
        delimLen := 4;
        break; //for i
      end;
      Inc(pb0, 2);
      Inc(pb1, 2);
      Inc(pb2, 2);
      Inc(pb3, 2);
      Inc(pb4, 2);
      Inc(pb5, 2);
      Inc(pb6, 2);
      Inc(pb7, 2);
    end; //for
  end
  else begin
    for i := tfReadlnBufPos to tfReadlnBufSize do begin
      if ((AcceptedDelimiters = []) or (ldCRLF in AcceptedDelimiters)) and
         ((pb0^ = $0D) and (pb1^ = $0A)) then
      begin
        delimPos := i;
        delimLen := 2;
        break; //for i
      end
      else if ((AcceptedDelimiters = []) or (ldLFCR in AcceptedDelimiters)) and
               ((pb0^ = $0A) and (pb1^ = $0D)) then
      begin
        delimPos := i;
        delimLen := 2;
        break; //for i
      end
      else if (((AcceptedDelimiters = []) or (ldCR in AcceptedDelimiters)) and (pb0^ = $0D)) or
              (((AcceptedDelimiters = []) or (ldLF in AcceptedDelimiters)) and (pb0^ = $0A)) then
      begin
        delimPos := i;
        delimLen := 1;
        break; //for i
      end;
      Inc(pb0);
      Inc(pb1);
    end; //for
  end;
end; { TGpTextFile.LocateDelimiter }

{:Allocates small buffer if not already allocated.
  @since   2.01
}
procedure TGpTextFile.PrepareBuffer;
begin
  if not assigned(tfSmallBuf) then
    GetMem(tfSmallBuf,CtsSmallBufSize);
  tfReadlnBufPos := 0;
  tfReadlnBufSize := 0;    
end; { TGpTextFile.PrepareBuffer }

{:Create EOL string according to current flags.
  @since   2002-10-11
}        
procedure TGpTextFile.RebuildNewline;
begin
  if IsUnicode then begin
    if Codepage = CP_UTF8 then begin
      if cfUse2028 in tfCFlags then begin
        tfLineDelimiterSize := 3;
        // $2028 in UTF8 encoding
        tfLineDelimiter[0] := $E2;
        tfLineDelimiter[1] := $80;
        tfLineDelimiter[2] := $A8;
      end
      else begin
        tfLineDelimiterSize := 2;
        tfLineDelimiter[0] := $0D;
        tfLineDelimiter[1] := $0A;
      end;
    end
    else if Codepage = CP_UNICODE32 then begin
      if cfUse2028 in tfCFlags then begin
        tfLineDelimiterSize := 4;
        tfLineDelimiter[0] := $28;
        tfLineDelimiter[1] := $20;
        tfLineDelimiter[2] := $00;
        tfLineDelimiter[3] := $00;
      end
      else begin
        tfLineDelimiterSize := 8;
        tfLineDelimiter[0] := $0D;
        tfLineDelimiter[1] := $00;
        tfLineDelimiter[2] := $00;
        tfLineDelimiter[3] := $00;
        tfLineDelimiter[4] := $0A;
        tfLineDelimiter[5] := $00;
        tfLineDelimiter[6] := $00;
        tfLineDelimiter[7] := $00;
      end;
    end
    else begin
      if cfUse2028 in tfCFlags then begin
        tfLineDelimiterSize := 2;
        tfLineDelimiter[0] := $28;
        tfLineDelimiter[1] := $20;
      end
      else begin
        tfLineDelimiterSize := 4;
        tfLineDelimiter[0] := $0D;
        tfLineDelimiter[1] := $00;
        tfLineDelimiter[2] := $0A;
        tfLineDelimiter[3] := $00;
      end;
    end;
  end
  else begin
    if cfUseLF in tfCFlags then begin
      tfLineDelimiterSize := 1;
      tfLineDelimiter[0] := $0D;
    end
    else begin
      tfLineDelimiterSize := 2;
      tfLineDelimiter[0] := $0D;
      tfLineDelimiter[1] := $0A;
    end
  end;
end; { TGpTextFile.RebuildNewline }

{:Reads line from file. If file is 8-bit, LF, CR, CRLF, and LFCR are considered
  end-of-line terminators (if included in AcceptedDelimiters).
  If file is 16-bit, both /000D/000A/ and /2028/ are considered end-of-line terminators
  (if included in AcceptedDelimiters).
  If file is 8-bit, line is converted to Unicode according to code page specified in
  Append, Reset or Rewrite.
  If file is 32-bit, high-end word of each character is stripped away.
  @returns Line without terminator characters.
  @raises  EGpHugeFile on Windows errors.
  @seeAlso Append, Reset, Rewrite
}
function TGpTextFile.Readln: WideString;
var
  delimLen: cardinal;
  delimPos: cardinal;
  leftUtf8: integer;
  uniBytes: integer;
  utf8Ln  : AnsiString;
begin
  try
    if Codepage = CP_UTF8 then
      utf8Ln := ''
    else
      Result := '';
    repeat
      if IsAfterEndOfBlock then
        FetchBlock(tfLeof);
      if tfReadlnBufSize = 0 then
        break; //repeat
      LocateDelimiter(delimPos, delimLen);
      ConvertCodepage(delimPos, delimLen, utf8ln, Result);
    until tfLeof or (delimLen > 0);
    if Codepage = CP_UTF8 then begin
      if utf8Ln = '' then
        Result := ''
      else begin
        SetLength(Result, Length(utf8Ln)); // worst case
        uniBytes := UTF8BufToWideCharBuf(utf8Ln[1], Length(utf8Ln), Result[1], leftUtf8);
        SetLength(Result, uniBytes div SizeOf(WideChar));
      end;
    end;
  except
    on E: EGpTextFile do raise;
    on E: EGpHugeFile do raise;
    on E: Exception   do raise EGpTextFile.CreateHelp(E.Message, hcTFUnexpected);
  end;
end; { TGpTextFile.Readln }

{:Simplest form of Reset.
  @param   bufferSize Size of buffer. 0 means default size (BUF_SIZE, currently
                      64 KB).
  @param   flags      Open flags. 
  @param   codePage   Code page to be used for 8/16/8 bit conversion. If 0,
                      default code page for currently used language will be
                      used.
  @raises  EGpTextFile if file could not be reset.
}
procedure TGpTextFile.Reset(flags: TOpenFlags; bufferSize: integer;
  codePage: word);
begin
  if ResetSafe(flags,bufferSize,0,0,0,codePage) <> hfOK then
    raise EGpTextFile.CreateFmtHelp(sFailedToResetFile,[FileName],hcTFFailedToReset);
end; { TGpTextFile.Reset }

{:Full form of Reset. Will retry if file is locked by another application (if
  diskLockTimeout and diskRetryDelay are specified). Allows caller to specify
  additional options. Does not raise an exception on error.
  @param   flags           Open flags.
  @param   bufferSize      Size of buffer. 0 means default size (BUF_SIZE,
                           currently 64 KB).
  @param   diskLockTimeout Max time (in milliseconds) Reset will wait for lock
                           file to become free.
  @param   diskRetryDelay  Delay (in milliseconds) between attempts to open
                           locked file.
  @param   waitObject      Handle of 'terminate' event (semaphore, mutex). If
                           this parameter is specified (not zero) and becomes
                           signalled, Reset will stop trying to open locked file
                           and will exit with.
  @param   codePage        Code page to be used for 8/16/8 bit conversion. If 0,
                           default code page for currently used language will be
                           used.
  @raises  EGpHugeFile on Windows errors.
}
function TGpTextFile.ResetSafe(flags: TOpenFlags; bufferSize: integer;
  diskLockTimeout, diskRetryDelay: integer; waitObject: THandle;
  codePage: word): THFError;
var
  marker : WideChar;
  marker3: AnsiChar;
  marker4: UCS4Char;
  options: THFOpenOptions;
begin
  try
    SetCodepage(codePage);
    PrepareBuffer;
    options := [hfoBuffered];
    if ofCloseOnEOF in flags then
      options := options + [hfoCloseOnEOF];
    tfNo8BitCPConversion := ofNo8BitCPConversion in flags;
    Result := ResetEx(1, bufferSize, diskLockTimeout, diskRetryDelay, options, waitObject);
    if Result = hfOK then begin
      tfCFlags := [];
      if FileSize >= SizeOf(UCS4Char) then begin
        Seek(0);
        BlockReadUnsafe(marker4, SizeOf(UCS4Char));
        if marker4 = CUnicode32Normal then
          SetCodepage(CP_UNICODE32)
        else if marker4 = CUnicode32Reversed then begin
          SetCodepage(CP_UNICODE32);
          tfCFlags := tfCFlags + [cfReverseByteOrder];
        end;
      end;
      if (FileSize >= SizeOf(WideChar)) and (Codepage <> CP_UNICODE32) then begin
        Seek(0);
        BlockReadUnsafe(marker,SizeOf(WideChar));
        if marker = CUnicodeNormal then
          SetCodepage(CP_UNICODE)
        else if marker = CUnicodeReversed then begin
          SetCodepage(CP_UNICODE);
          tfCFlags := tfCFlags + [cfReverseByteOrder];
        end
        else if (marker = CUTF8BOM12) and (FileSize >= 3) then begin
          BlockReadUnsafe(marker3,SizeOf(AnsiChar));
          if marker3 = CUTF8BOM3 then
            SetCodepage(CP_UTF8);
        end;
        if not IsUnicode then
          Seek(0);
      end;
      if (not IsUnicode) and IsUnicodeCodepage(Codepage) then
        tfCFlags := tfCFlags + [cfUnicode];
      RebuildNewline;
    end;
  except
    Result := hfError;
  end;
end; { TGpTextFile.ResetSafe }

{:Reverse prefetched block if file is in Motorola format.
  @since   2002-10-11