delphifiles.inc | searchcode

/delphifiles.inc

http://github.com/rofl0r/KOL
Pascal | 1163 lines | 1058 code | 31 blank | 74 comment | 19 complexity | 2866f898664e5a5fac6daa92a4805610 MD5 | raw file

{

   This part of the unit modified by Tim Slusher and Vladimir Kladov.

}



{* Set of utility methods to work with files

   and reqistry.

   When programming KOL, which is Windows API-oriented, You should

   avoid alien (for Windows) embedded Pascal files handling, and

   use API-calls which implemented very well. This set of functions

   is intended to make this easier.

   Also TDirList object implementation present here and some registry

   access functions, which allow to make code more elegant.

}



{$UNDEF ASM_LOCAL}

{$IFDEF ASM_VERSION}

  {$DEFINE ASM_LOCAL}

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

function FileCreate(const FileName: string; OpenFlags: DWord): THandle;

asm

        XOR      ECX, ECX

        PUSH     ECX

        MOV      ECX, EDX

        SHR      ECX, 16

        AND      CX, $1FFF

        JNZ      @@1

        MOV      CL, FILE_ATTRIBUTE_NORMAL

@@1:    PUSH     ECX

        MOV      CL, DH

        PUSH     ECX                  // CreationMode

        PUSH     0

        MOV      CL, DL

        PUSH     ECX                  // ShareMode

        MOV      DX, 0

        PUSH     EDX                  // AccessMode

        //CALL     System.@LStrToPChar // FileName must not be ''

        PUSH     EAX

        CALL     CreateFile

end;

{$ELSE ASM_VERSION} //Pascal

function FileCreate(const FileName: string; OpenFlags: DWord): THandle;

var Attr: DWORD;

begin

  Attr := (OpenFlags shr 16) and $1FFF;

  if Attr = 0 then Attr := FILE_ATTRIBUTE_NORMAL;

  Result := CreateFile( PChar(FileName), OpenFlags and $F0000000,

                        OpenFlags and $F, nil, (OpenFlags shr 8) and $F,

                        Attr, 0 );

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

function FileClose(Handle: THandle): Boolean;

asm

        PUSH     EAX

        CALL     CloseHandle

        TEST     EAX, EAX

        SETNZ    AL

end;

{$ELSE ASM_VERSION} //Pascal

function FileClose(Handle: THandle): boolean;

begin

     Result := CloseHandle(Handle);

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

function FileExists( const FileName : String ) : Boolean;

const size_TWin32FindData = sizeof( TWin32FindData );

asm

        CALL     EAX2PChar

        PUSH     EAX

        CALL     GetFileAttributes

        INC      EAX

        JZ       @@exit

        DEC      EAX

        {$IFDEF PARANOIA}

        DB $24, FILE_ATTRIBUTE_DIRECTORY

        {$ELSE}

        AND      AL, FILE_ATTRIBUTE_DIRECTORY

        {$ENDIF}

        SETZ     AL

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

function FileExists( const FileName : String ) : Boolean;

var

  Code: Integer;

begin

  Code := GetFileAttributes(PChar(FileName));

  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code = 0);

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

function FileSeek(Handle: THandle; MoveTo: integer; MoveMethod: TMoveMethod): DWord;

asm

        MOVZX    ECX, CL

        PUSH     ECX

        PUSH     0

        PUSH     EDX

        PUSH     EAX

        CALL     SetFilePointer

end;

{$ELSE ASM_VERSION} //Pascal

function FileSeek(Handle: THandle; MoveTo: integer; MoveMethod: TMoveMethod): DWord;

begin

  Result := SetFilePointer(Handle, MoveTo, nil, Ord( MoveMethod ) );

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

function FileRead(Handle: THandle; var Buffer; Count: DWord): DWord;

asm

        PUSH     EBP

        PUSH     0

        MOV      EBP, ESP

        PUSH     0

        PUSH     EBP

        PUSH     ECX

        PUSH     EDX

        PUSH     EAX

        CALL     ReadFile

        TEST     EAX, EAX

        POP      EAX

        JNZ      @@exit

        XOR      EAX, EAX

@@exit:

        POP      EBP

end;

{$ELSE ASM_VERSION} //Pascal

function FileRead(Handle: THandle; var Buffer; Count: DWord): DWord;

begin

     if not ReadFile(Handle, Buffer, Count, Result, nil) then

       Result := 0;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

function File2Str(Handle: THandle): String;

asm

        PUSH     EDX

        TEST     EAX, EAX

        JZ       @@exit // return ''



        PUSH     EBX

        MOV      EBX, EAX // EBX = Handle

        XOR      EDX, EDX

        XOR      ECX, ECX

        INC      ECX

        CALL     FileSeek

        PUSH     EAX // Pos

        PUSH     0

        PUSH     EBX

        CALL     GetFileSize

        POP      EDX

        SUB      EAX, EDX // EAX = Size - Pos

        JZ       @@exitEBX



        PUSH     EAX

        CALL     System.@GetMem

        XCHG     EAX, EBX

        MOV      EDX, EBX

        POP      ECX

        PUSH     ECX

        CALL     FileRead

        POP      ECX

        MOV      EDX, EBX

        POP      EBX

        POP      EAX

        PUSH     EDX

        {$IFDEF _D2}

        CALL     _LStrFromPCharLen

        {$ELSE}

        CALL     System.@LStrFromPCharLen

        {$ENDIF}

        JMP      @@freebuf



@@exitEBX:

        POP      EBX

@@exit:

        XCHG     EDX, EAX

        POP      EAX // @Result

        PUSH     EDX

        CALL     System.@LStrFromPChar

@@freebuf:

        POP      EAX

        TEST     EAX, EAX

        JZ       @@fin

        CALL     System.@FreeMem

@@fin:

end;

{$ELSE ASM_VERSION} //Pascal

function File2Str(Handle: THandle): String;

var Pos, Size: DWORD;

begin

  Result := '';

  if Handle = 0 then Exit;

  Pos := FileSeek( Handle, 0, spCurrent );

  Size := GetFileSize( Handle, nil );

  SetString( Result, nil, Size - Pos + 1 );

  FileRead( Handle, Result[ 1 ], Size - Pos );

  Result[ Size - Pos + 1 ] := #0;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

function FileWrite(Handle: THandle; const Buffer; Count: DWord): DWord;

asm

        PUSH     EBP

        PUSH     EBP

        MOV      EBP, ESP

        PUSH     0

        PUSH     EBP

        PUSH     ECX

        PUSH     EDX

        PUSH     EAX

        CALL     WriteFile

        TEST     EAX, EAX

        POP      EAX

        JNZ      @@exit

        XOR      EAX, EAX

@@exit:

        POP      EBP

end;

{$ELSE ASM_VERSION} //Pascal

function FileWrite(Handle: THandle; const Buffer; Count: DWord): DWord;

begin

     if not WriteFile(Handle, Buffer, Count, Result, nil) then

       Result := 0;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

function FileEOF( Handle: THandle ) : Boolean;

asm

        PUSH     EAX



        PUSH     0

        PUSH     EAX

        CALL     GetFileSize



        XCHG     EAX, [ESP]



        MOV      CL, spCurrent

        XOR      EDX, EDX

        CALL     FileSeek



        POP      EDX

        CMP      EAX, EDX

        SETGE    AL

end;

{$ELSE ASM_VERSION} //Pascal

function FileEOF( Handle: THandle ) : Boolean;

var Siz, Pos : DWord;

begin

  Siz := GetFileSize( Handle, nil );

  Pos := FileSeek( Handle, 0, spCurrent );

  Result := Pos >= Siz;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_noVERSION}

function FileFullPath( const FileName: String ) : String;

const

  BkSlash: String = '\';

  szTShFileInfo = sizeof( TShFileInfo );

asm

        PUSH     EBX

        PUSH     ESI

        MOV      EBX, EDX

        PUSH     EAX



        XCHG     EAX, EDX

        CALL     System.@LStrClr



        POP      EDX

        PUSH     0

        MOV      EAX, ESP

        CALL     System.@LStrAsg

        MOV      ESI, ESP



@@loo:  CMP      dword ptr [ESI], 0

        JZ       @@fin



        MOV      EAX, ESI

        MOV      EDX, [BkSlash]

        PUSH     0

        MOV      ECX, ESP

        CALL     Parse



        CMP      dword ptr [EBX], 0

        JE       @@1

        MOV      EAX, EBX

        MOV      EDX, [BkSlash]

        CALL     System.@LStrCat

        JMP      @@2

@@1:

        POP      EAX

        PUSH     EAX

        CALL     System.@LStrLen

        CMP      EAX, 2

        JNE      @@2

        POP      EAX

        PUSH     EAX

        CMP      byte ptr [EAX+1], ':'

        JNE      @@2



        MOV      EAX, EBX

        POP      EDX

        PUSH     EDX

        CALL     System.@LStrAsg

        JMP      @@3

@@2:

        PUSH     0

        MOV      EAX, ESP

        MOV      EDX, [EBX]

        CALL     System.@LStrAsg

        MOV      EAX, ESP

        MOV      EDX, [ESP+4]

        CALL     System.@LStrCat

        POP      EAX

        PUSH     EAX

        SUB      ESP, szTShFileInfo

        MOV      EDX, ESP

        PUSH     SHGFI_DISPLAYNAME

        PUSH     szTShFileInfo

        PUSH     EDX

        PUSH     0

        PUSH     EAX

        CALL     ShGetFileInfo

        LEA      EDX, [ESP].TShFileInfo.szDisplayName

        CMP      byte ptr [EDX], 0

        JE       @@clr_stk

        LEA      EAX, [ESP+szTShFileInfo+4]

        CALL     System.@LStrFromPChar

@@clr_stk:

        ADD      ESP, szTShFileInfo

        CALL     RemoveStr

        POP      EDX

        PUSH     EDX

        MOV      EAX, EBX

        CALL     System.@LStrCat



@@3:    CALL     RemoveStr

        JMP      @@loo



@@fin:  CALL     RemoveStr

        POP      ESI

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function FileFullPath( const FileName: String ) : String;

var SFI: TShFileInfo;

    Src, S: String;

begin

  Result := '';

  Src := FileName;

  while Src <> '' do

  begin

    S := Parse( Src, '\' );

    if Result <> '' then

      Result := Result + '\';

    if (Result = '') and (Length( S ) = 2) and (S[ 2 ] = ':') then

      Result := S

    else

    begin

      ShGetFileInfo( PChar( Result + S ), 0, SFI, Sizeof( SFI ),

                     SHGFI_DISPLAYNAME );

      if SFI.szDisplayName[ 0 ] <> #0 then

        S := SFI.szDisplayName;

      Result := Result + S;

    end;

  end;

  if ExtractFileExt( Result ) = '' then

  // case when flag 'Hide extensions for registered file types' is set on

  // in the Explorer:

    Result := Result + ExtractFileExt( FileName );

end;

{$ENDIF ASM_VERSION}



function FileShortPath( const FileName: String ): String;

var Buf: array[ 0..MAX_PATH ] of Char;

begin

  GetShortPathName( PChar( FileName ), Buf, Sizeof( Buf ) );

  Result := Buf;

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

   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}