home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / FileUtil.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  38KB  |  1,235 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997 Master-Bank                }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit FileUtil;
  11.  
  12. {$I RX.INC}
  13. {$I-,R-}
  14.  
  15. interface
  16.  
  17. uses Windows, RTLConsts, Messages, SysUtils, Classes, Consts, Controls;
  18.  
  19. procedure CopyFile(const FileName, DestName: string;
  20.   ProgressControl: TControl);
  21. procedure CopyFileEx(const FileName, DestName: string;
  22.   OverwriteReadOnly, ShellDialog: Boolean; ProgressControl: TControl);
  23. procedure MoveFile(const FileName, DestName: TFileName);
  24. procedure MoveFileEx(const FileName, DestName: TFileName; ShellDialog: Boolean);
  25. {$IFDEF RX_D4}
  26. function GetFileSize(const FileName: string): Int64;
  27. {$ELSE}
  28. function GetFileSize(const FileName: string): Longint;
  29. {$ENDIF}
  30. function FileDateTime(const FileName: string): TDateTime;
  31. function HasAttr(const FileName: string; Attr: Integer): Boolean;
  32. function DeleteFiles(const FileMask: string): Boolean;
  33. function DeleteFilesEx(const FileMasks: array of string): Boolean;
  34. function ClearDir(const Path: string; Delete: Boolean): Boolean;
  35. function NormalDir(const DirName: string): string;
  36. function RemoveBackSlash(const DirName: string): string;
  37. function ValidFileName(const FileName: string): Boolean;
  38. function DirExists(Name: string): Boolean;
  39. procedure ForceDirectories(Dir: string);
  40.  
  41. function FileLock(Handle: Integer; Offset, LockSize: Longint): Integer;
  42.   {$IFDEF RX_D4} overload; {$ENDIF}
  43. {$IFDEF RX_D4}
  44. function FileLock(Handle: Integer; Offset, LockSize: Int64): Integer; overload;
  45. {$ENDIF}
  46. function FileUnlock(Handle: Integer; Offset, LockSize: Longint): Integer;
  47.   {$IFDEF RX_D4} overload; {$ENDIF}
  48. {$IFDEF RX_D4}
  49. function FileUnlock(Handle: Integer; Offset, LockSize: Int64): Integer; overload;
  50. {$ENDIF}
  51.  
  52. function GetTempDir: string;
  53. function GetWindowsDir: string;
  54. function GetSystemDir: string;
  55.  
  56. function BrowseDirectory(var AFolderName: string; const DlgText: string;
  57.   AHelpContext: THelpContext): Boolean;
  58.  
  59. {$IFDEF WIN32}
  60. function BrowseComputer(var ComputerName: string; const DlgText: string;
  61.   AHelpContext: THelpContext): Boolean;
  62.  
  63. function ShortToLongFileName(const ShortName: string): string;
  64. function ShortToLongPath(const ShortName: string): string;
  65. function LongToShortFileName(const LongName: string): string;
  66. function LongToShortPath(const LongName: string): string;
  67.  
  68. procedure CreateFileLink(const FileName, DisplayName: string; Folder: Integer);
  69. procedure DeleteFileLink(const DisplayName: string; Folder: Integer);
  70. {$ENDIF WIN32}
  71.  
  72. {$IFNDEF RX_D3}
  73. function IsPathDelimiter(const S: string; Index: Integer): Boolean;
  74. {$ENDIF}
  75.  
  76. implementation
  77.  
  78. uses {$IFDEF WIN32} {$IFDEF RX_D3} ActiveX, ComObj, ShlObj, {$ELSE} Ole2,
  79.   OleAuto, {$ENDIF} {$ENDIF} DateUtil, ShellAPI, FileCtrl, Forms, VCLUtils,
  80.   RxPrgrss;
  81.  
  82. {$IFDEF WIN32}
  83.  
  84. {$IFNDEF RX_D3}
  85.  
  86. type
  87.  
  88. { TSHItemID -- Item ID }
  89.  
  90.   PSHItemID = ^TSHItemID;
  91.   TSHItemID = packed record           { mkid }
  92.     cb: Word;                         { Size of the ID (including cb itself) }
  93.     abID: array[0..0] of Byte;        { The item ID (variable length) }
  94.   end;
  95.  
  96. { TItemIDList -- List if item IDs (combined with 0-terminator) }
  97.  
  98.   PItemIDList = ^TItemIDList;
  99.   TItemIDList = packed record         { idl }
  100.      mkid: TSHItemID;
  101.    end;
  102.  
  103.   TFNBFFCallBack = function(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
  104.  
  105.   PBrowseInfo = ^TBrowseInfo;
  106.   TBrowseInfo = packed record
  107.     hwndOwner: HWND;
  108.     pidlRoot: PItemIDList;
  109.     pszDisplayName: LPSTR;  { Return display name of item selected. }
  110.     lpszTitle: LPCSTR;      { text to go in the banner over the tree. }
  111.     ulFlags: UINT;          { Flags that control the return stuff }
  112.     lpfn: TFNBFFCallBack;
  113.     lParam: LPARAM;         { extra info that's passed back in callbacks }
  114.     iImage: Integer;        { output var: where to return the Image index. }
  115.   end;
  116.  
  117. const
  118.  
  119. { Browsing for directory }
  120.  
  121.   BIF_RETURNONLYFSDIRS   = $0001; { For finding a folder to start document searching }
  122.   BIF_DONTGOBELOWDOMAIN  = $0002; { For starting the Find Computer }
  123.   BIF_STATUSTEXT         = $0004;
  124.   BIF_RETURNFSANCESTORS  = $0008;
  125.  
  126.   BIF_BROWSEFORCOMPUTER  = $1000; { Browsing for Computers }
  127.   BIF_BROWSEFORPRINTER   = $2000; { Browsing for Printers }
  128.   BIF_BROWSEINCLUDEFILES = $4000; { Browsing for Everything }
  129.  
  130. { message from browser }
  131.  
  132.   BFFM_INITIALIZED       = 1;
  133.   BFFM_SELCHANGED        = 2;
  134.  
  135. { messages to browser }
  136.  
  137.   BFFM_SETSTATUSTEXT      = (WM_USER + 100);
  138.   BFFM_ENABLEOK           = (WM_USER + 101);
  139.   BFFM_SETSELECTION       = (WM_USER + 102);
  140.  
  141. const
  142.   CSIDL_DRIVES             = $0011;
  143.   CSIDL_NETWORK            = $0012;
  144.  
  145. function SHBrowseForFolder(var lpbi: TBrowseInfo): PItemIDList; stdcall;
  146.   far; external Shell32 name 'SHBrowseForFolder';
  147. function SHGetPathFromIDList(pidl: PItemIDList; pszPath: LPSTR): BOOL; stdcall;
  148.   far; external Shell32 name 'SHGetPathFromIDList';
  149. function SHGetSpecialFolderLocation(hwndOwner: HWND; nFolder: Integer;
  150.   var ppidl: PItemIDList): HResult; stdcall; far; external Shell32
  151.   name 'SHGetSpecialFolderLocation';
  152.  
  153. {$ENDIF RX_D3}
  154.  
  155. { TBrowseFolderDlg }
  156.  
  157. type
  158.   TBrowseKind = (bfFolders, bfComputers);
  159.   TDialogPosition = (dpDefault, dpScreenCenter);
  160.  
  161.   TBrowseFolderDlg = class(TComponent)
  162.   private
  163.     FDefWndProc: Pointer;
  164.     FHelpContext: THelpContext;
  165.     FHandle: HWnd;
  166.     FObjectInstance: Pointer;
  167.     FDesktopRoot: Boolean;
  168.     FBrowseKind: TBrowseKind;
  169.     FPosition: TDialogPosition;
  170.     FText: string;
  171.     FDisplayName: string;
  172.     FSelectedName: string;
  173.     FFolderName: string;
  174.     FImageIndex: Integer;
  175.     FOnInitialized: TNotifyEvent;
  176.     FOnSelChanged: TNotifyEvent;
  177.     procedure SetSelPath(const Path: string);
  178.     procedure SetOkEnable(Value: Boolean);
  179.     procedure DoInitialized;
  180.     procedure DoSelChanged(Param: PItemIDList);
  181.     procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
  182.     procedure WMCommand(var Message: TMessage); message WM_COMMAND;
  183.   protected
  184.     procedure DefaultHandler(var Message); override;
  185.     procedure WndProc(var Message: TMessage); virtual;
  186.     function TaskModalDialog(var Info: TBrowseInfo): PItemIDList;
  187.   public
  188.     constructor Create(AOwner: TComponent); override;
  189.     destructor Destroy; override;
  190.     function Execute: Boolean;
  191.     property Handle: HWnd read FHandle;
  192.     property DisplayName: string read FDisplayName;
  193.     property SelectedName: string read FSelectedName write FSelectedName;
  194.     property ImageIndex: Integer read FImageIndex;
  195.   published
  196.     property BrowseKind: TBrowseKind read FBrowseKind write FBrowseKind default bfFolders;
  197.     property DesktopRoot: Boolean read FDesktopRoot write FDesktopRoot default True;
  198.     property DialogText: string read FText write FText;
  199.     property FolderName: string read FFolderName write FFolderName;
  200.     property HelpContext: THelpContext read FHelpContext write FHelpContext default 0;
  201.     property Position: TDialogPosition read FPosition write FPosition default dpScreenCenter;
  202.     property OnInitialized: TNotifyEvent read FOnInitialized write FOnInitialized;
  203.     property OnSelChanged: TNotifyEvent read FOnSelChanged write FOnSelChanged;
  204.   end;
  205.  
  206. function ExplorerHook(Wnd: HWnd; Msg: UINT; LParam: LPARAM; Data: LPARAM): Integer; stdcall;
  207. begin
  208.   Result := 0;
  209.   if Msg = BFFM_INITIALIZED then begin
  210.     if TBrowseFolderDlg(Data).Position = dpScreenCenter then
  211.       CenterWindow(Wnd);
  212.     TBrowseFolderDlg(Data).FHandle := Wnd;
  213.     TBrowseFolderDlg(Data).FDefWndProc := Pointer(SetWindowLong(Wnd, GWL_WNDPROC,
  214.       Longint(TBrowseFolderDlg(Data).FObjectInstance)));
  215.     TBrowseFolderDlg(Data).DoInitialized;
  216.   end
  217.   else if Msg = BFFM_SELCHANGED then begin
  218.     TBrowseFolderDlg(Data).FHandle := Wnd;
  219.     TBrowseFolderDlg(Data).DoSelChanged(PItemIDList(LParam));
  220.   end;
  221. end;
  222.  
  223. const
  224.   HelpButtonId = $FFFF;
  225.  
  226. constructor TBrowseFolderDlg.Create(AOwner: TComponent);
  227. begin
  228.   inherited Create(AOwner);
  229.   FObjectInstance := MakeObjectInstance(WndProc);
  230.   FDesktopRoot := True;
  231.   FBrowseKind := bfFolders;
  232.   FPosition := dpScreenCenter;
  233.   SetLength(FDisplayName, MAX_PATH);
  234. end;
  235.  
  236. destructor TBrowseFolderDlg.Destroy;
  237. begin
  238.   if FObjectInstance <> nil then FreeObjectInstance(FObjectInstance);
  239.   inherited Destroy;
  240. end;
  241.  
  242. procedure TBrowseFolderDlg.DoInitialized;
  243. const
  244.   SBtn = 'BUTTON';
  245. var
  246.   BtnHandle, HelpBtn, BtnFont: THandle;
  247.   BtnSize: TRect;
  248. begin
  249.   if (FBrowseKind = bfComputers) or DirExists(FFolderName) then
  250.     SetSelPath(FFolderName);
  251.   if FHelpContext <> 0 then begin
  252.     BtnHandle := FindWindowEx(FHandle, 0, SBtn, nil);
  253.     if (BtnHandle <> 0) then begin
  254.       GetWindowRect(BtnHandle, BtnSize);
  255.       ScreenToClient(FHandle, BtnSize.TopLeft);
  256.       ScreenToClient(FHandle, BtnSize.BottomRight);
  257.       BtnFont := SendMessage(FHandle, WM_GETFONT, 0, 0);
  258.       HelpBtn := CreateWindow(SBtn, PChar(ResStr(SHelpButton)),
  259.         WS_CHILD or WS_CLIPSIBLINGS or WS_VISIBLE or BS_PUSHBUTTON or WS_TABSTOP,
  260.         12, BtnSize.Top, BtnSize.Right - BtnSize.Left, BtnSize.Bottom - BtnSize.Top,
  261.         FHandle, HelpButtonId, HInstance, nil);
  262.       if BtnFont <> 0 then
  263.         SendMessage(HelpBtn, WM_SETFONT, BtnFont, MakeLParam(1, 0));
  264.       UpdateWindow(FHandle);
  265.     end;
  266.   end;
  267.   if Assigned(FOnInitialized) then FOnInitialized(Self);
  268. end;
  269.  
  270. procedure TBrowseFolderDlg.DoSelChanged(Param: PItemIDList);
  271. var
  272.   Temp: array[0..MAX_PATH] of Char;
  273. begin
  274.   if (FBrowseKind = bfComputers) then begin
  275.     FSelectedName := DisplayName;
  276.   end
  277.   else begin
  278.     if SHGetPathFromIDList(Param, Temp) then begin
  279.       FSelectedName := StrPas(Temp);
  280.       SetOkEnable(DirExists(FSelectedName));
  281.     end
  282.     else begin
  283.       FSelectedName := '';
  284.       SetOkEnable(False);
  285.     end;
  286.   end;
  287.   if Assigned(FOnSelChanged) then FOnSelChanged(Self);
  288. end;
  289.  
  290. procedure TBrowseFolderDlg.SetSelPath(const Path: string);
  291. begin
  292.   if FHandle <> 0 then
  293.     SendMessage(FHandle, BFFM_SETSELECTION, 1, Longint(PChar(Path)));
  294. end;
  295.  
  296. procedure TBrowseFolderDlg.SetOkEnable(Value: Boolean);
  297. begin
  298.   if FHandle <> 0 then SendMessage(FHandle, BFFM_ENABLEOK, 0, Ord(Value));
  299. end;
  300.  
  301. procedure TBrowseFolderDlg.DefaultHandler(var Message);
  302. begin
  303.   if FHandle <> 0 then
  304.     with TMessage(Message) do
  305.       Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam)
  306.   else inherited DefaultHandler(Message);
  307. end;
  308.  
  309. procedure TBrowseFolderDlg.WndProc(var Message: TMessage);
  310. begin
  311.   Dispatch(Message);
  312. end;
  313.  
  314. procedure TBrowseFolderDlg.WMCommand(var Message: TMessage);
  315. begin
  316.   if (Message.wParam = HelpButtonId) and (LongRec(Message.lParam).Hi =
  317.     BN_CLICKED) and (FHelpContext <> 0) then
  318.   begin
  319.     Application.HelpContext(FHelpContext);
  320.   end
  321.   else inherited;
  322. end;
  323.  
  324. procedure TBrowseFolderDlg.WMNCDestroy(var Message: TWMNCDestroy);
  325. begin
  326.   inherited;
  327.   FHandle := 0;
  328. end;
  329.  
  330. function TBrowseFolderDlg.Execute: Boolean;
  331. var
  332.   BrowseInfo: TBrowseInfo;
  333.   ItemIDList: PItemIDList;
  334.   Temp: array[0..MAX_PATH] of Char;
  335. begin
  336.   if FDesktopRoot and (FBrowseKind = bfFolders) then
  337.     BrowseInfo.pidlRoot := nil
  338.   else begin
  339.     if FBrowseKind = bfComputers then { root - Network }
  340.       OleCheck(SHGetSpecialFolderLocation(0, CSIDL_NETWORK,
  341.         BrowseInfo.pidlRoot))
  342.     else { root - MyComputer }
  343.       OleCheck(SHGetSpecialFolderLocation(0, CSIDL_DRIVES,
  344.         BrowseInfo.pidlRoot));
  345.   end;
  346.   try
  347.     SetLength(FDisplayName, MAX_PATH);
  348.     with BrowseInfo do begin
  349.       pszDisplayName := PChar(DisplayName);
  350.       if DialogText <> '' then lpszTitle := PChar(DialogText)
  351.       else lpszTitle := nil;
  352.       if FBrowseKind = bfComputers then
  353.         ulFlags := BIF_BROWSEFORCOMPUTER
  354.       else
  355.         ulFlags := BIF_RETURNONLYFSDIRS or BIF_RETURNFSANCESTORS;
  356.       lpfn := ExplorerHook;
  357.       lParam := Longint(Self);
  358.       hWndOwner := Application.Handle;
  359.       iImage := 0;
  360.     end;
  361.     ItemIDList := TaskModalDialog(BrowseInfo);
  362.     Result := ItemIDList <> nil;
  363.     if Result then
  364.     try
  365.       if FBrowseKind = bfFolders then begin
  366.         Win32Check(SHGetPathFromIDList(ItemIDList, Temp));
  367.         FFolderName := RemoveBackSlash(StrPas(Temp));
  368.       end
  369.       else begin
  370.         FFolderName := DisplayName;
  371.       end;
  372.       FSelectedName := FFolderName;
  373.       FImageIndex := BrowseInfo.iImage;
  374.     finally
  375.       CoTaskMemFree(ItemIDList);
  376.     end;
  377.   finally
  378.     if BrowseInfo.pidlRoot <> nil then CoTaskMemFree(BrowseInfo.pidlRoot);
  379.   end;
  380. end;
  381.  
  382. function TBrowseFolderDlg.TaskModalDialog(var Info: TBrowseInfo): PItemIDList;
  383. var
  384.   ActiveWindow: HWnd;
  385.   WindowList: Pointer;
  386. begin
  387.   ActiveWindow := GetActiveWindow;
  388.   WindowList := DisableTaskWindows(0);
  389.   try
  390.     try
  391.       Result := SHBrowseForFolder(Info);
  392.     finally
  393.       FHandle := 0;
  394.       FDefWndProc := nil;
  395.     end;
  396.   finally
  397.     EnableTaskWindows(WindowList);
  398.     SetActiveWindow(ActiveWindow);
  399.   end;
  400. end;
  401.  
  402. function BrowseDirectory(var AFolderName: string; const DlgText: string;
  403.   AHelpContext: THelpContext): Boolean;
  404. begin
  405.   if NewStyleControls then begin
  406.     with TBrowseFolderDlg.Create(Application) do
  407.     try
  408.       DialogText := DlgText;
  409.       FolderName := AFolderName;
  410.       HelpContext := AHelpContext;
  411.       Result := Execute;
  412.       if Result then AFolderName := FolderName;
  413.     finally
  414.       Free;
  415.     end;
  416.   end
  417.   else Result := SelectDirectory(AFolderName, [], AHelpContext);
  418. end;
  419.  
  420. function BrowseComputer(var ComputerName: string; const DlgText: string;
  421.   AHelpContext: THelpContext): Boolean;
  422. begin
  423.   with TBrowseFolderDlg.Create(Application) do
  424.   try
  425.     BrowseKind := bfComputers;
  426.     DialogText := DlgText;
  427.     FolderName := ComputerName;
  428.     HelpContext := AHelpContext;
  429.     Result := Execute;
  430.     if Result then ComputerName := FolderName;
  431.   finally
  432.     Free;
  433.   end;
  434. end;
  435.  
  436. { TRxFileOperator }
  437.  
  438. type
  439.   TFileOperation = (foCopy, foDelete, foMove, foRename);
  440.   TFileOperFlag = (flAllowUndo, flConfirmMouse, flFilesOnly, flMultiDest,
  441.     flNoConfirmation, flNoConfirmMkDir, flRenameOnCollision, flSilent,
  442.     flSimpleProgress, flNoErrorUI);
  443.   TFileOperFlags = set of TFileOperFlag;
  444.  
  445.   TRxFileOperator = class(TComponent)
  446.   private
  447.     FAborted: Boolean;
  448.     FOperation: TFileOperation;
  449.     FOptions: TFileOperFlags;
  450.     FProgressTitle: string;
  451.     FSource: string;
  452.     FDestination: string;
  453.     function TaskModalDialog(DialogFunc: Pointer; var DialogData): Boolean;
  454.   public
  455.     constructor Create(AOwner: TComponent); override;
  456.     function Execute: Boolean; virtual;
  457.     property Aborted: Boolean read FAborted;
  458.   published
  459.     property Destination: string read FDestination write FDestination;
  460.     property Operation: TFileOperation read FOperation write FOperation
  461.       default foCopy;
  462.     property Options: TFileOperFlags read FOptions write FOptions
  463.       default [flAllowUndo, flNoConfirmMkDir];
  464.     property ProgressTitle: string read FProgressTitle write FProgressTitle;
  465.     property Source: string read FSource write FSource;
  466.   end;
  467.  
  468. {$IFNDEF RX_D3}
  469. const
  470.   FOF_NOERRORUI = $0400;
  471. {$ENDIF}
  472.  
  473. constructor TRxFileOperator.Create(AOwner: TComponent);
  474. begin
  475.   inherited Create(AOwner);
  476.   FOptions := [flAllowUndo, flNoConfirmMkDir];
  477. end;
  478.  
  479. function TRxFileOperator.TaskModalDialog(DialogFunc: Pointer; var DialogData): Boolean;
  480. type
  481.   TDialogFunc = function(var DialogData): Integer stdcall;
  482. var
  483.   ActiveWindow: HWnd;
  484.   WindowList: Pointer;
  485. begin
  486.   ActiveWindow := GetActiveWindow;
  487.   WindowList := DisableTaskWindows(0);
  488.   try
  489.     Result := TDialogFunc(DialogFunc)(DialogData) = 0;
  490.   finally
  491.     EnableTaskWindows(WindowList);
  492.     SetActiveWindow(ActiveWindow);
  493.   end;
  494. end;
  495.  
  496. function TRxFileOperator.Execute: Boolean;
  497. const
  498.   OperTypes: array[TFileOperation] of UINT = (
  499.     FO_COPY, FO_DELETE, FO_MOVE, FO_RENAME);
  500.   OperOptions: array[TFileOperFlag] of FILEOP_FLAGS = (
  501.     FOF_ALLOWUNDO, FOF_CONFIRMMOUSE, FOF_FILESONLY, FOF_MULTIDESTFILES,
  502.     FOF_NOCONFIRMATION, FOF_NOCONFIRMMKDIR, FOF_RENAMEONCOLLISION,
  503.     FOF_SILENT, FOF_SIMPLEPROGRESS, FOF_NOERRORUI);
  504. var
  505.   OpStruct: TSHFileOpStruct;
  506.   Flag: TFileOperFlag;
  507.  
  508.   function AllocFileStr(const S: string): PChar;
  509.   var
  510.     P: PChar;
  511.   begin
  512.     Result := nil;
  513.     if S <> '' then begin
  514.       Result := StrCopy(StrAlloc(Length(S) + 2), PChar(S));
  515.       P := Result;
  516.       while P^ <> #0 do begin
  517.         if (P^ = ';') or (P^ = '|') then P^ := #0;
  518.         Inc(P);
  519.       end;
  520.       Inc(P);
  521.       P^ := #0;
  522.     end;
  523.   end;
  524.  
  525. begin
  526.   FAborted := False;
  527.   FillChar(OpStruct, SizeOf(OpStruct), 0);
  528.   with OpStruct do
  529.   try
  530.     if (Application.MainForm <> nil) and
  531.       Application.MainForm.HandleAllocated then
  532.       Wnd := Application.MainForm.Handle
  533.     else Wnd := Application.Handle;
  534.     wFunc := OperTypes[Operation];
  535.     pFrom := AllocFileStr(FSource);
  536.     pTo := AllocFileStr(FDestination);
  537.     fFlags := 0;
  538.     for Flag := Low(Flag) to High(Flag) do
  539.       if Flag in FOptions then fFlags := fFlags or OperOptions[Flag];
  540.     lpszProgressTitle := PChar(FProgressTitle);
  541.     Result := TaskModalDialog(@SHFileOperation, OpStruct);
  542.     FAborted := fAnyOperationsAborted;
  543.   finally
  544.     if pFrom <> nil then StrDispose(pFrom);
  545.     if pTo <> nil then StrDispose(pTo);
  546.   end;
  547. end;
  548.  
  549. {$ELSE}
  550.  
  551. function BrowseDirectory(var AFolderName: string; const DlgText: string;
  552.   AHelpContext: THelpContext): Boolean;
  553. begin
  554.   Result := SelectDirectory(AFolderName, [], AHelpContext);
  555. end;
  556.  
  557. {$ENDIF WIN32}
  558.  
  559. function NormalDir(const DirName: string): string;
  560. begin
  561.   Result := DirName;
  562.   if (Result <> '') and
  563. {$IFDEF RX_D3}
  564.     not (AnsiLastChar(Result)^ in [':', '\']) then
  565. {$ELSE}
  566.     not (Result[Length(Result)] in [':', '\']) then
  567. {$ENDIF}
  568.   begin
  569.     if (Length(Result) = 1) and (UpCase(Result[1]) in ['A'..'Z']) then
  570.       Result := Result + ':\'
  571.     else Result := Result + '\';
  572.   end;
  573. end;
  574.  
  575. function RemoveBackSlash(const DirName: string): string;
  576. begin
  577.   Result := DirName;
  578.   if (Length(Result) > 1) and
  579. {$IFDEF RX_D3}
  580.     (AnsiLastChar(Result)^ = '\') then
  581. {$ELSE}
  582.     (Result[Length(Result)] = '\') then
  583. {$ENDIF}
  584.   begin
  585.     if not ((Length(Result) = 3) and (UpCase(Result[1]) in ['A'..'Z']) and
  586.       (Result[2] = ':')) then
  587.       Delete(Result, Length(Result), 1);
  588.   end;
  589. end;
  590.  
  591. function DirExists(Name: string): Boolean;
  592. {$IFDEF WIN32}
  593. var
  594.   Code: Integer;
  595. begin
  596.   Code := GetFileAttributes(PChar(Name));
  597.   Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
  598. end;
  599. {$ELSE}
  600. var
  601.   SR: TSearchRec;
  602. begin
  603.   if Name[Length(Name)] = '\' then Dec(Name[0]);
  604.   if (Length(Name) = 2) and (Name[2] = ':') then
  605.     Name := Name + '\*.*';
  606.   Result := FindFirst(Name, faDirectory, SR) = 0;
  607.   Result := Result and (SR.Attr and faDirectory <> 0);
  608. end;
  609. {$ENDIF}
  610.  
  611. procedure ForceDirectories(Dir: string);
  612. begin
  613.   if Length(Dir) = 0 then Exit;
  614. {$IFDEF RX_D3}
  615.   if (AnsiLastChar(Dir) <> nil) and (AnsiLastChar(Dir)^ = '\') then
  616. {$ELSE}
  617.   if Dir[Length(Dir)] = '\' then
  618. {$ENDIF}
  619.     Delete(Dir, Length(Dir), 1);
  620.   if (Length(Dir) < 3) or DirectoryExists(Dir) or
  621.     (ExtractFilePath(Dir) = Dir) then Exit;
  622.   ForceDirectories(ExtractFilePath(Dir));
  623. {$IFDEF WIN32}
  624.   CreateDir(Dir);
  625. {$ELSE}
  626.   MkDir(Dir);
  627. {$ENDIF}
  628. end;
  629.  
  630. {$IFDEF WIN32}
  631. procedure CopyMoveFileShell(const FileName, DestName: string; Confirmation,
  632.   AllowUndo, MoveFile: Boolean);
  633. begin
  634.   with TRxFileOperator.Create(nil) do
  635.   try
  636.     Source := FileName;
  637.     Destination := DestName;
  638.     if MoveFile then begin
  639.       if AnsiCompareText(ExtractFilePath(FileName),
  640.         ExtractFilePath(DestName)) = 0 then
  641.         Operation := foRename
  642.       else Operation := foMove;
  643.     end
  644.     else Operation := foCopy;
  645.     if not AllowUndo then
  646.       Options := Options - [flAllowUndo];
  647.     if not Confirmation then
  648.       Options := Options + [flNoConfirmation];
  649.     if not Execute or Aborted then SysUtils.Abort;
  650.   finally
  651.     Free;
  652.   end;
  653. end;
  654. {$ENDIF}
  655.  
  656. procedure CopyFile(const FileName, DestName: string;
  657.   ProgressControl: TControl);
  658. begin
  659.   CopyFileEx(FileName, DestName, False, False, ProgressControl);
  660. end;
  661.  
  662. procedure CopyFileEx(const FileName, DestName: string;
  663.   OverwriteReadOnly, ShellDialog: Boolean; ProgressControl: TControl);
  664. var
  665.   CopyBuffer: Pointer;
  666.   Source, Dest: Integer;
  667.   Destination: TFileName;
  668.   FSize, BytesCopied, TotalCopied: Longint;
  669.   Attr: Integer;
  670. const
  671.   ChunkSize: Longint = 8192;
  672. begin
  673. {$IFDEF WIN32}
  674.   if NewStyleControls and ShellDialog then begin
  675.     CopyMoveFileShell(FileName, DestName, not OverwriteReadOnly,
  676.       False, False);
  677.     Exit;
  678.   end;
  679. {$ENDIF}
  680.   Destination := DestName;
  681.   if HasAttr(Destination, faDirectory) then
  682.     Destination := NormalDir(Destination) + ExtractFileName(FileName);
  683.   GetMem(CopyBuffer, ChunkSize);
  684.   try
  685.     TotalCopied := 0;
  686.     FSize := GetFileSize(FileName);
  687.     Source := FileOpen(FileName, fmShareDenyWrite);
  688.     if Source < 0 then
  689.       raise EFOpenError.CreateFmt(ResStr(SFOpenError), [FileName]);
  690.     try
  691.       if ProgressControl <> nil then begin
  692.         SetProgressMax(ProgressControl, FSize);
  693.         SetProgressMin(ProgressControl, 0);
  694.         SetProgressValue(ProgressControl, 0);
  695.       end;
  696.       ForceDirectories(ExtractFilePath(Destination));
  697.       if OverwriteReadOnly then begin
  698.         Attr := FileGetAttr(Destination);
  699.         if (Attr >= 0) and ((Attr and faReadOnly) <> 0) then
  700.           FileSetAttr(Destination, Attr and not faReadOnly);
  701.       end;
  702.       Dest := FileCreate(Destination);
  703.       if Dest < 0 then
  704.         raise EFCreateError.CreateFmt(ResStr(SFCreateError), [Destination]);
  705.       try
  706.         repeat
  707.           BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize);
  708.           if BytesCopied = -1 then
  709.             raise EReadError.Create(ResStr(SReadError));
  710.           TotalCopied := TotalCopied + BytesCopied;
  711.           if BytesCopied > 0 then begin
  712.             if FileWrite(Dest, CopyBuffer^, BytesCopied) = -1 then
  713.               raise EWriteError.Create(ResStr(SWriteError));
  714.           end;
  715.           if ProgressControl <> nil then
  716.             SetProgressValue(ProgressControl, TotalCopied);
  717.         until BytesCopied < ChunkSize;
  718.         FileSetDate(Dest, FileGetDate(Source));
  719.       finally
  720.         FileClose(Dest);
  721.       end;
  722.     finally
  723.       FileClose(Source);
  724.     end;
  725.   finally
  726.     FreeMem(CopyBuffer, ChunkSize);
  727.     if ProgressControl <> nil then
  728.       SetProgressValue(ProgressControl, 0);
  729.   end;
  730. end;
  731.  
  732. procedure MoveFile(const FileName, DestName: TFileName);
  733. var
  734.   Destination: TFileName;
  735.   Attr: Integer;
  736. begin
  737.   Destination := ExpandFileName(DestName);
  738.   if not RenameFile(FileName, Destination) then begin
  739.     Attr := FileGetAttr(FileName);
  740.     if Attr < 0 then Exit;
  741.     if (Attr and faReadOnly) <> 0 then
  742.       FileSetAttr(FileName, Attr and not faReadOnly);
  743.     CopyFile(FileName, Destination, nil);
  744.     DeleteFile(FileName);
  745.   end;
  746. end;
  747.  
  748. procedure MoveFileEx(const FileName, DestName: TFileName;
  749.   ShellDialog: Boolean);
  750. begin
  751. {$IFDEF WIN32}
  752.   if NewStyleControls and ShellDialog then
  753.     CopyMoveFileShell(FileName, DestName, False, False, True)
  754.   else
  755. {$ENDIF}
  756.     MoveFile(FileName, DestName);
  757. end;
  758.  
  759. {$IFDEF RX_D4}
  760. function GetFileSize(const FileName: string): Int64;
  761. var
  762.   Handle: THandle;
  763.   FindData: TWin32FindData;
  764. begin
  765.   Handle := FindFirstFile(PChar(FileName), FindData);
  766.   if Handle <> INVALID_HANDLE_VALUE then begin
  767.     Windows.FindClose(Handle);
  768.     if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
  769.     begin
  770.       Int64Rec(Result).Lo := FindData.nFileSizeLow;
  771.       Int64Rec(Result).Hi := FindData.nFileSizeHigh;
  772.       Exit;
  773.     end;
  774.   end;
  775.   Result := -1;
  776. end;
  777. {$ELSE}
  778. function GetFileSize(const FileName: string): Longint;
  779. var
  780.   SearchRec: TSearchRec;
  781. begin
  782.   if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
  783.     Result := SearchRec.Size
  784.   else Result := -1;
  785.   FindClose(SearchRec);
  786. end;
  787. {$ENDIF RX_D4}
  788.  
  789. function FileDateTime(const FileName: string): System.TDateTime;
  790. var
  791.   Age: Longint;
  792. begin
  793.   Age := FileAge(FileName);
  794.   if Age = -1 then
  795.     Result := NullDate
  796.   else
  797.     Result := FileDateToDateTime(Age);
  798. end;
  799.  
  800. function HasAttr(const FileName: string; Attr: Integer): Boolean;
  801. var
  802.   FileAttr: Integer;
  803. begin
  804.   FileAttr := FileGetAttr(FileName);
  805.   Result := (FileAttr >= 0) and (FileAttr and Attr = Attr);
  806. end;
  807.  
  808. function DeleteFiles(const FileMask: string): Boolean;
  809. var
  810.   SearchRec: TSearchRec;
  811. begin
  812.   Result := FindFirst(ExpandFileName(FileMask), faAnyFile, SearchRec) = 0;
  813.   try
  814.     if Result then
  815.       repeat
  816. //        if (SearchRec.Name[1] <> '.') and
  817. //      !!! BUG !!!
  818.         if (SearchRec.Name <> '.') and
  819.           (SearchRec.Attr and faVolumeID <> faVolumeID) and
  820.           (SearchRec.Attr and faDirectory <> faDirectory) then
  821.         begin
  822.           Result := DeleteFile(ExtractFilePath(FileMask) + SearchRec.Name);
  823.           if not Result then Break;
  824.         end;
  825.       until FindNext(SearchRec) <> 0;
  826.   finally
  827.     FindClose(SearchRec);
  828.   end;
  829. end;
  830.  
  831. function DeleteFilesEx(const FileMasks: array of string): Boolean;
  832. var
  833.   I: Integer;
  834. begin
  835.   Result := True;
  836.   for I := Low(FileMasks) to High(FileMasks) do
  837.     Result := Result and DeleteFiles(FileMasks[I]);
  838. end;
  839.  
  840. function ClearDir(const Path: string; Delete: Boolean): Boolean;
  841. const
  842. {$IFDEF WIN32}
  843.   FileNotFound = 18;
  844. {$ELSE}
  845.   FileNotFound = -18;
  846. {$ENDIF}
  847. var
  848.   FileInfo: TSearchRec;
  849.   DosCode: Integer;
  850. begin
  851.   Result := DirExists(Path);
  852.   if not Result then Exit;
  853.   DosCode := FindFirst(NormalDir(Path) + '*.*', faAnyFile, FileInfo);
  854.   try
  855.     while DosCode = 0 do begin
  856. //      if (FileInfo.Name[1] <> '.') and (FileInfo.Attr <> faVolumeID) then
  857. //      !!! BUG !!!
  858.       if (FileInfo.Name <> '.') and (FileInfo.Name <> '..') and (FileInfo.Attr <> faVolumeID) then
  859.       begin
  860.         if (FileInfo.Attr and faDirectory = faDirectory) then
  861.           Result := ClearDir(NormalDir(Path) + FileInfo.Name, Delete) and Result
  862.         else if (FileInfo.Attr and faVolumeID <> faVolumeID) then begin
  863.           if (FileInfo.Attr and faReadOnly = faReadOnly) then
  864.             FileSetAttr(NormalDir(Path) + FileInfo.Name, faArchive);
  865.           Result := DeleteFile(NormalDir(Path) + FileInfo.Name) and Result;
  866.         end;
  867.       end;
  868.       DosCode := FindNext(FileInfo);
  869.     end;
  870.   finally
  871.     FindClose(FileInfo);
  872.   end;
  873.   if Delete and Result and (DosCode = FileNotFound) and
  874.     not ((Length(Path) = 2) and (Path[2] = ':')) then
  875.   begin
  876.     RmDir(Path);
  877.     Result := (IOResult = 0) and Result;
  878.   end;
  879. end;
  880.  
  881. function GetTempDir: string;
  882. {$IFDEF WIN32}
  883. var
  884.   Buffer: array[0..1023] of Char;
  885. begin
  886.   SetString(Result, Buffer, GetTempPath(SizeOf(Buffer), Buffer));
  887. {$ELSE}
  888. var
  889.   Buffer: array[0..255] of Char;
  890. begin
  891.   GetTempFileName(GetTempDrive(#0), '$', 1, Buffer);
  892.   Result := ExtractFilePath(StrPas(Buffer));
  893. {$ENDIF}
  894. end;
  895.  
  896. function GetWindowsDir: string;
  897. {$IFDEF WIN32}
  898. var
  899.   Buffer: array[0..1023] of Char;
  900. begin
  901.   SetString(Result, Buffer, GetWindowsDirectory(Buffer, SizeOf(Buffer)));
  902. {$ELSE}
  903. begin
  904.   Result[0] := Char(GetWindowsDirectory(@Result[1], 254));
  905. {$ENDIF}
  906. end;
  907.  
  908. function GetSystemDir: string;
  909. {$IFDEF WIN32}
  910. var
  911.   Buffer: array[0..1023] of Char;
  912. begin
  913.   SetString(Result, Buffer, GetSystemDirectory(Buffer, SizeOf(Buffer)));
  914. {$ELSE}
  915. begin
  916.   Result[0] := Char(GetSystemDirectory(@Result[1], 254));
  917. {$ENDIF}
  918. end;
  919.  
  920. {$IFDEF WIN32}
  921.  
  922. function ValidFileName(const FileName: string): Boolean;
  923.   function HasAny(const Str, Substr: string): Boolean;
  924.   var
  925.     I: Integer;
  926.   begin
  927.     Result := False;
  928.     for I := 1 to Length(Substr) do begin
  929.       if Pos(Substr[I], Str) > 0 then begin
  930.         Result := True;
  931.         Break;
  932.       end;
  933.     end;
  934.   end;
  935. begin
  936.   Result := (FileName <> '') and (not HasAny(FileName, '<>"[]|'));
  937.   if Result then Result := Pos('\', ExtractFileName(FileName)) = 0;
  938. end;
  939.  
  940. function FileLock(Handle: Integer; Offset, LockSize: Longint): Integer;
  941. begin
  942.   if LockFile(Handle, Offset, 0, LockSize, 0) then
  943.     Result := 0
  944.   else
  945.     Result := GetLastError;
  946. end;
  947.  
  948. function FileUnlock(Handle: Integer; Offset, LockSize: Longint): Integer;
  949. begin
  950.   if UnlockFile(Handle, Offset, 0, LockSize, 0) then
  951.     Result := 0
  952.   else
  953.     Result := GetLastError;
  954. end;
  955.  
  956. {$IFDEF RX_D4}
  957. function FileLock(Handle: Integer; Offset, LockSize: Int64): Integer;
  958. begin
  959.   if LockFile(Handle, Int64Rec(Offset).Lo, Int64Rec(Offset).Hi,
  960.     Int64Rec(LockSize).Lo, Int64Rec(LockSize).Hi) then Result := 0
  961.   else
  962.     Result := GetLastError;
  963. end;
  964.  
  965. function FileUnlock(Handle: Integer; Offset, LockSize: Int64): Integer;
  966. begin
  967.   if UnlockFile(Handle, Int64Rec(Offset).Lo, Int64Rec(Offset).Hi,
  968.     Int64Rec(LockSize).Lo, Int64Rec(LockSize).Hi) then Result := 0
  969.   else
  970.     Result := GetLastError;
  971. end;
  972. {$ENDIF RX_D4}
  973.  
  974. {$ELSE}
  975.  
  976. function ValidFileName(const FileName: string): Boolean;
  977. const
  978.   MaxNameLen = 12; { file name and extension }
  979.   MaxExtLen  =  4; { extension with point }
  980.   MaxPathLen = 79; { full file path in DOS }
  981. var
  982.   Dir, Name, Ext: TFileName;
  983.  
  984.   function HasAny(Str, SubStr: string): Boolean; near; assembler;
  985.   asm
  986.         PUSH     DS
  987.         CLD
  988.         LDS      SI,Str
  989.         LES      DI,SubStr
  990.         INC      DI
  991.         MOV      DX,DI
  992.         XOR      AH,AH
  993.         LODSB
  994.         MOV      BX,AX
  995.         OR       BX,BX
  996.         JZ       @@2
  997.         MOV      AL,ES:[DI-1]
  998.         XCHG     AX,CX
  999.   @@1:  PUSH     CX
  1000.         MOV      DI,DX
  1001.         LODSB
  1002.         REPNE    SCASB
  1003.         POP      CX
  1004.         JE       @@3
  1005.         DEC      BX
  1006.         JNZ      @@1
  1007.   @@2:  XOR      AL,AL
  1008.         JMP      @@4
  1009.   @@3:  MOV      AL,1
  1010.   @@4:  POP      DS
  1011.   end;
  1012.  
  1013. begin
  1014.   Result := True;
  1015.   Dir := Copy(ExtractFilePath(FileName), 1, MaxPathLen);
  1016.   Name := Copy(ExtractFileName(FileName), 1, MaxNameLen);
  1017.   Ext := Copy(ExtractFileExt(FileName), 1, MaxExtLen);
  1018.   if (Dir + Name <> FileName) or HasAny(Name, ';,=+<>|"[] \') or
  1019.     HasAny(Copy(Ext, 2, 255), ';,=+<>|"[] \.') then Result := False;
  1020. end;
  1021.  
  1022. function LockFile(Handle: Integer; StartPos, Length: Longint;
  1023.   Unlock: Boolean): Integer; assembler;
  1024. asm
  1025.       PUSH     DS
  1026.       MOV      AH,5CH
  1027.       MOV      AL,Unlock
  1028.       MOV      BX,Handle
  1029.       MOV      DX,StartPos.Word[0]
  1030.       MOV      CX,StartPos.Word[2]
  1031.       MOV      DI,Length.Word[0]
  1032.       MOV      SI,Length.Word[2]
  1033.       INT      21H
  1034.       JNC      @@1
  1035.       NEG      AX
  1036.       JMP      @@2
  1037. @@1:  MOV      AX,0
  1038. @@2:  POP      DS
  1039. end;
  1040.  
  1041. function FileLock(Handle: Integer; Offset, LockSize: Longint): Integer;
  1042. begin
  1043.   Result := LockFile(Handle, Offset, LockSize, False);
  1044. end;
  1045.  
  1046. function FileUnlock(Handle: Integer; Offset, LockSize: Longint): Integer;
  1047. begin
  1048.   Result := LockFile(Handle, Offset, LockSize, True);
  1049. end;
  1050.  
  1051. {$ENDIF WIN32}
  1052.  
  1053. {$IFDEF WIN32}
  1054.  
  1055. function ShortToLongFileName(const ShortName: string): string;
  1056. var
  1057.   Temp: TWin32FindData;
  1058.   SearchHandle: THandle;
  1059. begin
  1060.   SearchHandle := FindFirstFile(PChar(ShortName), Temp);
  1061.   if SearchHandle <> INVALID_HANDLE_VALUE then begin
  1062.     Result := string(Temp.cFileName);
  1063.     if Result = '' then Result := string(Temp.cAlternateFileName);
  1064.   end
  1065.   else Result := '';
  1066.   Windows.FindClose(SearchHandle);
  1067. end;
  1068.  
  1069. function LongToShortFileName(const LongName: string): string;
  1070. var
  1071.   Temp: TWin32FindData;
  1072.   SearchHandle: THandle;
  1073. begin
  1074.   SearchHandle := FindFirstFile(PChar(LongName), Temp);
  1075.   if SearchHandle <> INVALID_HANDLE_VALUE then begin
  1076.     Result := string(Temp.cAlternateFileName);
  1077.     if Result = '' then Result := string(Temp.cFileName);
  1078.   end
  1079.   else Result := '';
  1080.   Windows.FindClose(SearchHandle);
  1081. end;
  1082.  
  1083. function ShortToLongPath(const ShortName: string): string;
  1084. var
  1085.   LastSlash: PChar;
  1086.   TempPathPtr: PChar;
  1087. begin
  1088.   Result := '';
  1089.   TempPathPtr := PChar(ShortName);
  1090.   LastSlash := StrRScan(TempPathPtr, '\');
  1091.   while LastSlash <> nil do begin
  1092.     Result := '\' + ShortToLongFileName(TempPathPtr) + Result;
  1093.     if LastSlash <> nil then begin
  1094.       LastSlash^ := char(0);
  1095.       LastSlash := StrRScan(TempPathPtr, '\');
  1096.     end;
  1097.   end;
  1098.   Result := TempPathPtr + Result;
  1099. end;
  1100.  
  1101. function LongToShortPath(const LongName: string): string;
  1102. var
  1103.   LastSlash: PChar;
  1104.   TempPathPtr: PChar;
  1105. begin
  1106.   Result := '';
  1107.   TempPathPtr := PChar(LongName);
  1108.   LastSlash := StrRScan(TempPathPtr, '\');
  1109.   while LastSlash <> nil do begin
  1110.     Result := '\' + LongToShortFileName(TempPathPtr) + Result;
  1111.     if LastSlash <> nil then begin
  1112.       LastSlash^ := char(0);
  1113.       LastSlash := StrRScan(TempPathPtr, '\');
  1114.     end;
  1115.   end;
  1116.   Result := TempPathPtr + Result;
  1117. end;
  1118.  
  1119. const
  1120.   IID_IPersistFile: TGUID = (
  1121.     D1:$0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  1122.  
  1123. {$IFNDEF RX_D3}
  1124. const
  1125.   IID_IShellLinkA: TGUID = (
  1126.     D1:$000214EE; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  1127.   CLSID_ShellLink: TGUID = (
  1128.     D1:$00021401; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  1129.  
  1130. type
  1131.   IShellLink = class(IUnknown) { sl }
  1132.     function GetPath(pszFile: LPSTR; cchMaxPath: Integer;
  1133.       var pfd: TWin32FindData; fFlags: DWORD): HResult; virtual; stdcall; abstract;
  1134.     function GetIDList(var ppidl: PItemIDList): HResult; virtual; stdcall; abstract;
  1135.     function SetIDList(pidl: PItemIDList): HResult; virtual; stdcall; abstract;
  1136.     function GetDescription(pszName: LPSTR; cchMaxName: Integer): HResult; virtual; stdcall; abstract;
  1137.     function SetDescription(pszName: LPSTR): HResult; virtual; stdcall; abstract;
  1138.     function GetWorkingDirectory(pszDir: LPSTR; cchMaxPath: Integer): HResult; virtual; stdcall; abstract;
  1139.     function SetWorkingDirectory(pszDir: LPSTR): HResult; virtual; stdcall; abstract;
  1140.     function GetArguments(pszArgs: LPSTR; cchMaxPath: Integer): HResult; virtual; stdcall; abstract;
  1141.     function SetArguments(pszArgs: LPSTR): HResult; virtual; stdcall; abstract;
  1142.     function GetHotkey(var pwHotkey: Word): HResult; virtual; stdcall; abstract;
  1143.     function SetHotkey(wHotkey: Word): HResult; virtual; stdcall; abstract;
  1144.     function GetShowCmd(var piShowCmd: Integer): HResult; virtual; stdcall; abstract;
  1145.     function SetShowCmd(iShowCmd: Integer): HResult; virtual; stdcall; abstract;
  1146.     function GetIconLocation(pszIconPath: LPSTR; cchIconPath: Integer;
  1147.       var piIcon: Integer): HResult; virtual; stdcall; abstract;
  1148.     function SetIconLocation(pszIconPath: LPSTR; iIcon: Integer): HResult; virtual; stdcall; abstract;
  1149.     function SetRelativePath(pszPathRel: LPSTR; dwReserved: DWORD): HResult; virtual; stdcall; abstract;
  1150.     function Resolve(Wnd: HWND; fFlags: DWORD): HResult; virtual; stdcall; abstract;
  1151.     function SetPath(pszFile: LPSTR): HResult; virtual; stdcall; abstract;
  1152.   end;
  1153. {$ENDIF}
  1154.  
  1155. const
  1156.   LinkExt = '.lnk';
  1157.  
  1158. procedure CreateFileLink(const FileName, DisplayName: string; Folder: Integer);
  1159. var
  1160.   ShellLink: IShellLink;
  1161.   PersistFile: IPersistFile;
  1162.   ItemIDList: PItemIDList;
  1163.   FileDestPath: array[0..MAX_PATH] of Char;
  1164.   FileNameW: array[0..MAX_PATH] of WideChar;
  1165. begin
  1166.   CoInitialize(nil);
  1167.   try
  1168.     OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_SERVER,
  1169.       IID_IShellLinkA, ShellLink));
  1170.     try
  1171.       OleCheck(ShellLink.QueryInterface(IID_IPersistFile, PersistFile));
  1172.       try
  1173.         OleCheck(SHGetSpecialFolderLocation(0, Folder, ItemIDList));
  1174.         SHGetPathFromIDList(ItemIDList, FileDestPath);
  1175.         StrCat(FileDestPath, PChar('\' + DisplayName + LinkExt));
  1176.         ShellLink.SetPath(PChar(FileName));
  1177.         ShellLink.SetIconLocation(PChar(FileName), 0);
  1178.         MultiByteToWideChar(CP_ACP, 0, FileDestPath, -1, FileNameW, MAX_PATH);
  1179.         OleCheck(PersistFile.Save(FileNameW, True));
  1180.       finally
  1181. {$IFDEF RX_D3}
  1182.         PersistFile := nil;
  1183. {$ELSE}
  1184.         PersistFile.Release;
  1185. {$ENDIF}
  1186.       end;
  1187.     finally
  1188. {$IFDEF RX_D3}
  1189.       ShellLink := nil;
  1190. {$ELSE}
  1191.       ShellLink.Release;
  1192. {$ENDIF}
  1193.     end;
  1194.   finally
  1195.     CoUninitialize;
  1196.   end;
  1197. end;
  1198.  
  1199. procedure DeleteFileLink(const DisplayName: string; Folder: Integer);
  1200. var
  1201.   ShellLink: IShellLink;
  1202.   ItemIDList: PItemIDList;
  1203.   FileDestPath: array[0..MAX_PATH] of Char;
  1204. begin
  1205.   CoInitialize(nil);
  1206.   try
  1207.     OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_SERVER,
  1208.       IID_IShellLinkA, ShellLink));
  1209.     try
  1210.       OleCheck(SHGetSpecialFolderLocation(0, Folder, ItemIDList));
  1211.       SHGetPathFromIDList(ItemIDList, FileDestPath);
  1212.       StrCat(FileDestPath, PChar('\' + DisplayName + LinkExt));
  1213.       DeleteFile(FileDestPath);
  1214.     finally
  1215. {$IFDEF RX_D3}
  1216.       ShellLink := nil;
  1217. {$ELSE}
  1218.       ShellLink.Release;
  1219. {$ENDIF}
  1220.     end;
  1221.   finally
  1222.     CoUninitialize;
  1223.   end;
  1224. end;
  1225.  
  1226. {$ENDIF WIN32}
  1227.  
  1228. {$IFNDEF RX_D3}
  1229. function IsPathDelimiter(const S: string; Index: Integer): Boolean;
  1230. begin
  1231.   Result := (Index > 0) and (Index <= Length(S)) and (S[Index] = '\');
  1232. end;
  1233. {$ENDIF}
  1234.  
  1235. end.