abutils.pas

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

procedure AbStripDrive( var FName : string );
{ strips the drive off a filename }
var
  Drive, Path, Name : string;
begin
  AbParseFileName( FName, Drive, Path, Name );
  FName := Path + Name;
end;
{ -------------------------------------------------------------------------- }
procedure AbFixName( var FName : string );
{ changes backslashes to forward slashes }
var
  i : Integer;
begin
  for i := 1 to Length( FName ) do
    if FName[i] = AbPathDelim then
      FName[i] := AB_ZIPPATHDELIM;
end;
{ -------------------------------------------------------------------------- }
procedure AbUnfixName( var FName : string );
{ changes forward slashes to backslashes }
var
  i : Integer;
begin
  for i := 1 to Length( FName ) do
    if FName[i] = AB_ZIPPATHDELIM then
      FName[i] := AbPathDelim;
end;
{ -------------------------------------------------------------------------- }
procedure AbUpdateCRC( var CRC : LongInt; var Buffer; Len : Word );
type
  TByteArray = array[0..65520] of Byte;
var
  BufArray : TByteArray absolute Buffer;
  i : Integer;
  CRCTemp : DWORD;
begin
  CRCTemp := CRC;
  for i := 0 to pred( Len ) do
    CRCTemp := AbCrc32Table[ Byte(CrcTemp xor DWORD( BufArray[i] ) ) ] xor
              ((CrcTemp shr 8) and $00FFFFFF);
  CRC := CRCTemp;
end;
{ -------------------------------------------------------------------------- }
function AbUpdateCRC32(CurByte : Byte; CurCrc : LongInt) : LongInt;
{ Return the updated 32bit CRC }
{ Normally a good candidate for basm, but Delphi32's code
    generation couldn't be beat on this one!}
begin
  Result := DWORD(AbCrc32Table[ Byte(CurCrc xor LongInt( CurByte ) ) ] xor
            ((CurCrc shr 8) and DWORD($00FFFFFF)));
end;
{ -------------------------------------------------------------------------- }
function AbWriteVolumeLabel(const VolName : string;
                                Drive : AnsiChar) : Cardinal;
var
  Temp : string;
  Vol : array[0..11] of AnsiChar;
  Root : array[0..3] of AnsiChar;
begin
  Temp := VolName;
  StrCopy(Root, '%:' + AbPathDelim);
  Root[0] := Drive;
  if Length(Temp) > 11 then
    SetLength(Temp, 11);
  StrPCopy(Vol, Temp);
{$IFDEF MSWINDOWS}
  if Windows.SetVolumeLabel(Root, Vol) then
    Result := 0
  else Result := GetLastError;
{$ENDIF MSWINDOWS}
{$IFDEF LINUX}
{ UNIX absolute paths start with a slash }
  Result := 0;
{$ENDIF LINUX}
end;
{ -------------------------------------------------------------------------- }
function AbUnixTimeToDateTime(UnixTime : LongInt) : TDateTime;
{ convert unix date to Delphi TDateTime }
var
  Hrs, Mins, Secs : Word;
  TodaysSecs : LongInt;
begin
  TodaysSecs := UnixTime mod SecondsInDay;
  Hrs := TodaysSecs div SecondsInHour;
  TodaysSecs := TodaysSecs - (Hrs * SecondsInHour);
  Mins := TodaysSecs div SecondsInMinute;
  Secs := TodaysSecs - (Mins * SecondsInMinute);

  Result := Unix0Date + (UnixTime div SecondsInDay) +
    EncodeTime(Hrs, Mins, Secs, 0);
end;
{ -------------------------------------------------------------------------- }
function AbDateTimeToUnixTime(DateTime : TDateTime) : LongInt;
{ convert Delphi TDateTime to unix date }
var
  Hrs, Mins, Secs, MSecs : Word;
  Dt, Tm : TDateTime;
begin
  Dt := Trunc(DateTime);
  Tm := DateTime - Dt;
  if Dt < Unix0Date then
    Result := 0
  else
    Result := Trunc(Dt - Unix0Date) * SecondsInDay;

  DecodeTime(Tm, Hrs, Mins, Secs, MSecs);
  Result := Result + (Hrs * SecondsInHour) + (Mins * SecondsInMinute) + Secs;
end;
{ -------------------------------------------------------------------------- }
{!!.01 -- Added }
function AbDosFileDateToDateTime(FileDate, FileTime : Word) : TDateTime;
{$IFDEF MSWINDOWS}
var
  Temp : LongInt;
begin
  LongRec(Temp).Lo := FileTime;
  LongRec(Temp).Hi := FileDate;
  Result := FileDateToDateTime(Temp);
{$ENDIF}
{$IFDEF LINUX}
{!!.02 -- rewritten }
var
  Yr, Mo, Dy : Word;
  Hr, Mn, S  : Word;
begin
  Yr := FileDate shr 9 + 1980;

  Mo := FileDate shr 5 and 15;
  if Mo < 1 then Mo := 1;
  if Mo > 12 then Mo := 12;


  Dy := FileDate and 31;
  if Dy < 1 then Dy := 1;
  if Dy > DaysInAMonth(Yr, Mo) then
    Dy := DaysInAMonth(Yr, Mo);

  Hr := FileTime shr 11;
  if Hr > 23 then Hr := 23;

  Mn := FileTime shr 5 and 63;
  if Mn > 59 then Mn := 59;

  S  := FileTime and 31 shl 1;
  if S * 2 > 59 then S := 29;

  Result :=
    EncodeDate(Yr, Mo, Dy) +
    EncodeTime(Hr, Mn, S, 0);

{
  Result :=
    EncodeDate(
      FileDate shr 9 + 1980,
      FileDate shr 5 and 15,
      FileDate and 31) +
    EncodeTime(
      FileTime shr 11,
      FileTime shr 5 and 63,
      FileTime and 31 shl 1, 0);
}
{$ENDIF}
{!!.02 -- end rewritten }
end;

function AbDateTimeToDosFileDate(Value : TDateTime) : LongInt;
{$IFDEF MSWINDOWS}
begin
  Result := DateTimeToFileDate(Value);
{$ENDIF}
{$IFDEF LINUX}
var
  Yr, Mo, Dy : Word;
  Hr, Mn, S, MS: Word;
begin
  DecodeDate(Value, Yr, Mo, Dy);
  if (Yr < 1980) or (Yr > 2107) then { outside DOS file date year range }
    Yr := 1980;
  DecodeTime(Value, Hr, Mn, S, MS);

  LongRec(Result).Lo := (S shr 1) or (Mn shl 5) or (Hr shl 11);
  LongRec(Result).Hi := Dy or (Mo shl 5) or ((Yr - 1980) shl 9);
{$ENDIF}
end;

{ -------------------------------------------------------------------------- }
{!!.01 -- End Added }
function AbSwapLongEndianness(Value : LongInt): LongInt;
{ convert BigEndian <-> LittleEndian 32-bit value }
type
  TCastArray = array [0..3] of Byte;
var
  i : Integer;
begin
  for i := 3 downto 0 do
    TCastArray(Result)[3-i] := TCastArray(Value)[i];
end;
{ -------------------------------------------------------------------------- }
function AbDOS2UnixFileAttributes(Attr: LongInt): LongInt;
begin
  {$IFDEF LINUX} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
  {$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
  Result := { default permissions }
    AB_FPERMISSION_OWNERREAD or
    AB_FPERMISSION_OWNERWRITE or
    AB_FPERMISSION_OWNEREXECUTE or
    AB_FPERMISSION_GROUPREAD or
    AB_FPERMISSION_OTHERREAD;

  if (Attr and faReadOnly) <> faReadOnly then
    Result := Result and not (AB_FPERMISSION_OWNERWRITE or AB_FPERMISSION_OWNEREXECUTE);
  {$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
  {$IFDEF LINUX} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
end;
{ -------------------------------------------------------------------------- }
function AbUnix2DosFileAttributes(Attr: LongInt): LongInt;
begin
  {$IFDEF LINUX} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
  {$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
  Result := 0;
  case (Attr shr 24) shl 24 of
    AB_FMODE_FILE, AB_FMODE_FILE2: begin { standard file }
      Result := 0;
    end;

    AB_FMODE_DIR : begin  { directory }
      Result := Result or faDirectory;
    end;

    AB_FMODE_FIFO,
    AB_FMODE_CHARSPECFILE,
    AB_FMODE_BLOCKSPECFILE,
    AB_FMODE_FILELINK,
    AB_FMODE_SOCKET: begin
      Result := Result or faSysFile;
    end;
  end;

  if (Attr and AB_FPERMISSION_OWNERWRITE) <> AB_FPERMISSION_OWNERWRITE then
    Result := Result or faReadOnly;
  {$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
  {$IFDEF LINUX} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
end;
{ -------------------------------------------------------------------------- }
function AbFileGetAttr(const aFileName : string) : Integer;
{$IFDEF LINUX}
{$WARN SYMBOL_PLATFORM OFF}
var
  SB: TStatBuf;
{$WARN SYMBOL_PLATFORM ON}
{$ENDIF LINUX}
begin
  {$IFDEF MSWINDOWS}
  {$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
  Result := FileGetAttr(aFileName);
  {$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
  {$ENDIF}

  {$IFDEF LINUX}
  {$WARN SYMBOL_PLATFORM OFF}
  stat(PAnsiChar(aFileName), SB);
  Result := AbUnix2DosFileAttributes(SB.st_mode);                        {!!.01}
  {$WARN SYMBOL_PLATFORM ON}
  {$ENDIF}
end;
{ -------------------------------------------------------------------------- }
procedure AbFileSetAttr(const aFileName : string; aAttr : Integer);
begin
  {$IFDEF MSWINDOWS}
  {$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
  FileSetAttr(aFileName, aAttr);
  {$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
  {$ENDIF}

  {$IFDEF LINUX}
  {$WARN SYMBOL_PLATFORM OFF}
  chmod(PAnsiChar(aFileName), AbDOS2UnixFileAttributes(aAttr));          {!!.01}
  {$WARN SYMBOL_PLATFORM ON}
  {$ENDIF}
end;
{ -------------------------------------------------------------------------- }
{!!.01 -- Added }
function AbFileGetSize(const aFileName : string) :
{$IFDEF MSWINDOWS}
  {$IFDEF VERSION4} Int64 {$ELSE} LongInt {$ENDIF};
{$ENDIF}
{$IFDEF LINUX}
  Int64;
{$ENDIF}
{$IFDEF MSWINDOWS}
var
  SR : TSearchRec;
{$ENDIF}
{$IFDEF LINUX}
var
  StatBuf: TStatBuf64;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
  Result := -1;
  if FindFirst(aFileName, faAnyFile, SR) = 0 then begin       {!!.02}
  {$IFDEF VERSION4}
  {$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
    Int64Rec(Result).Lo := SR.FindData.nFileSizeLow;
    Int64Rec(Result).Hi := SR.FindData.nFileSizeHigh;
  {$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
  {$ELSE}
    Result := SR.Size;
  {$ENDIF};
    FindClose(SR);                                            {!!.02}
  end;                                                        {!!.02}
{$ENDIF}
{$IFDEF LINUX}
  lstat64(PAnsiChar(aFileName), StatBuf);
  Result := StatBuf.st_size;
{$ENDIF}
end;
{!!.01 -- End Added }


{!!.04 - Added }
const
  MAX_VOL_LABEL = 16;

function AbGetVolumeLabel(Drive : AnsiChar) : AnsiString;
{$IFDEF LINUX}
begin
  Result:='';
end;
{$ELSE}
{-Get the volume label for the specified drive.}
var
  Root : AnsiString;
  Flags, MaxLength : DWORD;
  NameSize : Integer;
  VolName : string;
begin
  NameSize := 0;
  Root := Drive + ':\';
  SetLength(VolName, MAX_VOL_LABEL);

  Result := '';

  if GetVolumeInformation(PAnsiChar(Root), PChar(VolName), Length(VolName),
    nil, MaxLength, Flags, nil, NameSize)
  then
    Result := VolName;
end;
{$ENDIF}

procedure AbSetSpanVolumeLabel(Drive: AnsiChar; VolNo : Integer);
begin
  AbWriteVolumeLabel(Format(AB_SPAN_VOL_LABEL,
    [VolNo]), Drive);
end;

function AbTestSpanVolumeLabel(Drive: AnsiChar; VolNo : Integer): Boolean;
var
  VolLabel, TestLabel : string;
begin
  TestLabel := Format(AB_SPAN_VOL_LABEL, [VolNo]);
  VolLabel := UpperCase(AbGetVolumeLabel(Drive));
  Result := VolLabel = TestLabel;
end;
{!!.04 - Added End }


end.