{codecitation class="brush: pascal; gutter: false;" width="600px"}

Hа боpту самолета:

— Здpавствуйте, дамы и господа,— говоpит командиp экипажа.— Мы благодаpим вас за то, что вы выбpали нашу авиакомпанию для пеpвого полета в пеpвый день нового 2000 года. Мы находимся на высоте 3 тыс. футов, наша скоpость… вау!.. ох, блин!.. вот фак!.. Извините за неудобства, котоpые вы испытываете, находясь вниз головой, надеюсь, все были пpистегнуты. Есть ли сpеди пассажиpов на боpту пpогpаммист?

Классы Tstrings/TStringlist имеют свойство commatext, которое автоматически разделяет строки, содержащие разделители, на отдельные части. Пример показывает как считать CSV файл. В Конечном итоге, автоматически разделённые строки содержатся в TStringlist.

var

ts: tstringlist;

S: string;

Tf: Textfile;

begin

Ts:= Tstringlist.create;

Assignfile (tf, 'filename');

Reset (tf);

while not eof (tf) do

begin

Readln (tf,S);

Ts.CommaText:= S;

//ProcessLine;

end;

closefile (tf);

ts.free;

end;

Так же операцию можно производить в обратном порядке.

Свойство Commatext поддерживает разделители как в виде запятых, так и двойных кавычек: 1,2,3,4 и «1»,"2","3","4"

Например, строка вида «1»,"2,3","4" будет разделена на три элемента, которые заключены в кавычки (средняя запятая будет проигнорирована). Чтобы включить кавычку в конечный результ, нужно поставить две кавычки подряд: «1»,""2" (результат будет 1 и "2).

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

Автор: Dave

unit Cdbascii;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, DbiErrs, DbiTypes, DbiProcs, DB, DBTables;

type

TAsciiDelimTable = class (TTable)

private

{ Private declarations }

fQuote: Char;

fDelim: Char;

protected

{ Protected declarations }

function CreateHandle: HDBICur; override;

procedure SetQuote (newValue: Char);

procedure SetDelim (newValue: Char);

public

{ Public declarations }

constructor Create (AOwner: TComponent); override;

destructor Destroy; override;

{ Эти свойства не должны больше публиковаться }

property IndexFieldNames;

property IndexName;

property MasterFields;

property MasterSource;

property UpdateMode;

published

{ Published declarations }

property Quote: Char read fQuote write setQuote default '"';

property Delim: Char read fDelim write setDelim default ',';

end;

procedure Register;

implementation

uses DBConsts;

procedure Register;

begin

RegisterComponents ('Data Access', [TAsciiDelimTable]);

end;

constructor TAsciiDelimTable.Create (AOwner: TComponent);

begin

inherited Create (AOwner);

Exclusive:= True;

TableType:= ttASCII;

fQuote:= '"';

fDelim:= ',';

end;

destructor TAsciiDelimTable.Destroy;

begin

inherited Destroy;

end;

{ Рабочий код }

function CheckOpen (Status: DBIResult): Boolean;

begin

case Status of

DBIERR_NONE:

Result:= True;

DBIERR_NOTSUFFTABLERIGHTS:

begin

if not Session.GetPassword then

DbiError (Status);

Result:= False;

end;

else

DbiError (Status);

end;

end;

function TAsciiDelimTable.CreateHandle: HDBICur;

const

OpenModes: array[Boolean] of DbiOpenMode = (dbiReadWrite, dbiReadOnly);

ShareModes: array[Boolean] of DbiShareMode = (dbiOpenShared, dbiOpenExcl);

var

STableName: array[0..SizeOf (TFileName) — 1] of Char;

SDriverType: array[0..12] of Char;

begin

if TableName = '' then

DBError (SNoTableName);

AnsiToNative (DBLocale, TableName, STableName, SizeOf (STableName) — 1);

StrPCopy (SDriverType, 'ASCIIDRV-' Quote '-' Delim);

Result:= nil;

while not CheckOpen (DbiOpenTable (DBHandle, STableName, SDriverType,

nil, nil, 0, OpenModes[ReadOnly], ShareModes[Exclusive],

xltField, False, nil, Result)) do {Повтор}

;

end;

procedure TAsciiDelimTable.SetQuote (newValue: Char);

begin

if Active then

{ DBError (SInvalidBatchMove); };

fQuote:= newValue;

end;

procedure TAsciiDelimTable.SetDelim (newValue: Char);

begin

if Active then

{ DBError (SInvalidBatchMove); };

fDelim:= newValue;

end;

end.

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

Скачивание файла.

Размер: неизвестно (скачено 45%).

var s: String; f: TextFile;

AssignFile (f, 'D:\\INPUT.TXT);

Reset (f);

while not EOF (f) do

begin

ReadLn (s, f);

ShowMessage (GetField (s, 1)); {The first field\}

ShowMessage (GetField (s, 6)); {The sixth field\}

ShowMessage (GetField (s, 25)); {will return '' if no 25 column…\}

end;

CloseFile (f);

{ ==== This function will return a field from a delimited string. ==== \}

function GetField (InpString: String; fieldpos: Integer): String;

var

c: Char;

curpos, i: Integer;

begin

curpos:= 1;

for i:= 1 to fieldpos do

begin

result:= ''; if curpos > Length (InpString) then Break;

repeat

c:= InpString[curpos]; Inc (curpos, 1);

if (c = '"') or (c = #13) or (c = #10) then c:= ' ';

if c ',' then result:= result c;

until (c = ',') or (curpos > Length (InpString))

end;

if (curpos > Length (InpString)) and (i < fieldpos) then result := '';

result:= Trim (result);

end;

{ ==== This function will trim a string removing spaces etc. ==== \}

function Trim (inp_str: String): String;

var

i: Integer;

begin

for i:= 1 to Length (inp_str) do if inp_str[i] ' ' then Break;

if i > 1 then Delete (inp_str, 1, i — 1);

for i:= Length (inp_str) downto 1 do if inp_str[i] ' ' then Break;

if i < Length(inp_str) then Delete(inp_str, i 1, Length(inp_str));

result:= inp_str;

if result = ' ' then result:= '';

end;

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

Приведу несколько простых функций, позволяющих работать с отдельными словами в строке. Возможно они пригодятся вам для разбивки текстовых полей на отдельные слова (for i:= 1 to NumToken do …) с последующим сохранением их в базе данных.

function GetToken (aString, SepChar: string; TokenNum: Byte): string;

{

параметры: aString: полная строка

SepChar: единственный символ, служащий

разделителем между словами (подстроками)

TokenNum: номер требуемого слова (подстроки))

result: искомое слово или пустая строка, если количество слов

меньше значения 'TokenNum'

}

var

Token: string;

StrLen: Byte;

TNum: Byte;

TEnd: Byte;

begin

StrLen:= Length (aString);

TNum:= 1;

TEnd:= StrLen;

while ((TNum <= TokenNum) and (TEnd 0)) do

begin

TEnd:= Pos (SepChar, aString);

if TEnd 0 then

begin

Token:= Copy (aString, 1, TEnd — 1);

Delete (aString, 1, TEnd);

Inc (TNum);

end

else

begin

Token:= aString;

end;

end;

if TNum >= TokenNum then

begin

GetToken1:= Token;

end

else

begin

GetToken1:= '';

end;

end;

function NumToken (aString, SepChar: string): Byte;

{

parameters: aString: полная строка

SepChar: единственный символ, служащий

разделителем между словами (подстроками)

result: количество найденных слов (подстрок)

}

var

RChar: Char;

StrLen: Byte;

TNum: Byte;

TEnd: Byte;

begin

if SepChar = '#' then

begin

RChar:= '*'

end

else

begin

RChar:= '#'

end;

StrLen:= Length (aString);

TNum:= 0;

TEnd:= StrLen;

while TEnd 0 do

begin

Inc (TNum);

TEnd:= Pos (SepChar, aString);

if TEnd 0 then

begin

aString[TEnd]:= RChar;

end;

end;

Result:= TNum;

end;

// Или другое решение:

function CopyColumn (const s_string: string; c_fence: char;

i_index: integer): string;

var

i, i_left: integer;

begin

result:= EmptyStr;

if i_index = 0 then

begin

exit;

end;

i_left:= 0;

for i:= 1 to Length (s_string) do

begin

if s_string[i] = c_fence then

begin

Dec (i_index);

if i_index = 0 then

begin

result:= Copy (s_string, i_left 1, i — i_left — 1);

exit;

end

else

begin

i_left:= i;

end;

end;

end;

Dec (i_index);

if i_index = 0 then

begin

result:= Copy (s_string, i_left 1, Length (s_string));

end;

end;

Я знаю что в GetToken параметр SepChar (в моем случае c_fence) строка, не символ, но комментарий гласит, что функция ожидает единственный символ в этой строке, и это очевидно, поскольку если вы пошлете более одного символа, функция попросту несработает. (Delete (aString, 1,TEnd) будет ошибкой, если Length (SepChar) > 1 ).

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

procedure ReadTabFile (FN: TFileName; FieldSeparator:

Char; SG: TStringGrid);

var

i: Integer;

S: string;

T: string;

Colonne, ligne: Integer;

Les_Strings: TStringList;

CountCols: Integer;

CountLines: Integer;

TabPos: Integer;

StartPos: Integer;

InitialCol: Integer;

begin

Les_Strings:= TStringList.Create;

try

// Load the file, Datei laden

Les_Strings.LoadFromFile (FN);

// Get the number of rows, Anzahl der Zeilen ermitteln

CountLines:= Les_Strings.Count SG.FixedRows;

// Get the number of columns, Anzahl der Spalten ermitteln

T:= Les_Strings[0];

for i:= 0 to Length (T) — 1 do Inc (CountCols,

Ord (IsDelimiter (FieldSeparator, T, i)));

Inc (CountCols, 1 SG.FixedCols);

// Adjust Grid dimensions, Anpassung der Grid-Gro?e

if CountLines > SG.RowCount then SG.RowCount:= CountLines;

if CountCols > SG.ColCount then SG.ColCount:= CountCols;

// Initialisierung

InitialCol:= SG.FixedCols — 1;

Ligne:= SG.FixedRows — 1;

// Iterate through all rows of the table

// Schleife durch allen Zeilen der Tabelle

for i:= 0 to Les_Strings.Count — 1 do

begin

Colonne:= InitialCol;

Inc (Ligne);

StartPos:= 1;

S:= Les_Strings[i];

TabPos:= Pos (FieldSeparator, S);

repeat

Inc (Colonne);

SG.Cells[Colonne, Ligne]:= Copy (S, StartPos, TabPos — 1);

S:= Copy (S, TabPos 1, 999);

TabPos:= Pos (FieldSeparator, S);

until TabPos = 0;

end;

finally

Les_Strings.Free;

end;

end;

// Example, Beispiel:

procedure TForm1.Button1Click (Sender: TObject);

begin

Screen.Cursor:= crHourGlass;

// Open tab-delimited files

ReadTabFile ('C:\TEST.TXT', #9, StringGrid1);

Screen.Cursor:= crDefault;

end;

{/codecitation}