stsystem.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * 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 Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StSystem.pas 4.03                           *}
{*********************************************************}
{* SysTools: Assorted system level routines              *}
{*********************************************************}

{$I StDefine.inc}

unit StSystem;

interface

uses
  Windows, SysUtils, Classes,
{$IFDEF Version6} {$WARN UNIT_PLATFORM OFF} {$ENDIF}
  FileCtrl,
{$IFDEF Version6} {$WARN UNIT_PLATFORM ON} {$ENDIF}
  StConst, StBase, StUtils, StDate, StStrL;

{$IFNDEF VERSION6}
const
  PathDelim  =  '\';
  DriveDelim =  ':';
  PathSep    =  ';';
{$ENDIF VERSION6}
const
  StPathDelim     = PathDelim; { Delphi/Linux constant }
  StPathSep       = PathSep;   { Delphi/Linux constant }
  StDriveDelim    = DriveDelim;
  StDosPathDelim  = '\';
  StUnixPathDelim = '/';
  StDosPathSep    = ';';
  StUnixPathSep   = ':';
  StDosAnyFile    = '*.*';
  StUnixAnyFile   = '*';
  StAnyFile       = {$IFDEF LINUX} StUnixAnyFile; {$ELSE} StDosAnyFile; {$ENDIF}
  StThisDir       = '.';
  StParentDir     = '..';


type
  DiskClass = ( Floppy360, Floppy720, Floppy12, Floppy144, OtherFloppy,
    HardDisk, RamDisk, UnknownDisk, InvalidDrive, RemoteDrive, CDRomDisk );
    {This enumerated type defines the nine classes of disks that can be
     identified by GetDiskClass, as well as several types used as error
     indications}

  PMediaIDType = ^MediaIDType;
  MediaIDType = packed record
  {This type describes the information that DOS 4.0 or higher writes
   in the boot sector of a disk when it is formatted}
    InfoLevel : Word;                        {Reserved for future use}
    SerialNumber : LongInt;                  {Disk serial number}
    VolumeLabel : array[0..10] of AnsiChar;  {Disk volume label}
    FileSystemID : array[0..7] of AnsiChar;  {String for internal use by the OS}
  end;

  TIncludeItemFunc = function (const SR : TSearchRec;
                               ForInclusion : Boolean; var Abort : Boolean) : Boolean;
    {Function type for the routine passed to EnumerateFiles and
     EnumerateDirectories. It will be called in two ways: to request
     confirmation to include the entity described in SR into the
     string list (ForInclusion = true); or to ask whether to recurse
     into a particular subdirectory (ForInclusion = false).}

{**** Routine Declarations ****}


{CopyFile}
function CopyFile(const SrcPath, DestPath : AnsiString) : Cardinal;
{-Copy a file.}

{CreateTempFile}
function CreateTempFile(const aFolder : AnsiString;
                        const aPrefix : AnsiString) : AnsiString;
{-Creates a temporary file.}

{DeleteVolumeLabel}
function DeleteVolumeLabel(Drive : AnsiChar) : Cardinal;
{-Deletes an existing volume label on Drive. Returns 0 for success,
  or OS error code.}

{EnumerateDirectories}
procedure EnumerateDirectories(const StartDir : AnsiString; FL : TStrings; {!!.02}
                               SubDirs : Boolean;
                               IncludeItem : TIncludeItemFunc);
{-Retrieves the complete path name of directories on requested file
  system path.}

{EnumerateFiles}
procedure EnumerateFiles(const StartDir : AnsiString; FL : TStrings;   {!!.02}
                         SubDirs : Boolean;
                         IncludeItem : TIncludeItemFunc);
{-Retrieves the complete path name of files in a requested file system path.}

{FileHandlesLeft}
function FileHandlesLeft(MaxHandles : Cardinal) : Cardinal;
{-Return the number of available file handles.}

{FileMatchesMask}
function FileMatchesMask(const FileName, FileMask : AnsiString ) : Boolean;
{-see if FileName matches FileMask}

{FileTimeToStDateTime}
function FileTimeToStDateTime(FileTime : LongInt) : TStDateTimeRec;
{-Converts a DOS date-time value to TStDate and TStTime values.}

{FindNthSlash}
function FindNthSlash( const Path : AnsiString; n : Integer ) : Integer;
{ return the position of the character just before the nth slash }

{FlushOsBuffers}
function FlushOsBuffers(Handle : Integer) : Boolean;
{-Flush the OS buffers for the specified file handle.}

{GetCurrentUser}
function GetCurrentUser : AnsiString;
{-Obtains current logged in username}

{GetDiskClass}
function GetDiskClass(Drive : AnsiChar) : DiskClass;
{-Return the disk class for the specified drive.}

{GetDiskInfo}
function GetDiskInfo(Drive : AnsiChar; var ClustersAvailable, TotalClusters,
                     BytesPerSector, SectorsPerCluster : Cardinal) : Boolean;
{-Return technical information about the specified drive.}

{GetDiskSpace}
{$IFDEF CBuilder}
function GetDiskSpace(Drive : AnsiChar;
                  var UserSpaceAvail  : Double;           {space available to user}
                  var TotalSpaceAvail : Double;           {total space available}
                  var DiskSize        : Double) : Boolean;{disk size}
{-Return space information about the drive.}
{$ELSE}
function GetDiskSpace(Drive : AnsiChar;
                  var UserSpaceAvail  : Comp;           {space available to user}
                  var TotalSpaceAvail : Comp;           {total space available}
                  var DiskSize        : Comp) : Boolean;{disk size}
{-Return space information about the drive.}
{$ENDIF}

{GetFileCreateDate}
function GetFileCreateDate(const FileName : AnsiString) :
  TDateTime;
{-Obtains file system time of file creation.}

{GetFileLastAccess}
function GetFileLastAccess(const FileName : AnsiString) :
  TDateTime;
{-Obtains file system time of last file access.}

{GetFileLastModify}
function GetFileLastModify(const FileName : AnsiString) :
  TDateTime;
{-Obtains file system time of last file modification.}

{GetHomeFolder}
function GetHomeFolder(aForceSlash : Boolean) : AnsiString;
{-Obtains the "Home Folder" for the current user}

{$IFNDEF CBuilder}
{GetLongPath}
function GetLongPath(const APath : AnsiString) : AnsiString;
{-Returns the long filename version of a provided path.}
{$ENDIF}

{GetMachineName}
function GetMachineName : AnsiString;
{-Returns the "Machine Name" for the current computer }

{GetMediaID}
function GetMediaID(Drive : AnsiChar; var MediaIDRec : MediaIDType) : Cardinal;
{-Get the media information (Volume Label, Serial Number) for the specified drive}

{GetParentFolder}
function GetParentFolder(const APath : AnsiString; aForceSlash : Boolean) : AnsiString;
{-return the parent directory for the provided directory }

{GetShortPath}
function GetShortPath(const APath : AnsiString) : AnsiString;
{-Returns the short filename version of a provided path.}

{GetSystemFolder}
function GetSystemFolder(aForceSlash : Boolean) : AnsiString;
{-Returns the path to the Windows "System" folder".)

{GetTempFolder}
function GetTempFolder(aForceSlash : boolean) : AnsiString;
{-Returns the path to the system temporary folder.}

{GetWindowsFolder}
function GetWindowsFolder(aForceSlash : boolean) : AnsiString;
{-Returns the path to the main "Windows" folder.}

{GetWorkingFolder}
function GetWorkingFolder(aForceSlash : boolean) : AnsiString;
{-Returns the current working directory.}

{GlobalDateTimeToLocal}
function GlobalDateTimeToLocal(const UTC: TStDateTimeRec; MinOffset: Integer): TStDateTimeRec; {!!.02}
{-adjusts a global date/time (UTC) to the local date/time}

{IsDirectory}
function IsDirectory(const DirName : AnsiString) : Boolean;
{-Return True if DirName is a directory.}

{IsDirectoryEmpty}
function IsDirectoryEmpty(const S : AnsiString) : Integer;
{-checks if there are any entries in the directory}

{IsDriveReady}
function IsDriveReady(Drive : AnsiChar) : Boolean;
{-determine if requested drive is accessible }

{IsFile}
function IsFile(const FileName : AnsiString) : Boolean;
{-Determines if the provided path specifies a file.}

{IsFileArchive}
function IsFileArchive(const S : AnsiString) : Integer;
{-checks if file's archive attribute is set}

{IsFileHidden}
function IsFileHidden(const S : AnsiString) : Integer;
{-checks if file's hidden attribute is set}

{IsFileReadOnly}
function IsFileReadOnly(const S : AnsiString) : Integer;
{-checks if file's readonly attribute is set}

{IsFileSystem}
function IsFileSystem(const S : AnsiString) : Integer;
{-checks if file's system attribute is set}

{LocalDateTimeToGlobal}
function LocalDateTimeToGlobal(const DT1: TStDateTimeRec; MinOffset: Integer): TStDateTimeRec; {!!.02}
{-adjusts a local date/time to the global (UTC) date/time}

{ReadVolumeLabel}
function ReadVolumeLabel(var VolName : AnsiString; Drive : AnsiChar) : Cardinal;
{-Get the volume label for the specified drive.}

{SameFile}
function SameFile(const FilePath1, FilePath2 : AnsiString; var ErrorCode : Integer) : Boolean;
{-Return True if FilePath1 and FilePath2 refer to the same physical file.}

{SetMediaID} {!!!! does not work on NT/2000 !!!!}
function SetMediaID(Drive : AnsiChar; var MediaIDRec : MediaIDType) : Cardinal;
{-Set the media ID record for the specified drive.}

{SplitPath}
procedure SplitPath(const APath : AnsiString; Parts : TStrings);
{-Splits the provided path into its component sub-paths}

{StDateTimeToFileTime}
function StDateTimeToFileTime(const FileTime : TStDateTimeRec) : LongInt;  {!!.02}
{-Converts an TStDate and TStTime to a DOS date-time value.}

{StDateTimeToUnixTime}
function StDateTimeToUnixTime(const DT1 : TStDateTimeRec) : Longint;   {!!.02}
{-converts a TStDateTimeRec to a time in Unix base (1970)}

{UnixTimeToStDateTime}
function UnixTimeToStDateTime(UnixTime : Longint) : TStDateTimeRec;
{-converts a time in Unix base (1970) to a TStDateTimeRec}

{ValidDrive}
function ValidDrive(Drive : AnsiChar) : Boolean;
{-Determine if the drive is a valid drive.}

{WriteVolumeLabel}
function WriteVolumeLabel(const VolName : AnsiString; Drive : AnsiChar) : Cardinal;
{-Sets the volume label for the specified drive.}

(*
{$EXTERNALSYM GetLongPathNameA}
function GetLongPathNameA(lpszShortPath: PAnsiChar; lpszLongPath: PAnsiChar;
  cchBuffer: DWORD): DWORD; stdcall;
{$EXTERNALSYM GetLongPathNameW}
function GetLongPathNameW(lpszShortPath: PWideChar; lpszLongPath: PWideChar;
  cchBuffer: DWORD): DWORD; stdcall;
{$EXTERNALSYM GetLongPathName}
function GetLongPathName(lpszShortPath: PChar; lpszLongPath: PChar;
  cchBuffer: DWORD): DWORD; stdcall;
*)

implementation

const
  FILE_ANY_ACCESS = 0;
  METHOD_BUFFERED = 0;
  IOCTL_DISK_BASE = $00000007;
  VWIN32_DIOC_DOS_IOCTL = 1;
  IOCTL_DISK_GET_MEDIA_TYPES = ((IOCTL_DISK_BASE shl 16) or
    (FILE_ANY_ACCESS shl 14) or ($0300 shl 2) or METHOD_BUFFERED);

procedure StChDir(const S: AnsiString);                                {!!.02}
{ wrapper for Delphi ChDir to handle a bug in D6}
{$IFDEF VER140}
var
  Rslt : Integer;
{$ENDIF}
begin
{$IFNDEF VER140}
  Chdir(S);
{$ELSE}
{$I-}
  Chdir(S);
  if IOResult <> 0 then begin
    Rslt := GetLastError;
    SetInOutRes(Rslt);
  end;
{$I+}
{$ENDIF}
end;

{CopyFile}
function CopyFile(const SrcPath, DestPath : AnsiString) : Cardinal;
  {-Copy the file specified by SrcPath into DestPath. DestPath must specify
    a complete filename, it may not be the name of a directory without the
    file portion.  This a low level routine, and the input pathnames are not
    checked for validity.}
const
  BufferSize = 4 * 1024;

var
  BytesRead, BytesWritten : LongInt;
  FileDate : LongInt;
  Src, Dest, Mode, SaveFAttr : Integer;
  Buffer : Pointer;

begin
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
  Src := 0;
  Dest := 0;
  Buffer := nil;
  Result := 1;
  try
    GetMem(Buffer, BufferSize);
    Mode := FileMode and $F0;
    SaveFAttr := FileGetAttr(SrcPath);
    if SaveFAttr < 0 then begin
      Result := 1;
      Exit;
    end;
    Src := FileOpen(SrcPath, Mode);
    if Src < 0 then begin
      Result := 1;                     {unable to access SrcPath}
      Exit;
    end;
    Dest := FileCreate(DestPath);
    if Dest < 0 then begin
      Result := 2;                     {unable to open DestPath}
      Exit;
    end;
    repeat
      BytesRead := FileRead(Src, Buffer^, BufferSize);
      if (BytesRead = -1) then begin
        Result := 3;                   {error reading from Src}
        Exit;
      end;
      BytesWritten := FileWrite(Dest, Buffer^, BytesRead);
      if (BytesWritten = -1) or
         (BytesWritten <> BytesRead) then begin
        Result := 4;                   {error writing to Dest}
        Exit;
      end;
    until BytesRead < BufferSize;
    FileDate := FileGetDate(Src);
    if FileDate = -1 then begin
      Result := 5;                     {error getting SrcPath's Date/Time}
      Exit;
    end;
    FileSetDate(Dest, FileDate);
    FileSetAttr(DestPath, SaveFAttr);
    Result := 0;
  finally
    if Assigned(Buffer) then
      FreeMem(Buffer, BufferSize);
    if Src > 0 then FileClose(Src);
    if Dest > 0 then begin
      FileClose(Dest);
      if Result <> 0 then SysUtils.DeleteFile(DestPath);
    end;
  end;
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
end;

{CreateTempFile}
function CreateTempFile(const aFolder : AnsiString;
                        const aPrefix : AnsiString) : AnsiString;
{-Creates a temporary file.}
var
  TempFileNameZ : array [0..MAX_PATH] of AnsiChar;
  TempDir : AnsiString;
begin
  TempDir := aFolder;
  if not DirectoryExists(TempDir) then
    TempDir := GetTempFolder(True);
  if not DirectoryExists(TempDir) then
    TempDir := GetWorkingFolder(True);

  if (GetTempFileName(PAnsiChar(TempDir), PAnsiChar(aPrefix), 0,
    TempFileNameZ) = 0)
  then
{$IFDEF Version6}
    RaiseLastOSError;
{$ELSE}
    RaiseLastWin32Error;
{$ENDIF}
  Result := TempFileNameZ;
end;


{DeleteVolumeLabel}
function DeleteVolumeLabel(Drive : AnsiChar) : Cardinal;
{-Deletes an existing volume label on Drive. Returns 0 for success,
  or OS error code.}
var
  Root : array[0..3] of AnsiChar;
begin
  StrCopy(Root, '%:\');
  Root[0] := Drive;
  if Windows.SetVolumeLabel(Root, '') then
    Result := 0
  else Result := GetLastError;
end;

{EnumerateDirectories}
procedure EnumerateDirectories(const StartDir : AnsiString; FL : TStrings; {!!.02}
                               SubDirs : Boolean;
                               IncludeItem : TIncludeItemFunc);
{-Retrieves the complete path name of directories on requested file
  system path.}