dynamicarrays.pas

delphi通过OCI访问ORACLE

end;

function THArray.QuickFind(FindProc:TFindProc;FindData:pointer):integer;
label fin;
var L,R,res:integer;
    was1:boolean;
begin
 Result:=-1;
 if Count=0 then exit;
 if @FindProc=nil then exit;

 L:=0; R:=Count-1;
 if FindProc(self,R,FindData)<0 then begin
  Result:=-1;//R;
  exit;
 end;
 while True do begin
  was1:=abs(R-L)=1;
  Result:=(L+R) shr 1;
  if L=Result then goto fin;//exit;
  res:=FindProc(self,Result,FindData);
  if res<0 then L:=Result
  else if res>0 then R:=result
  else goto fin;//exit;
  if was1 then goto fin;//exit;
 end;
fin:

end;

procedure THArray.LoadFromStream(s: TStream);
var i,oc:integer;
begin
 s.Read(i,sizeof(i));
 oc:=FCount;
 AddFillValues(i);
 s.Read(CalcAddr(oc)^,i*FItemSize);
end;

procedure THArray.SaveToStream(s: TStream);
begin
 s.Write(Count,sizeof(integer));
 s.Write(PChar(FValues)^,Count*FItemSize);
end;

function THArray.IndexOf(Value: pointer): integer;
begin
 Result:=IndexOfFrom(Value,0);
end;

function THArray.IndexOfFrom(Value: pointer; Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if FValues<>nil then begin
   Result:=memfindgeneral(GetAddr(Start),Value,FItemSize,Count-Start);
   if Result<>-1 then Result:=Result+Start;
 end;
end;

{ THArrayObjects }

function THArrayObjects.AddValue(Value: TObject): integer;
begin
 Result:=inherited Add(@Value);
end;

procedure THArrayObjects.ClearMem;
var i:integer;
begin
 for i:=0 to Count-1 do GetValue(i).Free;
 inherited;
end;

procedure THArrayObjects.SafeClearMem;
begin
 inherited ClearMem;
end;

constructor THArrayObjects.Create;
begin
 inherited;
 FItemSize:=sizeof(TObject);
end;

procedure THArrayObjects.Delete(Index: integer);
var o:TObject;
begin
 o:=GetValue(Index);
 inherited;
 if Assigned(o) then o.Free;
end;

procedure THArrayObjects.SafeDelete(Index: integer);
begin
 inherited Delete(Index);
end;

function THArrayObjects.GetValue(Index: integer): TObject;
begin
 Result:=TObject(GetAddr(Index)^);
end;

procedure THArrayObjects.SetValue(Index: integer;const Value: TObject);
begin
 Update(Index,@Value);
end;

function THArrayObjects.IndexOf(Value: TObject): integer;
begin
 Result:=IndexOfFrom(Value,0);
end;

function THArrayObjects.IndexOfFrom(Value: TObject;
  Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if FValues<>nil then begin
   Result:=memfinddword(GetAddr(Start),dword(Value),Count-Start);
   if Result<>-1 then Result:=Result+Start;
 end;
end;

{ THArrayByte }

function THArrayByte.AddValue(Value: byte): integer;
begin
 Result:=inherited Add(@Value);
end;

constructor THArrayByte.Create;
begin
 inherited Create;
 FItemSize:=sizeof(byte);
end;

function THArrayByte.GetValue(Index: integer): byte;
begin
 Result:=pbyte(GetAddr(Index))^;
end;

function THArrayByte.IndexOf(Value: byte): integer;
begin
 Result:=IndexOfFrom(Value,0);
end;

function THArrayByte.IndexOfFrom(Value: byte; Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if FValues<>nil then begin
   Result:=memfindbyte(GetAddr(Start),Value,Count-Start);
   if Result<>-1 then Result:=Result+Start;
 end;
end;

procedure THArrayByte.SetValue(Index: integer; Value: byte);
begin
 Update(Index,@Value);
end;

{ THArraySmallInt }

constructor THArraySmallInt.Create;
begin
 inherited Create;
 FItemSize:=sizeof(smallint);
end;

function THArraySmallInt.AddValue(Value:smallint):integer;
begin
 Result:=inherited Add(@Value);
end;

function THArraySmallInt.GetValue(Index:integer):smallint;
begin
 Result:=psmallint(GetAddr(Index))^;
end;

procedure THArraySmallInt.SetValue(Index:integer;Value:smallint);
begin
 Update(Index,@Value);
end;

 function THArraySmallInt.IndexOf(Value: smallint): integer;
begin
 Result:=IndexOfFrom(Value,0);
end;

function THArraySmallInt.IndexOfFrom(Value: smallint;
  Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if FValues<>nil then begin
   Result:=memfindword(GetAddr(Start),word(Value),Count-Start);
   if Result<>-1 then Result:=Result+Start;
 end;
end;

{ THArrayWord }

constructor THArrayWord.Create;
begin
 inherited Create;
 FItemSize:=sizeof(Word);
end;

function THArrayWord.AddValue(Value:Word):integer;
begin
 Result:=inherited Add(@Value);
end;

function THArrayWord.GetValue(Index:integer):Word;
begin
 Result:=pword(GetAddr(Index))^;
end;

procedure THArrayWord.SetValue(Index:integer;Value:Word);
begin
 Update(Index,@Value);
end;

 function THArrayWord.IndexOf(Value: word): integer;
begin
 Result:=IndexOfFrom(Value,0);
end;

function THArrayWord.IndexOfFrom(Value: word; Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if FValues<>nil then begin
   Result:=memfindword(GetAddr(Start),Value,Count-Start);
   if Result<>-1 then Result:=Result+Start;
 end;
end;

{ THArrayLongWord }

constructor THArrayLongWord.Create;
begin
 inherited Create;
 FItemSize:=sizeof(LongWord);
end;

function THArrayLongWord.AddValue(Value:LongWord):integer;
begin
 Result:=inherited Add(@Value);
end;

function THArrayLongWord.GetValue(Index:integer):LongWord;
begin
 Result:=pLongWord(GetAddr(Index))^;
end;

procedure THArrayLongWord.SetValue(Index:integer;Value:LongWord);
begin
 Update(Index,@Value);
end;

function THArrayLongWord.IndexOf(Value: LongWord): integer;
begin
 Result:=IndexOfFrom(Value,0);
end;

function THArrayLongWord.IndexOfFrom(Value: LongWord; Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if FValues<>nil then begin
   Result:=memfinddword(GetAddr(Start),dword(Value),Count-Start);
   if Result<>-1 then Result:=Result+Start;
 end;
end;

 { THArrayInt64 }

constructor THArrayInt64.Create;
begin
 inherited Create;
 FItemSize:=sizeof(Int64);
end;

function THArrayInt64.AddValue(Value:Int64):integer;
begin
 Result:=inherited Add(@Value);
end;

function THArrayInt64.GetValue(Index:integer):Int64;
begin
 Result:=pint64(GetAddr(Index))^;
end;

procedure THArrayInt64.SetValue(Index:integer;Value:Int64);
begin
 Update(Index,@Value);
end;

 function THArrayInt64.IndexOf(Value: int64): integer;
begin
 Result:=IndexOfFrom(Value,0);
end;

function THArrayInt64.IndexOfFrom(Value: int64; Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if FValues<>nil then begin
   Result:=memfindint64(GetAddr(Start),Value,Count-Start);
   if Result<>-1 then Result:=Result+Start;
 end;
end;

{ THArrayInteger }

constructor THArrayInteger.Create;
begin
 inherited Create;
 FItemSize:=sizeof(integer);
end;

function THArrayInteger.AddValue(Value:integer):integer;
begin
 Result:=inherited Add(@Value);
end;

function THArrayInteger.InsertValue(num, Value: integer): integer;
begin
  Result := inherited Insert(num, @Value);
end;

function THArrayInteger.IndexOf(Value:integer):integer;
begin
 Result:=IndexOfFrom(Value,0);
end;

function THArrayInteger.IndexOfFrom(Value:integer;Start:integer):integer;
begin
 if Start=Count then begin
  Result:=-1;
  exit;
 end;
 Error(Start,0,Count-1);
 if FValues=nil
  then Result:=-1
  else begin
   Result:=memfinddword(GetAddr(Start),dword(Value),Count-Start);
   if Result<>-1 then Result:=Result+Start;
  end;
end;

function THArrayInteger.GetValue(Index:integer):integer;
begin
 Result:=pinteger(GetAddr(Index))^;
end;

procedure THArrayInteger.SetValue(Index:integer;Value:Integer);
begin
 Update(Index,@Value);
end;

procedure THArrayInteger.Push(Value:Integer);
begin
 AddValue(Value);
end;

function THArrayInteger.Pop:integer;
begin
 Result:=Value[Count-1];
 Delete(Count-1);
end;

procedure THArrayInteger.AddFromString(InputString,Delimiters:string);
var i,c:integer;
begin
 c:=HGetTokenCount(InputString,Delimiters,False);
 for i:=0 to c-1 do
  AddValue(StrToInt(HGetToken(InputString,Delimiters,False,i)));
end;

function THArrayInteger.GetAsString:string;
var i:integer;
begin
 Result:=' ';
 for i:=0 to Count-1 do
  Result:=Result+IntToStr(Value[i])+' ';
end;

function THArrayInteger.CalcMax: integer;
var i:integer;
begin
 if Count=0 then begin Result:=-1; exit; end;
 Result:=Value[0];
 for i:=1 to Count-1 do
  if Value[i]>Result then Result:=Value[i];
end;

{procedure THArrayInteger.QuickSort(L,R:integer);
 var
  I,J,P,temp: integer;
begin
  I:=L;
  J:=R;
  p:=(L+R) shr 1;
  repeat
    while Value[I]<Value[P] do Inc(I);
    while Value[J]>Value[P] do Dec(J);
    if I <= J then
    begin
      temp:=Value[I];
      Value[I]:=Value[J];
      Value[I]:=temp;
      Inc(I);
      Dec(J);
    end;
  until I > J;
  if L<J then QuickSort(L,J);
  if I<R then QuickSort(I,R);
end;}


{ THArrayPointer }

constructor THArrayPointer.Create;
begin
 inherited Create;
 FItemSize:=sizeof(pointer);
end;

function THArrayPointer.AddValue(Value:pointer):integer;
begin
 Result:=inherited Add(@Value);
end;

function THArrayPointer.IndexOf(Value:pointer):integer;
begin
 Result:=IndexOfFrom(Value,0);
end;

function THArrayPointer.IndexOfFrom(Value:pointer;Start:integer):integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if FValues<>nil then begin
   Result:=memfinddword(GetAddr(Start),dword(Value),Count-Start);
   if Result<>-1 then Result:=Result+Start;
 end;
end;

function THArrayPointer.GetValue(Index:integer):Pointer;
begin
 Result:=ppointer(GetAddr(Index))^;
end;

procedure THArrayPointer.SetValue(Index:integer;Value:Pointer);
begin
 Update(Index,@Value);
end;

 { THArrayBoolean }

constructor THArrayBoolean.Create;
begin
 inherited Create;
 FItemSize:=sizeof(boolean);
end;

function THArrayBoolean.AddValue(Value:boolean):integer;
begin
 Result:=inherited Add(@Value);
end;

function THArrayBoolean.GetValue(Index:integer):Boolean;
begin
 Result:=pboolean(GetAddr(Index))^;
end;

procedure THArrayBoolean.SetValue(Index:integer;Value:Boolean);
begin
 Update(Index,@Value);
end;

 function THArrayBoolean.IndexOf(Value: Boolean): integer;
begin
 Result:=IndexOfFrom(Value,0);
end;

function THArrayBoolean.IndexOfFrom(Value: Boolean;
  Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if Assigned(FValues) then begin
   Result:=memfindbyte(GetAddr(Start),byte(Value),Count-Start);
   if Result<>-1 then Result:=Result+Start;
 end;
end;

{ THArrayDouble }

constructor THArrayDouble.Create;
begin
 inherited Create;
 FItemSize:=sizeof(Double);
end;

function THArrayDouble.AddValue(Value:Double):integer;
begin
 Result:=inherited Add(@Value);
end;

function THArrayDouble.GetValue(Index:integer):Double;
begin
 Result:=pdouble(GetAddr(Index))^;
end;

procedure THArrayDouble.SetValue(Index:integer;Value:Double);
begin
 Update(Index,@Value);