精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● Delphi>>文件>>常用文件目录操作*12

主题:常用文件目录操作*12
发信人: aaa234(我只只在乎你)
整理人: teleme(2001-06-09 19:59:42), 站内信件
1-得到短文件名 
function GetShortFileName(const FileName : string) : string; 
var 
  aTmp: array[0..255] of char; 
begin 
  if GetShortPathName(PChar(FileName),aTmp,Sizeof(aTmp)-1)=0 then 
     Result:= FileName 
  else 
     Result:=StrPas(aTmp); 
end; 
2-长文件名 
function GetLongFileName(const FileName : string) : string; 
var 
  aInfo: TSHFileInfo; 
begin 
  if SHGetFileInfo(PChar(FileName),0,aInfo,Sizeof(aInfo),SHGFI_DISPLAYNAME)<>0 then 
     Result:= string(aInfo.szDisplayName) 
  else 
     Result:= FileName; 
end; 

删除到回收站 
uses ShellAPI; 

procedure SendToRecycleBin(FileName: string); 
var 
  SHF: TSHFileOpStruct; 
begin 
  with SHF do begin 
    Wnd := Application.Handle; 
    wFunc := FO_DELETE; 
    pFrom := PChar(FileName); 
    fFlags := FOF_SILENT or FOF_ALLOWUNDO; 
  end; 
  SHFileOperation(SHF); 
end; 

得到文件最后改动时间 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  FileHandle : THandle; 
  LocalFileTime : TFileTime; 
  DosFileTime : DWORD; 
  LastAccessedTime : TDateTime; 
  FindData : TWin32FindData; 
begin 
  FileHandle := FindFirstFile('AnyFile.FIL', FindData); 
  if FileHandle <> INVALID_HANDLE_VALUE then 
  begin 
    Windows.FindClose(Handle); 
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then 
    begin 
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); 
      FileTimeToDosDateTime(LocalFileTime, 
      LongRec(DosFileTime).Hi,LongRec(DosFileTime).Lo); 
      LastAccessedTime := FileDateToDateTime(DosFileTime); 
      Label1.Caption := DateTimeToStr(LastAccessedTime); 
    end; 
  end; 
end; 

得到目录大小 
function TFileBrowser.DirSize(Dir:string):integer; 
  var 
  SearchRec : TSearchRec; 
  Separator : string; 

begin 
  if Copy(Dir,Length(Dir),1)='\' then 
    Separator := '' 
  else 
    Separator := '\'; 
  if FindFirst(Dir+Separator+'*.*',faAnyFile,SearchRec) = 0 then 
  begin 
    if FileExists(Dir+Separator+SearchRec.name) then 
    begin 
      DirBytes := DirBytes + SearchRec.Size; 
      {Memo1.Lines.Add(Dir+Separator+SearchRec.Name);} 
    end 
    else 
      if DirectoryExists(Dir+Separator+SearchRec.name) then 
      begin 
        if (SearchRec.name<>'.') and (SearchRec.name<>'..') then 
          DirSize(Dir+Separator+SearchRec.name); 
      end; 
    end; 
    while FindNext(SearchRec) = 0 do 
    begin 
      if FileExists(Dir+Separator+SearchRec.name) then 
      begin 
        DirBytes := DirBytes + SearchRec.Size; 
        {Memo1.Lines.Add(Dir+Separator+SearchRec.Name);} 
      end 
      else 
        if DirectoryExists(Dir+Separator+SearchRec.name) then 
        begin 
          if (SearchRec.name<>'.') and (SearchRec.name<>'..') then 
            DirSize(Dir+Separator+SearchRec.name); 
        end; 
      end; 
    end; 
  end; 
  FindClose(SearchRec); 
end; 
扫描驱动器 
  private 
    { Private declarations } 
    FScanAborted: Boolean; 

  public 
    { Public declarations } 
    function ScanDrive( root, filemask: string; hitlist: TStrings ): Boolean; 


function TForm1.ScanDrive( root, filemask: string; hitlist: TStrings ): 
Boolean; 
  function ScanDirectory( var path: string ): Boolean; 
    var 
      SRec: TSearchRec; 
      pathlen: Integer; 
      res: Integer; 
    begin 
      label1.caption := path; 
      pathlen:= Length(path); 
      { first pass, files } 
      res := FindFirst( path+filemask, faAnyfile, SRec ); 
      if res = 0 then 
      try 
        while res = 0 do begin 
          hitlist.Add( path + SRec.name ); 
          res := FindNext(SRec); 
        end; 
      finally 
        FindClose(SRec) 
      end; 
      Application.ProcessMessages; 
      Result := not (FScanAborted or Application.Terminated); 
      if not Result then Exit; 

      {second pass, directories} 
      res := FindFirst( path+'*.*', faDirectory, SRec ); 
      if res = 0 then 
      try 
        while (res = 0) and Result do begin 
          if ((Srec.Attr and faDirectory) = faDirectory) and 
             (Srec.name[1] <> '.') 
          then begin 
            path := path + SRec.name + '\'; 
            Result := ScanDirectory( path ); 
            SetLength( path, pathlen ); 
          end; 
          res := FindNext(SRec); 
        end; 
      finally 
        FindClose(SRec) 
      end; 
    end; 
begin 
  FScanAborted := False; 
  Screen.Cursor := crHourglass; 
  try 
    Result := ScanDirectory(root); 
  finally 
    Screen.Cursor := crDefault 
  end; 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
var 
   ch: Char; 
   root: string; 
begin 
   root := 'C:\'; 
   for ch := 'A' to 'Z' do begin 
     root[1] := ch; 
     case GetDriveType( Pchar( root )) of 
       DRIVE_FIXED, DRIVE_REMOTE: 
         if not ScanDrive( root, edit1.text, listbox1.items ) then 
           Break; 
     end; 
   end; 
end; 

procedure TForm1.Button3Click(Sender: TObject); 
begin // aborts scan 
  fScanAborted := True; 
end; 

改目录名 
var 
  OldName,NewName : string; 

  . 
  . 
  OldName := 'C:\UTILITIES'; 
  NewName := 'C:\UTILS'; 
  if MoveFile(PChar(OldName), PChar(NewName)) then 
ShowMessage('Directory renamed!') 
                                     else ShowMessage('Failure 
renaming directory!'); 
  . 
  . 
end.  

临时文件 
function DGetTempFileName (const Folder, Prefix : string; const Unique: UINT) : string; 
var 
   FileName : array[0..MAX_PATH] of Char; 
begin 
   if GetTempFileName (PChar (Folder), PChar (Prefix), Unique, FileName) = 0 then 
       raise Exception.Create ('GetTempFileName error'); 
   Result := FileName; 
end; 




[关闭][返回]