procedure TForm1.Button1Click(Sender: TObject);
const yh=#39;
label redo,lr;
var
i,j,k,h,l,n,p0,p1,q,
tf,ll,nl,idd : integer;
stn,stc : array[1..20000] of string;
sline,sl,st,stcode,fname,blm,bs0 : string;
zf,chn,cf,chuan,yinhao: boolean;
fi,fo : textfile;
begin
memo1.Lines.Clear;
//放上一个memo控件
l:=0;
h:=0;
tf:=FileListBox1.Items.Count;
//放上一个FileListBox控件
redo:
nl:=0;
if l>=tf then exit;
fname:=FileListBox1.Items[l];
p0:=pos('.dcu',fname);
fname:=copy(fname,1,p0)+'pas';
memo1.Lines.Add(' ');
memo1.Lines.Add('// 源程序: '+fname);
l:=l+1;
if not ( FileExists(fname) ) then goto redo;
assignfile(fi,fname);
reset(fi);
assignfile(fo,'C'+fname);
rewrite(fo);
while not eof(fi) do
begin
readln(fi,sline);
sl:=trim(sline);
sl:=uppercase(sl);
if sl='END.' then
begin
writeln(fo,sline);
break;
end;
p0:=pos('//',sline);
if p0=1 then //空行或没有表示字符串存在的引号
begin
writeln(fo,sline);
continue;
end;
if p0>1 then sl:=copy(sline,1,p0-1)
else sl:=sline;
nl:=nl+1;
if (length(trim(sline))<1) or (pos(yh,sl)<1) then //空行或没有表示字符串存在的引号
begin
writeln(fo,sline);
continue;
end;
chuan:=false;
st:='';
p0:=0;
p1:=0;
k:=length(sl);
yinhao:=false;
while k>=1 do
begin
if (k>1) and (sl[k]=yh) and (sl[k-1]=yh) and (yinhao) then
begin
yinhao:=false;
k:=k-2;
continue;
end;
if sl[k]=yh then
begin
chuan:=not(chuan);
yinhao:=not(chuan);
if chuan then p1:=k else p0:=k;
k:=k-1;
continue;
end;
if (p1*p0>0) and (p1>p0+1) then st:=copy(sl,p0+1,p1-p0-1)
else begin k:=k-1;continue;end;
if length(st)=0 then
begin
k:=k-1;
continue;
end;
//检查字符串是否是中文?
chn:=false;
for i:=1 to length(st) do
if st[i]>#128 then chn:=true;
if not chn then
begin
st:='';
p1:=0;
p0:=0;
k:=k-1;
continue;
end;
//检查该字符串是否已存在?
cf:=false;
if h>1 then
for i:=1 to h do
if st=stc[i] then
begin
stcode:=stn[i];
cf:=true;
end;
if not cf then
begin
blm:=get_py(st);
//这里要用到昨天的获取汉字拼音首字母函数。
idd:=0;
bs0:=blm;
lr: idd:=idd+1;
for q:=1 to h do
if bs0=stn[q] then
begin
bs0:=blm+inttostr(idd);
goto lr;
end;
blm:=bs0;
h:=h+1;
stn[h]:=blm;
stcode:=blm;
stc[h]:=st;
memo1.Lines.Add('mymsg_'+stn[h]+#9+'='+#9+''''+stc[h]+''''+';'+#9+'// L'+inttostr(nl));
end;
if p0>0 then
begin
delete(sline,p0,p1-p0+1);
insert('mymsg_'+stcode+'(*'+st+'*)',sline,p0);
//将字符串代码 stcode 放到源程序中去:
end;
st:='';
p0:=0;
p1:=0;
k:=k-1;
end;
st:='';
writeln(fo,sline);
end;
closefile(fi);
closefile(fo);
goto redo;
end;