dbwebshower.pas

DELPHI 访问.net的WEB SERVICE的例子

{***************************************************************
 *
 * Project Name: XJGTest -- DBWebShower
 * Typist:       XJG([e-mail])
 * Purpose:      从数据库中载入数据到WebBrowser
 * Comment Time: 2003-5-3 14:25:17
 * History:      Create by xjg. 2003-5-3 14:25:17
 *
 ****************************************************************}

unit DBWebShower;

interface

uses
  SysUtils, Classes, DB, WebShower;

type
  TDBWebShower = class(TWebShower)
  private
    FDataSource: TDataSource;
    FFileNameField: string;
    FFileContentField: string;
    procedure SetDataSource(const Value: TDataSource);
    function PropertyIsReady: Boolean;
    procedure GetRecordContent(const AName: string; const AStream: TMemoryStream);
    procedure SetFileContentField(const Value: string);
    procedure SetFileNameField(const Value: string);
  protected
    procedure GetWebContent(const AUrl, AFile: string; const AStream: TMemoryStream); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure Assign(Source: TPersistent); override;
  published
    property DataSource: TDataSource read FDataSource write SetDataSource;
    property FileNameField: string read FFileNameField write SetFileNameField;
    property FileContentField: string read FFileContentField write SetFileContentField;
  end;

implementation

{ TDBWebShower }

procedure TDBWebShower.Assign(Source: TPersistent);
begin
  if Source is TDBWebShower then
  begin
    inherited;
    with TDBWebShower(Source) do
    begin
      Self.DataSource := DataSource;
      Self.FileNameField := FileNameField;
      Self.FileContentField := FileContentField;
    end;
  end
  else
    inherited;
end;

constructor TDBWebShower.Create(AOwner: TComponent);
begin
  inherited;
  G_WSClass := TDBWebShower;
end;

procedure TDBWebShower.GetRecordContent(const AName: string;
  const AStream: TMemoryStream);
begin
  with FDataSource.DataSet do
  begin
    if Locate(FileNameField, AName, [loCaseInsensitive]) then
      TBlobField(FieldByName(FileContentField)).SaveToStream(AStream);
  end;
end;

procedure TDBWebShower.GetWebContent(const AUrl, AFile: string;
  const AStream: TMemoryStream);
begin
  if PropertyIsReady then
    GetRecordContent(AFile, AStream);
end;

procedure TDBWebShower.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then
    if AComponent = FDataSource then
      FDataSource := nil;
end;

function TDBWebShower.PropertyIsReady: Boolean;
begin
  Result := Assigned(FDataSource) and Assigned(FDataSource.DataSet) and
    FDataSource.DataSet.Active;
end;

procedure TDBWebShower.SetDataSource(const Value: TDataSource);
begin
  if FDataSource <> Value then
  begin
    FDataSource := Value;
    if Assigned(Value) then
      Value.FreeNotification(Self);
  end;
end;

procedure TDBWebShower.SetFileContentField(const Value: string);
begin
  FFileContentField := Value;
end;

procedure TDBWebShower.SetFileNameField(const Value: string);
begin
  FFileNameField := Value;
end;

end.