Парни нужна ваша помощь. Негоже программисту вносить информацию в программу руками

помогите побобную информацию програмно "запихнуть", спросите куда запихнуть? Хоть в *.db,
*.dbf, TStringGrid, Excel, в любую "структурированную систему"

фалы прилагаются

Присоединённый файл ( Кол-во скачиваний: 10 )
 info.zip

А что сложного ? Читай построчно файл, и разбивай строки на поля...
Но так уж и быть написал универсальную функцию, заносит таблицу в StringGrid:

Код

procedure TForm1.Button12Click(Sender: TObject); var  f : TextFile;  s, s2 : string;  i, p, n : integer;  Widths : array of integer; begin  StringGrid1.FixedRows := 1;  StringGrid1.FixedCols := 0;  AssignFile (f, 'kvp22.txt'); // пропускаем ненужное до тех пор, пока не встретим шапку таблицы  Reset (f);  repeat ReadLn (f, s); until Pos(#$CD, s) <> 0; // читаем и формируем шапку таблицы  SetLength (Widths, 0);  repeat    ReadLn (f, s);    if Pos(#$B3, s) = 0 then Break;    i := 0;    while (s[1] < #32) do Delete(s, 1, 1);    OEMToChar(PChar(s), PChar(s));    repeat      p := 1;      while (s[p] <> '¦') and (p <= Length(s)) do Inc(p);      if p > 1 then      begin        if Length(Widths) < i+1 then        begin          SetLength(Widths, i+1);          Widths[i] := p;          StringGrid1.ColCount := i+1;          StringGrid1.Cells[i, 0] := Copy(s, 1, p-1);        end        else StringGrid1.Cells[i, 0] := StringGrid1.Cells[i, 0] + ' ' + Copy(s, 1, p-1);        Inc(i);      end;      Delete (s, 1, p);    until s = '';  until false;  StringGrid1.ColCount := StringGrid1.ColCount + 1;  StringGrid1.Cells[StringGrid1.ColCount-1, 0] := 'Примечание';  StringGrid1.ColWidths[StringGrid1.ColCount-1] := 128; // читаем данные  n := 1;  while not EOF(f) do  begin    StringGrid1.RowCount := n+1;    ReadLn (f, s);    ReadLn (f, s2);    if (s = '') or (s2 = '') then break;    OEMToChar(PChar(s), PChar(s));    OEMToChar(PChar(s2), PChar(s2));    p := 1;    for i := 0 to Length(Widths)-1 do    begin      StringGrid1.Cells[i, n] := Copy(s, p, Widths[i]);      if i = Length(Widths)-1 then      begin        StringGrid1.Cells[i, n] := StringGrid1.Cells[i, n] + ' ' + Copy(s2, p, Widths[i]);        StringGrid1.Cells[i+1, n] := Copy(s2, 1, p-1);      end;      Inc (p, Widths[i]);    end;    Inc(n);  end; // выставляем ширину столбцов  for i := 0 to Length(Widths)-1 do    StringGrid1.ColWidths[i] := Widths[i]*12;  CloseFile(f); end;

а может Excel может сделать db?

Я пару раз пользовался - на входе Excel текстовый файл (разграничители хоть пробелы, хоть табуляторы, хоть запятые - не важно), а на выходе делал .dbf.

Но это подходит для "разовой" работы.

Цитата

а может Excel может сделать db?

я специально присоединил файлы, ты пробовал их прочитать?
Добавлено @ 08:53
нельзя ли небольшие коментарии что есть #$B3, как ты узнаешь?
Widths - для чего эта переменная

Это сообщение отредактировал(а) dsergey - 23.10.2004, 10:50

$B3 - код символа "│" - разделителя столбцов в шапке таблицы
$CD - код символа "═" - верхняя часть таблицы, для определния начала шапки
Widths - хранит ширину столбцов в символах - т.е. это расстояния между двумя соседними символами "│"...
Например, для kvp22.txt:
Widths[0] = 4 // комнат
Widths[1] = 5 // схемкомн
Widths[2] = 12 // район
и т.д.

Цитата

Widths - хранит ширину столбцов в символах - т.е. это расстояния между двумя соседними символами "│"...

ну голова, а я до этого не додумался, у меня была проблема - как определить столбцы?

p0s0l, ты извини за наглость, но последнюю строчку не читает

вообще процедура шикарная, все отправляю в StringGrid, удаляю, ненужные столбцы, отправляю в RichEdit на печать

Это сообщение отредактировал(а) dsergey - 25.10.2004, 09:39

dsergey, пришли или прицепи файл, в котором не читается последняя строчка (файлы, которые были в архиве info.zip - в них всё читается...)

PS: строчку
StringGrid1.RowCount := n+1;
Помести после
if (s = '') or (s2 = '') then break;
А то получается одна лишняя пустая строка в StringGrid'е...

Полагаю, проблема в строке:
if (s = '') or (s2 = '') then break;
Если файл всегда кончается тремя странными символами, тогда можно (лучше) сделать вместо этой строки так (попробуй):
if (s = #$1B#$46#$0C) then Break;

извини, все в порядке, это моя ошибка

Цитата

PS: строчку StringGrid1.RowCount := n+1; Помести после if (s = '') or (s2 = '') then break; А то получается одна лишняя пустая строка в StringGrid'е...

это действительно так



---------------
огромное тебе спасибо
и спасибо эту форуму, за помощь
"сижу" на форуме с 2001 и не раз убеждался в этом, да и сам помогал.

Это сообщение отредактировал(а) dsergey - 26.10.2004, 11:45

Код

StringGrid1.ColCount := StringGrid1.ColCount + 1;  StringGrid1.Cells[StringGrid1.ColCount-1, 0] := 'Примечание';  StringGrid1.ColWidths[StringGrid1.ColCount-1] := 128;

перед этим пришлось добавить

Код

Widths[i] := p+20;//поле заявитель

ширина поля "заявитель" в заголовке 10,
а реально ширина поля больше раза в два.

Это сообщение отредактировал(а) dsergey - 26.10.2004, 16:11

Да, точно. Я вначале ориентировался (тестил) по файлу domd22, а там после "заявителя" наставлены пробелы до конца столбца. А в kvp*.txt пробелов таких нет - и так сразу не обратишь на это внимание...
Поэтому лучше (для универсальности) сделать так:

Код

procedure TForm1.Button13Click(Sender: TObject); var  f : TextFile;  s, s2 : string;  MinLen, i, p, n : integer;  Widths : array of integer; begin  StringGrid1.FixedRows := 1;  StringGrid1.FixedCols := 0;  AssignFile (f, 'c:\kvp22.txt'); // пропускаем ненужное до тех пор, пока не встретим шапку таблицы  Reset (f);  repeat ReadLn (f, s); until Pos(#$CD, s) <> 0;  while (s[1] < #32) do Delete(s, 1, 1); // !!!  MinLen := Length(s);                   // !!! // читаем и формируем шапку таблицы  SetLength (Widths, 0);  repeat    ReadLn (f, s);    if Pos(#$B3, s) = 0 then Break;    while (s[1] < #32) do Delete(s, 1, 1);    for i := 1 to Length(s) do if s[i] < #32 then s[i] := ' '; // !!!    while Length(s) < MinLen do s := s + ' '; // !!!        i := 0;    OEMToChar(PChar(s), PChar(s));    repeat      p := 1;      while (s[p] <> '¦') and (p <= Length(s)) do Inc(p);      if p > 1 then      begin        if Length(Widths) < i+1 then        begin          SetLength(Widths, i+1);          Widths[i] := p;          StringGrid1.ColCount := i+1;          StringGrid1.Cells[i, 0] := Trim(Copy(s, 1, p-1));        end        else        begin          StringGrid1.Cells[i, 0] := StringGrid1.Cells[i, 0] + ' ' + Copy(s, 1, p-1);        end;        Inc(i);      end;      Delete (s, 1, p);    until s = '';  until false;  StringGrid1.ColCount := StringGrid1.ColCount + 1;  StringGrid1.Cells[StringGrid1.ColCount-1, 0] := 'Примечание';  StringGrid1.ColWidths[StringGrid1.ColCount-1] := 128; // читаем данные  n := 1;  while not EOF(f) do  begin    ReadLn (f, s);    ReadLn (f, s2);    if (s = '') or (s2 = '') then break;    StringGrid1.RowCount := n+1;    OEMToChar(PChar(s), PChar(s));    OEMToChar(PChar(s2), PChar(s2));    p := 1;    for i := 0 to Length(Widths)-1 do    begin      StringGrid1.Cells[i, n] := Copy(s, p, Widths[i]);      if i = Length(Widths)-1 then      begin        StringGrid1.Cells[i, n] := StringGrid1.Cells[i, n] + ' ' + Copy(s2, p, Widths[i]);        StringGrid1.Cells[i+1, n] := Copy(s2, 1, p-1);      end;      Inc (p, Widths[i]);    end;    Inc(n);  end; // выставляем ширину столбцов  for i := 0 to Length(Widths)-1 do    StringGrid1.ColWidths[i] := Widths[i]*12;  CloseFile(f); end;

Изменения/дополнения - выделены таким вот образом "// !!!"

эта строка лишняя

Код

for i := 1 to Length(s) do if s[i] < #32 then s[i] := ' '; // !!!

ничего не загружается

а что остальные строки дают, я не понял, никаких изменений, я пока не заметил, буду разбираться,
огромное тебе спасибо еще раз
Добавлено @ 09:43
в этом участке

Код

while not EOF(f) do begin ReadLn (f, s); ReadLn (f, s2); if (s = '') or (s2 = '') then break; StringGrid1.RowCount := n+1; OEMToChar(PChar(s), PChar(s)); OEMToChar(PChar(s2), PChar(s2));

тоже ошибка

Код

n:=StringGrid1.RowCount;//для открытия сразу нескольких файлов в одну сетку while not EOF(f) do begin StringGrid1.RowCount := n;//ниже ставить нельзя - не читается посл.строки и вылетает ошибка ReadLn (f, s); ReadLn (f, s2); if (s = '') or (s2 = '') then break; OEMToChar(PChar(s), PChar(s)); OEMToChar(PChar(s2), PChar(s2));

[quite]ничего не загружается[/quote]Да ну ? У тебя тогда файл какой-то странный - все символы управляющие... Это строка нужна для того, чтобы убрать кракозябры, например, в "заявителе"...

Цитата

а что остальные строки дают, я не понял,

Код

while (s[1] < #32) do Delete(s, 1, 1); // !!!  MinLen := Length(s);                   // !!!

и

Код

while (s[1] < #32) do Delete(s, 1, 1);    for i := 1 to Length(s) do if s[i] < #32 then s[i] := ' '; // !!!    while Length(s) < MinLen do s := s + ' '; // !!!

MinLen содержит ширину таблицы (в символах), и когда загружаются заголовки таблицы, они дополняются пробелами так, чтобы имели одинаковую ширину... Это было сделано для решения проблемы с укороченным "заявителем"...
Больше никаких изменений...

Цитата(dsergey @ 27.10.2004, 09:35)

тоже ошибка

Не очень понял - почему если переместить вниз, работать не будет ?
Не вижу причин для неработания... А в твоём случае не должно правильно работать, т.к. ты устанавливаешь RowCount = n, а дальше в тексте (если не менял ничего) идёт обращение к n-ому ряду, а такого не существует (т.к. нумерация рядов идёт с нуля). Надо делать RowCount := n+1;

И как ты открываешь несколько файлов в одну сетку, если у них разные названия и ширины столбцов ?

Цитата

И как ты открываешь несколько файлов в одну сетку, если у них разные названия и ширины столбцов ?

названия и ширины столбцов одинаковые
(есть 2 типа фалов, а именно дома и квартиры)

Цитата

Не очень понял - почему если переместить вниз, работать не будет ? Не вижу причин для неработания... А в твоём случае не должно правильно работать, т.к. ты устанавливаешь RowCount = n, а дальше в тексте (если не менял ничего) идёт обращение к n-ому ряду, а такого не существует (т.к. нумерация рядов идёт с нуля). Надо делать RowCount := n+1;

тем не менее это факт, но не помню менял ли что дальше или нет

вот тебе весь код на текщий момент

Код

procedure TfmMain.opensouz(filename:string); var f : TextFile; s, s2 : string; i, p, n : integer; Widths : array of integer; begin  if StringGrid1.RowCount <2 then StringGrid1.RowCount:=2;  StringGrid1.FixedRows := 1;  StringGrid1.FixedCols := 0;  AssignFile (f, filename);  _sl.Add(filename);//добавляем файл в список удаления перед закрытием // пропускаем ненужное до тех пор, пока не встретим шапку таблицы  Reset (f);  repeat ReadLn (f, s); until Pos(#$CD, s) <> 0; //  while (s[1] < #32) do Delete(s, 1, 1);//!!! //  MinLen := Length(s);//!!! // читаем и формируем шапку таблицы  SetLength (Widths, 0);  repeat   ReadLn (f, s);   if Pos(#$B3, s) = 0 then Break;   i := 0;   while (s[1] < #32) do Delete(s, 1, 1); //   for i := 1 to Length(s) do if s[i] < #32 then s[i] := ' '; // !!! //   while Length(s) < MinLen do s := s + ' '; // !!!   OEMToChar(PChar(s), PChar(s));   repeat    p := 1;    while (s[p] <> '¦') and (p <= Length(s)) do Inc(p);    if p > 1 then    begin     if Length(Widths) < i+1 then     begin      SetLength(Widths, i+1);      Widths[i] := p;      StringGrid1.ColCount := i+1;      StringGrid1.Cells[i, 0] := Copy(s, 1, p-1);     end     else begin       //StringGrid1.Cells[i, 0] := StringGrid1.Cells[i, 0] + ' ' + Copy(s, 1, p-1);     end;     Inc(i);    end;    Delete (s, 1, p);   until s = '';  until false;  Widths[i] := p+20;//заявитель в заголовке 10 символов, а длина поля 20 символов  StringGrid1.ColCount := StringGrid1.ColCount + 1;  StringGrid1.Cells[StringGrid1.ColCount-1, 0] := 'Примечание';  StringGrid1.ColWidths[StringGrid1.ColCount-1] := 128; // читаем данные //n := 1; n:=StringGrid1.RowCount; while not EOF(f) do begin StringGrid1.RowCount := n;//+1; ReadLn (f, s); ReadLn (f, s2); if (s = '') or (s2 = '') then break; OEMToChar(PChar(s), PChar(s)); OEMToChar(PChar(s2), PChar(s2)); p := 1; for i := 0 to Length(Widths)-1 do begin  StringGrid1.Cells[i, n] := Copy(s, p, Widths[i]);  if i = Length(Widths)-1 then  begin    StringGrid1.Cells[i, n] := StringGrid1.Cells[i, n] + ' ' + Copy(s2, p, Widths[i]);   StringGrid1.Cells[i+1, n] := Copy(s2, 1, p-1);  end;  Inc (p, Widths[i]); end; Inc(n); end; // выставляем ширину столбцов for i := 0 to Length(Widths)-1 do StringGrid1.ColWidths[i] := Widths[i]*12; CloseFile(f); end;

Цитата(dsergey @ 27.10.2004, 09:35)

ничего не загружается

Это было из-за того, что надо было ставить i := 0 после строчки
for i := 1 to Length(s) do if s[i] < #32 then s[i] := ' ';
(ну забыл я поставить восклицания , а ты не посмотрел...)

Код

var f : TextFile; s, s2 : string; MinLen, i, p, n : integer; Widths : array of integer; begin  if StringGrid1.RowCount <2 then  begin    StringGrid1.RowCount:=2;    n := 1;  end  else  n:=StringGrid1.RowCount;  StringGrid1.FixedRows := 1;  StringGrid1.FixedCols := 0;  AssignFile (f, FileName);  _sl.Add(filename);//добавляем файл в список удаления перед закрытием // пропускаем ненужное до тех пор, пока не встретим шапку таблицы  Reset (f);  repeat ReadLn (f, s); until Pos(#$CD, s) <> 0;  while (s[1] < #32) do Delete(s, 1, 1);//!!!  MinLen := Length(s); //!!! // читаем и формируем шапку таблицы  SetLength (Widths, 0);  repeat   ReadLn (f, s);   if Pos(#$B3, s) = 0 then Break;   while (s[1] < #32) do Delete(s, 1, 1);   for i := 1 to Length(s) do if s[i] < #32 then s[i] := ' '; // !!!   while Length(s) < MinLen do s := s + ' '; // !!!   i := 0;   OEMToChar(PChar(s), PChar(s));   repeat    p := 1;    while (s[p] <> '¦') and (p <= Length(s)) do Inc(p);    if p > 1 then    begin     if Length(Widths) < i+1 then     begin      SetLength(Widths, i+1);      Widths[i] := p;      StringGrid1.ColCount := i+1;      StringGrid1.Cells[i, 0] := Copy(s, 1, p-1);     end     else begin       StringGrid1.Cells[i, 0] := StringGrid1.Cells[i, 0] + ' ' + Copy(s, 1, p-1);     end;     Inc(i);    end;    Delete (s, 1, p);   until s = '';  until false;  //Widths[i] := p+20;//заявитель в заголовке 10 символов, а длина поля 20 символов  StringGrid1.ColCount := StringGrid1.ColCount + 1;  StringGrid1.Cells[StringGrid1.ColCount-1, 0] := 'Примечание';  StringGrid1.ColWidths[StringGrid1.ColCount-1] := 128; // читаем данные //n := 1; while not EOF(f) do begin ReadLn (f, s); ReadLn (f, s2); if (s = '') or (s2 = '') then break; StringGrid1.RowCount := n+1; OEMToChar(PChar(s), PChar(s)); OEMToChar(PChar(s2), PChar(s2)); p := 1; for i := 0 to Length(Widths)-1 do begin  StringGrid1.Cells[i, n] := Copy(s, p, Widths[i]);  if i = Length(Widths)-1 then  begin    StringGrid1.Cells[i, n] := StringGrid1.Cells[i, n] + ' ' + Copy(s2, p, Widths[i]);   StringGrid1.Cells[i+1, n] := Copy(s2, 1, p-1);  end;  Inc (p, Widths[i]); end; Inc(n); end; // выставляем ширину столбцов for i := 0 to Length(Widths)-1 do StringGrid1.ColWidths[i] := Widths[i]*12; CloseFile(f); end;

Только перед первой загрузкой установи StringGrid1.RowCount:=1;