⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 hardlinks.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 4 页
字号:
{$IFDEF JCL}
{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Initial Developer of the Original Code is Oliver Schneider (Assarbad att gmx dott info).     }
{ Portions created by Oliver Schneider are Copyright (C) 1995 - 2004 Oliver Schneider.             }
{ All rights reserved.                                                                             }
{                                                                                                  }
{ Obtained through:                                                                                }
{   Joint Endeavour of Delphi Innovators (Project JEDI)                                            }
{                                                                                                  }
{ You may retrieve the latest version of the original file at the Original Developer's homepage,   }
{ located at [http://assarbad.net]. Note that the original file can be used with an arbitrary OSI- }
{ approved license as long as you follow the additional terms given in the original file.          }
{ Additionally a C/C++ (MS VC++) version is available under the same terms.                        }
{                                                                                                  }
{ Contributor(s):                                                                                  }
{   Oliver Schneider (assarbad)                                                                    }
{   Robert Marquardt (marquardt)                                                                   }
{   Robert Rossmair (rrossmair)                                                                    }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{  Windows NT 4.0 compatible implementation of the CreateHardLink() API introduced in Windows      }
{  2000.                                                                                           }
{                                                                                                  }
{**************************************************************************************************}
{$ELSE ~JCL}
(******************************************************************************
 ******************************************************************************
 ***                                                                        ***
 ***  Hardlinks. Implementation of the CreateHardLink() API introduced in   ***
 ***  Windows 2000 - BUT ALSO COMPATIBLE with Windows NT 4.0!               ***
 ***  This implementation should be fully compatible with the Windows 2000  ***
 ***  implementation (including last error and so on).                      ***
 ***                                                                        ***
 ***  Version [1.13a]                               {Last mod 2005-03-06}   ***
 ***                                                                        ***
 ******************************************************************************
 ******************************************************************************

                                 _\\|//_
                                (` * * ')
 ______________________________ooO_(_)_Ooo_____________________________________
 ******************************************************************************
 ******************************************************************************
 ***                                                                        ***
 ***                Copyright (c) 1995 - 2005 by -=Assarbad=-               ***
 ***             Portions Copyright (c) 2004 by Robert Marquardt            ***
 ***             Portions Copyright (c) 2004 by Robert Rossmair             ***
 ***                       (see JCL revision history)                       ***
 ***                                                                        ***
 ***   CONTACT TO THE AUTHOR(S):                                            ***
 ***    ____________________________________                                ***
 ***   |                                    |                               ***
 ***   | -=Assarbad=- aka Oliver            |                               ***
 ***   |____________________________________|                               ***
 ***   |                                    |                               ***
 ***   | Assarbad @ gmx.info|.net|.com|.de  |                               ***
 ***   | ICQ: 281645                        |                               ***
 ***   | AIM: nixlosheute                   |                               ***
 ***   |      nixahnungnicht                |                               ***
 ***   | MSN: Assarbad@ePost.de             |                               ***
 ***   | YIM: sherlock_holmes_and_dr_watson |                               ***
 ***   |____________________________________|                               ***
 ***             ___                                                        ***
 ***            /   |                     ||              ||                ***
 ***           / _  |   ________ ___  ____||__    ___   __||                ***
 ***          / /_\ |  / __/ __//   |/  _/|   \  /   | /   |                ***
 ***         / ___  |__\\__\\  / /\ || |  | /\ \/ /\ |/ /\ | DOT NET        ***
 ***        /_/   \_/___/___/ /_____\|_|  |____/_____\\__/\|                ***
 ***       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~        ***
 ***              [http://assarbad.net | http://assarbad.org]               ***
 ***                                                                        ***
 ***   Notes:                                                               ***
 ***   - my first name is Oliver, you may well use this in your e-mails     ***
 ***   - for questions and/or proposals drop me a mail or instant message   ***
 ***                                                                        ***
 ***~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~***
 ***              May the source be with you, stranger ... ;)               ***
 ***    Snizhok, eto ne tolko fruktovij kefir, snizhok, eto stil zhizni.    ***
 ***                     Vsekh Privet iz Germanii                           ***
 ***                                                                        ***
 *** Greets from -=Assarbad=- fly to YOU =)                                 ***
 *** Special greets fly 2 Nico, Casper, SA, Pizza, Navarion, Eugen, Zhenja, ***
 *** Xandros, Melkij, Strelok etc pp.                                       ***
 ***                                                                        ***
 *** Thanks to:                                                             ***
 *** W.A. Mozart, Vivaldi, Beethoven, Poeta Magica, Kurtzweyl, Manowar,     ***
 *** Blind Guardian, Weltenbrand, In Extremo, Wolfsheim, Carl Orff, Zemfira ***
 *** ... most of my work was done with their music in the background ;)     ***
 ***                                                                        ***
 ******************************************************************************
 ******************************************************************************

 LEGAL STUFF:
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 NOTE: This source is OSI-licensed. You may choose between any of the licenses
       approved by the OSI (Open Source Initiative) as long as the licensing
       of this module will not force a whole project under the chosen license.
       This basically means that the virulent character of a license (e.g. GPL)
       must no be misused to force a project to use the license you chose for
       this module!
       OSI-approved licenses can be found at this website:
       http://www.opensource.org/licenses/

       You have the choice to make this module compatible with your own open
       source or commercial or whatever project by choosing the right license.

       However, I recommend using either of the following licenses:
       - the BSD-License (as seen below)
       - the LGPL [ http://www.opensource.org/licenses/lgpl-license.php ]
       - the MPL [ http://www.opensource.org/licenses/mozilla1.1.php ]

       !ATTENTION!: if this unit comes bundled with the files of the project
       JEDI the project license (currently MPL) is mandatory!!!
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 Copyright (c) 1995-2005, -=Assarbad=- ["copyright holder(s)"]
 All rights reserved.

 Redistribution and use in source and binary forms, with or without
 modification, are permitted provided that the following conditions are met:

 1. Redistributions of source code must retain the above copyright notice, this
    list of conditions and the following disclaimer.
 2. Redistributions in binary form must reproduce the above copyright notice,
    this list of conditions and the following disclaimer in the documentation
    and/or other materials provided with the distribution.
 3. The name(s) of the copyright holder(s) may not be used to endorse or
    promote products derived from this software without specific prior written
    permission.

 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY
 DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
 ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                             .oooO     Oooo.
 ____________________________(   )_____(   )___________________________________
                              \ (       ) /
                               \_)     (_/

 ******************************************************************************)
{$ENDIF ~JCL}

{$IFDEF JCL}
// Last modified: $Date: 2005/03/08 08:33:18 $
// For history see end of file

{$ENDIF ~JCL}
unit Hardlinks;

{$ALIGN ON}
{$MINENUMSIZE 4}

interface
// ALL enabled by default for Project JEDI
{$DEFINE STDCALL}   // Make functions STDCALL always
{$DEFINE RTDL}      // Use runtime dynamic linking
{$DEFINE PREFERAPI} // Prefer the "real" Windows API on systems on which it exists
                    // If this is defined STDCALL is automatically needed and defined!

(*
  All possible combinations of the above DEFINEs have been tested and work fine.

   # | A  B  C
  ---|---------
   1 | 0  0  0                 A = STDCALL
   2 | 0  0  X                 B = RTDL
   3 | X  0  0                 C = PREFERAPI
   4 | X  0  X
   5 | X  X  0
   6 | X  X  X
*)
uses
  Windows;

{$IFDEF PREFERAPI}
  {$DEFINE STDCALL} // For the windows API we _require_ STDCALL calling convention
{$ENDIF PREFERAPI}

{$EXTERNALSYM CreateHardLinkW}
{$EXTERNALSYM CreateHardLinkA}

{$IFNDEF PREFERAPI}
// We prefer the homegrown version - use the static version
function CreateHardLinkW(szLinkName, szLinkTarget: PWideChar; lpSecurityAttributes: PSecurityAttributes): BOOL;
  {$IFDEF STDCALL} stdcall; {$ENDIF} // Makes the actual call STDCALL
function CreateHardLinkA(szLinkName, szLinkTarget: PAnsiChar; lpSecurityAttributes: PSecurityAttributes): BOOL;
  {$IFDEF STDCALL} stdcall; {$ENDIF} // Makes the actual call STDCALL
{$ELSE PREFERAPI}
// Well, we did not decide yet ;) - bind to either address, depending on whether
// the API could be found.
type
  TFNCreateHardLinkW = function(szLinkName, szLinkTarget: PWideChar; lpSecurityAttributes: PSecurityAttributes): BOOL; {$IFDEF STDCALL} stdcall; {$ENDIF}
  TFNCreateHardLinkA = function(szLinkName, szLinkTarget: PAnsiChar; lpSecurityAttributes: PSecurityAttributes): BOOL; {$IFDEF STDCALL} stdcall; {$ENDIF}
var
  CreateHardLinkW: TFNCreateHardLinkW = nil;
  CreateHardLinkA: TFNCreateHardLinkA = nil;
{$ENDIF PREFERAPI}

{$IFDEF RTDL}
var
  hNtDll: THandle = 0; // For runtime dynamic linking
  bRtdlFunctionsLoaded: Boolean = False; // To show wether the RTDL functions had been loaded
{$ENDIF RTDL}

implementation

const
  szNtDll           = 'NTDLL.DLL'; // Import native APIs from this DLL
{$IFDEF PREFERAPI}
  szCreateHardLinkA = 'CreateHardLinkA';
  szCreateHardLinkW = 'CreateHardLinkW';
{$ENDIF PREFERAPI}

(******************************************************************************

 Note, I only include function prototypes and constants here which are needed!
 For other prototypes or constants check out the related books of
 - Gary Nebbett
 - Sven B. Schreiber
 - Rajeev Nagar

 Note, one my homepage I have also some Native APIs listed in Delphi translated
 form. Not all of them might be translated correctly with respect to the fact
 whether or not they are pointer and whether or not the alignment of variables
 or types is always correct. This might be reviewed by me somewhen in future.

 ******************************************************************************)

// =================================================================
// Type definitions
// =================================================================

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -