gptextfile.pas

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

}
procedure TGpTextFile.ReverseBlock;
var
  i  : cardinal;
  pb : PByte;
  pb1: PByte;
  tmp: byte;
begin
  pb := @tfReadlnBuf[1];
  pb1 := pb;
  Inc(pb1);
  for i := 1 to tfReadlnBufSize div 2 do begin
    tmp := pb^;
    pb^ := pb1^;
    pb1^ := tmp;
    Inc(pb, 2);
    Inc(pb1, 2);
  end; //for
end; { TGpTextFile.ReverseBlock }

{:Simplest form of Rewrite.
  @param   flags      Create flags. 
  @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.Rewrite(flags: TCreateFlags; bufferSize: integer;
  codePage: word);
begin
  if RewriteSafe(flags,bufferSize,0,0,0,codePage) <> hfOK then
    raise EGpTextFile.CreateFmtHelp(sFailedToRewriteFile,[FileName],hcTFFailedToRewrite);
end; { TGpTextFile.Rewrite }

{:Full form of Rewrite. 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           Create flags.
  @param   bufferSize      Size of buffer. 0 means default size (BUF_SIZE,
                           currently 64 KB).
  @param   diskLockTimeout Max time (in milliseconds) Rewrite 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, Rewrite 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.
  @raises  EGpHugeFile on Windows errors.
}
function TGpTextFile.RewriteSafe(flags: TCreateFlags; bufferSize: integer;
  diskLockTimeout, diskRetryDelay: integer; waitObject: THandle;
  codePage: word): THFError;
var
  options: THFOpenOptions;
begin
  if (cfUnicode in flags) and (codePage <> CP_UTF8) and (codePage <> CP_UNICODE32) then
    codePage := CP_UNICODE;
  PrepareBuffer;
  if IsUnicodeCodepage(Codepage) then 
    flags := flags + [cfUnicode];    
  if flags * [cfUnicode, cfReverseByteOrder] = [cfUnicode, cfReverseByteOrder] then
    raise EGpTextFile.CreateFmtHelp(sCannotWriteReversedUnicodeFile, [FileName], hcTFCannotWriteReversed);
  tfNo8BitCPConversion := cfNo8BitCPConversion in flags;
  try
    SetCodepage(codePage);
    options := [hfoBuffered];
    if cfCompressed in flags then
      Include(options,hfoCompressed);
    Result := RewriteEx(1, bufferSize, diskLockTimeout, diskRetryDelay, options, waitObject);
    if Result = hfOK then begin
      Truncate;
      tfCFlags := flags;
      if IsUnicode 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;
      RebuildNewline;
    end;
  except
    Result := hfError;
  end;
end; { TGpTextFile.RewriteSafe }

{:Internal method that sets current code page or locates default code page if
  0 is passed as a parameter.
  @param   cp Code page number or 0 for default code page.
}
procedure TGpTextFile.SetCodepage(cp: word);
begin
  if IsUnicodeCodepage(cp) then begin
    tfCodePage := cp;
    tfCFlags := tfCFlags + [cfUnicode];
  end
  else begin
    if (cp = 0) and (not IsUnicode) then
      tfCodePage := GetDefaultAnsiCodepage(GetSystemDefaultLCID and $FFFF, 1252)
    else
      tfCodePage := cp;                   
    if not ((tfCodePage = 0) or IsUnicodeCodepage(tfCodePage)) then
      tfCFlags := tfCFlags - [cfUnicode];
  end;
  RebuildNewline;
end; { TGpTextFile.SetCodepage }

{:Writes string to the text file.
  If file is 8-bit, string is converted according to Codepage property.
  If file is 32-bit, high-end word of each char is set to 0.
  @param   ws String to be written.
  @raises  EGpHugeFile on Windows errors.
}
procedure TGpTextFile.WriteString(ws: WideString);
var
  ansiLn  : AnsiString;
  numBytes: integer;
  numChar : integer;
  tmpBuf  : pointer;
  tmpPtr  : PByte;
begin
  if ws = '' then
    Exit;
  if IsUnicode then begin
    if Codepage = CP_UTF8 then begin
      numChar := Length(ws);
      tmpBuf := AllocTmpBuffer(numChar*3); // worst case - 3 bytes per character
      try
        numBytes := WideCharBufToUTF8Buf(ws[1], Length(ws)*SizeOf(WideChar), tmpBuf^);
        BlockWriteUnsafe(tmpBuf^, numBytes);
      finally FreeTmpBuffer(tmpBuf); end;
    end
    else if codepage = CP_UNICODE32 then begin
      numBytes := Length(ws)*SizeOf(WideChar)*2;
      tmpBuf := AllocTmpBuffer(numBytes);
      try
        tmpPtr := tmpBuf;
        for numChar := 1 to Length(ws) do begin
          PWideChar(tmpPtr)^ := ws[numChar];
          Inc(tmpPtr, SizeOf(WideChar));
          PWideChar(tmpPtr)^ := #0;
          Inc(tmpPtr, SizeOf(WideChar));
        end;
        BlockWriteUnsafe(tmpBuf^, numBytes);
      finally FreeTmpBuffer(tmpBuf); end;
    end
    else
      BlockWriteUnsafe(ws[1], Length(ws)*SizeOf(WideChar))
  end
  else begin
    if tfNo8BitCPConversion then
      ansiLn := WideStringToStringNoCP(ws)
    else
      ansiLn := WideStringToString(ws, tfCodePage);
    BlockWriteUnsafe(ansiLn[1], Length(ansiLn));
  end;
end; { TGpTextFile.WriteString }

{:Writes array of values to the text file. If file is 8-bit, values are
  converted according to Codepage property.
  @param   Values.
  @raises  EGpTextFile on unsupported parameter.
  @raises  EGpHugeFile on Windows errors.
}
procedure TGpTextFile.Write(params: array of const);
var
  i     : integer;
  wideLn: WideString;
const
  BoolChars: array [boolean] of char = ('F','T');
begin
  try
    wideLn := '';
    for i := 0 to High(params) do begin
      with params[i] do begin
        case VType of
          vtInteger:    wideLn := wideLn + IntToStr(VInteger);
          vtBoolean:    wideLn := wideLn + BoolChars[VBoolean];
          vtChar:                          StringToWideString(VChar, tfCodePage, wideLn);
          vtExtended:                      StringToWideString({$IFDEF VCL12}AnsiString{$ENDIF}(FloatToStr(VExtended^)), tfCodePage, wideLn);
          vtString:                        StringToWideString(VString^, tfCodePage, wideLn);
          vtPointer:    wideLn := wideLn + IntToHex(integer(VPointer),8);
          vtPChar:                         StringToWideString(VPChar, tfCodePage, wideLn);
          vtObject:                        StringToWideString({$IFDEF VCL12}AnsiString{$ENDIF}(VObject.ClassName), tfCodePage, wideLn);
          vtClass:                         StringToWideString({$IFDEF VCL12}AnsiString{$ENDIF}(VClass.ClassName), tfCodePage, wideLn);
          vtWideChar:   wideLn := wideLn + VWideChar;
          vtPWideChar:  wideLn := wideLn + VPWideChar^;
          vtAnsiString:                    StringToWideString(AnsiString(VAnsiString), tfCodePage, wideLn);
          vtCurrency:                      StringToWideString({$IFDEF VCL12}AnsiString{$ENDIF}(CurrToStr(VCurrency^)), tfCodePage, wideLn);
          vtVariant:                       StringToWideString(AnsiString(VVariant^), tfCodePage, wideLn);
          vtWideString: wideLn := wideLn + WideString(VWideString);
          vtInt64:      wideLn := wideLn + IntToStr(VInt64^);
          else raise EGpTextFile.CreateFmtHelp(sInvalidParameter,[FileName],hcTFInvalidParameter);
        end;
      end;
    end;
    WriteString(wideLn);
  except
    on E: EGpTextFile do raise;
    on E: EGpHugeFile do raise;
    on E: Exception   do raise EGpTextFile.CreateHelp(E.Message,hcTFUnexpected);
  end;
end; { TGpTextFile.Write }

{$IFDEF D4plus}
procedure TGpTextFile.Write(s: AnsiString);
begin
  WriteString(StringToWideString(s,tfCodePage));
end; { TGpTextFile.Write }
{$ENDIF D4plus}

{:Writes line to the text file. If file is 8-bit, values are converted
  according to Codepage property. Uses line delimiter set in Rewrite/Append.
  @param   ln Line to be written.
  @raises  EGpHugeFile on Windows errors.
  @seeAlso Rewrite, Append
}
procedure TGpTextFile.Writeln(ln: WideString);
begin
  try
    WriteString(ln);
    BlockWriteUnsafe(tfLineDelimiter[Low(tfLineDelimiter)], tfLineDelimiterSize);
  except
    on E: EGpTextFile do raise;
    on E: EGpHugeFile do raise;
    on E: Exception   do raise EGpTextFile.CreateHelp(E.Message,hcTFUnexpected);
  end;
end; { TGpTextFile.Writeln }

{:Writes array of values to the text file then terminates the line with line
  delimiter. If file is 8-bit, values are converted according to Codepage
  property. Uses line delimiter set in Rewrite/Append.
  @param   Values.
  @raises  EGpTextFile on unsupported parameter.
  @raises  EGpHugeFile on Windows errors.
  @seeAlso Rewrite, Append
}
procedure TGpTextFile.Writeln(params: array of const);
begin
  Write(params);
  Writeln('');
end; { TGpTextFile.Writeln }

{ TGpTextFileStream }

{:Opens file in required access mode, then passes the file stream to the
  inherited constructor.
  @param   fileName    Name of file to be accessed.
  @param   access      Required access mode.
  @param   openFlags   Open flags (used when access mode is accReset).
  @param   createFlags Create flags (used when access mode is accRewrite or
                       accAppend).
  @param   codePage    Code page to be used for 8/16/8 bit conversions. If set
                       to 0, current default code page will be used.
}
constructor TGpTextFileStream.Create(const fileName: string;
  access: TGpHugeFileStreamAccess; openFlags: TOpenFlags;
  createFlags: TCreateFlags; codePage: word);
var
  openOptions: THFOpenOptions;
begin
  openOptions := [hfoBuffered];
  if (access = GpHugeF.accRead) and (ofCloseOnEOF in openFlags) then
    Include(openOptions,hfoCloseOnEOF);
  if cfCompressed in createFlags then
    Include(openOptions,hfoCompressed);
  tfsStream := TGpHugeFileStream.Create(fileName,access,openOptions);
  inherited Create(tfsStream,TGpTSAccess(access),TGpTSCreateFlags(createFlags),
    codePage);
end; { TGpTextFileStream.Create }

{:Wide version of the constructor.
  @since   2006-08-14
}
constructor TGpTextFileStream.CreateW(const fileName: WideString;
  access: TGpHugeFileStreamAccess; openFlags: TOpenFlags; createFlags: TCreateFlags;
  codePage: word);
var
  openOptions: THFOpenOptions;
begin
  openOptions := [hfoBuffered];
  if (access = GpHugeF.accRead) and (ofCloseOnEOF in openFlags) then
    Include(openOptions,hfoCloseOnEOF);
  if cfCompressed in createFlags then
    Include(openOptions,hfoCompressed);
  tfsStream := TGpHugeFileStream.CreateW(fileName,access,openOptions);
  inherited Create(tfsStream,TGpTSAccess(access),TGpTSCreateFlags(createFlags),
    codePage);
end; { TGpTextFileStream.CreateW }

destructor TGpTextFileStream.Destroy;
begin
  inherited;
  tfsStream.Free;
end; { TGpTextFileStream.Destroy }

{:Returns file name.
  @returns Returns file name or empty string if file is not open.
}
function TGpTextFileStream.GetFileName: WideString;
begin
  if assigned(tfsStream) then
    Result := tfsStream.FileName
  else
    Result := '';
end; { TGpTextFileStream.GetFileName }

{:Returns last Windows error code.
  @returns Last Windows error code.
}
function TGpTextFileStream.GetWindowsError: DWORD;
begin
  Result := inherited GetWindowsError;
  if (Result = 0) and assigned(tfsStream) then
    Result := tfsStream.WindowsError;
end; { TGpTextFileStream.GetWindowsError }

{:Returns error message prefix.
  @param   param Optional parameter to be added to the message prefix.
  @returns Error message prefix.
  @since   2001-05-15 (3.0)
}
function TGpTextFileStream.StreamName(param: string): string;
begin
  Result := 'TGpTextFileStream';
  if param <> '' then
    Result := Result + '.'