stsystem.pas

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

  Size   : integer;
  Buffer : PAnsiChar;
begin
  Size := GetTempPath(0, nil);
  GetMem(Buffer, Size);
  try
    SetString(Result, Buffer, GetTempPath(Size, Buffer));
  finally
    FreeMem(Buffer);
  end;
  if aForceSlash and (Result[length(Result)] <> StDosPathDelim) then
    Result := Result + StDosPathDelim;
end;

{GetWindowsFolder}
function GetWindowsFolder(aForceSlash : boolean) : AnsiString;
{-Returns the path to the main "Windows" folder.}
var
  Size   : integer;
  Buffer : PAnsiChar;
begin
  Size := GetWindowsDirectory(nil, 0);
  GetMem(Buffer, Size);
  try
    SetString(Result, Buffer, GetWindowsDirectory(Buffer, Size));
  finally
    FreeMem(Buffer);
  end;
  if aForceSlash and (Result[length(Result)] <> StDosPathDelim) then
    Result := Result + StDosPathDelim;
end;

{GetWorkingFolder}
function GetWorkingFolder(aForceSlash : boolean) : AnsiString;
{-Returns the current working directory.}
begin
  Result := ExpandFileName(StThisDir);
  if aForceSlash and (Result[length(Result)] <> StDosPathDelim) then
    Result := Result + StDosPathDelim;
end;

{GlobalDateTimeToLocal}
function GlobalDateTimeToLocal(const UTC: TStDateTimeRec; MinOffset: Integer): TStDateTimeRec; {!!.02}
{-adjusts a global date/time (UTC) to the local date/time}
{$IFNDEF VERSION4}
const
  TIME_ZONE_ID_INVALID  = DWORD($FFFFFFFF);
  TIME_ZONE_ID_UNKNOWN  = 0;
  TIME_ZONE_ID_STANDARD = 1;
  TIME_ZONE_ID_DAYLIGHT = 2;
{$ENDIF}
var
  Minutes : LongInt;
  TZ : TTimeZoneInformation;
begin
  Minutes := (UTC.D * MinutesInDay) + (UTC.T div 60);
  case GetTimeZoneInformation(TZ) of
    TIME_ZONE_ID_UNKNOWN :
      Minutes := Minutes - TZ.Bias;
    TIME_ZONE_ID_INVALID :
      Minutes := Minutes - MinOffset;
    TIME_ZONE_ID_STANDARD:
      Minutes := Minutes - (TZ.Bias + TZ.StandardBias);
    TIME_ZONE_ID_DAYLIGHT:
      Minutes := Minutes - (TZ.Bias + TZ.DaylightBias);
  end;

  Result.D := (Minutes div MinutesInDay);
  Result.T := ((Minutes mod MinutesInDay) * SecondsInMinute) + (UTC.T mod SecondsInMinute);
end;

{IsDirectory}
function IsDirectory(const DirName : AnsiString) : Boolean;
{-Return true if DirName is a directory}
var
  Attrs : DWORD;                                                         {!!.01}
begin
  Result := False;
    Attrs := GetFileAttributes(PAnsiChar(DirName));
  if Attrs <> DWORD(-1) then                                             {!!.01}
    Result := (FILE_ATTRIBUTE_DIRECTORY and Attrs <> 0);
end;

{IsDirectoryEmpty}
function IsDirectoryEmpty(const S : AnsiString) : Integer;
{-checks if there are any entries in the directory}
var
  SR : TSearchRec;
  R  : Integer;
  DS : AnsiString;
begin
  Result := 1;
  if IsDirectory(S) then begin
 {$IFOPT H+}
    DS := AddBackSlashL(S);
 {$ELSE}
    DS := AddBackSlashS(S);
 {$ENDIF}
    R := Abs(FindFirst(DS + StDosAnyFile, faAnyFile, SR));
    if R <> 18 then begin
      if (R = 0) then
      repeat
        if (SR.Attr and faDirectory = faDirectory) then begin
          if (SR.Name <> StThisDir) and (SR.Name <> StParentDir) then begin
            Result := 0;
            break;
          end;
        end else begin
          Result := 0;
          break;
        end;
        R := Abs(FindNext(SR));
      until R = 18;
    end;
    FindClose(SR);
  end else
    Result := -1;
end;

{IsDriveReady}
function IsDriveReady(Drive : AnsiChar) : Boolean;
{-determine if requested drive is accessible }
var
  Root : AnsiString;
  VolName : PAnsiChar;
  Flags, MaxLength : DWORD;
  NameSize : Integer;
begin
  Result := False;
  NameSize := 0;
  Root := Upcase(Drive) + ':\' ;
  GetMem(VolName, MAX_PATH);

  try
    if GetVolumeInformation(PAnsiChar(Root), VolName, MAX_PATH,
      nil, MaxLength, Flags, nil, NameSize) then
        Result := True;
  finally
    if Assigned(VolName) then
      FreeMem(VolName, MAX_PATH);
  end;
end;

{IsFile}
function IsFile(const FileName : AnsiString) : Boolean;
{-Determines if the provided path specifies a file.}
var
  Attrs : DWORD;                                                    {!!.02}
begin
  Result := False;
  Attrs := GetFileAttributes(PAnsiChar(FileName));
  if Attrs <> DWORD(-1) then                                        {!!.02}
    Result := (Attrs and FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY;
end;

{IsFileArchive}
function IsFileArchive(const S : AnsiString) : Integer;
  {-checks if file's archive attribute is set}
begin
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
  if FileExists(S) then
    Result := Integer((FileGetAttr(S) and faArchive) = faArchive)
  else
    Result := -1;
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
end;

{IsFileHidden}
function IsFileHidden(const S : AnsiString) : Integer;
  {-checks if file's hidden attribute is set}
begin
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
  if FileExists(S) then
    Result := Integer((FileGetAttr(S) and faHidden) = faHidden)
  else
    Result := -1;
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
end;

{IsFileReadOnly}
function IsFileReadOnly(const S : AnsiString) : Integer;
  {-checks if file's readonly attribute is set}
begin
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
  if FileExists(S) then
    Result := Integer((FileGetAttr(S) and faReadOnly) = faReadOnly)
  else
    Result := -1;
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
end;

{IsFileSystem}
function IsFileSystem(const S : AnsiString) : Integer;
  {-checks if file's system attribute is set}
begin
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
  if FileExists(S) then
    Result := Integer((FileGetAttr(S) and faSysFile) = faSysFile)
  else
    Result := -1;
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
end;

{LocalDateTimeToGlobal}
function LocalDateTimeToGlobal(const DT1: TStDateTimeRec; MinOffset: Integer): TStDateTimeRec; {!!.02}
{-adjusts a local date/time to the global (UTC) date/time}
{$IFNDEF VERSION4}
const
  TIME_ZONE_ID_INVALID  = DWORD($FFFFFFFF);
  TIME_ZONE_ID_UNKNOWN  = 0;
  TIME_ZONE_ID_STANDARD = 1;
  TIME_ZONE_ID_DAYLIGHT = 2;
{$ENDIF}
var
  Minutes : LongInt;
  TZ : TTimeZoneInformation;
begin
  Minutes := (DT1.D * MinutesInDay) + (DT1.T div 60);
  case GetTimeZoneInformation(TZ) of
    TIME_ZONE_ID_UNKNOWN : { Time Zone transition dates not used }
      Minutes := Minutes + TZ.Bias;
    TIME_ZONE_ID_INVALID :
      Minutes := Minutes + MinOffset;
    TIME_ZONE_ID_STANDARD:
      Minutes := Minutes + (TZ.Bias + TZ.StandardBias);
    TIME_ZONE_ID_DAYLIGHT:
      Minutes := Minutes + (TZ.Bias + TZ.DaylightBias);
  end;

  Result.D := (Minutes div MinutesInDay);
  Result.T := ((Minutes mod MinutesInDay) * SecondsInMinute) + (DT1.T mod SecondsInMinute);
end;

{ReadVolumeLabel}
function ReadVolumeLabel(var VolName : AnsiString; Drive : AnsiChar) : Cardinal;
{-Get the volume label for the specified drive.}
var
  Root : AnsiString;
  Flags, MaxLength : DWORD;
  NameSize : Integer;
begin
  NameSize := 0;
  Root := Drive + ':\';
  if Length(VolName) < 12 then
    SetLength(VolName, 12);
  if GetVolumeInformation(PAnsiChar(Root), PChar(VolName), Length(VolName),
    nil, MaxLength, Flags, nil, NameSize)
  then begin
    SetLength(VolName, StrLen(PAnsiChar(VolName)));
    Result := 0;
  end
  else begin
    VolName := '';
    Result := GetLastError;
  end;
end;

{SameFile}
function SameFile(const FilePath1, FilePath2 : AnsiString;
                  var ErrorCode : Integer) : Boolean;
  {-Return true if FilePath1 and FilePath2 refer to the same physical file.
    Error codes:
      0 - Success (no error)
      1 - Invalid FilePath1
      2 - Invalid FilePath2
      3 - Error on FileSetAttr/FileGetAttr }
var
  Attr1, Attr2, NewAttr : Integer;


  function DirectoryExists(const Name : AnsiString): Boolean;
  var
    Code : DWORD;                                                      {!!.02}
    Buf  : array[0..MAX_PATH] of AnsiChar;                             {!!.01}
  begin
    StrPLCopy(Buf, Name, SizeOf(Buf)-1);
    Code := GetFileAttributes(Buf);
    Result := (Code <> DWORD(-1)) and                                  {!!.02}
      (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);                        {!!.02}
  end;

begin
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
  Result := False;
  ErrorCode := 0;
  Attr1 := FileGetAttr(FilePath1);
  if Attr1 < 0 then begin
    ErrorCode := 1;
    Exit;
  end;
  Attr2 := FileGetAttr(FilePath2);
  if Attr2 < 0 then begin
    {leave ErrorCode at 0 if file not found but path is valid}
    if not DirectoryExists(ExtractFilePath(FilePath2)) then
      ErrorCode := 2;
    Exit;
  end;
  if Attr1 <> Attr2 then
    Exit;
  if ((Attr1 and faArchive) = 0) then
    NewAttr := Attr1 or faArchive
  else
    NewAttr := Attr1 and (not faArchive);
  if FileSetAttr(FilePath1, NewAttr) <> 0 then begin
    ErrorCode := 3;
    Exit;
  end;
  Attr2 := FileGetAttr(FilePath2);
  if Attr2 < 0 then
    ErrorCode := 3;

  Result := (Attr2 = NewAttr) or (Attr2 = $80);
  { If the attribute is set to $00, Win32 automatically sets it to $80. }

  if FileSetAttr(FilePath1, Attr1) <> 0 then
    ErrorCode := 3;
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
end;

{SetMediaID} {!!!! Does not work on NT/2000 !!!!}
function SetMediaID(Drive : AnsiChar; var MediaIDRec : MediaIDType) : Cardinal;
{-Set the media ID record for the specified drive.}
type
  DevIOCtlRegisters = record
    reg_EBX : LongInt;
    reg_EDX : LongInt;
    reg_ECX : LongInt;
    reg_EAX : LongInt;
    reg_EDI : LongInt;
    reg_ESI : LongInt;
    reg_Flags : LongInt;
  end;
var
  PMid : PMediaIDType;
  Regs : DevIOCtlRegisters;
  CB   : DWord;
  HDevice : THandle;
  SA   : TSecurityAttributes;
begin
  PMid := @MediaIDRec;
  with SA do begin
    nLength := SizeOf(SA);
    lpSecurityDescriptor := nil;
    bInheritHandle := True;
  end;
  with Regs do begin
    reg_EAX := $440D;
    reg_EBX := Ord(UpCase(Drive)) - (Ord('A') - 1);
    reg_ECX := $0846;
    reg_EDX := LongInt(PMid);
  end;
  HDevice := CreateFile('\\.\vwin32', GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
    Pointer(@SA), OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if HDevice <> INVALID_HANDLE_VALUE then begin
    if DeviceIOControl(HDevice, VWIN32_DIOC_DOS_IOCTL, Pointer(@Regs), SizeOf(Regs),
      Pointer(@Regs), SizeOf(Regs), CB, nil)
    then
      Result := 0
    else
      Result := GetLastError;
    CloseHandle(HDevice);
  end else
    Result := GetLastError;
end;

{SplitPath}
procedure SplitPath(const APath : AnsiString; Parts : TStrings);
{-Splits the provided path into its component sub-paths}
var
  i : Integer;
  iStart : Integer;
  iStartSlash : Integer;
  Path, SubPath : AnsiString;
begin
  Path := APath;
  if Path = '' then Exit;
  if not Assigned(Parts) then Exit;

  if Path[ Length( Path ) ] = StPathDelim then
    Delete( Path, Length( APath ), 1 );
  iStart := 1;
  iStartSlash := 1;
  repeat
    {find the Slash at iStartSlash}
    i := FindNthSlash( Path, iStartSlash );
    {get the subpath}
    SubPath := Copy( Path, iStart, i - iStart + 1 );
    iStart := i + 2;
    inc( iStartSlash );
    Parts.Add( SubPath );
  until ( i = Length( Path ) );
end;

{StDateTimeToFileTime}
function StDateTimeToFileTime(const FileTime : TStDateTimeRec) : LongInt;  {!!.02}
{-Converts an TStDate and TStTime to a DOS date-time value.}
var
  DDT : TDateTime;
begin
  DDT := Int(StDateToDateTime(FileTime.D)) + Frac(StTimeToDateTime(FileTime.T));
  Result := DateTimeToFileDate(DDT);
end;

{StDateTimeToUnixTime}
function StDateTimeToUnixTime(const DT1 : TStDateTimeRec) : Longint;   {!!.02}
{-converts a TStDateTimeRec to a time in Unix base (1970)}
begin
  Result := ((DT1.D - Date1970) * SecondsInDay) + DT1.T;
end;

{UnixTimeToStDateTime}
function UnixTimeToStDateTime(UnixTime : Longint) : TStDateTimeRec;
{-converts a time in Unix base (1970) to a TStDateTimeRec}
begin
  Result.D := Date1970 + (UnixTime div SecondsInDay);
  Result.T := UnixTime mod SecondsInDay;
end;

{ValidDrive}
function ValidDrive(Drive : AnsiChar) : Boolean;
{-Determine if the drive is a valid drive.}
var
  DriveBits : LongInt;
  DriveLtr : AnsiChar;
begin
  DriveLtr := UpCase(Drive);
  DriveBits := GetLogicalDrives shr (Ord(DriveLtr)-Ord('A'));
  Result := LongFlagIsSet(DriveBits, $00000001);
end;

{WriteVolumeLabel}
function WriteVolumeLabel(const VolName : AnsiString; Drive : AnsiChar) : Cardinal;
{-Sets the volume label for the specified drive.}
var
  Temp : AnsiString;
  Vol : array[0..11] of AnsiChar;
  Root : array[0..3] of AnsiChar;
begin
  Temp := VolName;
  StrCopy(Root, '%:\');
  Root[0] := Drive;
  if Length(Temp) > 11 then
    SetLength(Temp, 11);
  StrPCopy(Vol, Temp);
  if Windows.SetVolumeLabel(Root, Vol) then
    Result := 0
  else Result := GetLastError;
end;


end.