delphifiles.inc

   1 {\r
   2    This part of the unit modified by Tim Slusher and Vladimir Kladov.\r
   3 }\r
   4 \r
   5 {* Set of utility methods to work with files\r
   6    and reqistry.\r
   7    When programming KOL, which is Windows API-oriented, You should\r
   8    avoid alien (for Windows) embedded Pascal files handling, and\r
   9    use API-calls which implemented very well. This set of functions\r
  10    is intended to make this easier.\r
  11    Also TDirList object implementation present here and some registry\r
  12    access functions, which allow to make code more elegant.\r
  13 }\r
  14 \r
  15 {$UNDEF ASM_LOCAL}\r
  16 {$IFDEF ASM_VERSION}\r
  17   {$DEFINE ASM_LOCAL}\r
  18 {$ENDIF ASM_VERSION}\r
  19 \r
  20 {$IFDEF ASM_VERSION}\r
  21 function FileCreate(const FileName: string; OpenFlags: DWord): THandle;\r
  22 asm\r
  23         XOR      ECX, ECX\r
  24         PUSH     ECX\r
  25         MOV      ECX, EDX\r
  26         SHR      ECX, 16\r
  27         AND      CX, $1FFF\r
  28         JNZ      @@1\r
  29         MOV      CL, FILE_ATTRIBUTE_NORMAL\r
  30 @@1:    PUSH     ECX\r
  31         MOV      CL, DH\r
  32         PUSH     ECX                  // CreationMode\r
  33         PUSH     0\r
  34         MOV      CL, DL\r
  35         PUSH     ECX                  // ShareMode\r
  36         MOV      DX, 0\r
  37         PUSH     EDX                  // AccessMode\r
  38         //CALL     System.@LStrToPChar // FileName must not be ''\r
  39         PUSH     EAX\r
  40         CALL     CreateFile\r
  41 end;\r
  42 {$ELSE ASM_VERSION} //Pascal\r
  43 function FileCreate(const FileName: string; OpenFlags: DWord): THandle;\r
  44 var Attr: DWORD;\r
  45 begin\r
  46   Attr := (OpenFlags shr 16) and $1FFF;\r
  47   if Attr = 0 then Attr := FILE_ATTRIBUTE_NORMAL;\r
  48   Result := CreateFile( PChar(FileName), OpenFlags and $F0000000,\r
  49                         OpenFlags and $F, nil, (OpenFlags shr 8) and $F,\r
  50                         Attr, 0 );\r
  51 end;\r
  52 {$ENDIF ASM_VERSION}\r
  53 \r
  54 {$IFDEF ASM_VERSION}\r
  55 function FileClose(Handle: THandle): Boolean;\r
  56 asm\r
  57         PUSH     EAX\r
  58         CALL     CloseHandle\r
  59         TEST     EAX, EAX\r
  60         SETNZ    AL\r
  61 end;\r
  62 {$ELSE ASM_VERSION} //Pascal\r
  63 function FileClose(Handle: THandle): boolean;\r
  64 begin\r
  65      Result := CloseHandle(Handle);\r
  66 end;\r
  67 {$ENDIF ASM_VERSION}\r
  68 \r
  69 {$IFDEF ASM_VERSION}\r
  70 function FileExists( const FileName : String ) : Boolean;\r
  71 const size_TWin32FindData = sizeof( TWin32FindData );\r
  72 asm\r
  73         CALL     EAX2PChar\r
  74         PUSH     EAX\r
  75         CALL     GetFileAttributes\r
  76         INC      EAX\r
  77         JZ       @@exit\r
  78         DEC      EAX\r
  79         {$IFDEF PARANOIA}\r
  80         DB $24, FILE_ATTRIBUTE_DIRECTORY\r
  81         {$ELSE}\r
  82         AND      AL, FILE_ATTRIBUTE_DIRECTORY\r
  83         {$ENDIF}\r
  84         SETZ     AL\r
  85 @@exit:\r
  86 end;\r
  87 {$ELSE ASM_VERSION} //Pascal\r
  88 function FileExists( const FileName : String ) : Boolean;\r
  89 var\r
  90   Code: Integer;\r
  91 begin\r
  92   Code := GetFileAttributes(PChar(FileName));\r
  93   Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code = 0);\r
  94 end;\r
  95 {$ENDIF ASM_VERSION}\r
  96 \r
  97 {$IFDEF ASM_VERSION}\r
  98 function FileSeek(Handle: THandle; MoveTo: integer; MoveMethod: TMoveMethod): DWord;\r
  99 asm\r
 100         MOVZX    ECX, CL\r
 101         PUSH     ECX\r
 102         PUSH     0\r
 103         PUSH     EDX\r
 104         PUSH     EAX\r
 105         CALL     SetFilePointer\r
 106 end;\r
 107 {$ELSE ASM_VERSION} //Pascal\r
 108 function FileSeek(Handle: THandle; MoveTo: integer; MoveMethod: TMoveMethod): DWord;\r
 109 begin\r
 110   Result := SetFilePointer(Handle, MoveTo, nil, Ord( MoveMethod ) );\r
 111 end;\r
 112 {$ENDIF ASM_VERSION}\r
 113 \r
 114 {$IFDEF ASM_VERSION}\r
 115 function FileRead(Handle: THandle; var Buffer; Count: DWord): DWord;\r
 116 asm\r
 117         PUSH     EBP\r
 118         PUSH     0\r
 119         MOV      EBP, ESP\r
 120         PUSH     0\r
 121         PUSH     EBP\r
 122         PUSH     ECX\r
 123         PUSH     EDX\r
 124         PUSH     EAX\r
 125         CALL     ReadFile\r
 126         TEST     EAX, EAX\r
 127         POP      EAX\r
 128         JNZ      @@exit\r
 129         XOR      EAX, EAX\r
 130 @@exit:\r
 131         POP      EBP\r
 132 end;\r
 133 {$ELSE ASM_VERSION} //Pascal\r
 134 function FileRead(Handle: THandle; var Buffer; Count: DWord): DWord;\r
 135 begin\r
 136      if not ReadFile(Handle, Buffer, Count, Result, nil) then\r
 137        Result := 0;\r
 138 end;\r
 139 {$ENDIF ASM_VERSION}\r
 140 \r
 141 {$IFDEF ASM_VERSION}\r
 142 function File2Str(Handle: THandle): String;\r
 143 asm\r
 144         PUSH     EDX\r
 145         TEST     EAX, EAX\r
 146         JZ       @@exit // return ''\r
 147 \r
 148         PUSH     EBX\r
 149         MOV      EBX, EAX // EBX = Handle\r
 150         XOR      EDX, EDX\r
 151         XOR      ECX, ECX\r
 152         INC      ECX\r
 153         CALL     FileSeek\r
 154         PUSH     EAX // Pos\r
 155         PUSH     0\r
 156         PUSH     EBX\r
 157         CALL     GetFileSize\r
 158         POP      EDX\r
 159         SUB      EAX, EDX // EAX = Size - Pos\r
 160         JZ       @@exitEBX\r
 161 \r
 162         PUSH     EAX\r
 163         CALL     System.@GetMem\r
 164         XCHG     EAX, EBX\r
 165         MOV      EDX, EBX\r
 166         POP      ECX\r
 167         PUSH     ECX\r
 168         CALL     FileRead\r
 169         POP      ECX\r
 170         MOV      EDX, EBX\r
 171         POP      EBX\r
 172         POP      EAX\r
 173         PUSH     EDX\r
 174         {$IFDEF _D2}\r
 175         CALL     _LStrFromPCharLen\r
 176         {$ELSE}\r
 177         CALL     System.@LStrFromPCharLen\r
 178         {$ENDIF}\r
 179         JMP      @@freebuf\r
 180 \r
 181 @@exitEBX:\r
 182         POP      EBX\r
 183 @@exit:\r
 184         XCHG     EDX, EAX\r
 185         POP      EAX // @Result\r
 186         PUSH     EDX\r
 187         CALL     System.@LStrFromPChar\r
 188 @@freebuf:\r
 189         POP      EAX\r
 190         TEST     EAX, EAX\r
 191         JZ       @@fin\r
 192         CALL     System.@FreeMem\r
 193 @@fin:\r
 194 end;\r
 195 {$ELSE ASM_VERSION} //Pascal\r
 196 function File2Str(Handle: THandle): String;\r
 197 var Pos, Size: DWORD;\r
 198 begin\r
 199   Result := '';\r
 200   if Handle = 0 then Exit;\r
 201   Pos := FileSeek( Handle, 0, spCurrent );\r
 202   Size := GetFileSize( Handle, nil );\r
 203   SetString( Result, nil, Size - Pos + 1 );\r
 204   FileRead( Handle, Result[ 1 ], Size - Pos );\r
 205   Result[ Size - Pos + 1 ] := #0;\r
 206 end;\r
 207 {$ENDIF ASM_VERSION}\r
 208 \r
 209 {$IFDEF ASM_VERSION}\r
 210 function FileWrite(Handle: THandle; const Buffer; Count: DWord): DWord;\r
 211 asm\r
 212         PUSH     EBP\r
 213         PUSH     EBP\r
 214         MOV      EBP, ESP\r
 215         PUSH     0\r
 216         PUSH     EBP\r
 217         PUSH     ECX\r
 218         PUSH     EDX\r
 219         PUSH     EAX\r
 220         CALL     WriteFile\r
 221         TEST     EAX, EAX\r
 222         POP      EAX\r
 223         JNZ      @@exit\r
 224         XOR      EAX, EAX\r
 225 @@exit:\r
 226         POP      EBP\r
 227 end;\r
 228 {$ELSE ASM_VERSION} //Pascal\r
 229 function FileWrite(Handle: THandle; const Buffer; Count: DWord): DWord;\r
 230 begin\r
 231      if not WriteFile(Handle, Buffer, Count, Result, nil) then\r
 232        Result := 0;\r
 233 end;\r
 234 {$ENDIF ASM_VERSION}\r
 235 \r
 236 {$IFDEF ASM_VERSION}\r
 237 function FileEOF( Handle: THandle ) : Boolean;\r
 238 asm\r
 239         PUSH     EAX\r
 240 \r
 241         PUSH     0\r
 242         PUSH     EAX\r
 243         CALL     GetFileSize\r
 244 \r
 245         XCHG     EAX, [ESP]\r
 246 \r
 247         MOV      CL, spCurrent\r
 248         XOR      EDX, EDX\r
 249         CALL     FileSeek\r
 250 \r
 251         POP      EDX\r
 252         CMP      EAX, EDX\r
 253         SETGE    AL\r
 254 end;\r
 255 {$ELSE ASM_VERSION} //Pascal\r
 256 function FileEOF( Handle: THandle ) : Boolean;\r
 257 var Siz, Pos : DWord;\r
 258 begin\r
 259   Siz := GetFileSize( Handle, nil );\r
 260   Pos := FileSeek( Handle, 0, spCurrent );\r
 261   Result := Pos >= Siz;\r
 262 end;\r
 263 {$ENDIF ASM_VERSION}\r
 264 \r
 265 {$IFDEF ASM_noVERSION}\r
 266 function FileFullPath( const FileName: String ) : String;\r
 267 const\r
 268   BkSlash: String = '\';\r
 269   szTShFileInfo = sizeof( TShFileInfo );\r
 270 asm\r
 271         PUSH     EBX\r
 272         PUSH     ESI\r
 273         MOV      EBX, EDX\r
 274         PUSH     EAX\r
 275 \r
 276         XCHG     EAX, EDX\r
 277         CALL     System.@LStrClr\r
 278 \r
 279         POP      EDX\r
 280         PUSH     0\r
 281         MOV      EAX, ESP\r
 282         CALL     System.@LStrAsg\r
 283         MOV      ESI, ESP\r
 284 \r
 285 @@loo:  CMP      dword ptr [ESI], 0\r
 286         JZ       @@fin\r
 287 \r
 288         MOV      EAX, ESI\r
 289         MOV      EDX, [BkSlash]\r
 290         PUSH     0\r
 291         MOV      ECX, ESP\r
 292         CALL     Parse\r
 293 \r
 294         CMP      dword ptr [EBX], 0\r
 295         JE       @@1\r
 296         MOV      EAX, EBX\r
 297         MOV      EDX, [BkSlash]\r
 298         CALL     System.@LStrCat\r
 299         JMP      @@2\r
 300 @@1:\r
 301         POP      EAX\r
 302         PUSH     EAX\r
 303         CALL     System.@LStrLen\r
 304         CMP      EAX, 2\r
 305         JNE      @@2\r
 306         POP      EAX\r
 307         PUSH     EAX\r
 308         CMP      byte ptr [EAX+1], ':'\r
 309         JNE      @@2\r
 310 \r
 311         MOV      EAX, EBX\r
 312         POP      EDX\r
 313         PUSH     EDX\r
 314         CALL     System.@LStrAsg\r
 315         JMP      @@3\r
 316 @@2:\r
 317         PUSH     0\r
 318         MOV      EAX, ESP\r
 319         MOV      EDX, [EBX]\r
 320         CALL     System.@LStrAsg\r
 321         MOV      EAX, ESP\r
 322         MOV      EDX, [ESP+4]\r
 323         CALL     System.@LStrCat\r
 324         POP      EAX\r
 325         PUSH     EAX\r
 326         SUB      ESP, szTShFileInfo\r
 327         MOV      EDX, ESP\r
 328         PUSH     SHGFI_DISPLAYNAME\r
 329         PUSH     szTShFileInfo\r
 330         PUSH     EDX\r
 331         PUSH     0\r
 332         PUSH     EAX\r
 333         CALL     ShGetFileInfo\r
 334         LEA      EDX, [ESP].TShFileInfo.szDisplayName\r
 335         CMP      byte ptr [EDX], 0\r
 336         JE       @@clr_stk\r
 337         LEA      EAX, [ESP+szTShFileInfo+4]\r
 338         CALL     System.@LStrFromPChar\r
 339 @@clr_stk:\r
 340         ADD      ESP, szTShFileInfo\r
 341         CALL     RemoveStr\r
 342         POP      EDX\r
 343         PUSH     EDX\r
 344         MOV      EAX, EBX\r
 345         CALL     System.@LStrCat\r
 346 \r
 347 @@3:    CALL     RemoveStr\r
 348         JMP      @@loo\r
 349 \r
 350 @@fin:  CALL     RemoveStr\r
 351         POP      ESI\r
 352         POP      EBX\r
 353 end;\r
 354 {$ELSE ASM_VERSION} //Pascal\r
 355 function FileFullPath( const FileName: String ) : String;\r
 356 var SFI: TShFileInfo;\r
 357     Src, S: String;\r
 358 begin\r
 359   Result := '';\r
 360   Src := FileName;\r
 361   while Src <> '' do\r
 362   begin\r
 363     S := Parse( Src, '\' );\r
 364     if Result <> '' then\r
 365       Result := Result + '\';\r
 366     if (Result = '') and (Length( S ) = 2) and (S[ 2 ] = ':') then\r
 367       Result := S\r
 368     else\r
 369     begin\r
 370       ShGetFileInfo( PChar( Result + S ), 0, SFI, Sizeof( SFI ),\r
 371                      SHGFI_DISPLAYNAME );\r
 372       if SFI.szDisplayName[ 0 ] <> #0 then\r
 373         S := SFI.szDisplayName;\r
 374       Result := Result + S;\r
 375     end;\r
 376   end;\r
 377   if ExtractFileExt( Result ) = '' then\r
 378   // case when flag 'Hide extensions for registered file types' is set on\r
 379   // in the Explorer:\r
 380     Result := Result + ExtractFileExt( FileName );\r
 381 end;\r
 382 {$ENDIF ASM_VERSION}\r
 383 \r
 384 function FileShortPath( const FileName: String ): String;\r
 385 var Buf: array[ 0..MAX_PATH ] of Char;\r
 386 begin\r
 387   GetShortPathName( PChar( FileName ), Buf, Sizeof( Buf ) );\r
 388   Result := Buf;\r
 389 end;\r
 390 \r
 391 function FileIconSystemIdx( const Path: String ): Integer;\r
 392 var SFI: TShFileInfo;\r
 393 begin\r
 394   SFI.iIcon := 0; // Bartov\r
 395   ShGetFileInfo( PChar( Path ), 0, SFI, sizeof( SFI ),\r
 396                  //-- Babenko Alexey: -----------------//\r
 397                  // SHGFI_ICON or                     //\r
 398                  //----------------------------------//\r
 399                  SHGFI_SMALLICON or SHGFI_SYSICONINDEX );\r
 400   Result := SFI.iIcon;\r
 401 end;\r
 402 \r
 403 function FileIconSysIdxOffline( const Path: String ): Integer;\r
 404 var SFI: TShFileInfo;\r
 405 begin\r
 406   SFI.iIcon := 0; // Bartov\r
 407   ShGetFileInfo( PChar( Path ), FILE_ATTRIBUTE_NORMAL, SFI, sizeof( SFI ),\r
 408                  //-- Babenko Alexey: -----------------//\r
 409                  // SHGFI_ATTRIBUTES or SHGFI_ICON or //\r
 410                  //----------------------------------//\r
 411                  SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES );\r
 412   Result := SFI.iIcon;\r
 413 end;\r
 414 \r
 415 procedure LogFileOutput( const filepath, str: String );\r
 416 var F: HFile;\r
 417 begin\r
 418   F := FileCreate( filepath, ofOpenWrite or ofOpenAlways );\r
 419   if F = INVALID_HANDLE_VALUE then Exit;\r
 420   FileSeek( F, 0, spEnd );\r
 421   FileWrite( F, {$IFNDEF _D2} String {$ENDIF}\r
 422              ( str + #13#10 )[ 1 ], Length( str ) + 2 );\r
 423   FileClose( F );\r
 424 end;\r
 425 \r
 426 function StrSaveToFile( const Filename, Str: String ): Boolean;\r
 427 var F: HFile;\r
 428 begin\r
 429   Result := FALSE;\r
 430   F := FileCreate( Filename, ofOpenWrite or ofOpenAlways );\r
 431   if F = INVALID_HANDLE_VALUE then Exit;\r
 432   FileWrite( F, Str[ 1 ], Length( Str ) );\r
 433   FileClose( F );\r
 434   Result := TRUE;\r
 435 end;\r
 436 \r
 437 function StrLoadFromFile( const Filename: String ): String;\r
 438 var F: HFile;\r
 439 begin\r
 440   Result := '';\r
 441   F := FileCreate( Filename, ofOpenRead or ofOpenExisting or ofShareDenyWrite );\r
 442   if F = INVALID_HANDLE_VALUE then Exit;\r
 443   Result := File2Str( F );\r
 444   FileClose( F ); {??ee(zhog); Dark Knight}\r
 445 end;\r
 446 \r
 447 {$IFDEF ASM_VERSION}\r
 448 function DirectoryExists(const Name: string): Boolean;\r
 449 asm\r
 450         //CALL     System.@LStrToPChar // Name must not be ''\r
 451         PUSH     EAX\r
 452         CALL     GetFileAttributes\r
 453         INC      EAX\r
 454         JZ       @@exit\r
 455         DEC      EAX\r
 456         {$IFDEF PARANOIA}\r
 457         DB $24, FILE_ATTRIBUTE_DIRECTORY\r
 458         {$ELSE}\r
 459         AND      AL, FILE_ATTRIBUTE_DIRECTORY\r
 460         {$ENDIF}\r
 461         SETNZ    AL\r
 462 @@exit:\r
 463 end;\r
 464 {$ELSE ASM_VERSION} //Pascal\r
 465 function DirectoryExists(const Name: string): Boolean;\r
 466 var\r
 467   Code: Integer;\r
 468 begin\r
 469   Code := GetFileAttributes(PChar(Name));\r
 470   Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);\r
 471 end;\r
 472 {$ENDIF ASM_VERSION}\r
 473 \r
 474 function CheckDirectoryContent( const Name: String; SubDirsOnly: Boolean; const Mask: String ): Boolean;\r
 475 var FD: TWin32FindData;\r
 476     FH: THandle;\r
 477 begin\r
 478   if not DirectoryExists( Name ) then\r
 479     Result := TRUE\r
 480   else\r
 481   begin\r
 482     FH := Windows.FindFirstFile( PChar( IncludeTrailingPathDelimiter( Name )\r
 483        + Mask ), FD );\r
 484     if FH = INVALID_HANDLE_VALUE then\r
 485       Result := TRUE\r
 486     else\r
 487     begin\r
 488       Result := TRUE;\r
 489       repeat\r
 490         if not StrIn( FD.cFileName, ['.','..'] ) then\r
 491         begin\r
 492           if SubDirsOnly and LongBool(FD.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)\r
 493              or not SubDirsOnly then\r
 494           begin\r
 495             Result := FALSE;\r
 496             break;\r
 497           end;\r
 498         end;\r
 499       until not Windows.FindNextFile( FH, FD );\r
 500       Windows.FindClose( FH );\r
 501     end;\r
 502   end;\r
 503 end;\r
 504 \r
 505 function DirectoryEmpty(const Name: String): Boolean;\r
 506 begin\r
 507   Result := CheckDirectoryContent( Name, FALSE, '*.*' );\r
 508 end;\r
 509 \r
 510 {-}\r
 511 function DirectorySize( const Path: String ): I64;\r
 512 var DirList: PDirList;\r
 513     I: Integer;\r
 514 begin\r
 515   Result := MakeInt64( 0, 0 );\r
 516   DirList := NewDirList( Path, '*.*', 0 );\r
 517   for I := 0 to DirList.Count-1 do\r
 518   begin\r
 519     if LongBool( DirList.Items[ I ].dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY ) then\r
 520       Result := Add64( Result, DirectorySize( DirList.Path + DirList.Names[ I ] ) )\r
 521     else\r
 522       Result := Add64( Result, MakeInt64( DirList.Items[ I ].nFileSizeLow,\r
 523              DirList.Items[ I ].nFileSizeHigh ) );\r
 524   end;\r
 525   DirList.Free;\r
 526 end;\r
 527 {+}\r
 528 \r
 529 function DirectoryHasSubdirs( const Path: String ): Boolean;\r
 530 begin\r
 531   Result := not CheckDirectoryContent( Path, TRUE, '*.*' );\r
 532 end;\r
 533 \r
 534 function  GetFileList(const dir: string): PStrList;\r
 535 var\r
 536    Srch: TWin32FindData;\r
 537    flag: Integer;\r
 538    succ: boolean;\r
 539 begin\r
 540    result := nil;\r
 541    flag := FindFirstFile(PChar(dir), Srch);\r
 542    succ := flag <> 0;\r
 543    while succ do begin\r
 544       if (not (Srch.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0))then begin\r
 545          if Result = nil then begin\r
 546             Result := NewStrList;\r
 547          end;\r
 548          Result.Add(Srch.cFileName);\r
 549       end;\r
 550       succ := FindNextFile(Flag, Srch);\r
 551    end;\r
 552    FindClose(Flag);\r
 553 end;\r
 554 \r
 555 function ExcludeTrailingChar( const S: String; C: Char ): String;\r
 556 begin\r
 557   Result := S;\r
 558   if Result <> '' then\r
 559   if Result[ Length( Result ) ] = C then\r
 560     Delete( Result, Length( Result ), 1 );\r
 561 end;\r
 562 \r
 563 function IncludeTrailingChar( const S: String; C: Char ): String;\r
 564 begin\r
 565   Result := S;\r
 566   if (Result = '') or (Result[ Length( Result ) ] <> C) then\r
 567     Result := Result + C;\r
 568 end;\r
 569 \r
 570 //---------------------------------------------------------\r
 571 // Following functions/procedures are created by Edward Aretino:\r
 572 // IncludeTrailingPathDelimiter, ExcludeTrailingPathDelimiter,\r
 573 // ForceDirectories, CreateDir, ChangeFileExt\r
 574 //---------------------------------------------------------\r
 575 function IncludeTrailingPathDelimiter(const S: string): string;\r
 576 begin\r
 577    {if CopyTail(S, 1) <> '\' then\r
 578      Result := S + '\'\r
 579    else\r
 580      Result := S;}\r
 581    Result := IncludeTrailingChar( S, '\' );\r
 582 end;\r
 583 \r
 584 function ExcludeTrailingPathDelimiter(const S: string): string;\r
 585 begin\r
 586    {Result := S;\r
 587    if Length(Result) = 0 then Exit;\r
 588 \r
 589    if (CopyTail(Result, 1) = '\') then\r
 590      DeleteTail(Result, 1);}\r
 591    Result := ExcludeTrailingChar( S, '\' );\r
 592 end;\r
 593 \r
 594 function ForceDirectories(Dir: string): Boolean;\r
 595 begin\r
 596  Result := Length(Dir) > 0; {Centronix}\r
 597  If not Result then Exit;\r
 598  Dir := ExcludeTrailingPathDelimiter(Dir);\r
 599  If (Length(Dir) < 3) or DirectoryExists(Dir) or\r
 600    (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.\r
 601  Result := ForceDirectories(ExtractFilePath(Dir)) and CreateDir(Dir);\r
 602 end;\r
 603 \r
 604 function CreateDir(const Dir: string): Boolean;\r
 605 begin\r
 606    Result := Windows.CreateDirectory(PChar(Dir), nil);\r
 607 end;\r
 608 \r
 609 function ChangeFileExt(FileName: String; const Extension: string): string;\r
 610 var\r
 611    FileExt: String;\r
 612 begin\r
 613    FileExt := ExtractFileExt(FileName);\r
 614    DeleteTail(FileName, Length(FileExt));\r
 615    Result := FileName+ Extension;\r
 616 end;\r
 617 \r
 618 {$IFDEF ASM_VERSION}\r
 619 {$IFNDEF _D2}\r
 620 {$DEFINE ASM_LStrFromPCharLen}\r
 621 {$ENDIF}\r
 622 {$ENDIF ASM_VERSION}\r
 623 \r
 624 {$IFDEF ASM_LStrFromPCharLen}\r
 625   {$DEFINE ASM_DIRDelimiters}\r
 626 {$ENDIF}\r
 627 \r
 628 {$IFDEF ASM_VERSION}\r
 629   {$DEFINE ASM_DIRDelimiters}\r
 630 {$ENDIF ASM_VERSION}\r
 631 \r
 632 {$IFDEF ASM_DIRDelimiters}\r
 633 const\r
 634   DirDelimiters: PChar = ':\';\r
 635 {$ENDIF}\r
 636 \r
 637 {$IFDEF ASM_VERSION}\r
 638 function ExtractFileName( const Path : String ) : String;\r
 639 asm\r
 640         PUSH     EDX\r
 641         PUSH     EAX\r
 642         MOV      EDX, [DirDelimiters]\r
 643         CALL     __DelimiterLast\r
 644         POP      EDX\r
 645         CMP      byte ptr [EAX], 0\r
 646         JZ       @@1\r
 647         XCHG     EDX, EAX\r
 648         INC      EDX\r
 649 @@1:    POP      EAX\r
 650         CALL     System.@LStrFromPChar\r
 651 end;\r
 652 {$ELSE ASM_VERSION} //Pascal\r
 653 function ExtractFileName( const Path : String ) : String;\r
 654 var P: PChar;\r
 655 begin\r
 656   P := __DelimiterLast( PChar( Path ), ':\' );\r
 657   if P^ = #0 then\r
 658     Result := Path\r
 659   else\r
 660     Result := P + 1;\r
 661 end;\r
 662 {$ENDIF ASM_VERSION}\r
 663 \r
 664 {$IFDEF ASM_LStrFromPCharLen} // LStrFromPCharLen - there are no in D2\r
 665 function ExtractFilePath( const Path : String ) : String;\r
 666 asm\r
 667         PUSH     EDX\r
 668         MOV      EDX, [DirDelimiters]\r
 669         CALL     EAX2PChar\r
 670         PUSH     EAX\r
 671         CALL     __DelimiterLast\r
 672         XCHG     EDX, EAX\r
 673         XOR      ECX, ECX\r
 674         POP      EAX\r
 675         CMP      byte ptr [EDX], CL\r
 676         JZ       @@ret_0\r
 677         SUB      EDX, EAX\r
 678         INC      EDX\r
 679         XCHG     EDX, EAX\r
 680         XCHG     ECX, EAX\r
 681 @@ret_0:\r
 682         POP      EAX\r
 683         CALL     System.@LStrFromPCharLen\r
 684 end;\r
 685 {$ELSE} //Pascal\r
 686 function ExtractFilePath( const Path : String ) : String;\r
 687 //var I : Integer;\r
 688 var P, P0: PChar;\r
 689 begin\r
 690   P0 := PChar( Path );\r
 691   P := __DelimiterLast( P0, ':\' );\r
 692   if P^ = #0 then\r
 693     Result := ''\r
 694   else\r
 695     Result := Copy( Path, 1, P - P0 + 1 );\r
 696 end;\r
 697 {$ENDIF}\r
 698 \r
 699 function ExtractFileNameWOext( const Path : String ) : String;\r
 700 begin\r
 701   Result := ExtractFileName( Path );\r
 702   Result := Copy( Result, 1, Length( Result ) - Length( ExtractFileExt( Result ) ) );\r
 703 end;\r
 704 \r
 705 {$IFDEF ASM_VERSION}\r
 706 const\r
 707   ExtDelimeters: PChar = '.';\r
 708 \r
 709 function ExtractFileExt( const Path : String ) : String;\r
 710 asm\r
 711         PUSH     EDX\r
 712         MOV      EDX, [ExtDelimeters]\r
 713         CALL     EAX2PChar\r
 714         CALL     __DelimiterLast\r
 715 @@1:    XCHG     EDX, EAX\r
 716         POP      EAX\r
 717         CALL     System.@LStrFromPChar\r
 718 end;\r
 719 {$ELSE ASM_VERSION} //Pascal\r
 720 function ExtractFileExt( const Path : String ) : String;\r
 721 var P: PChar;\r
 722 begin\r
 723   P := __DelimiterLast( PChar( Path ), '.' );\r
 724   Result := P;\r
 725 end;\r
 726 {$ENDIF ASM_VERSION}\r
 727 \r
 728 function ReplaceFileExt( const Path, NewExt: String ): String;\r
 729 begin\r
 730   Result := ExtractFilePath( Path ) +\r
 731             ExtractFileNameWOext( ExtractFileName( Path ) ) +\r
 732             NewExt;\r
 733 end;\r
 734 \r
 735 function ExtractShortPathName( const Path: String ): String;\r
 736 var\r
 737   Buffer: array[0..MAX_PATH - 1] of Char;\r
 738 begin\r
 739   SetString(Result, Buffer,\r
 740     GetShortPathName(PChar(Path), Buffer, SizeOf(Buffer)));\r
 741 end;\r
 742 \r
 743 function FilePathShortened( const Path: String; MaxLen: Integer ): String;\r
 744 begin\r
 745   Result := FilePathShortenPixels( Path, 0, MaxLen );\r
 746 end;\r
 747 \r
 748 function PixelsLength( DC: HDC; const Text: String ): Integer;\r
 749 var Sz: TSize;\r
 750 begin\r
 751   if DC = 0 then\r
 752     Result := Length( Text )\r
 753   else\r
 754   begin\r
 755     Windows.GetTextExtentPoint32( DC, PChar( Text ), Length( Text ), Sz );\r
 756     Result := Sz.cx;\r
 757   end;\r
 758 end;\r
 759 \r
 760 function FilePathShortenPixels( const Path: String; DC: HDC; MaxPixels: Integer ): String;\r
 761 var L0, L1: Integer;\r
 762     Prev: String;\r
 763 begin\r
 764  Result := Path;\r
 765  L0 := PixelsLength( DC, Result );\r
 766  while L0 > MaxPixels do\r
 767  begin\r
 768    Prev := Result;\r
 769    L1 := pos( '\...\', Result );\r
 770    if L1 <= 0 then\r
 771      Result := ExcludeTrailingPathDelimiter( ExtractFilePath( Result ) )\r
 772    else\r
 773      Result := Copy( Result, 1, L1 - 1 );\r
 774    if Result <> '' then\r
 775      Result := IncludeTrailingPathDelimiter( ExtractFilePath( Result ) ) + '...\' + ExtractFileName( Path );\r
 776    if (Result = '') or (Result = Prev) then\r
 777    begin\r
 778      L1 := Length( ExtractFilePath( Result ) );\r
 779      while (PixelsLength( DC, Result ) > MaxPixels) and (L1 > 1) do\r
 780      begin\r
 781        Dec( L1 );\r
 782        Result := Copy( Result, 1, L1 ) + '...\' + ExtractFileName( Result );\r
 783      end;\r
 784      if PixelsLength( DC, Result ) > MaxPixels then\r
 785      begin\r
 786        L1 := MaxPixels + 1;\r
 787        while ((MaxPixels > 0) and (L1 > 1) or (MaxPixels = 0) and (L1 > 0)) and\r
 788              (PixelsLength( DC, Result ) > MaxPixels) do\r
 789        begin\r
 790          Dec( L1 );\r
 791          Result := Copy( ExtractFileName( Path ), 1, L1 ) + '...';\r
 792        end;\r
 793      end;\r
 794      break;\r
 795    end;\r
 796    L0 := PixelsLength( DC, Result );\r
 797  end;\r
 798 end;\r
 799 \r
 800 procedure CutFirstDirectory(var S: String);\r
 801 var\r
 802   Root: Boolean;\r
 803   P: Integer;\r
 804 begin\r
 805   if S = '\' then\r
 806     S := ''\r
 807   else\r
 808   begin\r
 809     if S[1] = '\' then\r
 810     begin\r
 811       Root := True;\r
 812       Delete(S, 1, 1);\r
 813     end\r
 814     else\r
 815       Root := False;\r
 816     if S[1] = '.' then\r
 817       Delete(S, 1, 4);\r
 818     P := pos('\',S);\r
 819     if P <> 0 then\r
 820     begin\r
 821       Delete(S, 1, P);\r
 822       S := '...\' + S;\r
 823     end\r
 824     else\r
 825       S := '';\r
 826     if Root then\r
 827       S := '\' + S;\r
 828   end;\r
 829 end;\r
 830 \r
 831 function MinimizeName( const Path: String; DC: HDC; MaxPixels: Integer ): String;\r
 832 var\r
 833   Drive, Dir, Name: String;\r
 834 begin\r
 835   Result := Path;\r
 836   Dir := ExtractFilePath(Result);\r
 837   Name := ExtractFileName(Result);\r
 838 \r
 839   if (Length(Dir) >= 2) and (Dir[2] = ':') then\r
 840   begin\r
 841     Drive := Copy(Dir, 1, 2);\r
 842     Delete(Dir, 1, 2);\r
 843   end\r
 844   else\r
 845     Drive := '';\r
 846   while ((Dir <> '') or (Drive <> '')) and (PixelsLength(DC, Result) > MaxPixels) do\r
 847   begin\r
 848     if Dir = '\...\' then\r
 849     begin\r
 850       Drive := '';\r
 851       Dir := '...\';\r
 852     end\r
 853     else if Dir = '' then\r
 854       Drive := ''\r
 855     else\r
 856       CutFirstDirectory(Dir);\r
 857     Result := Drive + Dir + Name;\r
 858   end;\r
 859 end;\r
 860 \r
 861 {$IFDEF ASM_VERSION}\r
 862 function FileSize( const Path : String ) : Integer;\r
 863 const size_TWin32FindData = sizeof( TWin32FindData );\r
 864 asm\r
 865         ADD      ESP, - size_TWin32FindData\r
 866         PUSH     ESP\r
 867         //CALL     System.@LStrToPChar // Path must not be ''\r
 868         PUSH     EAX\r
 869         CALL     FindFirstFile\r
 870         INC      EAX\r
 871         JZ       @@exit\r
 872         DEC      EAX\r
 873         PUSH     EAX\r
 874         CALL     FindClose\r
 875 \r
 876         MOV      EAX, [ESP].TWin32FindData.nFileSizeLow\r
 877 @@exit:\r
 878         ADD      ESP, size_TWin32FindData\r
 879 end;\r
 880 {$ELSE ASM_VERSION} //Pascal\r
 881 function FileSize( const Path : String ) : Integer;\r
 882 var FD : TWin32FindData;\r
 883     FH : THandle;\r
 884 begin\r
 885   FH := FindFirstFile( PChar( Path ), FD );\r
 886   Result := 0;\r
 887   if FH = INVALID_HANDLE_VALUE then exit;\r
 888   Result := FD.nFileSizeLow;\r
 889   if ((FD.nFileSizeLow and $80000000) <> 0) or\r
 890      (FD.nFileSizeHigh <> 0) then Result := -1;\r
 891   FindClose( FH );\r
 892 end;\r
 893 {$ENDIF ASM_VERSION}\r
 894 \r
 895 //*\r
 896 function FileTimeCompare( const FT1, FT2 : TFileTime ) : Integer;\r
 897 var ST1, ST2 : TSystemTime;\r
 898 begin\r
 899   FileTimeToSystemTime( FT1, ST1 );\r
 900   FileTimeToSystemTime( FT2, ST2 );\r
 901   Result := CompareSystemTime( ST1, ST2 );\r
 902 end;\r
 903 \r
 904 function GetSystemDir: String;\r
 905 var Buf: array[ 0..MAX_PATH ] of Char;\r
 906 begin\r
 907   GetSystemDirectory( @ Buf[ 0 ], MAX_PATH + 1 );\r
 908   Result := IncludeTrailingPathDelimiter( PChar( @ Buf[ 0 ] ) );\r
 909 end;\r
 910 \r
 911 //*\r
 912 function GetWindowsDir : string;\r
 913 var Buf : array[ 0..MAX_PATH ] of Char;\r
 914 begin\r
 915   GetWindowsDirectory( @Buf[ 0 ], MAX_PATH + 1 );\r
 916   Result := IncludeTrailingPathDelimiter( PChar( @ Buf[ 0 ] ) );\r
 917 end;\r
 918 \r
 919 function GetWorkDir : string;\r
 920 var Buf: array[ 0..MAX_PATH ] of Char;\r
 921 begin\r
 922   GetCurrentDirectory( MAX_PATH + 1, @ Buf[ 0 ] );\r
 923   Result := IncludeTrailingPathDelimiter( PChar( @ Buf[ 0 ] ) );\r
 924 end;\r
 925 \r
 926 //*\r
 927 function GetTempDir : string;\r
 928 var Buf : array[ 0..MAX_PATH ] of Char;\r
 929 begin\r
 930   Windows.GetTempPath( MAX_PATH + 1, @Buf[ 0 ] );\r
 931   Result := IncludeTrailingPathDelimiter( PChar( @ Buf[ 0 ] ) );\r
 932 end;\r
 933 \r
 934 function CreateTempFile( const DirPath, Prefix: String ): String;\r
 935 var Buf: array[ 0..MAX_PATH ] of Char;\r
 936 begin\r
 937   GetTempFileName( PChar( DirPath ), PChar( Prefix ), 0, Buf );\r
 938   Result := Buf;\r
 939 end;\r
 940 \r
 941 function  GetFileListStr(FPath{e.g.'c:\tmp\'}, FMask{e.g.'*.*'}: string): string;\r
 942 {* List of files in string, separating each path from others with semicolon (';').\r
 943    E.g.: 'c:\tmp\unit1.dcu;c:\tmp\unit1.~pa' (for use with DeleteFile2Recycle())}\r
 944 var\r
 945    Srch: TWin32FindData;\r
 946    flag: Integer;\r
 947    succ: boolean;\r
 948    dir:string;\r
 949 begin\r
 950    result := '';\r
 951    if (FPath<>'') and (FPath[length(FPath)]<>'\') then FPath:=FPath+'\';\r
 952    if (FMask<>'') and (FMask[1]='\') then FMask:=CopyEnd(FMask,2);\r
 953    dir:=FPath+FMask;\r
 954    flag := FindFirstFile(PChar(dir), Srch);\r
 955    succ := flag <> 0;\r
 956    while succ do begin\r
 957       if (not (Srch.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0))then begin\r
 958          if Result<>''then Result:=Result+';';\r
 959          Result:=Result+FPath+Srch.cFileName;\r
 960       end;\r
 961       succ := FindNextFile(Flag, Srch);\r
 962    end;\r
 963    FindClose(Flag);\r
 964 end;\r
 965 \r
 966 function DeleteFiles( const DirPath: String ): Boolean;\r
 967 var Files, Name: String;\r
 968 begin\r
 969   Files := GetFileListStr( ExtractFilePath( DirPath ), ExtractFileName( DirPath ) );\r
 970   Result := TRUE;\r
 971   while Files <> '' do\r
 972   begin\r
 973     Name := Parse( Files, ';' );\r
 974     Result := Result and DeleteFile( PChar( Name ) );\r
 975   end;\r
 976 end;\r
 977 \r
 978 //*\r
 979 function DeleteFile2Recycle( const Filename : String ) : Boolean;\r
 980 var FOS : TSHFileOpStruct;\r
 981     Buf : PChar;\r
 982     L : Integer;\r
 983 begin\r
 984   L := Length( Filename );\r
 985   GetMem( Buf, L + 2 );\r
 986   StrCopy( Buf, PChar( Filename ) );\r
 987   Buf[ L + 1 ] := #0;\r
 988   for L := L downto 0 do\r
 989     if Buf[ L ] = ';' then Buf[ L ] := #0;\r
 990   FillChar( FOS, Sizeof( FOS ), 0 );\r
 991   if Applet <> nil then\r
 992     FOS.Wnd := Applet.Handle;\r
 993   FOS.wFunc := FO_DELETE;\r
 994   FOS.pFrom := Buf;\r
 995   FOS.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;\r
 996   FOS.fAnyOperationsAborted := True;\r
 997   FOS.lpszProgressTitle := PChar( 'Delete ' + Filename + ' to Recycle bin' );\r
 998   Result := SHFileOperation( FOS ) = 0;\r
 999   if Result then\r
1000     Result := not FOS.fAnyOperationsAborted;\r
1001   FreeMem( Buf );\r
1002 end;\r
1003 \r
1004 function CopyMoveFiles( const FromList, ToList: String; Move: Boolean ): Boolean;\r
1005 var FOS : TSHFileOpStruct;\r
1006     Buf : PChar;\r
1007     L : Integer;\r
1008 begin\r
1009   L := Length( FromList );\r
1010   GetMem( Buf, L + 2 );\r
1011   StrCopy( Buf, PChar( FromList ) );\r
1012   Buf[ L + 1 ] := #0;\r
1013   for L := L downto 0 do\r
1014     if Buf[ L ] = ';' then Buf[ L ] := #0;\r
1015   FillChar( FOS, Sizeof( FOS ), 0 );\r
1016   if Applet <> nil then\r
1017     FOS.Wnd := Applet.Handle;\r
1018   if Move then\r
1019   begin\r
1020     FOS.wFunc := FO_MOVE;\r
1021     FOS.lpszProgressTitle := PChar( 'Move files' );\r
1022   end\r
1023     else\r
1024   begin\r
1025     FOS.wFunc := FO_COPY;\r
1026     FOS.lpszProgressTitle := PChar( 'Copy files' );\r
1027   end;\r
1028   FOS.pFrom := Buf;\r
1029   FOS.pTo := PChar( ToList + #0 );\r
1030   FOS.fFlags := FOF_ALLOWUNDO;\r
1031   FOS.fAnyOperationsAborted := True;\r
1032   Result := SHFileOperation( FOS ) = 0;\r
1033   if Result then\r
1034     Result := not FOS.fAnyOperationsAborted;\r
1035   FreeMem( Buf );\r
1036 end;\r
1037 \r
1038 {-}\r
1039 function DiskFreeSpace( const Path: String ): I64;\r
1040 type TGetDFSEx = function( Path: PChar; CallerFreeBytes, TotalBytes, FreeBytes: Pointer )\r
1041                  : Bool; stdcall;\r
1042 var GetDFSEx: TGetDFSEx;\r
1043     Kern32: THandle;\r
1044     V: TOSVersionInfo;\r
1045     Ex: Boolean;\r
1046     SpC, BpS, NFC, TNC: DWORD;\r
1047     FBA, TNB: I64;\r
1048 begin\r
1049   GetDFSEx := nil;\r
1050   V.dwOSVersionInfoSize := Sizeof( V );\r
1051   GetVersionEx( V );\r
1052   Ex := FALSE;\r
1053   if V.dwPlatformId = VER_PLATFORM_WIN32_NT then\r
1054   begin\r
1055     Ex := V.dwMajorVersion >= 4;\r
1056   end\r
1057     else\r
1058   if V.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then\r
1059   begin\r
1060     Ex := V.dwMajorVersion > 4;\r
1061     if not Ex then\r
1062     if V.dwMajorVersion = 4 then\r
1063     begin\r
1064       Ex := V.dwMinorVersion > 0;\r
1065       if not Ex then\r
1066         Ex := LoWord( V.dwBuildNumber ) >= $1111;\r
1067     end;\r
1068   end;\r
1069   if Ex then\r
1070   begin\r
1071     Kern32 := GetModuleHandle( 'kernel32.dll' );\r
1072     GetDFSEx := GetProcAddress( Kern32, 'GetDiskFreeSpaceExA' );\r
1073   end;\r
1074   if Assigned( GetDFSEx ) then\r
1075     GetDFSEx( PChar( Path ), @ FBA, @ TNB, @Result )\r
1076   else\r
1077   begin\r
1078     GetDiskFreeSpace( PChar( Path ), SpC, BpS, NFC, TNC );\r
1079     Result := Mul64i( MakeInt64( SpC * BpS, 0 ), NFC );\r
1080   end;\r
1081 end;\r
1082 {+}\r
1083 \r
1084 //*\r
1085 function GetUniqueFilename( PathName: string ) : String;\r
1086 var Path, Nam, Ext : String;\r
1087     I, J, K : Integer;\r
1088 begin\r
1089   Result := PathName;\r
1090   Path := ExtractFilePath( PathName );\r
1091   if not DirectoryExists( Path ) then Exit;\r
1092   Nam := ExtractFileNameWOext( PathName );\r
1093   if Nam = '' then\r
1094   begin\r
1095     if Path[ Length( Path ) ] = '\' then\r
1096        Path := Copy( Path, 1, Length( Path ) - 1 );\r
1097     PathName := Path;\r
1098     Result := Path;\r
1099   end;\r
1100   Nam := ExtractFileNameWOext( PathName );\r
1101   Ext := ExtractFileExt( PathName );\r
1102   I := Length( Nam );\r
1103   for J := I downto 1 do\r
1104   if not (Nam[ J ] in [ '0'..'9' ]) then\r
1105   begin\r
1106     I := J;\r
1107     break;\r
1108   end;\r
1109   K := Str2Int( CopyEnd( Nam, I + 1 ) );\r
1110   while FileExists( Result ) do\r
1111   begin\r
1112     Inc( K );\r
1113     Result := Path + Copy( Nam, 1, I ) + Int2Str( K ) + Ext;\r
1114   end;\r
1115 end;\r
1116 \r
1117 {$IFDEF ASM_VERSION}\r
1118 function GetStartDir : String;\r
1119 asm\r
1120         PUSH     EBX\r
1121         MOV      EBX, EAX\r
1122 \r
1123         XOR      EAX, EAX\r
1124         MOV      AH, 2\r
1125         SUB      ESP, EAX\r
1126         MOV      EDX, ESP\r
1127         PUSH     EAX\r
1128         PUSH     EDX\r
1129         PUSH     0\r
1130         CALL     GetModuleFileName\r
1131 \r
1132         LEA      EDX, [ESP + EAX]\r
1133 @@1:    DEC      EDX\r
1134         CMP      byte ptr [EDX], '\'\r
1135         JNZ      @@1\r
1136 \r
1137         INC      EDX\r
1138         MOV      byte ptr [EDX], 0\r
1139 \r
1140         MOV      EAX, EBX\r
1141         MOV      EDX, ESP\r
1142         CALL     System.@LStrFromPChar\r
1143 \r
1144         ADD      ESP, 200h\r
1145         POP      EBX\r
1146 end;\r
1147 {$ELSE ASM_VERSION} //Pascal\r
1148 function GetStartDir : String;\r
1149 var Buffer:array[0..260] of Char;\r
1150     I : Integer;\r
1151 begin\r
1152   I := GetModuleFileName( 0, Buffer, Sizeof( Buffer ) );\r
1153   for I := I downto 0 do\r
1154     if Buffer[ I ] = '\' then\r
1155     begin\r
1156       Buffer[ I + 1 ] := #0;\r
1157       break;\r
1158     end;\r
1159   Result := Buffer;\r
1160 end;\r
1161 {$ENDIF ASM_VERSION}\r
1162 \r
1163 //{$ENDIF LINUX/WIN32}