П...ка [дополнение]

Здесь обсуждаются графические оболочки, боты, языковые файлы и другие дополнения к CommFort 4.
Закрыто
Аватара пользователя
jackrv
Сообщения: 272
Зарегистрирован: 13:06, 31.12.2008
Откуда: Украина Кривой Рог
Контактная информация:
Контактная информация пользователя jackrv

Re: П...ка [дополнение]

Сообщение jackrv »

[удалено как офтопик]
Вернуться к началу
cema93
Сообщения: 162
Зарегистрирован: 23:06, 21.04.2009
Откуда: Минск
Контактная информация:
Контактная информация пользователя cema93

Re: П...ка [дополнение]

Сообщение cema93 »

dv писал(а):

Код: Выделить всё

{$I-}
procedure ScanDir(StartDir: string;Mask:string; List:TStrings);
var  SearchRec : TSearchRec;
begin
form1.ListBox1.Clear;
  if Mask = '' then Mask := '*.*';
  if StartDir[Length(StartDir)] <>  '\' then StartDir := StartDir + '\';
  if FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
    begin
     repeat
     Application.ProcessMessages;
     if (SearchRec.Attr and faDirectory) <>  faDirectory then
     List.Add({StartDir + }leftStr(SearchRec.Name,Length(SearchRec.Name)-4))
    { else if (SearchRec.Name <>  '..') and (SearchRec.Name <>  '.') then
       begin
         List.Add(StartDir + SearchRec.Name + '\');
         ScanDir(StartDir + SearchRec.Name+ '\',Mask,List);
       end; }
    until FindNext(SearchRec) <>  0;
    FindClose(SearchRec);
   end;
end;
function Replace(Str, X, Y: string): string;
{Str - строка, в которой будет производиться замена.
 X - подстрока, которая должна быть заменена.
 Y - подстрока, на которую будет произведена заменена}

var
  buf1, buf2, buffer: string;
  i: Integer;

begin
  buf1 := '';
  buf2 := Str;
  Buffer := Str;

  while Pos(X, buf2) > 0 do
  begin
    buf2 := Copy(buf2, Pos(X, buf2), (Length(buf2) - Pos(X, buf2)) + 1);
    buf1 := Copy(Buffer, 1, Length(Buffer) - Length(buf2)) + Y;
    Delete(buf2, Pos(X, buf2), Length(X));
    Buffer := buf1 + buf2;
  end;

  Replace := Buffer;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Items.Clear;
  ScanDir(tuta,'*.dat',ListBox1.Items);
  progressbar1.Position:=progressbar1.max;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
i1,i2:integer;
myfile,f2:textfile;
text:string;
s1,s2:string;

begin
progressbar1.Position:= progressbar1.Position+1 ;
if  progressbar1.Position=progressbar1.max then
   begin
     timer1.Enabled:=false;
     progressbar1.Position:=progressbar1.min;
     ScanDir(tuta,'*.dat',ListBox1.Items);

for i1:=0 to listbox1.Count-1 do
begin
if  listbox1.Items.strings[i1]<> 'баш' then
  begin
    // listbox1.Items.Strings
    // Попытка открыть файл Test.txt для записи
    s2:=tuta+listbox1.Items.strings[i1]+'.dat';
    s1:=tuta+listbox1.Items.strings[i1]+'-old.dat';

  // Повторное открытие файла для чтения
  //showmessage(myfile);
  // Отображение содержимого файла
  AssignFile(F2, s2);
  rename(f2,s1);
  CloseFile(f2);
  AssignFile(F2, s2);
  Rewrite(F2);
  AssignFile(myFile, s1);
  Reset(myFile);
  while not Eof(MyFile) do
     begin
       // По одной строке
       ReadLn(myFile, text);
       text:=Replace(text, '<b>', '[url]');
       text:=Replace(text, '</b>', '[/url]');

       text:=Replace(text, '<table border="0">', '');
       text:=Replace(text, '&nbsp;', '=');
       text:=Replace(text, '   ', ' ');
       text:=Replace(text, '  ', ' ');
       text:=Replace(text, '<tr>', '');
       text:=Replace(text, '<td>', '');
       text:=Replace(text, '</td>', '');
       text:=Replace(text, '</table>', '');
       text:=Replace(text, '"', '"');
       text:=Replace(text, '<', '');
       text:=Replace(text, '>', '');
       text:=Replace(text, 'PRE', '');
       text:=Replace(text, '/PRE', '');
       text:=Replace(text, ':01[/', ':10[/');
       text:=Replace(text, ':02[/', ':20[/');
       text:=Replace(text, ':03[/', ':30[/');
       text:=Replace(text, ':04[/', ':40[/');
       text:=Replace(text, ':05[/', ':50[/');
       text:=Replace(text, 'Пн', 'понедельник');
       text:=Replace(text, 'Вт', 'вторник');
       text:=Replace(text, 'Ср', 'среда');
       text:=Replace(text, 'Чт', 'четверг');
       text:=Replace(text, 'Пт', 'пятница');
       text:=Replace(text, 'Сб', 'суббота');
       text:=Replace(text, 'Вс', 'воскресенье');
       text:=Replace(text, ' янв,', ' январь,');
       text:=Replace(text, ' фев,', ' февраль,');
       text:=Replace(text, ' мар,', ' март,');
       text:=Replace(text, ' апр,', ' апрель,');
       {text:=Replace(text, ' май,', ' май,'); }
       text:=Replace(text, ' июн,', ' июнь,');
       text:=Replace(text, ' июл,', ' июль,');
       text:=Replace(text, ' авг,', ' август,');
       text:=Replace(text, ' сен,', ' сентябрь,');
       text:=Replace(text, ' окт,', ' октябрь,');
       text:=Replace(text, ' ноя,', ' ноябрь,');
       text:=Replace(text, ' дек,', ' декабрь,');
       {text:=Replace(text, ']]>', '');}
       text:=Replace(text, ']]>', #13#10+'[url]*[/url]');
       text:=Replace(text, '<![CDATA[','[url]_____[/url]'+#13#10);
       text:=Replace(text, '</tr>', #13#10);
       text:=Replace(text, '<br>', #13#10);
       text:=text+#13#10;
       text:=Replace(text, #13#10#13#10, #13#10);
       text:=Replace(text, #13#10#13#10, #13#10);
       //ShowMessage(text);
       write(f2,text);
       // проверяем всю строку
     end;
   end;
  // Закрытие файла в последний раз
  CloseFile(myFile);
  deletefile(s1);
  CloseFile(f2);
end;

  timer1.Enabled:=true;
end;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  tuta:=getcurrentdir;
  tuta:=tuta+'\text_Resource\';
  progressbar1.max:=strtoint(edit1.text);
  ScanDir(tuta,'*.dat',ListBox1.Items);

end;

end.
дерзайте..
<br />
vrbym плз в архиве исходники, а не просто код, а то у меня чутка не получается
Вернуться к началу
cema93
Сообщения: 162
Зарегистрирован: 23:06, 21.04.2009
Откуда: Минск
Контактная информация:
Контактная информация пользователя cema93

Re: П...ка [дополнение]

Сообщение cema93 »

dv писал(а):

Код: Выделить всё

{$I-}
procedure ScanDir(StartDir: string;Mask:string; List:TStrings);
var  SearchRec : TSearchRec;
begin
form1.ListBox1.Clear;
  if Mask = '' then Mask := '*.*';
  if StartDir[Length(StartDir)] <>  '\' then StartDir := StartDir + '\';
  if FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
    begin
     repeat
     Application.ProcessMessages;
     if (SearchRec.Attr and faDirectory) <>  faDirectory then
     List.Add({StartDir + }leftStr(SearchRec.Name,Length(SearchRec.Name)-4))
    { else if (SearchRec.Name <>  '..') and (SearchRec.Name <>  '.') then
       begin
         List.Add(StartDir + SearchRec.Name + '\');
         ScanDir(StartDir + SearchRec.Name+ '\',Mask,List);
       end; }
    until FindNext(SearchRec) <>  0;
    FindClose(SearchRec);
   end;
end;
function Replace(Str, X, Y: string): string;
{Str - строка, в которой будет производиться замена.
 X - подстрока, которая должна быть заменена.
 Y - подстрока, на которую будет произведена заменена}

var
  buf1, buf2, buffer: string;
  i: Integer;

begin
  buf1 := '';
  buf2 := Str;
  Buffer := Str;

  while Pos(X, buf2) > 0 do
  begin
    buf2 := Copy(buf2, Pos(X, buf2), (Length(buf2) - Pos(X, buf2)) + 1);
    buf1 := Copy(Buffer, 1, Length(Buffer) - Length(buf2)) + Y;
    Delete(buf2, Pos(X, buf2), Length(X));
    Buffer := buf1 + buf2;
  end;

  Replace := Buffer;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Items.Clear;
  ScanDir(tuta,'*.dat',ListBox1.Items);
  progressbar1.Position:=progressbar1.max;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
i1,i2:integer;
myfile,f2:textfile;
text:string;
s1,s2:string;

begin
progressbar1.Position:= progressbar1.Position+1 ;
if  progressbar1.Position=progressbar1.max then
   begin
     timer1.Enabled:=false;
     progressbar1.Position:=progressbar1.min;
     ScanDir(tuta,'*.dat',ListBox1.Items);

for i1:=0 to listbox1.Count-1 do
begin
if  listbox1.Items.strings[i1]<> 'баш' then
  begin
    // listbox1.Items.Strings
    // Попытка открыть файл Test.txt для записи
    s2:=tuta+listbox1.Items.strings[i1]+'.dat';
    s1:=tuta+listbox1.Items.strings[i1]+'-old.dat';

  // Повторное открытие файла для чтения
  //showmessage(myfile);
  // Отображение содержимого файла
  AssignFile(F2, s2);
  rename(f2,s1);
  CloseFile(f2);
  AssignFile(F2, s2);
  Rewrite(F2);
  AssignFile(myFile, s1);
  Reset(myFile);
  while not Eof(MyFile) do
     begin
       // По одной строке
       ReadLn(myFile, text);
       text:=Replace(text, '<b>', '[url]');
       text:=Replace(text, '</b>', '[/url]');

       text:=Replace(text, '<table border="0">', '');
       text:=Replace(text, '&nbsp;', '=');
       text:=Replace(text, '   ', ' ');
       text:=Replace(text, '  ', ' ');
       text:=Replace(text, '<tr>', '');
       text:=Replace(text, '<td>', '');
       text:=Replace(text, '</td>', '');
       text:=Replace(text, '</table>', '');
       text:=Replace(text, '"', '"');
       text:=Replace(text, '<', '');
       text:=Replace(text, '>', '');
       text:=Replace(text, 'PRE', '');
       text:=Replace(text, '/PRE', '');
       text:=Replace(text, ':01[/', ':10[/');
       text:=Replace(text, ':02[/', ':20[/');
       text:=Replace(text, ':03[/', ':30[/');
       text:=Replace(text, ':04[/', ':40[/');
       text:=Replace(text, ':05[/', ':50[/');
       text:=Replace(text, 'Пн', 'понедельник');
       text:=Replace(text, 'Вт', 'вторник');
       text:=Replace(text, 'Ср', 'среда');
       text:=Replace(text, 'Чт', 'четверг');
       text:=Replace(text, 'Пт', 'пятница');
       text:=Replace(text, 'Сб', 'суббота');
       text:=Replace(text, 'Вс', 'воскресенье');
       text:=Replace(text, ' янв,', ' январь,');
       text:=Replace(text, ' фев,', ' февраль,');
       text:=Replace(text, ' мар,', ' март,');
       text:=Replace(text, ' апр,', ' апрель,');
       {text:=Replace(text, ' май,', ' май,'); }
       text:=Replace(text, ' июн,', ' июнь,');
       text:=Replace(text, ' июл,', ' июль,');
       text:=Replace(text, ' авг,', ' август,');
       text:=Replace(text, ' сен,', ' сентябрь,');
       text:=Replace(text, ' окт,', ' октябрь,');
       text:=Replace(text, ' ноя,', ' ноябрь,');
       text:=Replace(text, ' дек,', ' декабрь,');
       {text:=Replace(text, ']]>', '');}
       text:=Replace(text, ']]>', #13#10+'[url]*[/url]');
       text:=Replace(text, '<![CDATA[','[url]_____[/url]'+#13#10);
       text:=Replace(text, '</tr>', #13#10);
       text:=Replace(text, '<br>', #13#10);
       text:=text+#13#10;
       text:=Replace(text, #13#10#13#10, #13#10);
       text:=Replace(text, #13#10#13#10, #13#10);
       //ShowMessage(text);
       write(f2,text);
       // проверяем всю строку
     end;
   end;
  // Закрытие файла в последний раз
  CloseFile(myFile);
  deletefile(s1);
  CloseFile(f2);
end;

  timer1.Enabled:=true;
end;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  tuta:=getcurrentdir;
  tuta:=tuta+'\text_Resource\';
  progressbar1.max:=strtoint(edit1.text);
  ScanDir(tuta,'*.dat',ListBox1.Items);

end;

end.
дерзайте..
мкинь плз в архиве исходники, а не просто код, а то у меня чутка не получается
Вернуться к началу
cema93
Сообщения: 162
Зарегистрирован: 23:06, 21.04.2009
Откуда: Минск
Контактная информация:
Контактная информация пользователя cema93

Re: П...ка [дополнение]

Сообщение cema93 »

вот то, что у меня есть, поправь пожалуйста
p..ka.rar
форма
(180.17 КБ) 329 скачиваний
Вернуться к началу
Аватара пользователя
dv
Сообщения: 1845
Зарегистрирован: 10:28, 11.05.2007
Откуда: Краснодар

Re: П...ка [дополнение]

Сообщение dv »

[Сообщение удaлено]
Последний раз редактировалось dv 02:36, 26.06.2012, всего редактировалось 1 раз.
Дополнения для CommFort
Адрес чата: chat.telered.ru




.
Вернуться к началу
cema93
Сообщения: 162
Зарегистрирован: 23:06, 21.04.2009
Откуда: Минск
Контактная информация:
Контактная информация пользователя cema93

Re: П...ка [дополнение]

Сообщение cema93 »

эта штука работает с викториной скифа?
у меня она не работает
Вернуться к началу
Закрыто

Вернуться в «Дополнения для 4-й версии»