delphifiles.inc

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

end;

function FileIconSystemIdx( const Path: String ): Integer;
var SFI: TShFileInfo;
begin
  SFI.iIcon := 0; // Bartov
  ShGetFileInfo( PChar( Path ), 0, SFI, sizeof( SFI ),
                 //-- Babenko Alexey: -----------------//
                 // SHGFI_ICON or                     //
                 //----------------------------------//
                 SHGFI_SMALLICON or SHGFI_SYSICONINDEX );
  Result := SFI.iIcon;
end;

function FileIconSysIdxOffline( const Path: String ): Integer;
var SFI: TShFileInfo;
begin
  SFI.iIcon := 0; // Bartov
  ShGetFileInfo( PChar( Path ), FILE_ATTRIBUTE_NORMAL, SFI, sizeof( SFI ),
                 //-- Babenko Alexey: -----------------//
                 // SHGFI_ATTRIBUTES or SHGFI_ICON or //
                 //----------------------------------//
                 SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES );
  Result := SFI.iIcon;
end;

procedure LogFileOutput( const filepath, str: String );
var F: HFile;
begin
  F := FileCreate( filepath, ofOpenWrite or ofOpenAlways );
  if F = INVALID_HANDLE_VALUE then Exit;
  FileSeek( F, 0, spEnd );
  FileWrite( F, {$IFNDEF _D2} String {$ENDIF}
             ( str + #13#10 )[ 1 ], Length( str ) + 2 );
  FileClose( F );
end;

function StrSaveToFile( const Filename, Str: String ): Boolean;
var F: HFile;
begin
  Result := FALSE;
  F := FileCreate( Filename, ofOpenWrite or ofOpenAlways );
  if F = INVALID_HANDLE_VALUE then Exit;
  FileWrite( F, Str[ 1 ], Length( Str ) );
  FileClose( F );
  Result := TRUE;
end;

function StrLoadFromFile( const Filename: String ): String;
var F: HFile;
begin
  Result := '';
  F := FileCreate( Filename, ofOpenRead or ofOpenExisting or ofShareDenyWrite );
  if F = INVALID_HANDLE_VALUE then Exit;
  Result := File2Str( F );
  FileClose( F ); {??ee(zhog); Dark Knight}
end;

{$IFDEF ASM_VERSION}
function DirectoryExists(const Name: string): Boolean;
asm
        //CALL     System.@LStrToPChar // Name must not be ''
        PUSH     EAX
        CALL     GetFileAttributes
        INC      EAX
        JZ       @@exit
        DEC      EAX
        {$IFDEF PARANOIA}
        DB $24, FILE_ATTRIBUTE_DIRECTORY
        {$ELSE}
        AND      AL, FILE_ATTRIBUTE_DIRECTORY
        {$ENDIF}
        SETNZ    AL
@@exit:
end;
{$ELSE ASM_VERSION} //Pascal
function DirectoryExists(const Name: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;
{$ENDIF ASM_VERSION}

function CheckDirectoryContent( const Name: String; SubDirsOnly: Boolean; const Mask: String ): Boolean;
var FD: TWin32FindData;
    FH: THandle;
begin
  if not DirectoryExists( Name ) then
    Result := TRUE
  else
  begin
    FH := Windows.FindFirstFile( PChar( IncludeTrailingPathDelimiter( Name )
       + Mask ), FD );
    if FH = INVALID_HANDLE_VALUE then
      Result := TRUE
    else
    begin
      Result := TRUE;
      repeat
        if not StrIn( FD.cFileName, ['.','..'] ) then
        begin
          if SubDirsOnly and LongBool(FD.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)
             or not SubDirsOnly then
          begin
            Result := FALSE;
            break;
          end;
        end;
      until not Windows.FindNextFile( FH, FD );
      Windows.FindClose( FH );
    end;
  end;
end;

function DirectoryEmpty(const Name: String): Boolean;
begin
  Result := CheckDirectoryContent( Name, FALSE, '*.*' );
end;

{-}
function DirectorySize( const Path: String ): I64;
var DirList: PDirList;
    I: Integer;
begin
  Result := MakeInt64( 0, 0 );
  DirList := NewDirList( Path, '*.*', 0 );
  for I := 0 to DirList.Count-1 do
  begin
    if LongBool( DirList.Items[ I ].dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY ) then
      Result := Add64( Result, DirectorySize( DirList.Path + DirList.Names[ I ] ) )
    else
      Result := Add64( Result, MakeInt64( DirList.Items[ I ].nFileSizeLow,
             DirList.Items[ I ].nFileSizeHigh ) );
  end;
  DirList.Free;
end;
{+}

function DirectoryHasSubdirs( const Path: String ): Boolean;
begin
  Result := not CheckDirectoryContent( Path, TRUE, '*.*' );
end;

function  GetFileList(const dir: string): PStrList;
var
   Srch: TWin32FindData;
   flag: Integer;
   succ: boolean;
begin
   result := nil;
   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 = nil then begin
            Result := NewStrList;
         end;
         Result.Add(Srch.cFileName);
      end;
      succ := FindNextFile(Flag, Srch);
   end;
   FindClose(Flag);
end;

function ExcludeTrailingChar( const S: String; C: Char ): String;
begin
  Result := S;
  if Result <> '' then
  if Result[ Length( Result ) ] = C then
    Delete( Result, Length( Result ), 1 );
end;

function IncludeTrailingChar( const S: String; C: Char ): String;
begin
  Result := S;
  if (Result = '') or (Result[ Length( Result ) ] <> C) then
    Result := Result + C;
end;

//---------------------------------------------------------
// Following functions/procedures are created by Edward Aretino:
// IncludeTrailingPathDelimiter, ExcludeTrailingPathDelimiter,
// ForceDirectories, CreateDir, ChangeFileExt
//---------------------------------------------------------
function IncludeTrailingPathDelimiter(const S: string): string;
begin
   {if CopyTail(S, 1) <> '\' then
     Result := S + '\'
   else
     Result := S;}
   Result := IncludeTrailingChar( S, '\' );
end;

function ExcludeTrailingPathDelimiter(const S: string): string;
begin
   {Result := S;
   if Length(Result) = 0 then Exit;

   if (CopyTail(Result, 1) = '\') then
     DeleteTail(Result, 1);}
   Result := ExcludeTrailingChar( S, '\' );
end;

function ForceDirectories(Dir: string): Boolean;
begin
 Result := Length(Dir) > 0; {Centronix}
 If not Result then Exit;
 Dir := ExcludeTrailingPathDelimiter(Dir);
 If (Length(Dir) < 3) or DirectoryExists(Dir) or
   (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
 Result := ForceDirectories(ExtractFilePath(Dir)) and CreateDir(Dir);
end;

function CreateDir(const Dir: string): Boolean;
begin
   Result := Windows.CreateDirectory(PChar(Dir), nil);
end;

function ChangeFileExt(FileName: String; const Extension: string): string;
var
   FileExt: String;
begin
   FileExt := ExtractFileExt(FileName);
   DeleteTail(FileName, Length(FileExt));
   Result := FileName+ Extension;
end;

{$IFDEF ASM_VERSION}
{$IFNDEF _D2}
{$DEFINE ASM_LStrFromPCharLen}
{$ENDIF}
{$ENDIF ASM_VERSION}

{$IFDEF ASM_LStrFromPCharLen}
  {$DEFINE ASM_DIRDelimiters}
{$ENDIF}

{$IFDEF ASM_VERSION}
  {$DEFINE ASM_DIRDelimiters}
{$ENDIF ASM_VERSION}

{$IFDEF ASM_DIRDelimiters}
const
  DirDelimiters: PChar = ':\';
{$ENDIF}

{$IFDEF ASM_VERSION}
function ExtractFileName( const Path : String ) : String;
asm
        PUSH     EDX
        PUSH     EAX
        MOV      EDX, [DirDelimiters]
        CALL     __DelimiterLast
        POP      EDX
        CMP      byte ptr [EAX], 0
        JZ       @@1
        XCHG     EDX, EAX
        INC      EDX
@@1:    POP      EAX
        CALL     System.@LStrFromPChar
end;
{$ELSE ASM_VERSION} //Pascal
function ExtractFileName( const Path : String ) : String;
var P: PChar;
begin
  P := __DelimiterLast( PChar( Path ), ':\' );
  if P^ = #0 then
    Result := Path
  else
    Result := P + 1;
end;
{$ENDIF ASM_VERSION}

{$IFDEF ASM_LStrFromPCharLen} // LStrFromPCharLen - there are no in D2
function ExtractFilePath( const Path : String ) : String;
asm
        PUSH     EDX
        MOV      EDX, [DirDelimiters]
        CALL     EAX2PChar
        PUSH     EAX
        CALL     __DelimiterLast
        XCHG     EDX, EAX
        XOR      ECX, ECX
        POP      EAX
        CMP      byte ptr [EDX], CL
        JZ       @@ret_0
        SUB      EDX, EAX
        INC      EDX
        XCHG     EDX, EAX
        XCHG     ECX, EAX
@@ret_0:
        POP      EAX
        CALL     System.@LStrFromPCharLen
end;
{$ELSE} //Pascal
function ExtractFilePath( const Path : String ) : String;
//var I : Integer;
var P, P0: PChar;
begin
  P0 := PChar( Path );
  P := __DelimiterLast( P0, ':\' );
  if P^ = #0 then
    Result := ''
  else
    Result := Copy( Path, 1, P - P0 + 1 );
end;
{$ENDIF}

function ExtractFileNameWOext( const Path : String ) : String;
begin
  Result := ExtractFileName( Path );
  Result := Copy( Result, 1, Length( Result ) - Length( ExtractFileExt( Result ) ) );
end;

{$IFDEF ASM_VERSION}
const
  ExtDelimeters: PChar = '.';

function ExtractFileExt( const Path : String ) : String;
asm
        PUSH     EDX
        MOV      EDX, [ExtDelimeters]
        CALL     EAX2PChar
        CALL     __DelimiterLast
@@1:    XCHG     EDX, EAX
        POP      EAX
        CALL     System.@LStrFromPChar
end;
{$ELSE ASM_VERSION} //Pascal
function ExtractFileExt( const Path : String ) : String;
var P: PChar;
begin
  P := __DelimiterLast( PChar( Path ), '.' );
  Result := P;
end;
{$ENDIF ASM_VERSION}

function ReplaceFileExt( const Path, NewExt: String ): String;
begin
  Result := ExtractFilePath( Path ) +
            ExtractFileNameWOext( ExtractFileName( Path ) ) +
            NewExt;
end;

function ExtractShortPathName( const Path: String ): String;
var
  Buffer: array[0..MAX_PATH - 1] of Char;
begin
  SetString(Result, Buffer,
    GetShortPathName(PChar(Path), Buffer, SizeOf(Buffer)));
end;

function FilePathShortened( const Path: String; MaxLen: Integer ): String;
begin
  Result := FilePathShortenPixels( Path, 0, MaxLen );
end;

function PixelsLength( DC: HDC; const Text: String ): Integer;
var Sz: TSize;
begin
  if DC = 0 then
    Result := Length( Text )
  else
  begin
    Windows.GetTextExtentPoint32( DC, PChar( Text ), Length( Text ), Sz );
    Result := Sz.cx;
  end;
end;

function FilePathShortenPixels( const Path: String; DC: HDC; MaxPixels: Integer ): String;
var L0, L1: Integer;
    Prev: String;
begin
 Result := Path;
 L0 := PixelsLength( DC, Result );
 while L0 > MaxPixels do
 begin
   Prev := Result;
   L1 := pos( '\...\', Result );
   if L1 <= 0 then
     Result := ExcludeTrailingPathDelimiter( ExtractFilePath( Result ) )
   else
     Result := Copy( Result, 1, L1 - 1 );
   if Result <> '' then
     Result := IncludeTrailingPathDelimiter( ExtractFilePath( Result ) ) + '...\' + ExtractFileName( Path );
   if (Result = '') or (Result = Prev) then