本协议最终解释权归:我要PASCAL源程序

Var st,st2:string;
i:integer;
Begin
readln(st);
while i<length(st) do
begin
inc(i);
if st[i]=" " then begin writeln(st2); st2:=""; end
else st2:=st2+st[i];
end;
End.
基本方法如下,有问题用百度消息

人家提问的既然问怎么简单的问题，就不要弄高级的二叉数什么的了，实用的最好啊！~~
program zimu;
var
c:char;
s:string;
begin
s:='';
repeat
read(c);
if ord(c)=13 then break else
if (ord(c)<>32)and(ord(c)<>63)and(ord(c)<>46)and(ord(c)<>59)
then s:=s+c else if (ord(c)<>32)or(ord(c)<>63)or(ord(c)<>46)or(ord(c)<>59)
then begin writeln(s); s:=''; end;
until false;
end.

解释：
用 ord 函数来判断所谓的分隔符甚至回车（ord 为 14）
进行完一次分离了就使 s 的值为空，进行下一次运算
很传统的东西啊
好好领会一下啊

我有一个程序,用来分析一篇文章的,会把所有单词找出来加入排序二叉树,并且在单词后加上文章索引.
{
This file is part of MT Search Kernel Beta.1
Copyright (c) 2006 by Galloplus P.Chang

Kernel for MT Search

See the file COPYING.FPC, included in this distribution,
for details about the copyright.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

**********************************************************************}
program MTSKernel;
const rootkey='NNNNN{Keyword}';
max=10000;
type pnt=^node;
node=record
num:longint;
next:pnt;
end;
tree=^tp;
tp=record
wrd:string[20];
dat:pnt;
left,right:tree;
end;
var tmphead,tmpp,tmpq:pnt;root,p:tree;command:string;ch:char;
filelist:array [1..max] of string;fotal,i:longint;
fileout:text;
sdnb:integer;
sd:array[1..max] of integer;
procedure ok;
begin
writeln('..............................................................................OK');
end;
function compare(f,s:string):integer;
begin
if f>s then exit(1);
if f=s then exit(0);
if f<s then exit(-1);
end;
procedure addtree(t:string;var rt:tree);
var d,dd,d2:pnt;p:tree;
begin
new(p);
p^.wrd:=t;
p^.dat:=nil;
p^.right:=nil;
p^.left:=nil;
new(d);
d^.num:=fotal;
d^.next:=nil;
case compare(t,rt^.wrd) of
1:if rt^.right= nil then begin rt^.right:=p;rt^.right^.dat:=d;end else addtree(t,rt^.right);
0:begin
d2:=rt^.dat;
while d2^.next<>nil do d2:=d2^.next;
if d2^.num<fotal then
begin new(dd);dd^.num:=fotal;dd^.next:=nil;d2^.next:=dd;end;
end;
-1:if rt^.left=nil then begin rt^.left:=p;rt^.left^.dat:=d;end else addtree(t,rt^.left);
end;
end;

procedure start;
begin
fillchar(sd,sizeof(sd),0);
sdnb:=0;
for i:=1 to max do
filelist[i]:='';
fotal:=0;
new(root);
root^.left:=nil;
root^.right:=nil;
new(tmphead);
tmphead:=nil;
root^.wrd:=rootkey;
root^.dat:=tmphead;
end;
function ava(v:char):boolean;
begin
if ((v>='a')and(v<='z')) or ((v>='A')and(v<='Z')) or ((v>='0')and(v<='9')) then ava:=true else ava:=false;
end;

procedure add;
var file1:text;name,t:string;
begin
writeln;
writeln('--ADD FILES---------------------------------------------------------------------');
// writeln(' ADD FILES');
writeln;
write(' Type in the file name:');
readln(name);
t:='data\'+name+'.txt';
assign(file1,t);
reset(file1);
{read}
for i:=1 to fotal do if filelist[i]=name then
begin
writeln;
writeln(' Error:the file has been assigned already');
writeln;
exit;end;
fotal:=fotal+1;
filelist[fotal]:=name;
begin
t:='';
while not eof(file1) do
begin
read(file1,ch);
while (not ava(ch)) and (t='') and (not eof(file1)) do read(file1,ch);
if ava(ch) then t:=t+ch else begin addtree(upcase(t),root);t:=''end;

end;

end;
ok;
// writeln('Assigned Successfully');

writeln('==Assigned Successfully!========================================================');
writeln;
close(file1);
end;
procedure del;
begin
end;

procedure srh;
var wd:array [1..10] of string;i,amount:longint;fnd:boolean;
procedure find(wd:string;t:tree);
var d:pnt;
begin
case compare(wd,t^.wrd) of
1:if t^.right <> nil then find(wd,t^.right);
0:begin d:=t^.dat;while d<>nil do begin inc(sd[d^.num]);
d:=d^.next; end;
end;
-1:if t^.left <> nil then find(wd,t^.left);
end;
end;
begin
writeln;
writeln('--SEARCH WORDS IN FILES---------------------------------------------------------');
write(' Total words:');readln(amount);
for i:=1 to amount do
begin
write(' Word No.',i,':');readln(wd[i]);wd[i]:=upcase(wd[i]);
end;
for i:=1 to amount do
find(wd[i],root);
writeln('==Result of the SEARCH==========================================================');
for i:=1 to max do
if sd[i]=amount then begin writeln(' In ',filelist[i],'.txt');fnd:=true;end;
if not fnd then writeln(' Not Found');
fillchar(sd,sizeof(sd),0);
ok;
end;
{procedure srh;
type data=record
n:integer;
a:array[1..max] of integer;
end;
var amount,i:longint;words:array[1..10] of string[20];d:pnt;p:data;

function find(st:string[20];t:tree):data;
var i:longint;
begin
find.n:=0;
fillchar(find.a,sizeof(find.a),0);
case compare(st,t^.wrd) of
1:find:=find(st,t^.right);
0:begin
d:=t^.dat;
while d<>nil do begin inc(find.n);find.a[find.n]:=d^.num;d:=d^.next;end;
end;
-1:find:=find(st,t^.left);
end;
end;

begin
writeln;
writeln('--SEARCH WORDS IN FILES----------------------------------');
write(' Total words:');readln(amount);
for i:=1 to amount do begin write(' Word',i,':');readln(words[i]); end;
p:=find(words[1],root);
writeln(p.a[1]);
end;}
procedure save;
begin
end;
procedure otpt(tr:tree);
var d:pnt;
begin
if tr^.left<>nil then otpt(tr^.left);
write(fileout,tr^.wrd);
d:=tr^.dat;
while d<>nil do begin write(fileout,d^.num:5);d:=d^.next end;
writeln(fileout);
if tr^.right<>nil then otpt(tr^.right);
end;
procedure help;
var rm:text;ch:char;
begin
writeln;
writeln;
writeln('==Help Menu=====================================================================');
writeln('read me.txt');
assign(rm,'readme.txt');
reset(rm);
while not eof(rm) do
begin
while not eoln(rm) do
begin read(rm,ch);write(ch) end;
readln(rm);
writeln;
end;
close(rm);
end;
procedure fls;
var i:longint;
begin
writeln;
writeln('--File List---------------------------------------------------------------------');
writeln;
for i:=1 to fotal do
writeln(' No.',i,' ',filelist[i]);
writeln;
ok;
end;
begin
writeln;
writeln('MT Search Kernel Beta.1');
writeln('--Need any help,type in "/help".------------------------------------------------');
start;
while 1>0 do
begin
write('-');
readln(command);
{ case command of
'/add' :add;
'/del' :del;
'/filelist':fls;
'/help' :help;
'/search' :srh;
'/outtree' :begin assign(fileout,'outtree.txt');rewrite(fileout);otpt(root);close(fileout);ok;end;
'/save' :save;
'/exit' :begin
repeat
writeln('Exit without saving the file list? (E)xit (S)ave (C)ancel');
readln(ch);
until ((ch='E') or(ch='e') or(ch='S')or (ch='s') or(ch='c')or (ch='C'));
if (ch='E') or (ch='e') then exit else if (ch='S') or (ch='s') then begin save;exit end;
end;
end; }
if command='/add' then add else
if command='/del' then del else
if command='/filelist' then fls else
if command='/help' then help else
if command='/search' then srh else
if command='/outtree' then begin assign(fileout,'outtree.txt');rewrite(fileout);otpt(root);close(fileout);ok;end else
if command='/save' then save else
begin if command='/exit' then begin
repeat
writeln('Exit without saving the file list? (E)xit (S)ave (C)ancel');
readln(ch);
until ((ch='E') or(ch='e') or(ch='S')or (ch='s') or(ch='c')or (ch='C'));
if (ch='E') or (ch='e') then exit else if (ch='S') or (ch='s') then begin save;exit end;
end; end
// else writeln('Bad command');
end;
end.

不用字符串的做法:
var
ch:array[1..10]of char;
i,j,k,n:integer;
begin
read(k){词组数}
for j:=1 to k do
begin
while (ch[i]<>' ')and(ch[i]<>'.' do
begin
inc(i);
read(ch[i]);
end;
for n:=1 to i do
write(ch[n]);
writeln;
end;
end.