dynamicarrays.pas

delphi通过OCI访问ORACLE

end;

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

function THArrayDouble.IndexOfFrom(Value: double; Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if Assigned(FValues) then begin
  Result:=memfindgeneral(FValues,@Value,ItemSize,Count-Start);
  if Result<>-1 then Result:=Result+Start;
 end;
end;

{ THArrayCurrency }

constructor THArrayCurrency.Create;
begin
 inherited Create;
 FItemSize:=sizeof(currency);
end;

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

function THArrayCurrency.GetValue(Index:integer):Currency;
begin
 Result:=pcurrency(GetAddr(Index))^;
end;

procedure THArrayCurrency.SetValue(Index:integer;Value:Currency);
begin
 Update(Index,@Value);
end;

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

function THArrayCurrency.IndexOfFrom(Value: currency;Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if Assigned(FValues) then begin
  Result:=memfindgeneral(FValues,@Value,ItemSize,Count-Start);
  if Result<>-1 then Result:=Result+Start;
 end;
end;

{ THArrayExtended }

constructor THArrayExtended.Create;
begin
 inherited Create;
 FItemSize:=sizeof(Extended);
end;

function THArrayExtended.GetValue(Index: integer): Extended;
begin
 Result:=pextended(GetAddr(Index))^;
end;

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

procedure THArrayExtended.SetValue(Index: integer; Value: Extended);
begin
 Update(Index,@Value);
end;

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

function THArrayExtended.IndexOfFrom(Value: Extended;
  Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if Assigned(FValues) then begin
  Result:=memfindgeneral(FValues,@Value,ItemSize,Count-Start);
  if Result<>-1 then Result:=Result+Start;
 end;
end;

{ TWideString }

constructor TWideString.Create(Value: WideString);
begin
 Str:=Value;
end;

{ THArrayWideStrings }

function THArrayWideStrings.AddValue(Value: WideString): integer;
begin
 Result:=inherited AddValue(TWideString.Create(Value));
end;

function THArrayWideStrings.GetValue(Index: integer): WideString;
begin
 Result:=TWideString(inherited GetValue(Index)).Str;
end;

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

function THArrayWideStrings.IndexOfFrom(Value: WideString;
  Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if Assigned(FValues) then
  for Result:=Start to Count-1 do
   if self.Value[Result]=Value then exit;
 Result:=-1;
end;

procedure THArrayWideStrings.SetValue(Index: integer; Value: WideString);
begin
 TWideString(inherited GetValue(Index)).Str:=Value;
end;

{ THArrayString }

constructor THArrayString.Create;
begin
  str_ptr:=THArrayPointer.Create;
  FCount:=0;
  FCapacity:=0;
  FItemSize:=0;
  FValues:=nil;
end;

destructor THArrayString.Destroy;
var
  i    : integer;
  pStr : PChar;
begin
  for i:=0 to str_ptr.Count-1 do
  begin
    pStr:=PChar(str_ptr.Value[i]);
    StrDispose(pStr);
  end;
  str_ptr.Free;
end;

function THArrayString.CalcAddr(num:integer):pointer;
begin
  Result:=pointer(dword(str_ptr.FValues)+dword(num)*dword(FItemSize));
end;

function THArrayString.AddValue(Value:String):integer;
begin
  result:=self.Add(PChar(Value));
end;

function THArrayString.Add(pValue:pointer):integer;
begin
  Result:=Insert(FCount,pValue);
end;

function THArrayString.Insert(num:integer;pValue:pointer):integer;
var
  pStr : PChar;
  l    : integer;
begin
  l:=StrLen(PChar(pValue));
  pStr:=StrAlloc(l+1);
  memcpy(pValue,pStr,l+1);
  str_ptr.Insert(num,@pStr);
  FCount:=str_ptr.Count;
  FCapacity:=str_ptr.Capacity;
  Result:=FCount;
end;

procedure THArrayString.Update(num:integer;pValue:pointer);
var
  pStr : PChar;
  l    : integer;
begin
  pStr:=PChar(str_ptr.Value[num]);
  if pStr<>nil then StrDispose(pStr);

  if pValue<>nil then begin
   l:=StrLen(PChar(pValue));
   pStr:=StrAlloc(l+1);
   memcpy(pValue,pStr,l+1);
   str_ptr.Value[num]:=pStr;
  end else
   str_ptr.Value[num]:=nil;
end;

procedure THArrayString.MoveData(FromPos,Count,Offset:integer);
begin
  str_ptr.MoveData(FromPos, Count, Offset);
end;

procedure THArrayString.Delete(num:integer);
var pStr:PChar;
begin
  pStr:=PChar(str_ptr.Value[num]);
  StrDispose(pStr);
  str_ptr.Delete(num);
  FCount:=str_ptr.Count;
end;

procedure THArrayString.Get(num:integer;pValue:pointer);
var
  pStr : PChar;
  l    : integer;
begin
  pStr:=PChar(str_ptr.Value[num]);
  l:=StrLen(pStr);
  memcpy(pointer(pStr),pValue,l+1);
end;

function THArrayString.GetValue(Index:integer):String;
var
  pStr : PChar;
begin
  pStr:=PChar(str_ptr.Value[Index]);
  Result:=pStr;
end;

procedure THArrayString.SetValue(Index:integer;Value:String);
begin
  Self.Update(Index,pointer(Value));
end;

procedure THArrayString.Clear;
var i:integer;
    pStr:PChar;
begin
  for i:=0 to str_ptr.Count-1 do
  begin
    pStr:=PChar(str_ptr.Value[i]);
    StrDispose(pStr);
  end;
  str_ptr.Clear;
  FCount:=0;
  FCapacity:=0;
end;

procedure THArrayString.ClearMem;
var
  i    : integer;
  pStr : PChar;
begin
  for i:=0 to str_ptr.Count-1 do
  begin
    pStr:=PChar(str_ptr.Value[i]);
    StrDispose(pStr);
  end;
 str_ptr.ClearMem;
 inherited ClearMem;
end;

function THArrayString.IndexOf(Value:string):integer;
//var i : integer;
//    PVal : PChar;
begin
{PVal := PChar(Value);
  for i := 0 to Count-1 do
  begin
    if (StrComp(PVal,PChar(str_ptr.Value[i])) = 0) then
    begin
      Result:=i;
      exit;
    end;
  end;
  Result := -1;}

 Result:=IndexOfFrom(Value,0);
end;

function THArrayString.IndexOfFrom(Value: string; Start: integer): integer;
begin
 Result:=-1;
 if Start=Count then exit;
 Error(Start,0,Count-1);
 if Assigned(FValues) then
  for Result:=Start to Count-1 do
   if self.Value[Result]=Value then exit;
 Result:=-1;
end;

procedure THArrayString.Swap(Index1, Index2: integer);
begin
 str_ptr.Swap(Index1,Index2);
end;

{ THArrayStringFix }

constructor THArrayStringFix.Create;
begin
 raise Exception.Create('Use CreateSize to create THArrayStringFix!');
end;

constructor THArrayStringFix.CreateSize(Size: integer);
begin
// roma 23.01.2005
// if(Size = 0)
//  then raise Exception.Create('The parameter Size cannot be zero!');

 inherited Create;
 FItemSize := Size;
end;

// cuts off value to the FItemSize size if the value is longer than FItemSize.
function THArrayStringFix.AddValue(Value: string): integer;
var buf:pointer;
begin
 buf := AllocMem(FItemSize + 1);
 memclr(buf, FItemSize + 1);
 try
  strplcopy(buf, Value, FItemSize);
  Result := inherited Add(buf);
 finally
  FreeMem(buf);
 end;
end;

function THArrayStringFix.GetValue(Index: integer): string;
var buf:pointer;
begin
 buf := AllocMem(FItemSize + 1);
 memclr(buf, FItemSize + 1);
 try
  memcpy(GetAddr(Index), buf, FItemSize);
  Result := strpas(buf);
 finally
  FreeMem(buf);
 end;
end;

procedure THArrayStringFix.SetValue(Index: integer; Value: string);
var buf:pointer;
begin
 buf := AllocMem(FItemSize + 1);
 memclr(buf, FItemSize + 1);
 try
  strplcopy(buf, Value, FItemSize);
  inherited Update(Index, buf);
 finally
  FreeMem(buf);
 end;
end;

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

function THArrayStringFix.IndexOfFrom(Value: string;
  Start: integer): integer;
begin
 Result := -1;
 if Start >= Count then exit;
// Error(Start, 0, Count - 1); //roma 21.03.2003
 if Assigned(FValues) then
  for Result := Start to Count - 1 do
   if self.Value[Result] = Value then exit;
 Result := -1;
end;

{ THash }

constructor THash.Create;
begin
 FReadOnly:=False;
 FAIndex:=THArrayInteger.Create;
end;

destructor THash.Destroy;
begin
 if not FReadOnly then FAIndex.Free;
 inherited Destroy;
end;

procedure THash.Clear;
begin
 FAIndex.Clear;
end;

procedure THash.ClearMem;
begin
 FAIndex.ClearMem;
end;

function THash.GetCount:integer;
begin
 Result:=FAIndex.Count;
end;

function THash.GetKey(Index:integer):integer;
begin
 Result:=FAIndex[Index];
end;

function THash.IfExist(Key:integer):boolean;
begin
 Result:=FAIndex.IndexOf(Key)<>-1;
end;

 { THashExists }

constructor THashExists.Create;
begin
 inherited Create;
end;

destructor THashExists.Destroy;
begin
 inherited Destroy;
end;

procedure THashExists.SetValue(Index:integer;Value:boolean);
var r:integer;
begin
 r:=FAIndex.IndexOf(Index);
 if (r=-1) and Value then FAIndex.AddValue(Index);
 if (r<>-1) and (not Value) then FAIndex.Delete(r);
end;

procedure THashExists.Delete(Key:integer);
var r:integer;
begin
 r:=FAIndex.IndexOf(Key);
 if (r<>-1) then FAIndex.Delete(r);
end;

function THashExists.GetValue(Index:integer):boolean;
var r:integer;
begin
 r:=FAIndex.IndexOf(Index);
 Result:=(r<>-1);
end;

 { THashBoolean }

constructor THashBoolean.Create;
begin
 inherited Create;
 FAValues:=THArrayBoolean.Create;
end;

constructor THashBoolean.CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayBoolean);
begin
 FAIndex:=IndexHArray;
 FAValues:=ValueHArray;
 FReadOnly:=True;
end;

destructor THashBoolean.Destroy;
begin
 if not FReadOnly then  FAValues.Free;
 inherited Destroy;
end;

procedure THashBoolean.SetValue(Key:integer;Value:boolean);
var n:integer;
begin
 n:=FAIndex.IndexOf(Key);
 if n>=0 then begin
  FAValues[n]:=Value;
  exit;
 end;
 if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
 FAIndex.AddValue(Key);
 FAValues.AddValue(Value);
end;

function THashBoolean.GetValue(Key:integer):boolean;
var n:integer;
begin
 n:=FAIndex.IndexOf(Key);
 if n>=0 then begin
  Result:=FAValues[n];
 end else begin
  Result:=False;
 end;
end;

procedure THashBoolean.Clear;
begin
 inherited Clear;
 FAValues.Clear;
end;

procedure THashBoolean.ClearMem;
begin
 inherited ClearMem;
 FAValues.ClearMem;
end;

procedure THashBoolean.Delete(Key:integer);
var n:integer;
begin
 n:=FAIndex.IndexOf(Key);
 if n>=0 then begin
  FAIndex.Delete(n);
  FAValues.Delete(n);
 end;
end;

 { THashInteger }

constructor THashInteger.Create;
begin
 inherited Create;
 FAValues:=THArrayInteger.Create;
end;

constructor THashInteger.CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayInteger);