zdirmssql.pas

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

begin
  { Check status }
  SetStatus(csFail);
  if not Active or not Assigned(FHandle) then Exit;
  SetStatus(csOk);
  if TransactSafe then
  begin
    { Rollback execute }
    dbcmd(FHandle, 'ROLLBACK');
    dbsqlexec(FHandle);
    if dbresults(FHandle) <> DBSUCCEED then
      SetStatus(csFail);
    MonitorList.InvokeEvent('ROLLBACK', Error, Error <> '');
    dbcancel(FHandle);
    { Start new trasaction }
    dbcmd(FHandle, 'BEGIN TRANSACTION');
    dbsqlexec(FHandle);
    if dbresults(FHandle) <> DBSUCCEED then
      SetStatus(csFail);
    MonitorList.InvokeEvent('BEGIN TRANSACTION', Error, Error <> '');
    dbcancel(FHandle);
  end;
end;

{******************* TDirMsSqlQuery implementation **********************}

{ Class constructor }
constructor TDirMsSqlQuery.Create(AConnect: TDirMsSqlConnect;
  ATransact: TDirMsSqlTransact);
begin
  inherited Create;
  Connect := AConnect;
  Transact := ATransact;
end;

{ Get an error message }
function TDirMsSqlQuery.GetErrorMsg: ShortString;
begin
  if Transact = nil then
    Result := 'Transaction object not defined'
  else if not Transact.Active then
    Result := 'Connection closed'
  else if not (Status in [qsTuplesOk, qsCommandOk]) then
  begin
    Result := dbsqlerror;
    if StrCmpBegin(Result, 'General SQL Server error') then
      Result := dbmessage;
  end else
    Result := '';
end;

{ Close open query }
procedure TDirMsSqlQuery.Close;
begin
  if Active and Assigned(Transact) then
    dbcancel(TDirMsSqlTransact(Transact).Handle);
  inherited Close;
  SetActive(False);
  SetStatus(qsCommandOk);
end;

{ Execute the query }
function TDirMsSqlQuery.Execute: LongInt;
var
  MsTransact: TDirMsSqlTransact;
begin
  Result := inherited Execute;
  SetStatus(qsFail);
  if not Assigned(Connect) or not Assigned(Transact)
    or not (Connect.Active and Transact.Active) then
    Exit;

  MsTransact := TDirMsSqlTransact(Transact);
  dbcmd(MsTransact.Handle, PChar(Trim(Sql)));
  dbsqlexec(MsTransact.Handle);
  if dbresults(MsTransact.Handle) = DBSUCCEED then
  begin
    SetAffectedRows(dbcount(MsTransact.Handle));
    Result := AffectedRows;
    SetStatus(qsCommandOk);
  end;
  MonitorList.InvokeEvent(Sql, Error, Error <> '');
  dbcancel(MsTransact.Handle);
end;

{ Open the query with result set }
procedure TDirMsSqlQuery.Open;
var
  MsTransact: TDirMsSqlTransact;
  Result: Integer;
begin
  inherited Open;
  SetStatus(qsFail);
  if not Assigned(Connect) or not Assigned(Transact)
    or not (Connect.Active and Transact.Active) then
    Exit;

  MsTransact := TDirMsSqlTransact(Transact);
  dbcmd(MsTransact.Handle, PChar(Trim(Sql)));
  dbsqlexec(MsTransact.Handle);

  Result := dbresults(MsTransact.Handle);
  while dbresults(MsTransact.Handle) = DBSUCCEED do;

  if Result = DBSUCCEED then
  begin
    SetActive(True);
    SetStatus(qsTuplesOk);
    SetBOF(False);
    SetEOF(False);
    Next;
    if Status <> qsTuplesOk then
      SetActive(False);
  end;
  MonitorList.InvokeEvent(Sql, Error, not Active);
end;

{ Go to next row }
procedure TDirMsSqlQuery.Next;
var
  FetchStat: Integer;
begin
  if not Active or EOF then Exit;
  SetStatus(qsFail);
  if not Assigned(Connect) or not Assigned(Transact) then
    Exit;

  FetchStat := dbnextrow(TDirMsSqlTransact(Transact).Handle);
  if FetchStat <> DBFAIL then
  begin
    SetStatus(qsTuplesOk);
    SetEOF(FetchStat = NO_MORE_ROWS);
    if FetchStat <> NO_MORE_ROWS then
      SetRecNo(RecNo+1);
  end else
    SetEOF(True);
end;

{ Get record quantity }
function TDirMsSqlQuery.RecordCount: Integer;
begin
  if not Active then Result := 0
  else Result := dbcount(TDirMsSqlTransact(Transact).Handle);
end;

{ Get fields quantity }
function TDirMsSqlQuery.FieldCount: Integer;
begin
  Result := 0;
  if Active then
    Result := dbnumcols(TDirMsSqlTransact(Transact).Handle);
end;

{ Get field name }
function TDirMsSqlQuery.FieldName(FieldNum: Integer): ShortString;
var
  Temp: PChar;
begin
  Result := '';
  if Active then
  begin
    Temp := dbcolname(TDirMsSqlTransact(Transact).Handle, FieldNum+1);
    if (Temp <> nil) and (Temp^ <> #0) then
      Result := StrPas(Temp)
    else
      Result := 'Field' + IntToStr(FieldNum+1);
  end;
end;

{ Get field size }
function TDirMsSqlQuery.FieldSize(FieldNum: Integer): Integer;
begin
  Result := 0;
  if Active then
  begin
    Result := dbdatlen(TDirMsSqlTransact(Transact).Handle, FieldNum+1);
    if Result = -1 then Result := 0;
  end;
end;

{ Get maximum field size }
function TDirMsSqlQuery.FieldMaxSize(FieldNum: Integer): Integer;
begin
  Result := 0;
  if Active then
  begin
    Result := dbcollen(TDirMsSqlTransact(Transact).Handle, FieldNum+1);
    if Result = -1 then Result := 0;
  end;
end;

{ Get field type }
function TDirMsSqlQuery.FieldType(FieldNum: Integer): Integer;
begin
  Result := 0;
  if Active then
    Result := dbcoltype(TDirMsSqlTransact(Transact).Handle, FieldNum+1);
end;

{ Define field type }
function TDirMsSqlQuery.FieldDataType(FieldNum: Integer): TFieldType;
begin
  Result := MsSqlToDelphiType(FieldType(FieldNum));
end;

{ Get field value }
function TDirMsSqlQuery.Field(FieldNum: Integer): string;
var
  Length: LongInt;
  MsTransact: TDirMsSqlTransact;
  Ptr: PByte;
  ColType: Integer;
  DateRec: DBDATEREC;
  TempDate: TDateTime;
  TempSqlDate: DBDATETIME;
  TempFloat: Double;
begin
  Result := '';
  if not Active or Eof or Bof then Exit;

  MsTransact := TDirMsSqlTransact(Transact);
  Length := dbdatlen(MsTransact.Handle, FieldNum+1);
  if Length = -1 then Length := 0;
  Ptr := dbdata(MsTransact.Handle, FieldNum+1);
  if Ptr = nil then Exit;
  ColType := dbcoltype(MsTransact.Handle, FieldNum+1);
  case ColType of
    SQLINT1: Result := IntToStr(PByte(Ptr)^);
    SQLINT2: Result := IntToStr(PSmallInt(Ptr)^);
    SQLINT4: Result := IntToStr(PInteger(Ptr)^);
    SQLVARCHAR, SQLCHAR, SQLVARBINARY, SQLBINARY:
      Result := MemPas(PChar(Ptr), Length);
    SQLBIT:
      if PByte(Ptr)^ <> 0 then Result := '1'
      else Result := '0';
    SQLFLT4: Result := FloatToStr(PSingle(Ptr)^);
    SQLFLT8: Result := FloatToStr(PDouble(Ptr)^);
    SQLDATETIME, SQLDATETIM4:
      begin
        dbconvert(MsTransact.Handle, ColType, Ptr, Length, SQLDATETIME,
          @TempSqlDate, SizeOf(DBDATETIME));
        dbdatecrack(MsTransact.Handle, @DateRec, @TempSqlDate);
        TempDate := EncodeDate(DateRec.year, DateRec.month, DateRec.day);
        TempDate := TempDate + EncodeTime(DateRec.hour, DateRec.minute,
        DateRec.second, DateRec.millisecond);
        Result := DateTimeToSqlDate(TempDate);
      end;
    SQLMONEY, SQLMONEY4:
      begin
        dbconvert(MsTransact.Handle, ColType, Ptr, Length, SQLFLT8,
          @TempFloat, SizeOf(TempFloat));
        Result := FloatToStr(TempFloat);
      end;
    else
      Result := MemPas(PChar(Ptr), Length);
  end;
end;

{ Get field buffer }
function TDirMsSqlQuery.FieldBuffer(FieldNum: Integer): PChar;
begin
  if not Active or Eof or Bof then
    Result := nil
  else
    Result := PChar(dbdata(TDirMsSqlTransact(Transact).Handle, FieldNum+1));
end;

{ Is field null }
function TDirMsSqlQuery.FieldIsNull(FieldNum: Integer): Boolean;
begin
  if not Active or Eof or Bof then
    Result := True
  else
    Result := (dbdata(TDirMsSqlTransact(Transact).Handle, FieldNum+1) = nil);
end;

{ Showes databases }
procedure TDirMsSqlQuery.ShowDatabases(DatabaseName: ShortString);
begin
  if Active then Close;
  Sql := 'SELECT name FROM master..sysdatabases';
  if DatabaseName <> '' then
    Sql := Sql + ' WHERE name LIKE '''+DatabaseName+'''';
  Sql := Sql + ' ORDER BY name';
  Open;
end;

{ Showes tables of the database }
procedure TDirMsSqlQuery.ShowTables(TableName: ShortString);
begin
  if Active then Close;
  Sql := 'select name from sysobjects where type=''U''';
  if TableName <> '' then
    Sql := Sql + ' and name like '''+TableName+'''';
  Sql := Sql + ' order by name';
  Open;
end;

{ Showes columns of the table }
procedure TDirMsSqlQuery.ShowColumns(TableName, ColumnName: ShortString);
begin
  if Active then Close;
  Sql := 'EXEC sp_mshelpcolumns '''+TableName+'''';
  Open;
end;

{ Showes indexes of the table }
procedure TDirMsSqlQuery.ShowIndexes(TableName: ShortString);
begin
  if Active then Close;
  Sql := 'EXEC sp_helpindex '''+TableName+'''';
  Open;
end;

{ Convert string to sql format }
function TDirMsSqlQuery.StringToSql(Value: string): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(Value) do
  begin
    Result := Result + Value[I];
    if Value[I] = '''' then
      Result := Result + Value[I];
  end;
end;

{ TDirMsSqlStoredProc }

procedure TDirMsSqlStoredProc.BindParam(Param: TParam);
var
  BindKind: Byte;
  MaxLen: LongInt;
  DataLen: LongInt;
  Ptr: PByte;
  tp: Integer;

  // temporary variables to pass a parameter to db-lib
  tmpInteger: Integer;
  tmpString: string;
  tmpBoolean: Boolean;
  tmpSmallInt: SmallInt;
  tmpWord: Word;
  tmpCurrency: Currency;
  tmpDouble: Double;
begin
  if Param.ParamType = ptUnknown then
    raise Exception.Create('Param '+Param.Name+' is of unknown type')
  else
  begin
    tp := DelphiToMsSqlType(Param.DataType);
    if Param.ParamType = ptInput then
    begin
      BindKind := 0;//DBRPCDEFAULT;
      MaxLen := -1;
      case Param.DataType of
        ftInteger, ftSmallint, ftWord, ftBoolean, ftFloat, ftCurrency, ftDateTime,
        ftDate, ftTime {$IFNDEF VER100}, ftLargeInt{$ENDIF}:
          DataLen := -1;
      else
        DataLen := Length(Param.asString)*SizeOf(Char);
      end;
    end
    else
    begin
      BindKind := DBRPCRETURN;
      case Param.DataType of
      ftInteger, ftSmallint, ftWord, ftBoolean, ftFloat, ftCurrency,
      ftDateTime, ftDate, ftTime {$IFNDEF VER100}, ftLargeInt {$ENDIF}:
          begin
             MaxLen := -1;
             if Param.Isnull then
               DataLen := 0
             else
               DataLen := -1;
          end;
      else
        begin
          if Param.Isnull then
          begin
            MaxLen := 0;
            DataLen := 0;
          end
          else
          begin
            //MaxLen := High(string);
            MaxLen := 2147483647;
            DataLen := Length(Param.asString)*SizeOf(Char);
          end;
        end;
      end;
    end;

    // Getting a pointer to a variable containing the value of the parameter
    case Param.DataType of
      ftInteger {$IFNDEF VER100}, ftLargeInt{$ENDIF}:
        begin
          tmpInteger := Param.AsInteger;
          Ptr := PByte(@tmpInteger);
        end;
      ftString:
        begin
          tmpString := Param.AsString;
          Ptr := PByte(PChar(tmpString));
        end;
      ftBoolean:
        begin
          tmpBoolean := Param.asBoolean;
          Ptr := PByte(@tmpBoolean);
        end;
      ftBlob, ftGraphic, ftFmtMemo:
        begin
          tmpString := Param.AsBlob;
          Ptr := PByte(PChar(tmpString));
        end;
      ftCurrency:
        begin
          tmpCurrency := Param.AsCurrency;
          Ptr := PByte(@tmpCurrency);
        end;
      ftDate:
        begin
          tmpDouble := Param.asDate;
          Ptr := PByte(@tmpDouble);
        end;
      ftDateTime:
        begin
          tmpDouble := Param.asDateTime;
          Ptr := PByte(@tmpDouble);
        end;
      ftTime:
        begin
          tmpDouble := Param.asTime;
          Ptr := PByte(@tmpDouble);
        end;
      ftFloat:
        begin
          tmpDouble := Param.asFloat;
          Ptr := PByte(@tmpDouble);
        end;
      ftSmallInt:
        begin
          tmpSmallInt := Param.AsSmallInt;
          Ptr := PByte(@tmpSmallInt);
        end;
      ftWord:
        begin
          tmpWord := Param.asWord;
          Ptr := PByte(@tmpWord);
        end;
      ftMemo:
        begin
          tmpString := Param.AsString;
          Ptr := PByte(PChar(tmpString));
        end
    else
      begin
        tmpString := Param.AsString;
        Ptr := PByte(PChar(tmpString));
      end;
    end;

    // add the parameter
    dbrpcparam(TDirMsSqlTransact(Transact).Handle, PChar(Param.Name), BindKind,
      tp, MaxLen, DataLen, Ptr);
  end;
end;

procedure TDirMsSqlStoredProc.Close;
begin
  if Active and Assigned(Transact) then
    dbcancel(TDirMsSqlTransact(Transact).Handle);

  inherited Close;
  SetActive(False);
  SetStatus(qsCommandOk);
end;

constructor TDirMsSqlStoredProc.Create(AConnect: TDirMsSqlConnect;
  ATransact: TDirMsSqlTransact);
begin
  inherited Create;
  Connect := AConnect;
  Transact := ATransact;
end;

procedure TDirMsSqlStoredProc.ExecProc;
var
  MsTransact: TDirMsSqlTransact;
  dbResult: Integer;
begin
  if Prepared then
  begin
    inherited ExecProc;
    SetStatus(qsFail);
    if not Assigned(Connect) or not Assigned(Transact)
      or not (Connect.Active and Transact.Active) then
        Exit;

    MsTransact := TDirMsSqlTransact(Transact);
    dbrpcexec(MsTransact.Handle);

    dbResult := dbresults(MsTransact.Handle);

    while dbresults(MsTransact.Handle) = DBSUCCEED do;