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

📄 hardlinks.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 3 页
字号:
{**************************************************************************************************}
{                                                                                                  }
{ 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.                                                                                           }
{                                                                                                  }
{**************************************************************************************************}
// Last modified: $Date: 2005/03/08 08:33:21 $
// For history see end of file

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
// =================================================================
type
  NTSTATUS = Longint;
  PPWideChar = ^PWideChar;

type
  LARGE_INTEGER = TLargeInteger;
  PLARGE_INTEGER = ^LARGE_INTEGER;

type
  UNICODE_STRING = record
    Length: WORD;
    MaximumLength: WORD;
    Buffer: PWideChar;
  end;
  PUNICODE_STRING = ^UNICODE_STRING;

type
  ANSI_STRING = record
    Length: WORD;
    MaximumLength: WORD;
    Buffer: PAnsiChar;
  end;
  PANSI_STRING = ^ANSI_STRING;

type
  OBJECT_ATTRIBUTES = record
    Length: ULONG;
    RootDirectory: THandle;
    ObjectName: PUNICODE_STRING;
    Attributes: ULONG;
    SecurityDescriptor: Pointer;       // Points to type SECURITY_DESCRIPTOR
    SecurityQualityOfService: Pointer; // Points to type SECURITY_QUALITY_OF_SERVICE
  end;
  POBJECT_ATTRIBUTES = ^OBJECT_ATTRIBUTES;

type
  IO_STATUS_BLOCK = record
    case integer of
      0:
       (Status: NTSTATUS);
      1:
       (Pointer: Pointer;
        Information: ULONG); // 'Information' does not belong to the union!
  end;
  PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;

type
  _FILE_LINK_RENAME_INFORMATION = record // File Information Classes 10 and 11
    ReplaceIfExists: BOOL;
    RootDirectory: THandle;
    FileNameLength: ULONG;
    FileName: array[0..0] of WideChar;
  end;
  FILE_LINK_INFORMATION = _FILE_LINK_RENAME_INFORMATION;
  PFILE_LINK_INFORMATION = ^FILE_LINK_INFORMATION;
  FILE_RENAME_INFORMATION = _FILE_LINK_RENAME_INFORMATION;
  PFILE_RENAME_INFORMATION = ^FILE_RENAME_INFORMATION;

// =================================================================
// Constants
// =================================================================
const
  FileLinkInformation          = 11;
  FILE_SYNCHRONOUS_IO_NONALERT = $00000020; // All operations on the file are
                                            // performed synchronously. Waits
                                            // in the system to synchronize I/O
                                            // queuing and completion are not
                                            // subject to alerts. This flag
                                            // also causes the I/O system to
                                            // maintain the file position context.
                                            // If this flag is set, the
                                            // DesiredAccess SYNCHRONIZE flag also
                                            // must be set.
  FILE_OPEN_FOR_BACKUP_INTENT  = $00004000; // The file is being opened for backup
                                            // intent, hence, the system should
                                            // check for certain access rights
                                            // and grant the caller the appropriate
                                            // accesses to the file before checking
                                            // the input DesiredAccess against the
                                            // file's security descriptor.
  FILE_OPEN_REPARSE_POINT      = $00200000;
  DELETE                       = $00010000;
  SYNCHRONIZE                  = $00100000;
  STATUS_SUCCESS               = NTSTATUS(0);
  OBJ_CASE_INSENSITIVE         = $00000040;
  SYMBOLIC_LINK_QUERY          = $00000001;

  // Should be defined, but isn't
  HEAP_ZERO_MEMORY             = $00000008;

  // Related constant(s) for RtlDetermineDosPathNameType_U()
  INVALID_PATH                 = 0;
  UNC_PATH                     = 1;
  ABSOLUTE_DRIVE_PATH          = 2;
  RELATIVE_DRIVE_PATH          = 3;
  ABSOLUTE_PATH                = 4;
  RELATIVE_PATH                = 5;
  DEVICE_PATH                  = 6;
  UNC_DOT_PATH                 = 7;

// =================================================================
// Function prototypes
// =================================================================

{$IFNDEF RTDL}
function RtlCreateUnicodeStringFromAsciiz(var destination: UNICODE_STRING;
  source: PChar): Boolean; stdcall; external szNtDll;

function ZwClose(Handle: THandle): NTSTATUS; stdcall; external szNtDll;

function ZwSetInformationFile(FileHandle: THandle; var IoStatusBlock: IO_STATUS_BLOCK;
  FileInformation: Pointer; FileInformationLength: ULONG;
  FileInformationClass: DWORD): NTSTATUS; stdcall; external szNtDll;

function RtlPrefixUnicodeString(const usPrefix: UNICODE_STRING;
  const usContainingString: UNICODE_STRING;
  ignore_case: Boolean): Boolean; stdcall; external szNtDll;

function ZwOpenSymbolicLinkObject(var LinkHandle: THandle; DesiredAccess: DWORD;
  const ObjectAttributes: OBJECT_ATTRIBUTES): NTSTATUS; stdcall; external szNtDll;

function ZwQuerySymbolicLinkObject(LinkHandle: THandle;
  var LinkTarget: UNICODE_STRING; ReturnedLength: PULONG): NTSTATUS; stdcall; external szNtDll;

function ZwOpenFile(var FileHandle: THandle; DesiredAccess: DWORD;
  const ObjectAttributes: OBJECT_ATTRIBUTES; var IoStatusBlock: IO_STATUS_BLOCK;
  ShareAccess: ULONG; OpenOptions: ULONG): NTSTATUS; stdcall; external szNtDll;

function RtlAllocateHeap(HeapHandle: Pointer;
  Flags, Size: ULONG): Pointer; stdcall; external szNtDll;

function RtlFreeHeap(HeapHandle: Pointer; Flags: ULONG;
  MemoryPointer: Pointer): Boolean; stdcall; external szNtDll;

function RtlDosPathNameToNtPathName_U(DosName: PWideChar;
  var NtName: UNICODE_STRING; DosFilePath: PPWideChar;
  NtFilePath: PUNICODE_STRING): Boolean; stdcall; external szNtDll;

function RtlInitUnicodeString(var DestinationString: UNICODE_STRING;
  const SourceString: PWideChar): NTSTATUS; stdcall; external szNtDll;

function RtlDetermineDosPathNameType_U(wcsPathNameType: PWideChar): DWORD; stdcall; external szNtDll;

function RtlNtStatusToDosError(status: NTSTATUS): ULONG; stdcall; external szNtDll;

{$ELSE RTDL}

type
  TRtlCreateUnicodeStringFromAsciiz = function(var destination: UNICODE_STRING;

⌨️ 快捷键说明

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