superstream.pas

C++中的STL真的让人爱不释手,如果你使用DELPHI,现在你也有了类似于STL的标准库,还不赶快下载啊!

	if dir = iodirRead then
  	begin
    	fs := TFileStream.Create(fn, fmOpenRead);
      try
	      bi := TBufferedInputStream.Create(fs, FileBuffering, true);
	      Create(bi, true, options);
      except on e:Exception do
      	begin
        	fs.free;
          raise;
        end
      end;
    end
  else
  	begin
    	fs := TFileStream.Create(fn, fmCreate);
      try
	      bo := TBufferedOutputStream.Create(fs, FileBuffering, true);
	      Create(bo, true, options);
      except on e:Exception do
      	begin
        	fs.free;
          raise;
        end
      end;
    end;
end;

destructor TObjStream.destroy;
begin
	FObjList.Free;
	inherited;
end;

procedure TObjStream.DoHeaderTransfer;
begin
  if not FHeaderTransferred then
    begin
    end;
	FHeaderTransferred := true;
end;

procedure TObjStream.ReadFixed(var buffer; count : LongInt);
var bytes : LongInt;
begin
	bytes := Read(buffer, count);
  if bytes <> count then
  	raise TObjStreamException.Create('Fixed read failed -- incorrect number of bytes read.');
end;

class function TObjStream.ReadObjectInFile(const fn : String; options : TObjStreamOptions) : TObject;
var f : TFileStream;
		b : TBufferedInputStream;
		os : TObjStream;
begin
	f := TFileStream.Create(fn, fmOpenRead);
  try
  	b := TBufferedInputStream.Create(f, FileBuffering, false);
    try
      os := TObjStream.Create(b, false, options);
      try
        result := os.ReadObject;
      finally
        os.free;
      end;
    finally
    	b.free;
    end;
  finally
  	f.free;
  end;
end;

class procedure TObjStream.WriteObjectToFile(const fn : String; options : TObjStreamOptions; obj : TObject);
var f : TFileStream;
		b : TBufferedOutputStream;
		os : TObjStream;
begin
	f := TFileStream.Create(fn, fmCreate);
  try
  	b := TBufferedOutputStream.Create(f, FileBuffering, false);
    try
      os := TObjStream.Create(b, false, options);
      try
        os.WriteObject(obj);
      finally
        os.free;
      end;
    finally
    	b.free;
    end;
  finally
  	f.free;
  end;
end;

constructor TBufferedInputStream.Create(targetStream : TStream; bufSize : Integer; Owned : Boolean);
begin
	FStream := targetStream;
	FWindow := TMemoryStream.Create;
	FBufferSize := bufSize;
	FWindowPosition := 0;
	FOwned := Owned;
end;

destructor TBufferedInputStream.Destroy;
begin
	FWindow.Free;
	if FOwned then
		FStream.Free;
	inherited;
end;

function TBufferedInputStream.Read(var Buffer; Count: Longint): Longint;
var number, bytesRead : Integer;
    pos : PChar;
begin
	// default return is zero (to handle 0 byte requests)
	result := 0;

  pos := PChar(@buffer);
  while count > 0 do
  	begin
			number := count;
      if FWindow.Size - FWindow.Position < number then
      	number := FWindow.Size - FWindow.Position;
      if number > 0 then
      	begin
        	bytesRead := FWindow.Read(pos^, number);
          Inc(pos, bytesRead);
          Dec(count, bytesRead);
          Inc(result, bytesRead);
        end;
      if (count > 0) and (FWindow.Size - FWindow.Position = 0) then
      	begin
        	// Try to read more data into our buffer.
          FWindow.Clear;
          number := FBufferSize;
          if FStream.Size - FStream.Position < number then
          	number := FStream.Size - FStream.Position;
          if number > 0 then
          	begin
		          FWindow.CopyFrom(FStream, number);
  		        FWindow.Position := 0;
            end;

          // If we couldn't read any more data, we're done.
          if FWindow.Size = 0 then
          	break;
        end;
    end;

end;

function TBufferedInputStream.Write(const Buffer; Count: Longint): Longint;
begin
	raise Exception.Create('Can''t write to buffered input stream.');
end;

function TBufferedInputStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
	case origin of
		soFromCurrent:
			begin
				result := FWindowPosition + FWindow.Position + offset;
				if offset <> 0 then
					begin
						result := FStream.Seek(result, origin);
					end;
			end;
		soFromBeginning:
			begin
				if (offset >= FWindowPosition) and (offset < (FWindowPosition + FWindow.Size)) then
					begin
						FWindow.Position := offset - FWindowPosition;
						result := offset;
					end
				else
					begin
						result := FStream.Seek(offset, origin);
					end;
			end;
		else
			begin
				result := FStream.Seek(offset, origin);
			end;
	end;
end;

procedure TBufferedInputStream.SetBufferSize(newSize : Integer);
begin
	if FBufferSize <> newSize then
  	begin
		  FBufferSize := newSize;
    end;
end;

procedure TBufferedInputStream.SetSize(NewSize: Longint);
begin
	raise Exception.Create('Can''t set size of buffered input stream.');
end;

procedure TBufferedInputStream._SetSize(NewSize : LongInt);
begin
  SetSize(newSize);
end;

constructor TBufferedOutputStream.Create(targetStream : TStream; bufSize : Integer; Owned : Boolean);
begin
	FStream := targetStream;
	FWindow := TMemoryStream.Create;
	FBufferSize := bufSize;
	FOwned := Owned;
end;

destructor TBufferedOutputStream.Destroy;
begin
	Flush;
	FWindow.Free;
	if FOwned then
		FStream.Free;
	inherited;
end;

function TBufferedOutputStream.Read(var Buffer; Count: Longint): Longint;
begin
	raise Exception.Create('Can''t read from buffered output stream.');
end;

function TBufferedOutputStream.Write(const Buffer; Count: Longint): Longint;
begin
	result := FWindow.Write(buffer, count);
  if FWindow.Size > FBufferSize then
  	Flush;
end;

procedure TBufferedOutputStream.Flush;
begin
	FStream.CopyFrom(FWindow, 0);
  FWindow.Clear;
end;

function TBufferedOutputStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
	raise Exception.Create('Can''t seek on buffered output stream.');
end;

procedure TBufferedOutputStream.SetBufferSize(newSize : Integer);
begin
	if FBufferSize <> newSize then
  	begin
		  FBufferSize := newSize;
    end;
end;

procedure TBufferedOutputStream.SetSize(NewSize: Longint);
begin
	raise Exception.Create('Can''t set size of buffered output stream.');
end;

procedure TBufferedOutputStream._SetSize(NewSize : LongInt);
begin
  SetSize(newSize);
end;


constructor TStreamAdapter.Create(targetStream : TStream; owned : Boolean);
begin
	inherited Create;
  FStream := targetStream;
  FOwned := owned;
end;

destructor TStreamAdapter.Destroy;
begin
	if FOwned then
  	FStream.Free;
end;

function TStreamAdapter.Read(var Buffer; Count: Longint): Longint;
begin
	result := FStream.Read(buffer, count);
end;

function TStreamAdapter.Write(const Buffer; Count: Longint): Longint;
begin
	result := FStream.Write(buffer, count);
end;

function TStreamAdapter.Seek(Offset: Longint; Origin: Word): Longint;
begin
	result := FStream.Seek(offset, origin);
end;

procedure TStreamAdapter.SetSize(NewSize: Longint);
begin
	TStreamAdapter(FStream)._SetSize(NewSize);
end;

procedure TStreamAdapter._SetSize(NewSize : LongInt);
begin
	SetSize(NewSize);
end;

function TObjList.GetObject(idx : Integer) : TObject;
begin
	result := TObject(Items[idx]);
end;

procedure TObjList.SetObject(idx : Integer; obj : Tobject);
begin
	Items[idx] := obj;
end;

destructor TObjList.Destroy;
begin
	if FOwns then
  	FreeAll;
	inherited;
end;

procedure TObjList.FreeAll;
var i : Integer;
begin
	for i := 0 to count - 1 do
  	Objects[i].Free;
  Clear;
end;

var
	DelphiFound : Boolean = false;

procedure Init;
{$IFDEF TRIAL}
const
	msg = 'This program uses a trial version of SuperStream by Soletta, which cannot be distributed.  Halt.';
{$ENDIF}
{$IFDEF BETA}
const
	msg = 'This program uses a beta version of SuperStream by Soletta, which cannot be distributed.  Halt.';
  expiredMSG = 'The SuperStream version this program uses has expired.  Please check www.soletta.com for a new one.';
{$ENDIF}
begin
{$IFDEF TRIAL}

	DelphiFound := (FindWindow(nil, 'Delphi') <> 0) or (FindWindow(nil, 'Delphi 3') <> 0) or (FindWindow(nil, 'Delphi 4') <> 0);

	if not DelphiFound then
		begin
			if IsConsole then
				writeln(msg)
			else
				MessageBox(0, msg, 'Soletta - SuperStream', MB_APPLMODAL or MB_OK);
			Halt;
		end;

{$ENDIF}
{$IFDEF BETA}
	DelphiFound := (FindWindow(nil, 'Delphi') <> 0) or (FindWindow(nil, 'Delphi 3') <> 0) or (FindWindow(nil, 'Delphi 4') <> 0);
	if (now > encodeDate(1998, 8, 1)) then
  	begin
    	if IsConsole then
      	writeln(expiredMSG)
      else
	    	MessageBox(0, expiredMSG, 'Soletta - SuperStream Beta', MB_APPLMODAL or MB_OK);
    end;
	if (not DelphiFound) then
  	begin
    	if IsConsole then
				writeln(msg)
      else
	    	MessageBox(0, msg, 'Soletta - SuperStream Beta', MB_APPLMODAL or MB_OK);
      Halt;
    end;
{$ENDIF}

end;

procedure Term;
var i : Integer;
begin
	for i := 0 to registry.count - 1 do
  	TObject(registry[i]).Free;
  registry.free;
end;

initialization
	Init;
finalization
	Term;
end.