wsado.pas

Workflow Studio是一款专为商业进程管理（BPM）设计的Delphi VCL框架。通过Workflow Studio你可以轻易地将工作流与BPM功能添加到你的应用程序里。这样能使你或你的最

unit wsADO;

{$I wsdefs.inc}

interface
uses SysUtils, Classes, Dialogs,
  {$IFDEF DELPHI6_LVL} Variants, {$ENDIF}
  wsDB, DB, ADODB;

type
  TWorkflowADODB = class(TCustomWorkflowDB)
  private
    FConnection: TADOConnection;
    procedure SetConnection(const Value: TADOConnection);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function DoCreateQuery(SQL: string): TDataset; override;
    procedure DoExecuteQuery(Dataset: TDataset); override;
    procedure DoAssignSQLParams(Dataset: TDataset; AParams: TParams); override;
    function BlobFieldToString(AField: TField): string; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Connection: TADOConnection read FConnection write SetConnection; 
  end;

procedure Register;

implementation
uses wsRes;

function Max(A, B: Integer): Integer;
begin
  if A > B then
    Result := A
  else
    Result := B;
end;

{ TWorkflowADODB }

constructor TWorkflowADODB.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DestroyQueries := true;
end;

function TWorkflowADODB.BlobFieldToString(AField: TField): string;
var
  BlobField: TBlobField;
  StrStream: TStringStream;
  c: integer;
  IsOleStr: boolean;
begin
  if AField is TBlobField then
  begin
    BlobField := TBlobField(AField);
    StrStream := TStringStream.Create('');
    try
      BlobField.SaveToStream(StrStream);
      StrStream.Position := 0;
      result := StrStream.ReadString(StrStream.Size);
    finally
      StrStream.Free;
    end;
  end else
    result := AField.AsString;

  {workaround to "tell" if the string is an Ole string}
  IsOleStr := true;
  c := 2;
  while c < length(result) do
  begin
    if result[c] <> chr(0) then
    begin
      IsOleStr := false;
      break;
    end;
    c := c + 2;
  end;

  {remove #0 characters}
  if IsOleStr then
  begin
    c := 2;
    while c < length(result) do
    begin
      Delete(result, c, 1);
      inc(c);
    end;
  end;
end;

procedure TWorkflowADODB.DoExecuteQuery(Dataset: TDataset);
begin
  TADOQuery(Dataset).ExecSQL;
end;

function TWorkflowADODB.DoCreateQuery(SQL: string): TDataset;
var
  Q: TADOQuery;
begin
  Q := TADOQuery.Create(nil);
  Q.Connection := FConnection;
  Q.Parameters.Clear;
  Q.SQL.Text := SQL;
  result := Q;
end;

procedure TWorkflowADODB.DoAssignSQLParams(Dataset: TDataset; AParams: TParams);
var
  Q: TADOQuery;
  c: integer;
  AParam: TParam;
begin
  Q := TADOQuery(Dataset);
  Q.Parameters.ParseSQL(Q.SQL.Text, true);

  //Q.Parameters.Assign(Params);
  for c := 0 to Q.Parameters.Count - 1 do
  begin
    AParam := AParams.FindParam(Q.Parameters[c].Name);
    if AParam = nil then
    begin
      wsDBError(Format(_str(SErrorParamNotFound),
        [Q.Parameters[c].Name]));
    end;

    Q.Parameters[c].DataType := AParam.DataType;
    Q.Parameters[c].Direction := pdInput;
    Q.Parameters[c].Value := AParam.Value;
    if Q.Parameters[c].DataType in [ftString] then
      Q.Parameters[c].Size := Max(1, Length(VarToSTr(Q.Parameters[c].Value)));
  end;
end;

procedure TWorkflowADODB.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if (Operation = opRemove) and (AComponent = FConnection) then
    FConnection := nil;
  inherited Notification(AComponent, Operation);
end;

procedure TWorkflowADODB.SetConnection(const Value: TADOConnection);
begin
  FConnection := Value;
  if (FConnection <> Value) then
  begin
    FConnection := Value;
    if Value <> nil then
      Value.FreeNotification(Self);
  end;
end;

procedure Register;
begin
  RegisterComponents('Workflow Studio', [TWorkflowADODB]);
end;

end.