Скачиваний:
10
Добавлен:
15.06.2014
Размер:
1.97 Кб
Скачать
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, Grids;

type
TForm1 = class(TForm)
Edit1: TEdit;
Memo1: TMemo;
Button1: TButton;
Memo2: TMemo;
BitBtn1: TBitBtn;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Type Tps=^Ts;
Ts=record
inf:string;
ps:Tps;
end;
var p:Tps;
f1,f2:textfile;
s,s1,s2,sl:string;
i,j,q,k:integer;
p1:Tps;
implementation

{$R *.dfm}
Procedure AddStack(var p:Tps; s:string);
var pt:Tps;
begin
New(pt);
pt^.inf:=s;
pt^.ps:=p;
p:=pt;
end;
Procedure FromStack(var p:Tps; var s:string);
var pt:Tps;
begin
if p<>nil then begin
pt:=p;
s:=p^.inf;
p:=p^.ps;
Dispose(pt);
end
else s:='';
end;
procedure TForm1.Button1Click(Sender: TObject);

begin
Memo1.Clear;
Memo2.Clear;
s1:=Edit1.Text;
s2:=s1;
s2[length(s1)]:='~';
AssignFile(f1,s1);
AssignFile(f2,s2);
{$I-}
Reset(f1);
If IoResult<>0 then
MessageDlg('Ошибка открытия файла'+s1,mtWarning,[mbOk],0);
{$I+}
Memo1.Lines.LoadFromFile(s1);
Rewrite(f2);
while not Eof(f1) do begin
Readln(f1,s);
sl:='';
for i:=1 to length(s) do begin
if s[i]<>' ' then begin
sl:=sl+s[i];
if (s[i+1]=' ') or(s[i+1]='') then begin
sl:=sl+' '; AddStack(p1,sl);
sl:=''; end;end; end;
end;
while p1<>nil do begin
FromStack(p1,sl);
AddStack(p,sl);
end;
while p<>nil do begin
FromStack(p,sl);
Writeln(f2,sl);
end;
CloseFile(f1); CloseFile(f2);
Memo2.Lines.LoadFromFile(s2);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Text:='d:\oaip\Unit1.pas';


end;

end.
Соседние файлы в папке загрузка с файла
  • #
    15.06.201435 б101.txt
  • #
    15.06.201442 б101.tx~
  • #
    15.06.20146.64 Кб10Unit1.dcu
  • #
    15.06.20141.27 Кб10Unit1.dfm
  • #
    15.06.20141.97 Кб10Unit1.pas
  • #
    15.06.20141.98 Кб10Unit1.pa~
  • #
    15.06.20141.7 Кб10Unit1.~dfm