找出自己应用程序里面所有的中文字符串,替换为字符串变量,并将所有字符串放到一个文本文件中。

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;

posted on 2011-08-15 07:31  dps  阅读(543)  评论(0编辑  收藏  举报

导航