gptextfile.pas

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

      Inc(pwc);
      Dec(leftUTF8);
    end
    else if (ch AND $E0) = $C0 then begin // 2-byte code
      if leftUTF8 < 2 then
        break;
      c1 := byte(pch^);
      Inc(pch);
      word(pwc^) := (word(ch AND $1F) SHL 6) OR (c1 AND $3F);
      Inc(pwc);
      Dec(leftUTF8,2);
    end
    else begin // 3-byte code
      if leftUTF8 < 3 then
        break;
      c1 := byte(pch^);
      Inc(pch);
      c2 := byte(pch^);
      Inc(pch);
      word(pwc^) :=
        (word(ch AND $0F) SHL 12) OR
        (word(c1 AND $3F) SHL 6) OR
        (c2 AND $3F);
      Inc(pwc);
      Dec(leftUTF8,3);
    end;
  end; //while
  Result := integer(pwc)-integer(@unicodeBuf);
end; { UTF8BufToWideCharBuf }

{:Returns default Ansi codepage for LangID or 'defCP' in case of error (LangID
  does not specify valid language ID).
  @param   LangID Language ID.
  @param   defCP  Default value that is to be returned if LangID doesn't specify
                  a valid language ID.
  @returns Default Ansi codepage for LangID or 'defCP' in case of error.
}
function GetDefaultAnsiCodepage (LangID: LCID; defCP: integer): word;
var
  p: array [0..255] of char;
begin
  if GetLocaleInfo(LangID, 4100, p, High (p)) > 0 then
    Result := StrToIntDef(p, defCP)
  else
    Result := defCP;
end; { GetDefaultAnsiCodepage }

{ TGpTextFile }

{:Allocates buffer for 8/16/8 bit conversions. If requested size is small
  enough, returns pre-allocated buffer, otherwise allocates new buffer.
  @param   size Requested size in bytes.
  @returns Pointer to buffer.
}
function TGpTextFile.AllocTmpBuffer(size: integer): pointer;
begin
  if size <= CtsSmallBufSize then
    Result := tfSmallBuf
  else
    GetMem(Result,size);
end; { TGpTextFile.AllocTmpBuffer }

{:Convert tfReadlnBuf from (including) tfReadlnBufPos to (not including)
  delimPos and append result to wideLn or utf8ln. Set tfReadlnBufPos to the
  first character after delimiter.
  @since   2002-10-11
}
procedure TGpTextFile.ConvertCodepage(delimPos, delimLen: cardinal;
  var utf8ln: AnsiString; var wideLn: WideString);
var
  bufPtr  : PByte;
  delimPtr: PByte;
  lResult : cardinal;
begin
  if tfReadlnBufPos < delimPos then
    if IsUnicode then begin
      if Codepage = CP_UTF8 then begin
        lResult := length(utf8Ln);
        SetLength(utf8Ln, lResult + (delimPos-tfReadlnBufPos));
        Move(tfReadlnBuf[tfReadlnBufPos], utf8Ln[lResult+1], delimPos-tfReadlnBufPos);
      end
      else if Codepage = CP_UNICODE32 then begin
        lResult := Length(wideLn);
        SetLength(wideLn, lResult + (delimPos-tfReadlnBufPos+1) div (SizeOf(WideChar)*2));
        bufPtr := @tfReadlnBuf[tfReadlnBufPos];
        delimPtr := @tfReadlnBuf[delimPos];
        while cardinal(bufPtr) < cardinal(delimPtr) do begin
          Inc(lResult);
          wideLn[lResult] := PWideChar(bufPtr)^;
          Inc(bufPtr, 4);
        end;
      end
      else begin
        lResult := Length(wideLn);
        SetLength(wideLn, lResult + (delimPos-tfReadlnBufPos+1) div SizeOf(WideChar));
        Move(tfReadlnBuf[tfReadlnBufPos], wideLn[lResult+1], delimPos-tfReadlnBufPos);
      end;
    end
    else begin
      if tfNo8BitCPConversion then
        StringToWideStringNoCP(tfReadlnBuf[tfReadlnBufPos], delimPos-tfReadlnBufPos, wideLn)
      else
        StringToWideString(tfReadlnBuf[tfReadlnBufPos], delimPos-tfReadlnBufPos, tfCodePage, wideLn);
    end;
  tfReadlnBufPos := delimPos + delimLen;
end; { TGpTextFile.ConvertCodepage }

{:Prefetch next block from the file.
  @since   2002-10-11
}
procedure TGpTextFile.FetchBlock(out endOfFile: boolean);
var
  overshoot: cardinal;
begin
  if tfReadlnBufSize = 0 then begin
    BlockRead(tfReadlnBuf, SizeOf(tfReadlnBuf), tfReadlnBufSize);
    if tfReadlnBufSize > (SizeOf(tfReadlnBuf)-6) then
      tfOverRead := tfReadlnBufSize - (SizeOf(tfReadlnBuf)-6)
    else
      tfOverRead := 0;
    overshoot := 0;
  end
  else if tfReadlnBufSize < (SizeOf(tfReadlnBuf)-6) then begin
    endOfFile := true;
    tfReadlnBufSize := 0;
    Exit;
  end
  else begin
    overshoot := tfReadlnBufPos - (High(tfReadlnBuf)-5);
    if not (cfReverseByteOrder in tfCFlags) then begin
      PDWord(@tfReadlnBuf[1])^ := PDWord(@tfReadlnBuf[tfReadlnBufSize+1])^;
      PWord(@tfReadlnBuf[5])^ := PWord(@tfReadlnBuf[tfReadlnBufSize+5])^;
    end
    else begin
      tfReadlnBuf[1] := tfReadlnBuf[tfReadlnBufSize+2];
      tfReadlnBuf[2] := tfReadlnBuf[tfReadlnBufSize+1];
      tfReadlnBuf[3] := tfReadlnBuf[tfReadlnBufSize+4];
      tfReadlnBuf[4] := tfReadlnBuf[tfReadlnBufSize+3];
      tfReadlnBuf[5] := tfReadlnBuf[tfReadlnBufSize+6];
      tfReadlnBuf[6] := tfReadlnBuf[tfReadlnBufSize+5];
    end;
    if tfOverRead < 6 then begin
      tfReadlnBufSize := tfOverRead;
      tfOverRead := 0;
    end
    else begin
      BlockRead(tfReadlnBuf[7], SizeOf(tfReadlnBuf)-6, tfReadlnBufSize);
      Inc(tfReadlnBufSize, 6);
      if tfReadlnBufSize > (SizeOf(tfReadlnBuf)-6) then
        tfOverRead := tfReadlnBufSize - (SizeOf(tfReadlnBuf)-6)
      else
        tfOverRead := 0;
    end;
  end;
  if cfReverseByteOrder in tfCFlags then
    ReverseBlock;
  endOfFile := (tfReadlnBufSize < (SizeOf(tfReadlnBuf)-6));
  // simplify LocateDelimiter
  if not endOfFile then begin
    if tfReadlnBufSize > (SizeOf(tfReadlnBuf)-6) then
      tfReadlnBufSize := (SizeOf(tfReadlnBuf)-6);
  end
  else begin
    tfReadlnBuf[tfReadlnBufSize+1] := 0;
    tfReadlnBuf[tfReadlnBufSize+2] := 0;
    tfReadlnBuf[tfReadlnBufSize+3] := 0;
    tfReadlnBuf[tfReadlnBufSize+4] := 0;
    tfReadlnBuf[tfReadlnBufSize+5] := 0;
    tfReadlnBuf[tfReadlnBufSize+6] := 0;
  end;
  tfReadlnBufPos := Low(tfReadlnBuf) + overshoot;
end; { TGpTextFile.FetchBlock }

{:Frees buffer for 8/16/8 bit conversions. If pre-allocated buffer is passed,
  nothing will be done.
  @param   buffer Conversion buffer.
}
procedure TGpTextFile.FreeTmpBuffer(var buffer: pointer);
begin
  if buffer <> tfSmallBuf then begin
    FreeMem(buffer);
    buffer := nil;
  end;
end; { TGpTextFile.FreeTmpBuffer }

{:Simplest form of Append.
  @param   flags      Create flags. Only cfUse2028, cfUseLF, and cfUnicode flags are used.
  @param   bufferSize Size of buffer. 0 means default size (BUF_SIZE, currently
                      64 KB).
  @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 appended.
}
procedure TGpTextFile.Append(flags: TCreateFlags; bufferSize: integer;
  codePage: word);
begin
  if AppendSafe(flags,bufferSize,0,0,0,codePage) <> hfOK then
    raise EGpTextFile.CreateFmtHelp(sFailedToAppendFile,[FileName],hcTFFailedToAppend);
end; { TGpTextFile.Append }

{:Full form of Append. 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 (except appending
  reversed Unicode file).
  @param   flags           Create flags. Only cfUse2028, cfUseLF, and cfUnicode flags are
                           used.
  @param   bufferSize      Size of buffer. 0 means default size (BUF_SIZE,
                           currently 64 KB).
  @param   diskLockTimeout Max time (in milliseconds) AppendSafe will wait for
                           locked 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, AppendSafe 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  EGpTextFile if file is 'reversed' Unicode file.
}

function TGpTextFile.AppendSafe(flags: TCreateFlags; bufferSize: integer;
  diskLockTimeout, diskRetryDelay: integer; waitObject: THandle;
  codePage: word): THFError;
var
  marker : WideChar;
  marker3: AnsiChar;
  marker4: UCS4Char;
  options: THFOpenOptions;
begin
  try
    if (cfUnicode in flags) and (codePage <> CP_UTF8) and (codePage <> CP_UNICODE32) then
      codePage := CP_UNICODE;
    PrepareBuffer;
    SetCodepage(codePage);
    options := [hfoBuffered, hfoCanCreate];
    if cfCompressed in flags then
      Include(options, hfoCompressed);
    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;
      end
      else if (FileSize = 0) and (cfUnicode in flags) then begin
        if Codepage = CP_UNICODE32 then
          BlockWriteUnsafe(CUnicode32Normal, SizeOf(UCS4Char))
        else if Codepage <> CP_UTF8 then
          BlockWriteUnsafe(CUnicodeNormal, SizeOf(WideChar))
        else if cfWriteUTF8BOM in flags then begin
          BlockWriteUnsafe(CUTF8BOM12, SizeOf(WideChar));
          BlockWriteUnsafe(CUTF8BOM3, SizeOf(AnsiChar));
        end;
      end;
      if (not IsUnicode) and IsUnicodeCodepage(Codepage) then
        tfCFlags := tfCFlags + [cfUnicode];
      if [cfUnicode, cfReverseByteOrder] <= tfCFlags then
        raise EGpTextFile.CreateFmtHelp(sCannotAppendReversedUnicodeFile, [FileName],
          hcTFCannotAppendReversed);
      tfCFlags := tfCFlags + (flags * [cfUse2028, cfUseLF]);
      RebuildNewline;
      Seek(FileSize);
    end;
  except
    on EGpTextFile do
      raise;
    on Exception do
      Result := hfError;
  end;
end; { TGpTextFile.Append }

{:Cleanup.
  @since   2.01
}
destructor TGpTextFile.Destroy;
begin
  if assigned(tfSmallBuf) then begin
    FreeMem(tfSmallBuf);
    tfSmallBuf := nil;
  end;
  inherited;
end; { TGpTextFile.Destroy }

{:Checks if file pointer is at end of file.
  @returns True if file pointer is at end of file.
  @raises  EGpHugeFile on Windows errors.
}
function TGpTextFile.EOF: boolean;
begin
  Result := IsAfterEndOfBlock and (FilePos >= FileSize);
end; { TGpTextFile.Eof }

{:Checks if file is 16-bit Unicode.
  @since   2.01
}
function TGpTextFile.Is16bit: boolean;
begin
  Result := IsUnicode and (Codepage = CP_UNICODE);
end; { TGpTextFile.Is16bit }

{:Checks if file is 32-bit Unicode.
  @since   2000-10-12
}
function TGpTextFile.Is32bit: boolean;
begin
  Result := IsUnicode and (Codepage = CP_UNICODE32);
end; { TGpTextFile.Is32bit }

{:Checks if readln buffer pointer is positioned after end of block.
  @since   2002-10-15
}
function TGpTextFile.IsAfterEndOfBlock: boolean;
begin
  Result := (tfReadlnBufPos > tfReadlnBufSize) or (tfReadlnBufSize = 0);
end; { TGpTextFile.IsAfterEndOfBlock }

{:Checks if file is Unicode (UCS-2 or UTF-8 encoding).