bm_changefileu.~pas

DELPHI办公全套管理系统

unit BM_CHANGEFILEU;

interface

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

type
  TBM_CHANGEFILEF = class(TForm)
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    CheckBox1: TCheckBox;
    Memo1: TMemo;
    rnlist1: TStringGrid;
    OpenDialog1: TOpenDialog;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    ComboBox1: TComboBox;
    Label2: TLabel;
    Panel2: TPanel;
    RadioB1: TRadioButton;
    RadioB2: TRadioButton;
    Panel3: TPanel;
    LEdit1: TLabeledEdit;
    UpDown1: TUpDown;
    Label3: TLabel;
    ComboBox2: TComboBox;
    CheckBox2: TCheckBox;
    ComboBox3: TComboBox;
    Edit1: TEdit;
    SpeedButton5: TSpeedButton;
    Edit2: TEdit;
    ListBox1: TListBox;
    SpeedButton6: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure RadioB1Click(Sender: TObject);
    procedure RadioB2Click(Sender: TObject);
    procedure UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;
      NewValue: Smallint; Direction: TUpDownDirection);
    procedure CheckBox2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
  private
    { Private declarations }
    procedure SearchFile(path:string);
  public
    { Public declarations }
  end;

var
  BM_CHANGEFILEF: TBM_CHANGEFILEF;
  totanum:integer;
 ii,tmplen:integer;
  tmptstr:tstrings;
implementation

{$R *.dfm}
function getffname(ffname:string):string;
begin   //只取文件名,不取扩展名
 result:=copy(ffname,1,LastDelimiter('.',ffname)-1);
end;
function getint(instr:string;intx:integer):string;
var ii,cc0:integer;
    is0:boolean;
    str0:string;
begin
 is0:=true;
 cc0:=0;
 if length(instr)>1 then        //当起始数字只为1位时没必要加前导0
  for ii:=1 to length(instr) do begin    //得到前导0的个数
   if not is0 then break;
   if instr[ii]='0' then inc(cc0)
   else is0:=false;
  end;
        //计算因进位而减少前导0的数量
 cc0:=cc0-(length(inttostr(strtoint(instr)+intx-1))-length(inttostr(strtoint(instr))));
 str0:='';
 for ii:=1 to cc0 do  str0:=str0+'0';   //转为字串
 result:=str0+inttostr(strtoint(instr)+intx-1);//前导0+数值
end;
function getletter(sletter:string;addorsub:boolean;steps:integer):string;
var ii,strord:integer;
    tmpstr:string;
begin   //字母递增
 strord:=0;
  for ii:=1 to length(sletter) do
   strord:=strord+(ord(sletter[ii])-65)*round(power(26,length(sletter)-ii)) ; //power(x,y):float X的Y次方
  if addorsub then
   strord:=strord+steps
  else if strord>1 then
   strord:=strord-steps;
  tmpstr:='';
  while (strord>=26) do
  begin
   tmpstr :=chr(strord mod 26 +65)+tmpstr;
   strord:=strord div 26;
  end;
   tmpstr :=chr(strord mod 26 +65)+tmpstr;
 result:=tmpstr;
end;
function getok(mbstr,instr,startx:string;norl:boolean;intx:integer;fore:boolean):string;
             //模板字串,输入字串,开始字符,数字/字母,列表中序号,文件名/扩展名
var tmpok:string;
begin
 tmpok:='';
 while length(mbstr)>0 do
 begin
  if mbstr[1]='*' then begin
   if fore then tmpok:=tmpok+getffname(instr) else tmpok:=tmpok+instr ;
   delete(mbstr,1,1);
  end
  else
   if mbstr[1]='<' then
    if pos('>',mbstr)>0 then begin
     tmpok:=tmpok+instr[strtoint(copy(mbstr,2,pos('>',mbstr)-2))];
     delete(mbstr,1,pos('>',mbstr));
    end
    else begin tmpok:=tmpok+mbstr[1]; delete(mbstr,1,1); end
   else
    if mbstr[1]='?' then begin
     if norl then tmpok:=tmpok+getint(startx,intx)
     else tmpok:=tmpok+getletter(startx,true,intx-1);
     delete(mbstr,1,1);
    end
    else begin tmpok:=tmpok+mbstr[1]; delete(mbstr,1,1); end;
 end;
 result:=tmpok;
end;
procedure TBM_CHANGEFILEF.SpeedButton1Click(Sender: TObject);

begin
if opendialog1.Execute then
 begin
  totanum:=totanum+opendialog1.Files.Count;
  rnlist1.RowCount:=totanum;
//  tmptstr:=tstrings.Create ;
  tmptstr:=opendialog1.Files;
  tmplen:=tmptstr.Count ;
  for ii:=0 to tmplen-1 do begin
   rnlist1.Cols[0].Append(ExtractFileName(tmptstr.Strings[ii]));
   rnlist1.Cols[1].Append(ExtractFileName(tmptstr.Strings[ii]));
   rnlist1.Cols[2].Append(ExtractFilePath(tmptstr.Strings[ii]));
  end;
//  rnlist1.Cols[0].AddStrings(tmptstr);
 end;
end;

procedure TBM_CHANGEFILEF.SpeedButton2Click(Sender: TObject);
var nn,cc:integer;
begin
 cc:=rnlist1.Selection.Bottom-rnlist1.Selection.Top+1;
 if rnlist1.RowCount<=2 then rnlist1.rows[1].clear
 else begin
  for nn:= rnlist1.Selection.Top to rnlist1.Selection.Bottom do
   rnlist1.Rows[nn].Clear ;
  for nn:= rnlist1.Selection.Bottom+1 to rnlist1.RowCount-1 do begin
   rnlist1.Rows[nn-cc]:=rnlist1.Rows[nn];
   rnlist1.Rows[nn].Clear ;
  end;
  if rnlist1.RowCount-cc<2 then rnlist1.RowCount:=2
  else  rnlist1.RowCount:= rnlist1.RowCount-cc;
 end;
 totanum:=rnlist1.RowCount-1;

end;

procedure TBM_CHANGEFILEF.SpeedButton3Click(Sender: TObject);
var moban,okstr,nostr,tmpstr :string;
    nn,ii:integer;
    tmplist:tstrings;
begin   //预览
//先执行模板改名
 nostr:='\/:"<>*?|';
 if checkbox1.Checked then begin        //如果允许使用模板
  moban:=combobox2.Text;
   for nn:=1 to rnlist1.RowCount-1 do begin
    okstr:='';
    okstr:=getok(moban,rnlist1.Cells[0,nn],ledit1.Text,radiob1.Checked,nn,true);
    if rnlist1.Cells[0,nn]<>'' then
     if checkbox2.Checked then   //如果允许改扩展名
      rnlist1.Cells[1,nn]:=okstr+getok(combobox3.Text,extractfileext(rnlist1.Cells[0,nn]),ledit1.Text,radiob1.Checked,nn,false)
     else
      rnlist1.Cells[1,nn]:=okstr+extractfileext(rnlist1.Cells[0,nn]);
    tmpstr:='';
    for ii:=1 to length(rnlist1.Cells[1,nn]) do
     if pos(rnlist1.Cells[1,nn][ii],nostr)<=0 then
      tmpstr:=tmpstr+rnlist1.Cells[1,nn][ii];
    rnlist1.Cells[1,nn]:=tmpstr;  
   end;
  tmplist:=rnlist1.Cols[1];
 end
 else
  tmplist:=rnlist1.Cols[0];
// 判断是否有非法字符

//再执行大小写转换
 case combobox1.ItemIndex of
  0: rnlist1.Cols[1]:=tmplist;
  1: for nn:=1 to rnlist1.RowCount-1 do   //首字母大写,其他小写
      if rnlist1.Cells[0,nn]<>'' then
       rnlist1.Cells[1,nn]:=uppercase(tmplist.Strings[nn][1])+lowercase(copy(tmplist.Strings[nn],2,length(tmplist.Strings[nn])-1));
  2: for nn:=1 to rnlist1.RowCount-1 do   //全部大写
      if rnlist1.Cells[0,nn]<>'' then
       rnlist1.Cells[1,nn]:=uppercase(tmplist.Strings[nn]);
  3: for nn:=1 to rnlist1.RowCount-1 do   //全部小写
      if rnlist1.Cells[0,nn]<>'' then
       rnlist1.Cells[1,nn]:=lowercase(tmplist.Strings[nn]);
  4: for nn:=1 to rnlist1.RowCount-1 do   //文件名大写
      if rnlist1.Cells[0,nn]<>'' then
       rnlist1.Cells[1,nn]:=uppercase(getffname(tmplist.Strings[nn]))+extractfileext(tmplist.Strings[nn]);
  5: for nn:=1 to rnlist1.RowCount-1 do   //文件名小写
      if rnlist1.Cells[0,nn]<>'' then
       rnlist1.Cells[1,nn]:=lowercase(getffname(tmplist.Strings[nn]))+extractfileext(tmplist.Strings[nn]);
  6: for nn:=1 to rnlist1.RowCount-1 do   //扩展名大写
      if rnlist1.Cells[0,nn]<>'' then
       rnlist1.Cells[1,nn]:=getffname(tmplist.Strings[nn])+uppercase(extractfileext(tmplist.Strings[nn]));
  7: for nn:=1 to rnlist1.RowCount-1 do   //扩展名小写
      if rnlist1.Cells[0,nn]<>'' then
       rnlist1.Cells[1,nn]:=getffname(tmplist.Strings[nn])+lowercase(extractfileext(tmplist.Strings[nn]));
 end;
 rnlist1.Cells[1,0]:='新文件名';

end;

procedure TBM_CHANGEFILEF.SpeedButton4Click(Sender: TObject);
var  nn:integer;
begin
 SpeedButton3click(self);//先执行预览,然后根据预览结果改名
 for nn:=1 to rnlist1.RowCount-1 do
  if rnlist1.Cells[0,nn]<>'' then
   RenameFile(rnlist1.Cells[2,nn]+rnlist1.Cells[0,nn],rnlist1.Cells[2,nn]+rnlist1.Cells[1,nn]);
 rnlist1.Cols[0]:= rnlist1.Cols[1];
 rnlist1.Cells[0,0]:='原文件名';
 showmessage('文件改名完毕!');

end;

procedure TBM_CHANGEFILEF.CheckBox1Click(Sender: TObject);
begin
radiob1.Enabled := checkbox1.Checked;
  radiob2.Enabled := checkbox1.Checked;
  ledit1.Enabled := checkbox1.Checked;
  updown1.Enabled := checkbox1.Checked;
  label3.Enabled := checkbox1.Checked;
  label4.Enabled := checkbox1.Checked;
  combobox2.Enabled := checkbox1.Checked;
  checkbox2.Enabled :=  checkbox1.Checked;
end;

procedure TBM_CHANGEFILEF.RadioB1Click(Sender: TObject);
begin
if radiob1.Checked then
  ledit1.Text :='0';
 updown1.Position :=0;
end;

procedure TBM_CHANGEFILEF.RadioB2Click(Sender: TObject);
begin
 if radiob2.Checked then
  ledit1.Text :='A';
 updown1.Position :=0;
end;

procedure TBM_CHANGEFILEF.UpDown1ChangingEx(Sender: TObject;
  var AllowChange: Boolean; NewValue: Smallint;
  Direction: TUpDownDirection);
begin
 if radiob1.Checked then
  if direction=updup then
   ledit1.Text :=inttostr(strtoint(ledit1.Text)+1)
  else
  begin if strtoint(ledit1.Text)>0 then
   ledit1.Text :=inttostr(strtoint(ledit1.Text)-1);
  end
 else if direction=updUp then ledit1.Text :=getletter(ledit1.Text,true,1)
      else ledit1.Text :=getletter(ledit1.Text,false,1);

end;

procedure TBM_CHANGEFILEF.CheckBox2Click(Sender: TObject);
begin
  combobox3.Enabled:= checkbox2.Checked;
end;

procedure TBM_CHANGEFILEF.FormCreate(Sender: TObject);
begin
rnlist1.Cells[0,0]:='原文件名';
 rnlist1.Cells[1,0]:='新文件名';
 rnlist1.Cells[2,0]:='文件路径';
 totanum:=1;
 label4.Caption :='模板说明:'+#13
 +'用*符号 代表原文件名(或扩展名);'+#13
 +'用<X>符号 代表原文件名(或扩展名)中第'+#13
 +'  　　　　X个字母,X为数字;'+#13
 +'用?符号 替换原文件名(或扩展名)中对应'+#13
 +'　　　　位置的字母为数字或字母;' ;
end;

procedure TBM_CHANGEFILEF.SearchFile(path: string);
var
  sr: TSearchRec;
begin
 {
  if FindFirst(path,faanyfile, sr) = 0 then
  repeat 
  if (sr.name<>'.') and (sr.name<>'..') then
      if (sr.Attr and fadirectory) = fadirectory then
      SearchFile(path+'\'+sr.name)
      else
      begin
       listbox1.Items.Add(sr.name+'            ['+path+sr.name+']');
       totanum:=totanum+listbox1.Items.Count ;
          rnlist1.RowCount:=totanum;
          tmplen:=tmptstr.Count ;
          for ii:=0 to tmplen-1 do
          begin
           rnlist1.Cols[0].Append(path+sr.name);
           rnlist1.Cols[1].Append(path+sr.name);
           rnlist1.Cols[2].Append(path+sr.name);
          end;
   until findnext(sr)<>0 ;
  end;  }
end;

procedure TBM_CHANGEFILEF.SpeedButton5Click(Sender: TObject);
begin
listbox1.Items.Clear ;
SearchFile(edit1.Text+'\'+edit2.Text);

end;

procedure TBM_CHANGEFILEF.SpeedButton6Click(Sender: TObject);
begin
close;
end;

end.