随拷随用

procedure TForm1.BitBtn1Click(Sender:TObject);

var

 SearchRec: TSearchRec; //TSearchRec是一个文件信息的纪录(Record)类型

 filelist: TStringlist; //TStringslist是字符串列表类型

 xls_txt_Ext,middle_vary: string;

//定义 xls_txt_Ext为文件后缀名变量,middle_vary为中间变量

 found: integer;

 aFileName: array of string; //aFileName为包含文件名数组

  x:integer;

//........................获取指定文件夹中文件名................................

{

TSearchRec是一个文件信息的纪录(Record)类型

在Windows下原型:

type

TSearchRec = record

Time: Integer;

Size: Integer;

Attr: Integer;       //SearchRec.Attr是查找的文件属性

Name: TFileName;

ExcludeAttr: Integer;

FindHandle: THandle;

FindData: TWin32FindData;

end;

}

 begin

  try

 begin

   filelist := TStringList.Create; //filelist启用

   found := FindFirst('D:\Myapp\R1.0\注：只存放导入文件(暂支持.txt,.xls后缀)\'+'*.*',faAnyFile,SearchRec);

   while found = 0 do

   begin

     if (SearchRec.Name <> '.')and(SearchRec.Name <> '..')then//SearchRec.Attr是查找的文件属性

     xls_txt_Ext := ExtractFileExt(SearchRec.Name);   //获取文件后缀名

     if (xls_txt_Ext ='.xls')or(xls_txt_Ext ='.txt') then

     filelist.Add(SearchRec.Name);  //List.Add('Strings1');filelist添加

     found := FindNext(SearchRec);

//FindNext是寻找下一个 TSearchRec是一个文件信息的纪录

   end;

   FindClose(SearchRec);  //关闭SearchRec

 end;

 except

   showmessage('获取文件名失败！');

 end;

{//..................FindFirst使用介绍 ........................................

 FindFirst是用来寻找目标目录下的第一个文件,声明如下：

 Fucntion FindFirst(const Path:String;Attr:Integer;VarF:TSearchRec):Integer;

返回结果保存到F参数中，成功返回0，否则返回错误代码

参数Path:包含路径和搜索模糊文件名，包括通配符: './text/*.*'搜索test目录下的全部文件

参数Attr:指定文件属性类型

 faReadOnly:只读文件  faHidden:隐藏文件  faSysFile:系统文件  faVolumeID:卷标文件

 faDirectory:目录文件  faArchive:归档文件//压缩文件  faAnyFile：任何文件

 Attr可以通过组合使用faReadOnly+faSysFile

注意:  使用FindFist是要分配内存的使用完之后必须用FindClose关闭

}

//..............................分割线..........................................

 

//..........把filelist数组中的文件名转移给aFileName数组 ........................

 Setlength(aFileName,filelist.Count); // Setlength(数组名,大小)为动态函数分配大小

  forx:=0 to filelist.Count-1 do

 begin

   middle_vary := ChangeFileExt(ExtractFileName(filelist[x]),'');

   showmessage(filelist[x]+#13+middle_vary);     //测试语句

   aFileName[x] :=ChineseFileName(middle_vary);  //将文件名只留下汉字代码段

   showmessage(aFileName[x]);    //测试语句

 end;

 

//注：由于不确定是否能定义多个TStringlist类的对象，故将值用自定义的组数aFileName存储

//..............................分割线..........................................

 filelist.Free;     //释放filelist

end;

 

procedure TForm1.BitBtn2Click(Sender:TObject);

begin

  form2.showmodal;

end;

 

 

 

 

//..............将文件名只留下汉字代码段.......................................

FunctionChineseFileName(CFileName:string):string;

var

 middle_length,y: integer;

 middle_vary1:string;

begin

 middle_length := length(CFileName);

 y:=0;

 while(y<middle_length) do

 begin

  if(ByteType(CFileName,y) <> mbSingleByte) then

 begin

   middle_vary1 := middle_vary1+ copy(CFileName,y,2)+'';

//copy该函数用于从字符串中复制指定范围中的字符

   y:=y+2;

  end

 else

   y:=y+1;

 end;

 result:= middle_vary1;

end;

end.