delphifiles.inc

DEILPHI写的QQ安全软件源码!功能全套,该有的全有了,欢迎交流

   begin
     L1 := Length( ExtractFilePath( Result ) );
     while (PixelsLength( DC, Result ) > MaxPixels) and (L1 > 1) do
     begin
       Dec( L1 );
       Result := Copy( Result, 1, L1 ) + '...\' + ExtractFileName( Result );
     end;
     if PixelsLength( DC, Result ) > MaxPixels then
     begin
       L1 := MaxPixels + 1;
       while ((MaxPixels > 0) and (L1 > 1) or (MaxPixels = 0) and (L1 > 0)) and
             (PixelsLength( DC, Result ) > MaxPixels) do
       begin
         Dec( L1 );
         Result := Copy( ExtractFileName( Path ), 1, L1 ) + '...';
       end;
     end;
     break;
   end;
   L0 := PixelsLength( DC, Result );
 end;
end;

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 MinimizeName( const Path: String; DC: HDC; MaxPixels: Integer ): String;
var
  Drive, Dir, Name: String;
begin
  Result := Path;
  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 (PixelsLength(DC, Result) > MaxPixels) do
  begin
    if Dir = '\...\' then
    begin
      Drive := '';
      Dir := '...\';
    end
    else if Dir = '' then
      Drive := ''
    else
      CutFirstDirectory(Dir);
    Result := Drive + Dir + Name;
  end;
end;

{$IFDEF ASM_VERSION}
function FileSize( const Path : String ) : Integer;
const size_TWin32FindData = sizeof( TWin32FindData );
asm
        ADD      ESP, - size_TWin32FindData
        PUSH     ESP
        //CALL     System.@LStrToPChar // Path must not be ''
        PUSH     EAX
        CALL     FindFirstFile
        INC      EAX
        JZ       @@exit
        DEC      EAX
        PUSH     EAX
        CALL     FindClose

        MOV      EAX, [ESP].TWin32FindData.nFileSizeLow
@@exit:
        ADD      ESP, size_TWin32FindData
end;
{$ELSE ASM_VERSION} //Pascal
function FileSize( const Path : String ) : Integer;
var FD : TWin32FindData;
    FH : THandle;
begin
  FH := FindFirstFile( PChar( Path ), FD );
  Result := 0;
  if FH = INVALID_HANDLE_VALUE then exit;
  Result := FD.nFileSizeLow;
  if ((FD.nFileSizeLow and $80000000) <> 0) or
     (FD.nFileSizeHigh <> 0) then Result := -1;
  FindClose( FH );
end;
{$ENDIF ASM_VERSION}

//*
function FileTimeCompare( const FT1, FT2 : TFileTime ) : Integer;
var ST1, ST2 : TSystemTime;
begin
  FileTimeToSystemTime( FT1, ST1 );
  FileTimeToSystemTime( FT2, ST2 );
  Result := CompareSystemTime( ST1, ST2 );
end;

function GetSystemDir: String;
var Buf: array[ 0..MAX_PATH ] of Char;
begin
  GetSystemDirectory( @ Buf[ 0 ], MAX_PATH + 1 );
  Result := IncludeTrailingPathDelimiter( PChar( @ Buf[ 0 ] ) );
end;

//*
function GetWindowsDir : string;
var Buf : array[ 0..MAX_PATH ] of Char;
begin
  GetWindowsDirectory( @Buf[ 0 ], MAX_PATH + 1 );
  Result := IncludeTrailingPathDelimiter( PChar( @ Buf[ 0 ] ) );
end;

function GetWorkDir : string;
var Buf: array[ 0..MAX_PATH ] of Char;
begin
  GetCurrentDirectory( MAX_PATH + 1, @ Buf[ 0 ] );
  Result := IncludeTrailingPathDelimiter( PChar( @ Buf[ 0 ] ) );
end;

//*
function GetTempDir : string;
var Buf : array[ 0..MAX_PATH ] of Char;
begin
  Windows.GetTempPath( MAX_PATH + 1, @Buf[ 0 ] );
  Result := IncludeTrailingPathDelimiter( PChar( @ Buf[ 0 ] ) );
end;

function CreateTempFile( const DirPath, Prefix: String ): String;
var Buf: array[ 0..MAX_PATH ] of Char;
begin
  GetTempFileName( PChar( DirPath ), PChar( Prefix ), 0, Buf );
  Result := Buf;
end;

function  GetFileListStr(FPath{e.g.'c:\tmp\'}, FMask{e.g.'*.*'}: string): string;
{* List of files in string, separating each path from others with semicolon (';').
   E.g.: 'c:\tmp\unit1.dcu;c:\tmp\unit1.~pa' (for use with DeleteFile2Recycle())}
var
   Srch: TWin32FindData;
   flag: Integer;
   succ: boolean;
   dir:string;
begin
   result := '';
   if (FPath<>'') and (FPath[length(FPath)]<>'\') then FPath:=FPath+'\';
   if (FMask<>'') and (FMask[1]='\') then FMask:=CopyEnd(FMask,2);
   dir:=FPath+FMask;
   flag := FindFirstFile(PChar(dir), Srch);
   succ := flag <> 0;
   while succ do begin
      if (not (Srch.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0))then begin
         if Result<>''then Result:=Result+';';
         Result:=Result+FPath+Srch.cFileName;
      end;
      succ := FindNextFile(Flag, Srch);
   end;
   FindClose(Flag);
end;

function DeleteFiles( const DirPath: String ): Boolean;
var Files, Name: String;
begin
  Files := GetFileListStr( ExtractFilePath( DirPath ), ExtractFileName( DirPath ) );
  Result := TRUE;
  while Files <> '' do
  begin
    Name := Parse( Files, ';' );
    Result := Result and DeleteFile( PChar( Name ) );
  end;
end;

//*
function DeleteFile2Recycle( const Filename : String ) : Boolean;
var FOS : TSHFileOpStruct;
    Buf : PChar;
    L : Integer;
begin
  L := Length( Filename );
  GetMem( Buf, L + 2 );
  StrCopy( Buf, PChar( Filename ) );
  Buf[ L + 1 ] := #0;
  for L := L downto 0 do
    if Buf[ L ] = ';' then Buf[ L ] := #0;
  FillChar( FOS, Sizeof( FOS ), 0 );
  if Applet <> nil then
    FOS.Wnd := Applet.Handle;
  FOS.wFunc := FO_DELETE;
  FOS.pFrom := Buf;
  FOS.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
  FOS.fAnyOperationsAborted := True;
  FOS.lpszProgressTitle := PChar( 'Delete ' + Filename + ' to Recycle bin' );
  Result := SHFileOperation( FOS ) = 0;
  if Result then
    Result := not FOS.fAnyOperationsAborted;
  FreeMem( Buf );
end;

function CopyMoveFiles( const FromList, ToList: String; Move: Boolean ): Boolean;
var FOS : TSHFileOpStruct;
    Buf : PChar;
    L : Integer;
begin
  L := Length( FromList );
  GetMem( Buf, L + 2 );
  StrCopy( Buf, PChar( FromList ) );
  Buf[ L + 1 ] := #0;
  for L := L downto 0 do
    if Buf[ L ] = ';' then Buf[ L ] := #0;
  FillChar( FOS, Sizeof( FOS ), 0 );
  if Applet <> nil then
    FOS.Wnd := Applet.Handle;
  if Move then
  begin
    FOS.wFunc := FO_MOVE;
    FOS.lpszProgressTitle := PChar( 'Move files' );
  end
    else
  begin
    FOS.wFunc := FO_COPY;
    FOS.lpszProgressTitle := PChar( 'Copy files' );
  end;
  FOS.pFrom := Buf;
  FOS.pTo := PChar( ToList + #0 );
  FOS.fFlags := FOF_ALLOWUNDO;
  FOS.fAnyOperationsAborted := True;
  Result := SHFileOperation( FOS ) = 0;
  if Result then
    Result := not FOS.fAnyOperationsAborted;
  FreeMem( Buf );
end;

{-}
function DiskFreeSpace( const Path: String ): I64;
type TGetDFSEx = function( Path: PChar; CallerFreeBytes, TotalBytes, FreeBytes: Pointer )
                 : Bool; stdcall;
var GetDFSEx: TGetDFSEx;
    Kern32: THandle;
    V: TOSVersionInfo;
    Ex: Boolean;
    SpC, BpS, NFC, TNC: DWORD;
    FBA, TNB: I64;
begin
  GetDFSEx := nil;
  V.dwOSVersionInfoSize := Sizeof( V );
  GetVersionEx( V );
  Ex := FALSE;
  if V.dwPlatformId = VER_PLATFORM_WIN32_NT then
  begin
    Ex := V.dwMajorVersion >= 4;
  end
    else
  if V.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
  begin
    Ex := V.dwMajorVersion > 4;
    if not Ex then
    if V.dwMajorVersion = 4 then
    begin
      Ex := V.dwMinorVersion > 0;
      if not Ex then
        Ex := LoWord( V.dwBuildNumber ) >= $1111;
    end;
  end;
  if Ex then
  begin
    Kern32 := GetModuleHandle( 'kernel32.dll' );
    GetDFSEx := GetProcAddress( Kern32, 'GetDiskFreeSpaceExA' );
  end;
  if Assigned( GetDFSEx ) then
    GetDFSEx( PChar( Path ), @ FBA, @ TNB, @Result )
  else
  begin
    GetDiskFreeSpace( PChar( Path ), SpC, BpS, NFC, TNC );
    Result := Mul64i( MakeInt64( SpC * BpS, 0 ), NFC );
  end;
end;
{+}

//*
function GetUniqueFilename( PathName: string ) : String;
var Path, Nam, Ext : String;
    I, J, K : Integer;
begin
  Result := PathName;
  Path := ExtractFilePath( PathName );
  if not DirectoryExists( Path ) then Exit;
  Nam := ExtractFileNameWOext( PathName );
  if Nam = '' then
  begin
    if Path[ Length( Path ) ] = '\' then
       Path := Copy( Path, 1, Length( Path ) - 1 );
    PathName := Path;
    Result := Path;
  end;
  Nam := ExtractFileNameWOext( PathName );
  Ext := ExtractFileExt( PathName );
  I := Length( Nam );
  for J := I downto 1 do
  if not (Nam[ J ] in [ '0'..'9' ]) then
  begin
    I := J;
    break;
  end;
  K := Str2Int( CopyEnd( Nam, I + 1 ) );
  while FileExists( Result ) do
  begin
    Inc( K );
    Result := Path + Copy( Nam, 1, I ) + Int2Str( K ) + Ext;
  end;
end;

{$IFDEF ASM_VERSION}
function GetStartDir : String;
asm
        PUSH     EBX
        MOV      EBX, EAX

        XOR      EAX, EAX
        MOV      AH, 2
        SUB      ESP, EAX
        MOV      EDX, ESP
        PUSH     EAX
        PUSH     EDX
        PUSH     0
        CALL     GetModuleFileName

        LEA      EDX, [ESP + EAX]
@@1:    DEC      EDX
        CMP      byte ptr [EDX], '\'
        JNZ      @@1

        INC      EDX
        MOV      byte ptr [EDX], 0

        MOV      EAX, EBX
        MOV      EDX, ESP
        CALL     System.@LStrFromPChar

        ADD      ESP, 200h
        POP      EBX
end;
{$ELSE ASM_VERSION} //Pascal
function GetStartDir : String;
var Buffer:array[0..260] of Char;
    I : Integer;
begin
  I := GetModuleFileName( 0, Buffer, Sizeof( Buffer ) );
  for I := I downto 0 do
    if Buffer[ I ] = '\' then
    begin
      Buffer[ I + 1 ] := #0;
      break;
    end;
  Result := Buffer;
end;
{$ENDIF ASM_VERSION}

//{$ENDIF LINUX/WIN32}