Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Плиз хелп ми!!!

Автор: Неоновый мальчик 17.9.2004, 08:53

Hi!
Ищу умного человека который смогбы решить мою проблему с программой - javascript:emoticon(':qstn')
Пишу программу для склеивания нескольких файлов из базы
[c:\Base\
{файлы в базу формирует программа}
...........
ss070904.txt
gb070904.txt
kl070904.txt
{они формируются ежедневно, отличие только в дате, т.е. ss??????.txt, gb??????.txt, kl??????.txt}
...........]

Что требуется от программы: нужно что бы она формировала например из этих трех файлов формировал к примеру файл: of070904.txt

of070904.txt = ss070904.txt + gb070904.txt + kl070904.txt и делал это на каждый день для одного прошедшего месяца (проблема тут, вот в чем месяц бывает 28, 29, 30 и 31 день)!

Сам я начал писать программу на Pascal, т.к. других языков не знаю:javascript:emoticon(':withstupid')

таким вот методом:

assign(c, 'c:\base\.......');
reset©;
.....
while not eof ©;
......
assign(a, 'c:\base\.......');
write(a, q);
...........

Очень большая проблема с описанием переменных .............

Большая благодарность тому кто мне поможет

Жду помощи....

Автор: Ptica 17.9.2004, 11:07

Код не отлаживался. Use "as is" without any warranty at your own risk.
Функция LeadingZero взята из хелпа к ТР6.0.

Код


Program p;

function LeadingZero(w : byte) : String;
var
  s : String;
begin
  Str(w:0,s);
  if Length(s) = 1 then
    s := '0' + s;
  LeadingZero := s;
end;

procedure join1(var f: text; fn: string);
var s: string;
    ff: text;
begin

{ СОРРИ!!!! ЭТИХ ДВУХ СТРОК ТУТ БЫТЬ НЕ ДОЛЖНО!!!

  writeln(f,fn);
  exit;
}

  assign(ff,fn);
  reset(ff);

  while not eof(ff) do
     begin
       readln(ff,s);
       writeln(f,s);
     end;

  close(ff);
end;

{god is for Year,  mes is for Month,  kd is for NumberOfDays}
procedure jointxt(god: word; mes,kd:byte);
var f: text;
    s,suffix: string;
    i: byte;
begin
    Str(god:4,s);

    suffix := LeadingZero(mes)+Copy(s,3,2)+'.txt';

    for i:=1 to kd do
        begin
          s := 'c:\base\of'+LeadingZero(i)+suffix;
          assign(f,s);
          rewrite(f);

          s := 'c:\base\ss'+LeadingZero(i)+suffix;
          join1(f,s);

          s := 'c:\base\gb'+LeadingZero(i)+suffix;
          join1(f,s);

          s := 'c:\base\kl'+LeadingZero(i)+suffix;
          join1(f,s);

          close(f)
        end;
end;

{----------------------------------------------------}
begin
   jointxt(2004,9,30);
end.

Автор: The MASTER 21.9.2004, 15:34

[code]
begin
Memo1.lines.add(eExtractFilePath(paramstr(0))+'1.txt');// любой вместо 1.txt
Memo1.lines.add(ExtractFilePath(paramstr(0))+'2.txt');
Memo1.lines.savetofile(ExtractFilePath(paramstr(0))+'file.txt');
end;