zdirmssql.pas

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

    if dbResult = DBSUCCEED then
    begin
      SetActive(True);
      SetStatus(qsTuplesOk);
      SetBOF(False);
      SetEOF(False);
      Next;
      if Status <> qsTuplesOk then
        SetActive(False);
    end;

    MonitorList.InvokeEvent(StoredProcName, Error, not Active);
  end;
end;

function TDirMsSqlStoredProc.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;

function TDirMsSqlStoredProc.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;

function TDirMsSqlStoredProc.FieldCount: Integer;
begin
  Result := 0;
  if Active then
    Result := dbnumcols(TDirMsSqlTransact(Transact).Handle);
end;

function TDirMsSqlStoredProc.FieldDataType(FieldNum: Integer): TFieldType;
begin
  Result := MsSqlToDelphiType(FieldType(FieldNum));
end;

function TDirMsSqlStoredProc.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;

function TDirMsSqlStoredProc.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;

function TDirMsSqlStoredProc.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;

function TDirMsSqlStoredProc.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;

function TDirMsSqlStoredProc.FieldType(FieldNum: Integer): Integer;
begin
  Result := 0;
  if Active then
    Result := dbcoltype(TDirMsSqlTransact(Transact).Handle, FieldNum+1);
end;

function TDirMsSqlStoredProc.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;

procedure TDirMsSqlStoredProc.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;

procedure TDirMsSqlStoredProc.Open;
begin
  ExecProc;
end;

function TDirMsSqlStoredProc.Param(ParamNum: Integer): string;
var
  MsTransact: TDirMsSqlTransact;
  Length: LongInt;
  Ptr: PByte;
  ParType: Integer;
  tmpSqlDate: DBDATETIME;
  DateRec: DBDATEREC;
  TempDate: TDateTime;
  TempFloat: Double;
begin
  Result := '';
  if not Active then
    Exit;

  MsTransact := TDirMsSqlTransact(Transact);
  Length := dbretlen(MsTransact.Handle,ParamNum+1);
  if Length = -1 then
    Length := 0;
  Ptr := dbretdata(MsTransact.Handle,ParamNum+1);
  if Ptr = nil then
    Exit;
  ParType := dbrettype(MsTransact.Handle,ParamNum+1);
  case ParType 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,ParType,Ptr,Length,SQLDATETIME,
                  @tmpSqlDate, sizeof(DBDATETIME));
        dbdatecrack(MsTransact.Handle,@DateRec,@tmpSqlDate);
        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,ParType,Ptr,Length,SQLFLT8,@TempFloat,
                  sizeOf(TempFloat));
        Result := FloatToStr(TempFloat);
      end;
    else
      Result := MemPas(PChar(Ptr),Length);
  end;
end;

function TDirMsSqlStoredProc.ParamBuffer(ParamNum: Integer): PChar;
begin
  if not Transact.Active then
    Result := nil
  else
    Result := PChar(dbretdata(TDirMsSqlTransact(Transact).Handle, ParamNum+1));
end;

function TDirMsSqlStoredProc.ParamCount: Integer;
begin
  Result := 0;
  if Transact.Active then
    Result := dbnumrets(TDirMsSqlTransact(Transact).Handle);
end;

function TDirMsSqlStoredProc.ParamDataType(ParamNum: Integer): TFieldType;
begin
  Result := MsSqlToDelphiType(ParamType(ParamNum));
end;

function TDirMsSqlStoredProc.ParamIsNull(ParamNum: Integer): Boolean;
begin
  if not Transact.Active then
    Result := True
  else
    Result := (dbretdata(TDirMsSqlTransact(Transact).Handle, ParamNum+1) = nil);
end;

function TDirMsSqlStoredProc.ParamMaxSize(ParamNum: Integer): Integer;
begin
  Result := 0;
  if Transact.Active then
  begin
    Result := dbretlen(TDirMsSqlTransact(Transact).Handle, ParamNum+1);
    if Result = -1 then Result := 0;
  end;
end;

function TDirMsSqlStoredProc.ParamName(ParamNum: Integer): ShortString;
var
  Temp: PChar;
begin
  Result := '';
  if Transact.Active then
  begin
    Temp := dbretname(TDirMsSqlTransact(Transact).Handle, ParamNum+1);
    if (Temp <> nil) and (Temp^ <> #0) then
      Result := StrPas(Temp)
    else
      Result := 'Field' + IntToStr(ParamNum+1);
  end;
end;

function TDirMsSqlStoredProc.ParamSize(ParamNum: Integer): Integer;
begin
  Result := 0;
  if Transact.Active then
  begin
    Result := dbretlen(TDirMsSqlTransact(Transact).Handle, ParamNum+1);
    if Result = -1 then Result := 0;
  end;
end;

function TDirMsSqlStoredProc.ParamType(ParamNum: Integer): Integer;
begin
  Result := 0;
  if Transact.Active then
    Result := dbrettype(TDirMsSqlTransact(Transact).Handle, ParamNum+1);
end;

procedure TDirMsSqlStoredProc.Prepare(Params: TParams);
var
  I: Integer;
begin
  if not Prepared then
  begin
    dbrpcinit(TDirMsSqlTransact(Transact).Handle,PChar(StoredProcName),0);
    for I := 0 to Params.Count-1 do
//      if (Params[I].ParamType=ptInput) or (Params[I].ParamType=ptInputOutput) then
      BindParam(Params[i]);
    Prepared := true;
  end;
end;

function TDirMsSqlStoredProc.RecordCount: Integer;
begin
  if not Active then
    Result := 0
  else
    Result := dbcount(TDirMsSqlTransact(Transact).Handle);
end;

procedure TDirMsSqlStoredProc.ShowParams(StoredProcedureName: ShortString);
var
  tmpString: String;
  tmpprocname: string;
  Ptr: PByte;
begin
  if Active then
    Close;

//  StoredprocName := 'sp_sproc_columns';
  tmpprocname := 'sp_sproc_columns';
  dbrpcinit(TDirMsSqlTransact(Transact).Handle,PChar(tmpprocname),0);
    if dbresults(TDirMsSqlTransact(Transact).Handle)<>SUCCEED then
      raise Exception.Create('no succes init');

  if StoredProcedureName<>'' then
  begin
//    if StoredProcedureName[Length(StoredProcedureName)] = '.' then
//    raise Exception.Create(storedprocedurename[Length(StoredProcedureName)]);
    tmpString := Copy(StoredProcedureName,1,pos(';',StoredProcedureName)-1);
    Ptr := PByte(PChar(tmpString));
    dbrpcparam(TDirMsSqlTransact(Transact).Handle,PChar('@procedure_name'),0,
               SQLVARCHAR,-1,Length(tmpString)*sizeof(Char),Ptr);
    if dbresults(TDirMsSqlTransact(Transact).Handle)<>SUCCEED then
      raise Exception.Create('no succes');
  end
  else
    raise exception.Create('no spName');
  Prepared := true;
  ExecProc;
end;

procedure TDirMsSqlStoredProc.ShowStoredProcs;
begin
  if Active then
    Close;

  StoredProcName := 'sp_stored_procedures';
  dbrpcinit(TDirMsSqlTransact(Transact).Handle,PChar(StoredProcName),0);
  Prepared := true;
  ExecProc;
end;

function TDirMsSqlStoredProc.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;

procedure TDirMsSqlStoredProc.UnPrepare;
begin
  inherited Unprepare;
  dbcancel(TDirMsSqlTransact(Transact).Handle);
end;

function DelphiToMsSqlType(const DelphiType: TFieldType): Integer;
begin
  case DelphiType of
    ftUnknown: Result := -1;
    ftString: Result := SQLVARCHAR;
    ftSmallInt: Result := SQLINT2;
    ftInteger: Result := SQLINT4;
    ftWord: Result := SQLINT2;
    ftBoolean: Result := SQLBIT;
    ftFloat: Result := SQLFLT8;
    ftCurrency: Result := SQLMONEY;
    ftDate: Result := SQLDATETIME;
    ftTime: Result := SQLDATETIME;
    ftDateTime: Result := SQLDATETIME;
    ftBytes: Result := SQLBINARY;
    ftVarBytes: Result := SQLVARBINARY;
    ftBlob: Result := SQLIMAGE;
    ftMemo: Result := SQLTEXT;
    ftGraphic: Result := SQLIMAGE;
    ftFmtMemo: Result := SQLIMAGE;
//    ftFixedChar: Result := SQLCHAR;
//    ftWideString: Result := SQLVARCHAR;
//    ftLargeInt: Result := SQLINT4;
  else
    Result := -1;
  end;
end;

function TDirMsSqlStoredProc.GetReturnValue: String;
begin
  if Transact.Active and dbhasretstat(TDirMsSqlTransact(Transact).Handle) then
    Result := IntToStr(dbretstatus(TDirMsSqlTransact(Transact).Handle));
end;

function MsSqlToDelphiParamType(Value: Integer): TParamType;
begin
  case Value of
    SQL_PARAM_TYPE_UNKNOWN: Result := ptUnknown;
    SQL_PARAM_TYPE_INPUT: Result := ptInput;
    SQL_PARAM_TYPE_OUTPUT: Result := ptInputOutput;
    SQL_RESULT_COL: Result := ptUnknown;
    SQL_PARAM_OUTPUT: Result := ptUnknown;
    SQL_RETURN_VALUE: Result := ptResult;
  else
    Result := ptUnknown;
  end;
end;

{*************** Extra functions implementation ****************}

{ Convert MS SQL field type to delphi field type }
function MsSqlToDelphiType(Value: Integer): TFieldType;
begin
  case Value of
    SQLINT1, SQLINT2:
      Result := ftSmallInt;
    SQLINT4:
      Result := ftInteger;
    SQLFLT4, SQLFLT8, SQLFLTN:
      Result := ftFloat;
    SQLDECIMAL, SQLNUMERIC:
      Result := ftFloat;
    SQLMONEY, SQLMONEYN:
      Result := ftCurrency;
    SQLBINARY, SQLVARBINARY:
      Result := ftBytes;
    SQLDATETIME:
      Result := ftDateTime;
    SQLBIT:
      Result := ftBoolean;
    SQLTEXT:
      Result := ftMemo;
    SQLIMAGE:
      Result := ftBlob;
    else
      Result := ftString;
  end;
end;

{ Convert MS SQL field types description to delphi field types }
function MsSqlToDelphiTypeDesc(Value: string): TFieldType;
begin
  Value := LowerCase(Value);
  if Value = 'int' then
    Result := ftInteger
  else if (Value = 'char') or (Value = 'varchar') then
    Result := ftString
  else if (Value = 'nchar') or (Value = 'nvarchar') then
    Result := ftString
  else if (Value = 'varbinary') or (Value = 'binary')
    or (Value = 'timestamp') then
    Result := ftBytes
  else if (Value = 'float') or (Value = 'real') then
    Result := ftFloat
  else if (Value = 'decimal') or (Value = 'numeric') then
    Result := ftFloat
  else if (Value = 'datetime') or (Value = 'smalldatetime') then
    Result := ftDateTime
  else if (Value = 'money') or (Value = 'smallmoney') then
    Result := ftCurrency
  else if (Value = 'tinyint') or (Value = 'smallint') then
    Result := ftSmallInt
  else if Value = 'text' then
    Result := ftMemo
  else if Value = 'image' then
    Result := ftBlob
  else if Value = 'bit' then
    Result := ftBoolean
  else
    Result := ftUnknown;
end;

initialization
  MonitorList := TZMonitorList.Create;
finalization
  MonitorList.Free;
end.