abspanst.pas

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

      soFromEnd : begin
        { calc size }
        NewPos := FStr.Size + Offset;
      end;
      soFromCurrent : begin
        NewPos := FStr.Position + Offset;
      end;
    end;

{!!.01}
    if FIgnoreSpanning then begin
      if NewPos < 0 then
        NewPos := 0;
      if NewPos > FStr.Size then
        NewPos := FStr.Size;
    end;
{!!.01}

    if (NewPos < 0) then begin  { past beginning of current stream }

      { request previous media }
      if not Assigned(FOnRequestImage) then exit;
      Dec(FSpanNumber);
      FOnRequestImage(Self,
        FixSpanNumber(FSpanNumber), FImageName, FCancelled);             {!!.01}
      { reset internal stream }
      Valid := MediaIsValid(FImageName);
      if Valid and not FCancelled then begin
        FStr.Free;
        FStr := nil;
        FStr := TFileStream.Create(FImageName, FFileMode);
      end else begin
        if not Valid then
          raise EAbFileNotFound.Create;
        if FCancelled then
          raise EAbUserAbort.Create;
      end;

      { seek rest of way in new stream}
      Result := Result + FStr.Seek(NewPos, soFromEnd);
    end
    else
    if (NewPos > FStr.Size) then begin { past end of current stream }
      { request next media }
      if not Assigned(FOnRequestImage) then exit;
      Dec(FSpanNumber);
      FOnRequestImage(Self,
        FixSpanNumber(FSpanNumber), FImageName, FCancelled);             {!!.01}


      { reset internal stream }
      Valid := MediaIsValid(FImageName);
      if Valid and not FCancelled then begin
        FStr.Free;
        FStr := nil;
        FStr := TFileStream.Create(FImageName, FFileMode);
      end else begin
        if not Valid then
          raise EAbFileNotFound.Create;
        if FCancelled then
          raise EAbUserAbort.Create;
      end;

      { seek rest of way in new stream}
      Result := Result + FStr.Seek(NewPos - FStr.Size, soFromBeginning);
    end
    else { offset is within current stream } begin
      Result := FStr.Seek(NewPos, soFromBeginning);
    end;
  end;
end;

{------------------------------------------------------------------------------}
constructor TAbSpanStream.Create(const FileName: string; Mode: Word;
                                 MediaType : TAbMediaType; Threshold : LongInt);
begin
  inherited Create;

  if AbGetPathType(FileName) <> ptAbsolute then                          {!!.02}
    raise EAbException.Create('Full Path Required');                     {!!.02}

  if ((Mode and fmCreate) = fmCreate) or
     ((Mode and fmOpenWrite) = fmOpenWrite) then
    FSpanMode := smWriting
  else if ((Mode and fmOpenRead) = fmOpenRead) then
    FSpanMode := smReading
  else
    { error: can't support read/write at same time}
    raise EAbException.Create('File must be opened for Read OR Write');

  FArchiveTotalWritten := 0;                                           {!!.04}
  FArchiveTotalSize := 0;                                              {!!.04}
  FSpanStreamInCharge := False;
  FImageName := FileName;
  FThreshold := Threshold;
  FMediaType := MediaType;
  FFileMode := Mode;
  if MediaIsValid(FileName) or (FSpanMode = smReading) then              {!!.02}
    FStr := TFileStream.Create(FileName, Mode)
  else
    raise EAbException.Create( 'Invalid Media' );
end;
{------------------------------------------------------------------------------}
destructor TAbSpanStream.Destroy;
begin
  if FStr <> nil then
    FStr.Free;
  inherited Destroy;
end;
{------------------------------------------------------------------------------}
function TAbSpanStream.MediaIsValid(FName : string) : Boolean;
{- Determines if media is valid / formatted}
{$IFDEF MSWINDOWS}
var
  DriveLetter : string;
{$ENDIF}  
begin
  {$IFDEF MSWINDOWS}
  Result := True;
  if Pos(':', FName) > -1 then
    DriveLetter := UpperCase(FName[1])
  else
    DriveLetter := UpperCase(GetCurrentDir[1]);

  FBytesAvail := AbGetDriveFreeSpace(FName);

  if FBytesAvail < -1 then FBytesAvail := High(FBytesAvail);
  if FBytesAvail = -1 then         {either no disk or disk not formatted}
    Result := False;

  {check that filename doesn't already exist}
  if not Result then begin
    Result := not FileExists(FName);                                     {!!.01}
  end;
  {$ENDIF}
  {$IFDEF LINUX}                                                         {!!.01}
    FBytesAvail := AbGetDriveFreeSpace(FName);                           {!!.01}
    Result := {Result and} (FBytesAvail > 0);                            {!!.01}
  {$ENDIF}                                                               {!!.01}
end;
{------------------------------------------------------------------------------}
function TAbSpanStream.DoRequestNewMedia{(const Prompt: string)}: Boolean; {!!.01}
{- Fires OnRequestImage when new media is required}
var
  NewName   : string;
  ValidName : Boolean;
  Mode      : Word;
  SpanNo    : Byte;                                                      {!!.01}
begin
  Result := true;
  FStr.Free;                                                             {!!.01}
  FStr := nil;                                                           {!!.01}
  if Assigned(FOnRequestImage) then begin
    if MediaType = mtLocal then begin                                    {!!.01}
      NewName := NextDefaultImageName;
      SpanNo := SpanNumber + 1;                                          {!!.01}
    end
    else begin { it's a floppy span }                                    {!!.01}
      NewName := FImageName;                                             {!!.01}
      SpanNo := SpanNumber + 2; { floppy spans are 1 based }             {!!.01}
    end;                                                                 {!!.01}
    ValidName := False;
    while ((not ValidName) and (not FCancelled)) do begin

      FOnRequestImage(Self, FixSpanNumber(SpanNo), NewName, FCancelled); {!!.01}
      if not FCancelled then begin
        if ValidateImageName(NewName) then begin
          Mode := FFileMode;
          ValidName := True;
          FImageName := NewName;
          Inc(FSpanNumber);
          FBytesWritten := 0;
          FStr := TFileStream.Create(FImageName, fmCreate);              {!!.01}
          FStr.Free;                                                     {!!.01}
          FStr := TFileStream.Create(FImageName, Mode);
        end
        else                                                             {!!.01}
          Result := False;                                               {!!.01}
      end;
    end;
  end;
end;
{------------------------------------------------------------------------------}
function TAbSpanStream.NextDefaultImageName : string;
begin
  Result := FImageName;
  if pos('.', Result) > 0 then
    Delete(Result, Pos('.', Result), Length(Result) - Pos('.', Result) + 1);
  Result := Result + '.z';
  if (FSpanNumber + 1) < 10 then
    Result := Result + '0' + IntToStr(FSpanNumber + 1)
  else if (FSpanNumber + 1) < 100 then
    Result := Result + IntToStr(FSpanNumber + 1)
  else
    Result := '';
end;
{------------------------------------------------------------------------------}
function TAbSpanStream.ValidateImageName(NewName : string) : Boolean;
begin
  Result := MediaIsValid(NewName);
end;
{------------------------------------------------------------------------------}
{!!.01 -- Rewritten}
function TAbSpanStream.GetSpace: LongInt;
{ Return space remaining in current span}
var
  EffectiveThreshold : LongInt;
begin
  if FMediaType = mtRemoveable then begin
    EffectiveThreshold := FThreshold;
    if EffectiveThreshold = 0 then
      EffectiveThreshold := MaxLongInt;
    Result := Least([EffectiveThreshold, AbGetDriveFreeSpace(FImageName)]);
  end
  else begin { spanning locally }
    if FThreshold = 0 then
      Result := AbGetDriveFreeSpace(FImageName)
    else
      Result := FThreshold - FBytesWritten;
  end;
end;
{!!.01 -- End Rewritten}
{------------------------------------------------------------------------------}
{!!.01 -- Rewritten}
procedure TAbSpanStream.SetSize(NewSize: Integer);
var
  CurSize, Remaining : LongInt;
begin
  if Assigned(FStr) then begin
    if NewSize = 0 then
      FStr.Size := 0
    else begin
      CurSize := FStr.Size;
      Remaining := AbGetDriveFreeSpace(FImageName);
      if NewSize < (CurSize + Remaining) then
        FStr.Size := NewSize
      else
        FStr.Size := CurSize + Remaining;
    end;
  end;
  inherited SetSize(NewSize);
end;
{------------------------------------------------------------------------------}
{!!.01 -- End Rewritten}
procedure TAbSpanStream.GotoNext;
var
  GotNewMedia : Boolean;
begin
  { close current span}
  FStr.Free;
  FStr := nil;

  repeat
    { ask for new media, if needed}
    GotNewMedia := DoRequestNewMedia;

  { until new media or cancelled}
  until GotNewMedia or FCancelled;

  if not FCancelled then begin
    { open new stream on new media}
    if FSpanMode = smWriting then
      FStr := TFileStream.Create(FImageName, FFileMode);

    if FSpanMode = smReading then begin
      if FileExists(FImageName) then
        FStr := TFileStream.Create(FImageName, FFileMode)
      else
        raise EAbException.Create('Cannot open spanned file: ' + FImageName);
    end;

    Inc(FSpanNumber);                                                  {!!.04}
  end
  else begin
  {cancel and cleanup}
    FStr.Free;
    FStr := nil;
    raise EAbUserAbort.Create;                                           {!!.01}

  end;
end;
{------------------------------------------------------------------------------}
end.