zstoredproc.pas

控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre

      Screen.Cursor := crSqlWait;
{$ENDIF}

    FStoredProc.Close;
    SqlBuffer.ClearBuffer(true);
    CacheBuffer.ClearBuffer(true);
    SqlParser.Clear;
    if DefaultFields then            //??????
      DestroyFields;
  finally
{$IFNDEF NO_GUI}
    if doHourGlass in Options then
      Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

procedure TZStoredProc.InternalInitFieldDefs;
var
  SaveActive: Boolean;
  I: Integer;
  FieldName: string;
  FieldRequired: Boolean;
  FieldSize: Integer;
  FieldType: TFieldType;
  FieldNo: Integer;
  FieldDesc: PFieldDesc;
begin
  { Set start values }
  FieldDefs.Clear;
  FieldNo := 1;
  { Open connections for separate func call }
  SaveActive := FStoredProc.Active;
  if not FStoredProc.Active then
    ExecProc;

  { Create TField for every query field }
  for I := 0 to FStoredProc.FieldCount - 1 do
  begin
    FieldRequired := False;
    FieldDesc := SqlParser.SqlFields.FindByAlias(FStoredProc.FieldAlias(I));
    if Assigned(FieldDesc) then
    begin
      { Process table fields }
      FieldName := FieldDesc.Alias;
      FieldType := FieldDesc.FieldType;
      FieldSize := FieldDesc.Length;
      FieldRequired := not FieldDesc.IsNull and (FieldDesc.AutoType = atNone);
    end
    else
    begin
      { Process calc and unknown fields }
      FieldName := FStoredProc.FieldAlias(I);
      FieldSize := Max(FStoredProc.FieldSize(I), FStoredProc.FieldMaxSize(I));
      FieldType := FStoredProc.FieldDataType(I);
    end;
    { Correct field size }
    UpdateFieldDef(FieldDesc, FieldType, FieldSize);
    { Add new field def }
    TFieldDef.Create(FieldDefs, FieldName, FieldType, FieldSize,
      FieldRequired, FieldNo);
    Inc(FieldNo);
  end;
  { Restore dataset state }
  if not SaveActive then
    FStoredProc.Close;
end;

procedure TZStoredProc.InternalLast;
begin
  QueryRecords(True);
  CurRec := SqlBuffer.Count;
end;

procedure TZStoredProc.InternalOpen;
begin
  ExecProc;
end;

procedure TZStoredProc.InternalRefresh;
var
//  Error: string;
  KeyFields: string;
  KeyValues: Variant;
//  RecordCount: Integer;
{$IFNDEF NO_GUI}
  OldCursor: TCursor;
{$ENDIF}
begin
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if doHourGlass in Options then
       Screen.Cursor := crSqlWait;
{$ENDIF}
    { Store record params }
//    RecordCount := Self.RecordCount;
    FormKeyValues(KeyFields, KeyValues);
    { Clear all collections }
    StoredProc.Close;
    SqlBuffer.ClearBuffer(False);
    CacheBuffer.ClearBuffer(False);

    { Exec the storedProc }
    ExecProc;

    { Set mail query params }
//    FRowsAffected := 0;
//    CurRec := -1;

    { Sort with old method }
    SqlBuffer.SortRestore;
    { Locate to old position }
    if KeyFields <> '' then
      Locate(KeyFields, KeyValues, []);
    { Resync records }
    if not (State in [dsInactive]) then Resync([]);
  finally
{$IFNDEF NO_GUI}
    if doHourGlass in Options then
      Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

procedure TZStoredProc.InternalSort(Fields: string; SortType: TSortType);
var
  Index: Integer;
{$IFNDEF NO_GUI}
  OldCursor: TCursor;
{$ENDIF}
begin
  { Get all records and check buffer }
  QueryRecords(True);
  if SqlBuffer.Count = 0 then Exit;
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if doHourGlass in Options then
      Screen.Cursor := crSqlWait;
{$ENDIF}
    { Save current position }
    if CurRec >= 0 then
      Index := SqlBuffer[CurRec].Index
    else
     Index := -1;
    { Sorting fields }
    if Fields <> '' then
      SqlBuffer.SetSort(Fields, SortType)
    else begin
      if SortType = stAscending then
        SqlBuffer.ClearSort
      else
        SqlBuffer.SortInverse;
    end;
    { Restore position }
    if Index >= 0 then
      CurRec := SqlBuffer.IndexOfIndex(Index);
    { Resync recordset }
    if not (State in [dsInactive]) then
      Resync([]);
  finally
{$IFNDEF NO_GUI}
    if doHourGlass in Options then
      Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

function TZStoredProc.IsCursorOpen: Boolean;
begin
  Result := StoredProc.Active or Active or (SqlBuffer.Count > 0);
end;

procedure TZStoredProc.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
end;

{procedure TZStoredProc.ParamsRequery;
var
  I, N: Integer;
  MasterField: TField;
begin
  if FMasterLink.Active or not FDataLink.Active then Exit;
  if not MasterStateCheck(FDataLink.Dataset) then Exit;

{ Changing parameter values
  N := 0;
  for I := 0 to ParamCount-1 do
  begin
    MasterField := FDataLink.Dataset.FieldByName(Params[I].Name);
    if Assigned(MasterField) then
    begin
      Params[I].Value := MasterField.AsVariant;
      Inc(N);
    end;
  end;

  if (N = 0) then Exit;
end;
}
procedure TZStoredProc.Prepare;
begin
  Prepared := True;
end;

procedure TZStoredProc.QueryParams;
var
  I: Integer;
begin
  if FParamBindMode = zpbByName then
  begin
    for I := 0 to FStoredProc.ParamCount-1 do
      Params.ParamByName(FStoredProc.ParamName(I)).AsString := FStoredProc.Param(I);
  end
  else
  begin
    for I := 0 to FStoredProc.ParamCount-1 do
      Params[I].AsString := FStoredProc.Param(I);
  end;
  I := 0;
  while (I < Params.Count) and (Params[I].ParamType <> ptResult) do
    Inc(I);
  if I < Params.Count then
      Params[I].AsString := FStoredProc.GetReturnValue;
end;

procedure TZStoredProc.QueryRecords(Force: Boolean);
{$IFNDEF NO_GUI}
var
  OldCursor: TCursor;
{$ENDIF}
begin
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if doHourGlass in Options then
      Screen.Cursor := crSqlWait;
{$ENDIF}
    { Check current fetch state }
    if not ((not FStoredProc.EOF) and ((doQueryAllRecords in Options)
      or (FStoredProc.RecNo < MIN_FETCH_ROWS) or Force
      or (DatabaseType = dtMsSql))) then Exit;
    { Invoke on progress event }
    DoProgress(psStarting, ppFetching, SqlBuffer.Count);
    { Query records }
    while (not FStoredProc.EOF) and ((doQueryAllRecords in Options)
      or (FStoredProc.RecNo < MIN_FETCH_ROWS) or Force) do
      QueryRecord;
    { Invoke on progress event }
    DoProgress(psEnding, ppFetching, SqlBuffer.Count);
  finally
{$IFNDEF NO_GUI}
    if doHourGlass in Options then
      Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

procedure TZStoredProc.SetDatabase(Value: TZDatabase);
begin
  if Active then Close;
  try
    if Assigned(FDatabase) then
      FDatabase.RemoveDataset(Self);
    if Assigned(Value) then
    begin
      FStoredProc.Connect := Value.Handle;
      Value.AddDataset(Self);
      if not Assigned(FTransact) then
        SetTransact(TZTransact(Value.DefaultTransaction));
    end else
      FStoredProc.Connect := nil;
  finally
    FDatabase := Value;
  end;
end;

procedure TZStoredProc.SetPrepared(const Value: Boolean);
begin
  if Value <> FPrepared then
  begin
    if Value then
      FStoredProc.Prepare(Params)
    else FStoredProc.Unprepare;
    FPrepared := Value;
  end;
end;

procedure TZStoredProc.SetRecNo(Value: Integer);
{$IFNDEF NO_GUI}
var
  OldCursor: TCursor;
{$ENDIF}
begin
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if doHourGlass in Options then
      Screen.Cursor := crSqlWait;
{$ENDIF}

    Value := Max(1, Value);

    { Invoke on progress event }
    DoProgress(psStarting, ppFetching, SqlBuffer.Count);
    { Fetch one record from server }
    while not StoredProc.EOF and (Value > SqlBuffer.Count) do
      QueryRecord;
    { Invoke on progress event }
    DoProgress(psEnding, ppFetching, SqlBuffer.Count);

    if Value <= SqlBuffer.Count then
      CurRec := Value - 1
    else
      CurRec := SqlBuffer.Count - 1;
    if not (State in [dsInactive]) then Resync([]);
  finally
{$IFNDEF NO_GUI}
    if doHourGlass in Options then
      Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

procedure TZStoredProc.SetStoredProcName(const Value: string);
begin
  if FStoredProcName <> Value then
  begin
    if Active then
      Close;
    FStoredProcName := Value;
    if csDesigning	in ComponentState then
      GetAllParams(FStoredProcName);
    FStoredProc.StoredProcName := Value;
  end;
end;

procedure TZStoredProc.SetTransact(Value: TZTransact);
begin
  if Active then Close;
  FTransact := Value;
  if Assigned(FTransact) then
    FStoredProc.Transact := Value.Handle
  else
    FStoredProc.Transact := nil;
end;

{procedure TZStoredProc.ShortRefresh;
var
  OldCursor: TCursor;
begin
  { Change cursor
  OldCursor := Screen.Cursor;
  try
    if doHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
    { Clear all collections
    StoredProc.Close;
    SqlBuffer.ClearBuffer(False);
    CacheBuffer.ClearBuffer(False);
    { Open the query
    StoredProc.ExecProc;
  finally
    { Recover cursor
    if doHourGlass in FOptions then
      Screen.Cursor := OldCursor;
  end;
end;
}
procedure TZStoredProc.UnPrepare;
begin
  Prepared := False;
end;

end.