zdirsql.pas

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

end;

{ Set begin of rows property }
procedure TDirQuery.SetBof(Value: Boolean);
begin
  FBof := Value;
end;

{ Is end of rows }
function TDirQuery.GetEof: Boolean;
begin
  Result := FEof;
end;

{ Set end of rows property }
procedure TDirQuery.SetEof(Value: Boolean);
begin
  FEof := Value;
end;

{ Set current row number }
procedure TDirQuery.SetRecNo(Value: Integer);
begin
  FRecNo := Value;
end;

{ Set query status }
procedure TDirQuery.SetStatus(Value: TDirQueryStatus);
begin
  FStatus := Value;
end;

{ Get an error message }
function TDirQuery.GetErrorMsg: ShortString;
begin
  Result := '';
  if not (FStatus in [qsTuplesOk, qsCommandOk]) and Assigned(Transact) then
    Result := Transact.Error;
end;

{ Execute a query without rows returning }
function TDirQuery.Execute: LongInt;
begin
  if Active then Close;
  SetStatus(qsNotImplemented);
  FAffectedRows := 0;
  Result := 0;
end;

{ Execute a query with parameters }
function TDirQuery.ExecuteParams(Params: TVarRecArray;
  ParamCount: Integer): LongInt;
begin
  Result := Execute;
end;

{ Open a query }
procedure TDirQuery.Open;
begin
  if Active then Close;
  FAffectedRows := 0;
  SetStatus(qsNotImplemented);
end;

{ Close an open query }
procedure TDirQuery.Close;
begin
  FLocFields.Clear;
  FLocValues.Clear;
  FActive := False;
  FAffectedRows := 0;
  FBof := True;
  FEof := True;
  FRecNo := 0;
  SetStatus(qsNotImplemented);
end;

{ Create connected bob stream }
function TDirQuery.CreateBlobObject: TDirBlob;
begin
  Result := nil;
end;

{ Go to the first row }
procedure TDirQuery.First;
begin
  FRecno := 0;
  FBof := (RecordCount <= 0);
  FEof := FBof;
end;

{ Go to the last row }
procedure TDirQuery.Last;
begin
  FRecno := IIF(RecordCount>0, RecordCount-1, 0);
  FBof := (RecordCount <= 0);
  FEof := FBof;
end;

{ Go to prior row }
procedure TDirQuery.Prev;
begin
  FEof := False;
  if FRecno > 0 then
  begin
    Dec(FRecno);
    FBof := False;
  end else
    FBof := True;
  if RecordCount <= 0 then
  begin
    FBof := True;
    FEof := True;
  end;
end;

{ Go to next row }
procedure TDirQuery.Next;
begin
  FBof := False;
  if FRecno < (RecordCount-1) then
  begin
    Inc(FRecno);
    FEof := False;
  end else
    FEof := True;
  if RecordCount <= 0 then
  begin
    FBof := True;
    FEof := True;
  end;
end;

{ Go to Num row }
procedure TDirQuery.Go(Num: Integer);
begin
  FRecno := IIF(Num < (RecordCount-1), Num, RecordCount-1);
  FRecno := IIF(FRecno < 0, 0, FRecno);
  FBof   := (FRecno < 0);
  FEof   := (FRecno >= RecordCount);
end;

{ Get field quantity in a query }
function TDirQuery.FieldCount: Integer;
begin
  Result := 0;
end;

{ Get a record quantity in a query }
function TDirQuery.RecordCount: Integer;
begin
  Result := 0;
end;

{ Get a field name by it number }
function TDirQuery.FieldName(FieldNum: Integer): ShortString;
begin
  Result := '';
end;

{ Get field alias }
function TDirQuery.FieldAlias(FieldNum: Integer): ShortString;
var
  I, P:  Integer;
begin
  Result := FieldName(FieldNum);
  P := 0;
  for I := 0 to FieldNum-1 do
  begin
    if FieldName(I) = Result then
      Inc(P);
  end;
  if P <> 0 then
    Result := Result + '_' + IntToStr(P);
end;

{ Get field number by it name }
function TDirQuery.FieldIndex(FieldName: ShortString): Integer;
var
  I, P: Integer;
  Name, Num: string;
begin
  Result := -1;
  if FieldCount = 0 then Exit;
  
  for I := 0 to FieldCount-1 do
    if CompareText(FieldName, Self.FieldName(I)) = 0 then
    begin
      Result := I;
      Break;
    end;

  if Result <> -1 then Exit;

  Name := '';
  Num  := '';
  P := LastDelimiter('_', FieldName);
  if P > 0 then
  begin
    Name := Copy(FieldName, 1, P-1);
    Num  := Copy(FieldName, P+1, 10);
  end else
    Exit;

  P := StrToIntDef(Num, 0) + 1;
  if P <= 1 then Exit;

  for I := 0 to FieldCount-1 do
  begin
    if CompareText(Name, Self.FieldName(I)) = 0 then Dec(P);
    if P = 0 then
    begin
      Result := I;
      Exit;
    end;
  end;
end;

{ Get a field size }
function TDirQuery.FieldSize(FieldNum: Integer): Integer;
begin
  Result := 0;
end;

{ Get a maximum field size }
function TDirQuery.FieldMaxSize(FieldNum: Integer): Integer;
begin
  Result := 0;
end;

{ Get field decimals }
function TDirQuery.FieldDecimals(FieldNum: Integer): Integer;
begin
  Result := 0;
end;

{ Get a field value by it number }
function TDirQuery.Field(FieldNum: Integer): string;
begin
  Result := '';
end;

{ Get a field value by it name }
function TDirQuery.FieldByName(FieldName: ShortString): string;
begin
  Result := Field(FieldIndex(FieldName));
end;

{ Check if field is null }
function TDirQuery.FieldIsNull(FieldNum: Integer): Boolean;
begin
  Result := True;
end;

{ Check if field is ReadOnly }
function TDirQuery.FieldReadOnly(FieldNum: Integer): boolean;
begin
  Result := False;
end;

{ Get field buffer }
function TDirQuery.FieldBuffer(FieldNum: Integer): PChar;
begin
  Result := nil;
end;

{ Get field type }
function TDirQuery.FieldType(FieldNum: Integer): Integer;
begin
  Result := 0;
end;

{ Get field delphi compatible type }
function TDirQuery.FieldDataType(FieldNum: Integer): TFieldType;
begin
  Result := ftUnknown;
end;

{ Find a first row equal to params }
{ Params - params string as "field=value..." }
function TDirQuery.Locate(Params: string): Boolean;
var
  I, N: Integer;
begin
  Result := False;
  SplitParams(Params, FLocFields, FLocValues);
  if FLocValues.Count = 0 then Exit;

  for I := FLocValues.Count-1 downto 0 do
  begin
    if IsDigit(FLocFields[I][1]) then
      N := StrToIntDef(FLocFields[I], -1)
    else
      N := FieldIndex(FLocFields[I]);
    if (N < 0) or (N >= FieldCount) then
    begin
      FLocFields.Delete(I);
      FLocValues.Delete(I);
    end else
      FLocFields.Objects[I] := TObject(N);
  end;

  First;
  while not Eof do
  begin
    Result := True;
    for I := 0 to FLocValues.Count-1 do
      if Field(Integer(FLocFields.Objects[I])) <> FLocValues[I] then
      begin
        Result := False;
        Break;
      end;
    if Result then Break;
    Next;
  end;
end;

{ Find a next by locate row }
function TDirQuery.FindNext: Boolean;
var
  I: Integer;
begin
  Result := False;
  if FLocValues.Count = 0 then Exit;

  Next;
  while not Eof do
  begin
    Result := True;
    for I := 0 to FLocValues.Count-1 do
      if Field(Integer(FLocValues.Objects[I])) <> FLocValues[I] then
        Result := False;
    if Result then Break;
    Next;
  end;
end;

{ Showes all databases }
procedure TDirQuery.ShowDatabases(DatabaseName: ShortString);
begin
  if Active then Close;
  SetStatus(qsNotImplemented);
end;

{ Showes tables of the database }
procedure TDirQuery.ShowTables(TableName: ShortString);
begin
  if Active then Close;
  SetStatus(qsNotImplemented);
end;

{ Showes columns of the table }
procedure TDirQuery.ShowColumns(TableName, ColumnName: ShortString);
begin
  if Active then Close;
  SetStatus(qsNotImplemented);
end;

{ Showes indexes of the table }
procedure TDirQuery.ShowIndexes(TableName: ShortString);
begin
  if Active then Close;
  SetStatus(qsNotImplemented);
end;

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

{***************** TDirBlob implementation ****************}

{ Class constructor }
constructor TDirBlob.Create(AConnect: TDirConnect; ATransact: TDirTransact;
  AHandle: TBlobHandle);
begin
  FConnect := AConnect;
  FTransact := ATransact;
  FHandle := AHandle;
end;

{ Class destructor }
destructor TDirBlob.Destroy;
begin
  if Active then Close;
  inherited Destroy;
end;

{ Set blob active status }
procedure TDirBlob.SetActive(Value: Boolean);
begin
  FActive := Value;
end;

{ Set blob status }
procedure TDirBlob.SetStatus(Value: TDirBlobStatus);
begin
  FStatus := Value;
end;

{ Set blob handle }
procedure TDirBlob.SetHandle(Value: TBlobHandle);
begin
  FHandle := Value;
end;

{ Get error message }
function TDirBlob.GetErrorMsg: ShortString;
begin
  Result := '';
  if (Status <> bsOk) and Assigned(Transact) then
    Result := Transact.Error;
end;

{ Get current blob position }
function TDirBlob.GetPosition: LongInt;
begin
  Result := 0;
end;

{ Open new blob for any mode }
procedure TDirBlob.Open(Mode: Integer);
begin
  FStatus := bsNotImplemented;
end;

{ Close open blob }
procedure TDirBlob.Close;
begin
  FActive := False;
  FStatus := bsNotImplemented;
end;

{ Create new blob }
procedure TDirBlob.CreateBlob;
begin
  FStatus := bsNotImplemented;
end;

{ Delete open blob }
procedure TDirBlob.DropBlob;
begin
  FStatus := bsNotImplemented;
  FActive := False;
end;

{ Read blob segment }
function TDirBlob.Read(Buffer: PChar; Length: Integer): Integer;
begin
  Result := 0;
end;

{ Write blob segment }
function TDirBlob.Write(Buffer: PChar; Length: Integer): Integer;
begin
  Result := 0;
end;

{ Seek new blob position }
procedure TDirBlob.Seek(Offset: Integer; Origin: Integer);
begin
  FStatus := bsNotImplemented;
end;

{ Export blob to file }
procedure TDirBlob.ExportFile(FileName: ShortString);
begin
  FStatus := bsNotImplemented;
end;

{ Import blob from file }
procedure TDirBlob.ImportFile(FileName: ShortString);
begin
  FStatus := bsNotImplemented;
end;

{ Get blob as string value }
function TDirBlob.GetValue: string;
var
  Buffer: array[0..512] of Char;
  N: Integer;
begin
  Result := '';
  Open(fmOpenRead);
  if Status = bsOk then
    repeat
      N := Read(Buffer, 512);
      Result := Result + Copy(Buffer, 1, N);
    until N = 0;
end;

{ Set blob as string value }
procedure TDirBlob.SetValue(Value: string);
begin
  DropBlob;
  CreateBlob;
  Write(PChar(Value), Length(Value));
end;

{***************** TDirNotify implementation ****************}

{ Set instance status }
procedure TDirNotify.SetStatus(Value: TDirNotifyStatus);
begin
  FStatus := Value;
end;

{ Set notify active state }
procedure TDirNotify.SetActive(Value: Boolean);
begin
  FActive := Value;
end;

{ Get an internal error }
function TDirNotify.GetErrorMsg: ShortString;
begin
  Result := '';
  if Status <> nsOk then
  begin
    if Assigned(Transact) then
      Result := Transact.Error
    else Result := 'Transact object isn''t defined';
  end;
end;