unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ShlObj,StrUtils, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
btn2: TButton;
ListBox1: TListBox;
btn3: TButton;
DateTimePicker1: TDateTimePicker;
DateTimePicker2: TDateTimePicker;
DateTimePicker3: TDateTimePicker;
DateTimePicker4: TDateTimePicker;
btn4: TButton;
Label2: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
procedure btn4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
function SelectFolderDialog(const Handle: integer; const Caption: string;
const InitFolder: WideString; var SelectedFolder: string): boolean;
var
BInfo: _browseinfo;
Buffer: array[0..MAX_PATH] of Char;
ID: IShellFolder;
Eaten, Attribute: Cardinal;
ItemID: PItemidlist;
begin
Result := False;
BInfo.HwndOwner := Handle;
BInfo.lpfn := nil;
BInfo.lpszTitle := Pchar(Caption);
BInfo.ulFlags := BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE;
SHGetDesktopFolder(ID);
ID.ParseDisplayName(0, nil, PWideChar(InitFolder), Eaten, ItemID, Attribute);
BInfo.pidlRoot := ItemID;
GetMem(BInfo.pszDisplayName, MAX_PATH);
try
if SHGetPathFromIDList(SHBrowseForFolder(BInfo), Buffer) then
begin
SelectedFolder := Buffer;
if Length(SelectedFolder) <> 3 then
SelectedFolder := SelectedFolder + '\';
result := True;
end
else
begin
SelectedFolder := '';
Result := False;
end;
finally
FreeMem(BInfo.pszDisplayName);
end;
end;
function SearchFile(mainpath:string;filename:string; var foundresult:TStrings):Boolean;
function IsValidDir(SearchRec:TSearchRec):Boolean;
begin
if (SearchRec.Attr=16) and
(SearchRec.Name <> '. ') and
(SearchRec.Name <> '.. ') then
Result:=True
else
Result:=False;
end;
var
i:integer;
Found:Boolean;
subdir1:TStrings;
searchRec:TsearchRec;
begin
if copy(mainpath,length(mainpath),1) <> '\ ' then mainpath:=mainpath+ '\ ';
found:=false;
if Trim(filename) <> ' ' then
begin
subdir1:=TStringList.Create;
if (FindFirst(mainpath+ '*.* ', faDirectory,SearchRec)=0) then
begin
if IsValidDir(SearchRec) then subdir1.Add(SearchRec.Name);
while (FindNext(SearchRec) = 0) do
begin
if IsValidDir(SearchRec) then subdir1.Add(SearchRec.Name);
end;
end;
FindClose(SearchRec);
//查找当前目录。
if (FindFirst(mainpath+ '*.* ', faAnyFile-faDirectory, SearchRec)=0) then
begin
foundresult.Add(mainpath+SearchRec.Name);
while (FindNext(SearchRec) = 0) do
begin
foundresult.Add(mainpath+SearchRec.Name);
end;
end;
FindClose(SearchRec);
for i:=0 to subdir1.Count-1 do
found:=Searchfile(mainpath+subdir1.Strings[i]+
'\ ',Filename,foundresult)or found;
subdir1.Free;
end;
result:=found;
end;
function MakeFileList(Path,FileExt:string):TStringList ;
var
sch:TSearchrec;
begin
Result:=TStringlist.Create;
if rightStr(trim(Path), 1) <> '\' then
Path := trim(Path) + '\'
else
Path := trim(Path);
if not DirectoryExists(Path) then
begin
Result.Clear;
exit;
end;
if FindFirst(Path + '*', faAnyfile, sch) = 0 then
begin
repeat
Application.ProcessMessages;
if ((sch.Name = '.') or (sch.Name = '..')) then Continue;
if DirectoryExists(Path+sch.Name) then // 这个地方加上一个判断，可以区别子文件夹河当前文件夹的操作
begin
Result.AddStrings(MakeFileList(Path+sch.Name,FileExt));
end
else
begin
if (UpperCase(extractfileext(Path+sch.Name)) = UpperCase(FileExt)) or (FileExt='.*') then
Result.Add(Path+sch.Name);
end;
until FindNext(sch) <> 0;
SysUtils.FindClose(sch);
end;
end;
procedure ModifyFileDate(const ASourceFile:string);
var
LSourceStream: TFileStream;
FT : FILETIME;
ST : SYSTEMTIME;
begin
LSourceStream := TFileStream.Create(ASourceFile, fmOpenReadWrite);
try
FileTimeToSystemTime(FT,ST);
ST.wYear :=2009;
ST.wMonth :=5;
ST.wDay :=10;
SystemTimeToFileTime(ST,FT);
SetFileTime(LSourceStream.Handle,@FT,@FT,@FT);
finally
FreeAndNil(LSourceStream);
end;
end;
function CovFileDate(Fd:_FileTime):TDateTime; // 转换文件的时间格式
var
Tct:_SystemTime;
Temp:_FileTime;
begin
FileTimeToLocalFileTime(Fd,Temp);
FileTimeToSystemTime(Temp,Tct);
CovFileDate:=SystemTimeToDateTime(Tct);
end;
procedure SetFileDateTime(const Tf:string); //设置文件时间，输入值表示目标文件的路径
var
Dt1,Dt2:Integer;
Fs:TFileStream;
Fct,Flt:TFileTime;
begin
Dt1:=DateTimeToFileDate(Trunc(Form1.DateTimePicker1.Date) + Frac(Form1.DateTimePicker2.Time));
Dt2:=DateTimeToFileDate(Trunc(Form1.DateTimePicker3.Date) + Frac(Form1.DateTimePicker4.Time));
//以上转换用户输入在DataTimePicker中的信息，Form1.DateTimePicker1.Date和Form1.DateTimePicker2.Time就是创建时间，Form1.DateTimePicker3.Date和Form1.DateTimePicker4.Time就是修改时间
try
FS := TFileStream.Create(Tf, fmOpenReadWrite); //创建TFileStream
try
if DosDateTimeToFileTime(LongRec(DT1).Hi, LongRec(DT1).Lo, Fct) and LocalFileTimeToFileTime(Fct, Fct) and dosDateTimeToFileTime(LongRec(DT2).Hi, LongRec(DT2).Lo, Flt) and LocalFileTimeToFileTime(Flt, Flt)
then SetFileTime(FS.Handle,@Fct, @Flt, @Flt); // 设置文件时间属性
finally
FS.Free; //释放
end;
MessageDlg('修改成功',mtconfirmation, [mbOk], 0); //提示成功
except
MessageDlg('修改失败',mtError, [mbOk], 0); //因为目标文件正在被使用等原因而导致失败
end;
end;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
NewDir: string;
begin
if SelectFolderDialog(Handle, '选择', '', NewDir) then
label1.Caption:=NewDir;
end;
procedure TForm1.btn2Click(Sender: TObject);
begin
ListBox1.Items:= MakeFileList(Label1.Caption ,'.*');
end;
procedure TForm1.btn3Click(Sender: TObject);
var i:integer;
begin
for i:=0 to listbox1.Items.Count-1 do
ModifyFileDate (ListBox1.Items[i]);
end;
procedure TForm1.btn4Click(Sender: TObject);
var i:integer;
begin
for i:=0 to listbox1.Items.Count-1 do
if ListBox1.Selected[i] then
begin
SetFileDateTime (ListBox1.Items[i]);
end;
end;
end.
但是能分别显示日期和时间，就是说要用两个datetimepicker来实现
一个设置kind属性为dtkdate，另外一个设置kind属性为dtkTime，就行了。
浙公网安备 33010602011771号