dbf.pas

OICQ黑客工具。可以查看对方IP地址

  Inc (FRecordCount);
end;

// ____________________________________________________________________________
// TDBF.InternalDelete
// III: Delete the current record
procedure TDBF.InternalDelete;
begin
  CheckActive;
  // not supported in this version
{  raise eBinaryDataSetError.Create (
    'Delete: Operation not supported');}
//  pRecordHeader(ActiveBuffer)^.DeletedFlag := fDataFileHeader.LastDeleted;
  PChar(ActiveBuffer)^ := '*';
  _WriteRecord(ActiveBuffer,fCurrentRecord);
  {FStream.Position := FDataFileHeader.StartData + (FRecordSize * FCurrentRecord);
  FStream.WriteBuffer (ActiveBuffer^, FRecordSize);}
//  fDBFHeader.LastDeleted := GetRecNo;
//  Inc(fDeletedCount);
//  Dec(fRecordCount);
//  fDBFHeader.NumberOfRecords := fRecordCount;
//  WriteHeader;
  Resync([]);
end;

// ____________________________________________________________________________
// TDBF.GetFieldData
// III: Move data from record buffer to field
function TDBF.GetFieldData(Field:TField; Buffer:Pointer):Boolean;
var
  FieldOffset: Integer;
  S : string;
  Buf2 : PChar;
  i,l : integer;
  D : Double;
  n : integer;
  T : TDateTime;
  j : integer;
  OldDateFormat : string;
begin
  Result := False;
  Buf2 := ActiveBuffer;
  if (FRecordCount>0) and (Field.FieldNo > 0) and (Assigned(Buffer)) and (Assigned(Buf2))  then
    begin
      FieldOffset := Integer(FFileOffset[Field.FieldNo-1])+FRecordHeaderSize;
      if Field.DataType = ftString then
        begin
          l := Integer(FFileWidth[Field.FieldNo-1]);
          S := '';
          i := 0;
          While (Buf2[FieldOffset+i] <> #0) and (i<l) do
            begin
              S := S+pChar(Buf2+FieldOffset+i)^;
              inc(i);
            end;
          SetLength(S,l);
          S := Trim(S);
          CharToOemBuff(PChar(S), Buffer,l);
          Result := True;
        end
      else if Field.DataType = ftFloat then
        begin
          n := Integer(FFileWidth[Field.FieldNo-1]);
          S := '';
          for i := FieldOffset to FieldOffset+n-1 do
            S := S+pChar(Buf2+i)^;
          S := Trim(S);
          if S='' then
            Result := False
          else
            begin
              if (Pos('.',S) > 0) and (DecimalSeparator <> '.') then
                S[Pos('.',S)] := DecimalSeparator;
              Result := True;
             try
              D := StrToFloat(S);
             except
              D := 0;
              Result := False;
             end;
              PDouble(Buffer)^ := D;
            end;
        end
      else if Field.DataType = ftDate then
        begin
          S := '';
          for j := 0 to 7 do
            S := S + pChar(Buf2+FieldOffset+j);
          SetLength(S,8);
          if (trim(S) = '') or (S='00000000') then
            Result := false
          else
            begin
              S := Copy(S,7,2)+DateSeparator+Copy(S,5,2)+DateSeparator+Copy(S,1,4);
              OldDateFormat := ShortDateFormat;
              ShortDateFormat := 'dd/mm/yyyy';
              t := StrToDate(S);
              ShortDateFormat := OldDateFormat;
              j := Trunc(pDouble(@t)^)+693594;
              pInteger(Buffer)^ := j;
              result := True;
            end;
        end
      else if Field.DataType = ftBoolean then
        begin
          Result := True;
          if PChar(Buf2+FieldOffset)^ in ['S','T','Y'] then
            pBoolean(Buffer)^ := True
          else if PChar(Buf2+FieldOffset)^ in ['N','F'] then
            pBoolean(Buffer)^ := False
          else
            Result := False;
        end
      else
        begin
          ShowMessage ('very bad error in get field data');
          Result := False;
        end;
    end;
end;

// ____________________________________________________________________________
// TDBF.SetFieldData
// III: Move data from field to record buffer
procedure TDBF.SetFieldData(Field: TField; Buffer: Pointer);
var
  FieldOffset: Integer;
  Buf2 : PChar;
  l,i,n:integer;
  S : string;
  D : TDateTime;
  j : integer;
begin
  Buf2 := ActiveBuffer;
  if (Field.FieldNo >= 0) and (Assigned(Buffer)) and (Assigned(Buf2)) then
    begin
      FieldOffset := Integer(FFileOffset[Field.FieldNo-1])+FRecordHeaderSize;
      if Field.DataType = ftString then
        begin
          l := Integer(FFileWidth[Field.FieldNo-1]);
          S := '';
          i := 0;
          While (PChar(Buffer)[i] <> #0) and (i<l) do
            begin
              S := S+PChar(Buffer)[i];
              inc(i);
            end;
          SetLength(S,l);
          OemToCharBuff(PChar(S),PChar(Buf2+FieldOffset),l);
        end
      else if Field.DataType = ftFloat then
        begin
          n := Integer(FFileWidth[Field.FieldNo-1]);
          Str(pDouble(Buffer)^:n:Integer(FFileDecimals[Field.FieldNo-1]),S);
          while Length(S)<n do
            S :=  ' '+S;
          if (Pos(DecimalSeparator,S) > 0) and (DecimalSeparator <> '.') then
            S[Pos(DecimalSeparator,S)] := '.';
          CopyMemory(Pchar(Buf2+FieldOffset),PChar(S),n);
        end
      else if Field.DataType = ftDate then
        begin
          j := pInteger(Buffer)^-693594;
          pDouble(@d)^ := j;
          S := FormatDateTime('yyyymmdd',d);
          StrLCopy(pChar(Buf2+FieldOffset),pChar(S),8);
        end
      else if Field.DataType = ftBoolean then
        begin
          if pBoolean(Buffer)^ then
            PChar(Buf2+FieldOffset)^ := 'T'
          else
            PChar(Buf2+FieldOffset)^ := 'F';
        end
      else
        ShowMessage ('very bad error in setfield data');
      DataEvent (deFieldChange, Longint(Field));
    end;
end;

// ____________________________________________________________________________
// TDBF.InternalHandleException
// default exception handling
procedure TDBF.InternalHandleException;
begin
  // standard exception handling
  Application.HandleException(Self);
end;

Function TDBF._ProcessFilter(Buffer:PChar):boolean;
var
  FilterExpresion : string;
  PosComp : integer;
  FName : string;
  FieldPos : integer;
  FieldOffset : integer;
  FieldValue : Variant;
  TestValue : Variant;
  FieldText : string;
  OldShortDateFormat : string;
begin
  FilterExpresion := Filter;
  PosComp := Pos('>',FilterExpresion);
  if PosComp=0 then
    PosComp := Pos('<',FilterExpresion);
  if PosComp=0 then
    PosComp := Pos('=',FilterExpresion);
  if PosComp=0 then
    begin
      _ProcessFilter := True;
      Exit;
    end;
  FName := Trim(Copy(FilterExpresion,1,PosComp-1));
  FieldPos := FieldDefs.IndexOf(FName);
  FieldOffset := integer(FFileOffset[FieldPos]);
  if FieldPos < 0 then
    _ProcessFilter := True
  else if FieldDefs.Items[FieldPos].DataType = ftString then
    begin // STRING
     try
      FieldValue := '';
      FieldOffset := FieldOffset+1;
      While (Buffer[FieldOffset]<>#0) and (Length(FieldValue)<integer(FFileWidth[FieldPos])) do
        begin
          FieldValue := FieldValue + Buffer[FieldOffset];
          FieldOffset := FieldOffset+1;
        end;
      FieldValue := Trim(FieldValue);
      TestValue := Trim(Copy(FilterExpresion,PosComp+2,Length(FilterExpresion)-PosComp-2));
      if FilterExpresion[PosComp]='=' then
        _ProcessFilter := (FieldValue=TestValue)
      else if FilterExpresion[PosComp]='>' then
        begin
          if FilterExpresion[PosComp+1]='=' then
            _ProcessFilter := (FieldValue>=Copy(TestValue,2,(Length(TestValue)-1)))
          else
            _ProcessFilter := (FieldValue>TestValue);
        end
      else if FilterExpresion[PosComp]='<' then
        begin
          if FilterExpresion[PosComp+1]='=' then
            _ProcessFilter := (FieldValue<=Copy(TestValue,2,(Length(TestValue)-1)))
          else
            _ProcessFilter := (FieldValue<TestValue);
        end
      else
        _ProcessFilter := False;
     except
       _ProcessFilter := False;
     end;
    end
  else if FieldDefs.Items[FieldPos].DataType = ftFloat then
    begin // FLOAT
     try
      FieldText := '';
      FieldOffset := FieldOffset+1;
      While (Buffer[FieldOffset]<>#0) and (Length(FieldText)<integer(FFileWidth[FieldPos])) do
        begin
          FieldText := FieldText + Buffer[FieldOffset];
          FieldOffset := FieldOffset+1;
        end;
      FieldText := Trim(FieldText);
      if Pos('.',FieldText)>0 then
        FieldText[Pos('.',FieldText)] := DecimalSeparator;
      FieldValue := StrToFloat(FieldText);
      if FilterExpresion[PosComp+1]='='then
        FieldText := Trim(Copy(FilterExpresion,PosComp+2,Length(FilterExpresion)-PosComp-1))
      else
        FieldText := Trim(Copy(FilterExpresion,PosComp+1,Length(FilterExpresion)-PosComp));
      if Pos('.',FieldText)>0 then
        FieldText[Pos('.',FieldText)] := DecimalSeparator;
      TestValue := StrToFloat(FieldText);
      if FilterExpresion[PosComp]='=' then
        _ProcessFilter := (FieldValue=TestValue)
      else if FilterExpresion[PosComp]='>'then
        begin
          if FilterExpresion[PosComp+1]='='then
            _ProcessFilter := (FieldValue>=TestValue)
          else
            _ProcessFilter := (FieldValue>TestValue);
        end
      else if FilterExpresion[PosComp]='<'then
        begin
          if FilterExpresion[PosComp+1]='='then
            _ProcessFilter := (FieldValue<=TestValue)
          else
            _ProcessFilter := (FieldValue<TestValue);
        end
      else
        _ProcessFilter := False;
     except
      _ProcessFilter := False;
     end;
    end
  else if FieldDefs.Items[FieldPos].DataType = ftDate then
    begin // DATE
      OldShortDateFormat := ShortDateFormat;
     try
      FieldText := '';
      FieldOffset := FieldOffset+1;
      While (Buffer[FieldOffset]<>#0) and (Length(FieldText)<integer(FFileWidth[FieldPos])) do
        begin
          FieldText := FieldText + Buffer[FieldOffset];
          FieldOffset := FieldOffset+1;
        end;
      FieldText := Trim(FieldText);
      FieldText := Copy(FieldText,1,4)+DateSeparator+Copy(FieldText,5,2)+DateSeparator+Copy(FieldText,7,2);
      ShortDateFormat := 'yyyy/mm/dd';
      FieldValue := StrToDate(FieldText);
      if FilterExpresion[PosComp+1]='=' then
        FieldText := Trim(Copy(FilterExpresion,PosComp+2,Length(FilterExpresion)-PosComp-1))
      else
        FieldText := Trim(Copy(FilterExpresion,PosComp+1,Length(FilterExpresion)-PosComp));
      FieldText := Copy(FieldText,1,4)+DateSeparator+Copy(FieldText,5,2)+DateSeparator+Copy(FieldText,7,2);
      TestValue := StrToDate(FieldText);
      if FilterExpresion[PosComp]='=' then
        begin
          _ProcessFilter := (FieldValue=TestValue);
        end
      else if FilterExpresion[PosComp]='>' then
        begin
          if FilterExpresion[PosComp+1]='='then
            _ProcessFilter := (FieldValue>=TestValue)
          else
            _ProcessFilter := (FieldValue>TestValue);
        end
      else if FilterExpresion[PosComp]='<' then
        begin
          if FilterExpresion[PosComp+1]='='then
            _ProcessFilter := (FieldValue<=TestValue)
          else
            _ProcessFilter := (FieldValue<TestValue);
        end
      else
        _ProcessFilter := False;
     except
      _ProcessFilter := False;
     end;
      ShortDateFormat := OldShortDateFormat;
    end
  else
    _ProcessFilter := False;
end;

{******************************************************************************}
{* Property Editors Code                                                       *}
{******************************************************************************}

procedure TFilenameProperty.Edit;
var
  FileOpen: TOpenDialog;
begin
  FileOpen := TOpenDialog.Create(Nil);
  FileOpen.Filename := GetValue;
  FileOpen.Filter := 'dBase Files (*.DBF)|*.DBF|All Files (*.*)|*.*';
  FileOpen.Options := FileOpen.Options + [ofPathMustExist, ofFileMustExist];
  try
    if FileOpen.Execute then SetValue(FileOpen.Filename);
  finally
    FileOpen.Free;
  end;
end;

function TFilenameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paRevertable];
end;

procedure Register;
begin
  RegisterComponents('Terabyte', [TDBF]);
  RegisterPropertyEditor(TypeInfo(String), TDBF, 'TableName', TFileNameProperty);
end;

end.