/////////////////////////////////////////////////////////////
//            MYFUNCTION 日期、文件操作居多       //
//       多媒体操作的部分正在整理，整理好上传    //
/////////////////////////////////////////////////////////////    unit Utils;    interface    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,ComCtrls,
    Dialogs, StdCtrls,IniFiles,StrUtils,DateUtils,IdGlobal, shlObj, FileCtrl,Reg,shellapi;    //->> 取得YYYY年strDate月的第N个星期X的日期
Function GetDateForWeek(StrDate:string;N,X:integer):String;    //->> 取得两个时间相差值
Function CalcDateDiff(EndDate,StartDate:TDateTime):Longword;    //->> 删除目录函数
//**** 建议复制、删除目录不要使用CHDIR即相对路径，因为我以前这样用的，导致在一个多线程里删除出错，
//**** 因为当该线程的将相对路径修改时，其它线程也收到影响
//vForced 是否删除只读文件s
Function DeleteDir(const vDirPath: AnsiString;vForced : Boolean=True): Boolean;    //->> 取得文件的修改时间
Function GetModifyDate(FileName:String):TDateTime;    //->> 判断是否是目录
Function IsDirectory(IsDirPath: String): Boolean;    //->> 将一个很长的路径转换为 \..\XXX.XXX格式
Function MinimizePathName(Wnd: HWND;Const Filename: String):String;    //->> 得到上一级目录
Function GetUpPath(Const NowPath: String):String;    //->> 取得指定文件的长度
Function GetFileLen(Const FileName: String):int64;    //->> 取得指定目录的长度(*havesub 为true时，包含子目录 为false时，不包含子目录)
Function GetDirectorySize(const ADirectory: string; havesub: Boolean): int64;    //->> 得到系统的PATH
Function GetSystemPath:string;    //->> 监测一个文件是否可以被打开
Function FileCanBeOpened(Const fname: String ): Boolean;    //->> 检验两个文件是否相等
Function Are2FilesEqual(Const fileName1,fileName2: String):Boolean;    //->> CRC效验,FileName为文件路径
Function GetCheckSum(FileName:String):DWORD;    //->> 取得特殊文件夹路径，更多的请参看ShlObj单元
//**** CSIDL_DESKTOP 桌面
//**** CSIDL_PROGRAMS Programs
//**** CSIDL_FAVORITES 收藏夹
//**** CSIDL_FONTS 字体
Function GetSpecialFolderDir(const folderid:integer):string;    //->> 取得磁盘容量，支持FAT、NTFS,传回时自动转换成MB或GB，isFree是控制取可用空间，还是全部空间大小
function MyGetDiskSize(obj : string; isFree:boolean ): string;    //->> 给定文件名取得在系统盘下的路径，复制时用
function PathSystemDriveFile(const Filename: string): string;    implementation    function GetDateForWeek(strDate:string;N,X:integer):String;
var
  i : integer;
begin
  try
    strDate := strDate   '-01';
    if dayofweek(strtodate(strDate)) > X then
      strDate := datetostr(strtodate(strDate) 7-dayofweek(strtodate(strDate)) X)
    else
      strDate := datetostr(strtodate(strDate) X-dayofweek(strtodate(strDate)));        For i := 1 to N Do
    begin
      strDate := formatDateTime('YYYY-MM-DD',strtoDate(strDate)  7);
    end;
  except
    showmessage('请正确输入参数，如：2003-01，0，1');
  end;
  result := strDate;
end;    function CalcDateDiff(EndDate,StartDate:TDateTime):Longword;
begin
  Result:=Trunc(EndDate-StartDate);
end;    function DeleteDir(const vDirPath: AnsiString;vForced : Boolean=True): Boolean;
var
  r: TSearchRec;
  d, nd: AnsiString;
begin
  try
    Result := true;
    d := IncludeTrailingPathDelimiter(vDirPath);
    if DirectoryExists(d) then
    begin
      if FindFirst(d   '*.*',faAnyFile,r) = 0 then
      begin
        repeat
          application.ProcessMessages;
          if (r.Name <> '.') and (r.Name <> '..') then
          begin
            nd := d   r.Name;
            if vForced then FileSetAttr(nd, r.Attr and (not faReadOnly));
            if (r.Attr and faDirectory) <> 0 then
            begin
              DeleteDir(nd,vForced);
            end
            else
            begin
              DeleteFile(PChar(nd));
            end;
          end;
        until FindNext(r) <> 0;
      end;
      FindClose(r);
      if vForced then FileSetAttr(d, FileGetAttr(d) and (not faReadOnly));
      if Not RemoveDir(d) then
      begin
        FileSetAttr(d,faArchive);
        Result := RemoveDir(d);
      end
      else
      begin
        Result := True;
      end;
    end;
  except
    on e: Exception do begin result := false; FindClose(r); end;
  end;
end;    function GetModifyDate(FileName:String):TDateTime;
var
  SearchRec: TSearchRec;
begin
  try
    if FindFirst(ExpandFileName(FileName),faAnyFile,SearchRec) = 0 then
      Result := FileDateToDateTime(SearchRec.Time)
    else
      Result := 0;
  finally
    FindClose(SearchRec);
  end;        
end;    Function IsDirectory(IsDirPath: String): Boolean;
var
  FileGetAttrValue: Integer;
begin
{$IFDEF WIN32}
  Result := DirectoryExists(IsDirPath);
  Exit;
{$ENDIF}
  FileGetAttrValue := FileGetAttr(IsDirPath);
  if FileGetAttrValue = 16 Then
  begin
    Result := True;
  end
  else
  begin
    Result := False;
  end;
end;    function MinimizePathName(Wnd: HWND; const Filename: string): string;
{ func to shorten the long path name with an ellipses '...' to fit }
{ in whatever control is passed to the Wnd parameter.              }
{ Usage: Panel1.Caption := MinimizePathName(Panel1.Handle, DirectoryOutline1.Directory) }
{        This will shorten the path if necessary to fit in Panel1.                      }
  procedure CutFirstDirectory(var S: string);
  var
    Root: Boolean;
    P: Integer; 
  begin
    if S = '\' then
      S := ''
    else 
      begin
        if S[1] = '\' then
          begin
            Root := True;
            Delete(S, 1, 1);
          end
        else
          Root := False;
        if S[1] = '.' then
          Delete(S, 1, 4);
        P := Pos('\',S);
        if P <> 0 then
          begin
            Delete(S, 1, P);
            S := '...\'   S;
          end
        else
          S := '';
        if Root then
          S := '\'   S;
      end;
  end;      function GetTextWidth(DC: HDC; const Text: string): Integer;
  var
    Extent: TSize;
  begin
    if GetTextExtentPoint(DC, PChar(Text), Length(Text), Extent) then 
      Result := Extent.cX - 80
    else 
      Result := 0;
  end;    var
  Drive,
  Dir,
  Name: string; 
  R: TRect;
  DC: HDC;
  MaxLen: integer;
  OldFont, Font: HFONT; 
begin
  Result := FileName;      if Wnd = 0 then
    Exit;      DC := GetDC(Wnd); 
  if DC = 0 then
    Exit;      Font := HFONT(SendMessage(Wnd, WM_GETFONT, 0, 0));
  OldFont := SelectObject(DC, Font);
  try
    GetWindowRect(Wnd, R);
    MaxLen := R.Right - R.Left;        Dir := ExtractFilePath(Result);
    Name := ExtractFileName(Result);        if (Length(Dir) >= 2) and (Dir[2] = ':') then
      begin
        Drive := Copy(Dir, 1, 2);
        Delete(Dir, 1, 2);
      end
    else 
      Drive := '';        while ((Dir <> '') or (Drive <> '')) and (GetTextWidth(DC, Result) > MaxLen) do
      begin
        if Dir = '\...\' then
          begin
            Drive := '';
            Dir := '...\';
          end
        else
          if Dir = '' then
            Drive := ''
          else
            CutFirstDirectory(Dir);
        Result := Drive   Dir   Name;
      end;
  finally
    SelectObject(DC, OldFont);
    ReleaseDC(Wnd, DC);
  end;
end;    Function GetUpPath(Const NowPath: String):String;
var
  GetPath : String;
  i : Integer;
begin
  GetPath := Trim(NowPath);
  if GetPath = '' then
  begin
    Result := 'Failed';
    exit;
  end;
  if Pos('\',GetPath)<=1 then
  begin
    Result := 'Failed';
    exit;
  end;
  if Rightbstr(GetPath,1)='\' then
  begin
    GetPath := LeftBstr(GetPath,length(GetPath)-1);
  end;
  for i := length(GetPath) downto 1 do
  begin
    if midbstr(GetPath,i,1) = '\' then
    begin
      Result := Leftbstr(GetPath,i-1);
      exit;
    end;
  end;
  Result := 'Failed';
end;    Function GetFileLen(Const FileName:String):int64;
var
  SearchRec: TSearchRec;
begin
  try
    if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0         then
      Result := SearchRec.Size
    else
      Result := 0;
  finally
    FindClose(SearchRec);
  end;    
end;    Function GetDirectorySize(Const ADirectory: string; HaveSub : boolean): Int64;
var
  r: TSearchRec;
  d, nd: AnsiString;
begin
  try
    Result := 0;
    d := IncludeTrailingPathDelimiter(ADirectory);
    if Not DirectoryExists(d) then exit;
    if FindFirst(d   '*.*',faAnyFile,r) = 0 then
    begin
      repeat
        application.ProcessMessages;
        inc(Result,r.Size);
        if (r.Name <> '.') and (r.Name <> '..') then
        begin
          nd := d   r.Name;
          if (r.Attr and faDirectory) <> 0 then
          begin
            if Not HaveSub then Continue;
            Inc(Result,GetDirectorySize(nd,HaveSub));
          end;
        end;
      until FindNext(r) <> 0;
    end;
    FindClose(r);
  except
    on e: Exception do begin Result := 0; FindClose(r); end;
  end;
end;    function GetSystemPath():string;
var
  Dir: array [0..255] of Char;
  i : integer;
  Dn: string;
begin
  GetSystemDirectory(@Dir, 255);
  For i := 0 to 255 do
  begin
    if Ord(Dir[I]) = 0 then Break;
    Dn := Dn   Dir[I];
  end;
  Dn := Dn   '\';
  Result := Dn;
end;    Function FileCanBeOpened( Const fname: String ): Boolean;
Var
  fhandle: Integer;
begin
  try
    fhandle := FileOpen( fname,fmOpenRead or fmShareExclusive );
    If fhandle > 0 Then
    Begin
      Result := True;
      FileClose(fhandle);
    End Else
      Result := False;
  except
    Result := False
  end;
end;    Function Are2FilesEqual(Const fileName1,fileName2: String ):Boolean;
Var
  ms1,ms2 : TMemoryStream;
Begin
  Result := False;
  ms1 := TMemoryStream.Create;
  try
    ms1.LoadFromFile(fileName1);
    ms2:= TMemoryStream.Create;
    try
      ms2.LoadFromFile(fileName2);
      If ms1.size = ms2.size Then
        Result := CompareMem(ms1.Memory,ms2.memory,ms1.size);
    finally
      ms2.free;
    end;
  finally
    ms1.free;
  end;
End;    function GetCheckSum(FileName : string) : DWORD;
var
  F : File of DWORD;
  P : Pointer;
  Fsize : DWORD;
  Buffer : Array [0..500] of DWORD;
begin
  FileMode := 0;
  AssignFile(F,FileName);
  Reset(F);
  Seek(F,FileSize(F) div 2);
  Fsize := FileSize(F) -1 -FilePos(F);
  if Fsize > 500 then Fsize := 500;
  BlockRead(F,Buffer,Fsize);
  Closefile(f);
  P := @Buffer;
  asm
    xor eax,eax
    xor ecx,ecx
    mov edi,p
    @again:
    add eax,[edi   4*ecx]
    inc ecx
    cmp ecx,fsize
    jl @again
    mov @result,eax
  end; 
end;    function GetSpecialFolderDir(const folderid:integer):string;
var
  pidl:pItemIDList;
  buffer:array [ 0..255 ] of char ;
begin
  //取指定的文件夹项目表
  SHGetSpecialFolderLocation(application.Handle,folderid,pidl);
  SHGetPathFromIDList(pidl, buffer);    //转换成文件系统的路径
  Result:=strpas(buffer);
end;    function MyGetDiskSize( obj : string; isFree:boolean ): string;
var
  Tmp_1:int64;
  Tmp_2:int64;
  Tmp_3:int64;
  Tmp_4:int64;
  FDiskFreeSpace,FTotalDiskSpace : string;
  VolName, FileSysName :array[0..255] of Char;
  Tmp_BytesPerSector,SerialN  :DWORD;
  FSectorsPerCluster,Tmp_SectorsPerCluster,MaxCLength :DWORD;
  FClusters,FFreeClusters,FBytesPerSector, FileSysFlag :DWORD;
  Tmp_FreeClusters,Tmp_Clusters:dword;
begin
  GetVolumeInformation(pchar(obj), VolName, 255, @SerialN, MaxCLength,
     FileSysFlag, FileSysName, 255);
  if GetDiskFreeSpace(pchar(obj),Tmp_SectorsPerCluster,Tmp_BytesPerSector,Tmp_FreeClusters,Tmp_Clusters) then
  begin
    FSectorsPerCluster:=Tmp_SectorsPerCluster;
    FBytesPerSector:=Tmp_BytesPerSector;
    FFreeClusters:=Tmp_FreeClusters;
    FClusters:=Tmp_Clusters;
    if uppercase(FileSysName)='FAT32' then
    begin
      GetDiskFreeSpaceEx(pchar(obj), TMP_1, TMP_2, @TMP_3);
      Tmp_4 := 0;
      if TMP_1>1048576 then
      begin
        Tmp_4 := TMP_1 div 1048576;
        if Tmp_4 > 1024 then
        begin
          FDiskFreeSpace  :=Floattostr((((Tmp_4*100) div 1024)/100)) ' GB';
        end
        else
        begin
          FDiskFreeSpace  :=inttostr(Tmp_4) ' MB';
        end;
      end;
      Tmp_4 := 0;
      if TMP_2>1048576 then
      begin
        Tmp_4 := TMP_2 div 1048576;
        if Tmp_4 > 1024 then
        begin
          FTotalDiskSpace  :=Floattostr((((Tmp_4*100) div 1024)/100)) ' GB';
        end
        else
        begin
          FTotalDiskSpace :=inttostr(Tmp_4) ' MB';
        end;
      end;
      if TMP_1<1048576 then FDiskFreeSpace  :=inttostr(TMP_1) ' MB';
      if TMP_2<1048576 then FTotalDiskSpace :=inttostr(TMP_2) ' MB';
    end;
    if Uppercase(FileSysName)<>'FAT32' then
    begin
      Tmp_4 := 0;
      Tmp_4 := (Tmp_FreeClusters*Tmp_BytesPerSector*Tmp_SectorsPerCluster) div 1048576;
      if Tmp_4 > 1024 then
      begin
        FDiskFreeSpace  :=Floattostr((((Tmp_4*100) div 1024)/100)) ' GB';
      end
      else
      begin
        FDiskFreeSpace  :=Inttostr(Tmp_4) ' MB';
      end;
      Tmp_4 := 0;
      Tmp_4 := (Tmp_Clusters*Tmp_BytesPerSector*Tmp_SectorsPerCluster) div 1048576;
      if Tmp_4 > 1024 then
      begin
        FTotalDiskSpace  :=Floattostr((((Tmp_4*100) div 1024)/100)) ' GB';
      end
      else
      begin
        FTotalDiskSpace :=Inttostr(Tmp_4) ' MB';
      end;
    end;
  end;
  if isFree then
    Result := FDiskFreeSpace
  else
    Result := FTotalDiskSpace;
end;