stsystem.pas

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

                     BytesPerSector, SectorsPerCluster : Cardinal) : Boolean;
{-Return technical information about the specified drive.}
var
  Root : AnsiString;
begin
  if Drive <> ' ' then begin
    Root := AnsiChar(Upcase(Drive)) + ':\';
    Result := GetDiskFreeSpace(PAnsiChar(Root), DWORD(SectorsPerCluster),
      DWORD(BytesPerSector), DWORD(ClustersAvailable), DWORD(TotalClusters));
  end else
    Result := GetDiskFreeSpace(nil, DWORD(SectorsPerCluster),
      DWORD(BytesPerSector), DWORD(ClustersAvailable), DWORD(TotalClusters));
end;


{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.}
type
  TGetDiskFreeSpace = function (Drive : PAnsiChar;
                            var UserFreeBytes : Comp;
                            var TotalBytes : Comp;
                            var TotalFreeBytes : Comp) : Bool; stdcall;
  LH = packed record L,H : word; end;
var
  UserFree, Total, Size : Comp;
  VerInfo : TOSVersionInfo;
  LibHandle : THandle;
  GDFS : TGetDiskFreeSpace;
  Root : AnsiString;
begin
  Result := False;
  {get the version info}
  FillChar(VerInfo, SizeOf(TOSVersionInfo), #0);
  VerInfo.dwOSVersionInfoSize := SizeOf(VerInfo);
  if GetVersionEx(VerInfo) then begin
    with VerInfo do begin
      if ((dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) and
          (LH(dwBuildNumber).L <> 1000)) or
         ((dwPlatformId = VER_PLATFORM_WIN32_NT) and
          (dwMajorVersion >= 4)) then begin
        LibHandle := LoadLibrary('KERNEL32.DLL');
        try
          if (LibHandle <> 0) then begin
            @GDFS := GetProcAddress(LibHandle, 'GetDiskFreeSpaceExA');
            if Assigned(GDFS) then begin
              Root := AnsiChar(Upcase(Drive)) + ':\';
              if GDFS(PAnsiChar(Root), UserFree, Size, Total) then begin
                UserSpaceAvail := UserFree;
                DiskSize := Size;
                TotalSpaceAvail := Total;
                Result := true;
              end;
            end;
          end;

        finally
          FreeLibrary(LibHandle);
        end;
      end;
    end;
  end;
end;
{$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.}
type
  TGetDiskFreeSpace = function (Drive : PAnsiChar;
                            var UserFreeBytes : Comp;
                            var TotalBytes : Comp;
                            var TotalFreeBytes : Comp) : Bool; stdcall;
  LH = packed record L,H : word; end;
var
  CA, TC, BPS, SPC : Cardinal;
  VerInfo : TOSVersionInfo;
  LibHandle : THandle;
  GDFS : TGetDiskFreeSpace;
  Root : AnsiString;
begin
  Result := false;
  {get the version info}
  FillChar(VerInfo, SizeOf(TOSVersionInfo), #0);
  VerInfo.dwOSVersionInfoSize := SizeOf(VerInfo);
  if GetVersionEx(VerInfo) then begin
    with VerInfo do begin
      if ((dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) and
          (LH(dwBuildNumber).L <> 1000)) or
         ((dwPlatformId = VER_PLATFORM_WIN32_NT) and
          (dwMajorVersion >= 4)) then begin
        LibHandle := LoadLibrary('KERNEL32.DLL');
        try
          if (LibHandle <> 0) then begin
            @GDFS := GetProcAddress(LibHandle, 'GetDiskFreeSpaceExA');
            if Assigned(GDFS) then begin
              Root := AnsiChar(Upcase(Drive)) + ':\';
              if GDFS(PAnsiChar(Root), UserSpaceAvail, DiskSize, TotalSpaceAvail) then
                Result := true;
            end;
          end;

        finally
          FreeLibrary(LibHandle);
        end;
      end;
    end;
  end;

  if not Result then begin
    if GetDiskInfo(Drive, CA, TC, BPS, SPC) then begin
      Result := true;
      DiskSize := BPS;
      DiskSize := DiskSize * SPC * TC;
      TotalSpaceAvail := BPS;
      TotalSpaceAvail := TotalSpaceAvail * SPC * CA;
      UserSpaceAvail := TotalSpaceAvail;
    end;
  end;
end;
{$ENDIF}

function GetFileCreateDate(const FileName : AnsiString) :
  TDateTime;
{-Obtains file system time of file creation.}
{!!.01 - Rewritten}
var
  Rslt : Integer;
  SR : TSearchRec;
  FTime : Integer;
begin
  Result := 0.0;
  Rslt := FindFirst(FileName, faAnyFile, SR);
  if Rslt = 0 then begin
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
    FileTimeToDosDateTime(SR.FindData.ftCreationTime,
      LongRec(FTime).Hi, LongRec(FTime).Lo);
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
    Result := FileDateToDateTime(FTime);
    FindClose(SR);
  end;
{!!.01 - End Rewritten}
end;

{GetFileLastAccess}
function GetFileLastAccess(const FileName : AnsiString) :
  TDateTime;
  {-Obtains file system time of last file access.}
{!!.01 - Rewritten}
var
  Rslt : Integer;
  SR : TSearchRec;
  FTime : Integer;
begin
  Result := 0.0;
  Rslt := FindFirst(FileName, faAnyFile, SR);
  if Rslt = 0 then begin
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
    FileTimeToDosDateTime(SR.FindData.ftLastAccessTime,
      LongRec(FTime).Hi, LongRec(FTime).Lo);
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
    Result := FileDateToDateTime(FTime);
    FindClose(SR);
  end;
{!!.01 - End Rewritten}
end;

{GetFileLastModify}
function GetFileLastModify(const FileName : AnsiString) :
  TDateTime;
  {-Obtains file system time of last file modification.}
{!!.01 - Rewritten}
var
  Rslt : Integer;
  SR : TSearchRec;
  FTime : Integer;
begin
  Result := 0.0;
  Rslt := FindFirst(FileName, faAnyFile, SR);
  if Rslt = 0 then begin
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
    FileTimeToDosDateTime(SR.FindData.ftLastWriteTime,
      LongRec(FTime).Hi, LongRec(FTime).Lo);
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
    Result := FileDateToDateTime(FTime);
    FindClose(SR);
  end;
{!!.01 - End Rewritten}
end;

{GetHomeFolder}
function GetHomeFolder(aForceSlash : boolean) : AnsiString;
{-Obtains the "Home Folder" for the current user}
var
  Size   : integer;
  Path   : AnsiString;
  Buffer : PAnsiChar;
begin
  Size := GetEnvironmentVariable('HOMEDRIVE', nil, 0);
  GetMem(Buffer, Size);
  try
    SetString(Result, Buffer, GetEnvironmentVariable('HOMEDRIVE',
      Buffer, Size));
  finally
    FreeMem(Buffer);
  end;

  Size := GetEnvironmentVariable('HOMEPATH', nil, 0);
  GetMem(Buffer, Size);
  try
    SetString(Path, Buffer, GetEnvironmentVariable('HOMEPATH',
      Buffer, Size));
  finally
    FreeMem(Buffer);
  end;

  if Path = '' then
    Path := GetWorkingFolder(aForceSlash);

  if aForceSlash and (Result[length(Result)] <> StDosPathDelim) then
    Path := Path + StDosPathDelim;
  if (Path[1] <> StDosPathDelim) then
    Result := Result + StDosPathDelim + Path
  else
    Result := Result + Path;
end;

function GetLongPathName(lpszShortPath: PAnsiChar; lpszLongPath: PAnsiChar;
  cchBuffer: DWORD): DWORD;
var
  PathBuf : PAnsiChar;
  Len, i : Integer;
  FD : TWIN32FindData;
  FH : THandle;
  ResBuf : AnsiString;
begin
  if not Assigned(lpszShortPath) then begin
    SetLastError(ERROR_INVALID_PARAMETER);
    Result := 0;
    Exit;
  end;

  { Check whether the input path is valid. }
  if (GetFileAttributes(lpszShortPath) = $FFFFFFFF) then begin
    Result := 0;
    Exit;
  end;

  Len := StrLen(lpszShortPath);
  GetMem(PathBuf, Len + 1);

  try
    StrCopy(PathBuf, lpszShortPath);
    ResBuf := '';

    i := 0;
    { Check for Drive Letter }
    if (IsCharAlpha(PathBuf[0])) and (PathBuf[1] = DriveDelim) and (Len > 3) then begin
      repeat
        ResBuf := ResBuf + PathBuf[i];
        Inc(i);
      until PathBuf[i] = StPathDelim;
      ResBuf := ResBuf + StPathDelim;
    end;

    { Check for UNC Path }
    if (PathBuf[0] = StPathDelim) and (PathBuf[1] = StPathDelim) then begin
      { extract machine name }
      ResBuf := '\\';
      i := 2;
      repeat
        ResBuf := ResBuf + PathBuf[i];
        Inc(i);
      until PathBuf[i] = StPathDelim;
      ResBuf := ResBuf + StPathDelim;
      Inc(i);

      { extract share name }
      repeat
        ResBuf := ResBuf + PathBuf[i];
        Inc(i);
      until PathBuf[i] = StPathDelim;
      ResBuf := ResBuf + StPathDelim;
      Inc(i);
    end;

    { move past current delimiter }                                 {!!.01}
    Inc(i);                                                         {!!.01}

    { find next occurrence of path delimiter }
    while i < Len do begin
      if (PathBuf[i] = StPathDelim) then begin
        PathBuf[i] := #0;
        FH := FindFirstFile(PathBuf, FD);
        if FH <> INVALID_HANDLE_VALUE then begin
          ResBuf := ResBuf + StrPas(FD.cFileName) + StPathDelim;
          Windows.FindClose(FH);
        end;
        PathBuf[i] := StPathDelim;

      end;
      Inc(i);
    end;

    { one mo' time for the entire string: }
    FH := FindFirstFile(PathBuf, FD);
    if FH <> INVALID_HANDLE_VALUE then begin
      ResBuf := ResBuf + StrPas(FD.cFileName);
      Windows.FindClose(FH);
    end;

    Result := Length(ResBuf);

    if Assigned(lpszLongPath) and (cchBuffer >= DWord(Length(ResBuf))) then begin
      StrPCopy(lpszLongPath, ResBuf);
    end;
  finally
    FreeMem(PathBuf, Len + 1);
  end;
end;

{GetLongPath}
function GetLongPath(const APath : AnsiString) : AnsiString;
{-Returns the long filename version of a provided path.}
var
  Size   : integer;
  Buffer : PAnsiChar;
begin
  Buffer := nil;
  Size := GetLongPathName(PAnsiChar(APath), Buffer, 0);
  GetMem(Buffer, Size + 1);
  try
    SetString(Result, Buffer, GetLongPathName(PAnsiChar(APath), Buffer, Size));
  finally
    if Assigned(Buffer) then
      FreeMem(Buffer, Size + 1);
  end;
end;

{GetMachineName}
function GetMachineName : AnsiString;
{-Returns the "Machine Name" for the current computer }
var
  Size : DWORD;
  MachineNameZ : array [0..MAX_COMPUTERNAME_LENGTH] of AnsiChar;
begin
  Size := sizeof(MachineNameZ);
  if not GetComputerName(MachineNameZ, Size) then
{$IFDEF Version6}
    RaiseLastOSError;
{$ELSE}
    RaiseLastWin32Error;
{$ENDIF}
//  SetString(Result, MachineNameZ, Size);                            {!!.02}
  SetString(Result, MachineNameZ, StrLen(MachineNameZ));              {!!.02}
end;

{GetMediaID}
function GetMediaID(Drive : AnsiChar; var MediaIDRec : MediaIDType) : Cardinal;
{-Get the media information (Volume Label, Serial Number) for the specified drive}
var
  VolBuf, FSNameBuf : PAnsiChar;
  VolSiz, FSNSiz : Integer;
  Root : AnsiString;
  SN, ML, Flags : DWORD;
begin
  VolSiz := SizeOf(MediaIDRec.VolumeLabel) + 1;
  FSNSiz := SizeOf(MediaIDRec.FileSystemID) + 1;

  Root := AnsiChar(Upcase(Drive)) + ':\';

  VolBuf := nil;
  FSNameBuf := nil;

  try
    GetMem(VolBuf,  VolSiz);
    GetMem(FSNameBuf, FSNSiz);
    Result := 0;
    if GetVolumeInformation(PAnsiChar(Root), VolBuf, VolSiz, @SN, ML, Flags, FSNameBuf, FSNSiz) then begin
      StrCopy(MediaIDRec.FileSystemID, FSNameBuf);
      StrCopy(MediaIDRec.VolumeLabel, VolBuf);
      MediaIDRec.SerialNumber := SN;

    end else
      Result := GetLastError;
  finally
    if Assigned(VolBuf) then
      FreeMem(VolBuf, VolSiz);
    if Assigned(FSNameBuf) then
      FreeMem(FSNameBuf, FSNSiz);
  end;
end;

{!!.02 -- Added }
function StAddBackSlash(const DirName : string) : string;
{ Add a default slash to a directory name }
const
  DelimSet : set of Char = [StPathDelim, ':', #0];
begin
  Result := DirName;
  if Length(DirName) = 0 then
    Exit;
  if not (DirName[Length(DirName)] in DelimSet) then
    Result := DirName + StPathDelim;
end;
{!!.02 -- End Added }

{GetParentFolder}
function GetParentFolder(const APath : AnsiString; aForceSlash : Boolean) : AnsiString;
{-return the parent directory for the provided directory }
begin
  Result := ExpandFileName(StAddBackSlash(APath) + StParentDir);   {!!.02}
  if aForceSlash and (Result[length(Result)] <> StDosPathDelim) then
    Result := Result + StDosPathDelim;
end;

{GetShortPath}
function GetShortPath(const APath : AnsiString) : AnsiString;
{-Returns the short filename version of a provided path.}
var
  Size   : integer;
  Buffer : PAnsiChar;
begin
  Buffer := nil;
  Size := GetShortPathName(PAnsiChar(APath), Buffer, 0);
  GetMem(Buffer, Size);
  try
    SetString(Result, Buffer, GetShortPathName(PAnsiChar(APath), Buffer, Size));
  finally
    if Assigned(Buffer) then
      FreeMem(Buffer);
  end;
end;

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

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