dynamicarrays.pas

delphi通过OCI访问ORACLE

begin
 FAIndex:=IndexHArray;
 FAValues:=ValueHArray;
 FReadOnly:=True;
end;

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

procedure THashInteger.SetValue(Key:integer;Value:integer);
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 THashInteger.GetValue(Key:integer):integer;
var n:integer;
begin
 n:=FAIndex.IndexOf(Key);
 if n>=0 then begin
  Result:=FAValues[n];
 end else begin
  Result:=0;
 end;
end;

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

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

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

 { THashPointer }

constructor THashPointer.Create;
begin
 inherited Create;
 FAValues:=THArrayPointer.Create;
end;

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

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

procedure THashPointer.SetValue(Key:integer;Value:Pointer);
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 THashPointer.GetValue(Key:integer):Pointer;
var n:integer;
begin
 n:=FAIndex.IndexOf(Key);
 if n>=0 then begin
  Result:=FAValues[n];
 end else begin
  Result:=nil;
 end;
end;

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

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

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

 { THashCurrency }

constructor THashCurrency.Create;
begin
 inherited Create;
 FAValues:=THArrayCurrency.Create;
end;

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

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

procedure THashCurrency.SetValue(Key:integer;Value:currency);
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;

procedure THashCurrency.Inc(Key:integer;Value:currency);
var n:integer;
begin
 n:=FAIndex.IndexOf(Key);
 if n>=0 then begin
  FAValues[n]:=FAValues[n]+Value;
 end else begin
  if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
  SetValue(Key,Value);
 end;
end;

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

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

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

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

 { THashDouble }

constructor THashDouble.Create;
begin
 inherited Create;
 FAValues:=THArrayDouble.Create;
end;

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

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

procedure THashDouble.SetValue(Key:integer;Value:Double);
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;

procedure THashDouble.Inc(Key:integer;Value:Double);
var n:integer;
begin
 n:=FAIndex.IndexOf(Key);
 if n>=0 then begin
  FAValues[n]:=FAValues[n]+Value;
 end else begin
  if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
  SetValue(Key,Value);
 end;
end;

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

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

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

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

 { THashString }

constructor THashString.Create;
begin
 inherited Create;
 FAValues:=TStringList.Create;
 FAllowEmptyStr:=True;
end;

destructor THashString.Destroy;
begin
 FAValues.Free;
 inherited Destroy;
end;

procedure THashString.SetValue(Key:integer;Value:String);
var n:integer;
begin
 n:=FAIndex.IndexOf(Key);
 if n>=0 then begin
  if not FAllowEmptyStr and (Value='')
   then begin FAValues.Delete(n); FAIndex.Delete(n); end
   else FAValues[n]:=Value;
 end else
  if FAllowEmptyStr or (Value<>'') then begin
   FAIndex.AddValue(Key);
   FAValues.Add(Value);
  end;
end;

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

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

procedure THashString.ClearMem;
begin
 inherited ClearMem;
 FAValues.Clear;
end;

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

 { THash2 }

constructor THash2.Create;
begin
 MainListIndex:=THArrayInteger.Create;
 MainListValue:=THArrayPointer.Create;
end;

destructor THash2.Destroy;
begin
 Clear;
 MainListValue.Free;
 MainListIndex.Free;
 inherited Destroy;
end;

{function THash2.GetKey(Index:integer):integer;
begin
 Result:=MainListIndex[Index];
end;}

procedure THash2.ClearMem;
begin
 Clear;
 MainListValue.ClearMem;
 MainListIndex.ClearMem;
end;

function THash2.GetChildHash(Key:integer):THash;
var n:integer;
begin
 n:=MainListIndex.IndexOf(Key);
 if n=-1
  then Result:=nil
  else Result:=MainListValue[n];
end;

procedure THash2.Delete(MainIndex,Index:integer);
var n:integer;
    arr:THashBoolean;
begin
 n:=MainListIndex.IndexOf(MainIndex);
 if n=-1 then exit;
 arr:=MainListValue[n];
 THash(arr).Delete(Index);
 if arr.Count=0 then begin
  arr.Free;
  MainListValue.Delete(n);
  MainListIndex.Delete(n);
 end;
end;

{function THash2.ExistMainHash(MainIndex:integer):boolean;
var n:integer;
begin
 n:=MainListIndex.IndexOf(MainIndex);
 Result:=n<>-1;
end;}

 { THash2Exists }

procedure THash2Exists.Clear;
var i:integer;
begin
 for i:=0 to MainListValue.Count-1 do begin
  THashExists(MainListValue[i]).Free;
 end;
 MainListValue.Clear;
 MainListIndex.Clear;
end;

procedure THash2Exists.SetValue(MainIndex,Index:integer;Value:boolean);
var arr:THashExists;
begin
 arr:=THashExists(GetChildHash(MainIndex));
 if arr=nil then begin
  arr:=THashExists.Create;
  MainListIndex.AddValue(MainIndex);
  MainListValue.AddValue(arr);
 end;
 arr[Index]:=Value;
end;

function THash2Exists.GetValue(MainIndex,Index:integer):boolean;
var arr:THashExists;
begin
 Result:=False;
 arr:=THashExists(GetChildHash(MainIndex));
 if arr=nil then exit;
 Result:=arr[Index];
end;

function THash2Exists.CreateMainHash(MainIndex:integer):THashExists;
var Co:integer;
    n:integer;
    arr:THashExists;
begin
 Result:=nil;
 n:=MainListIndex.IndexOf(MainIndex);
 if n=-1 then exit;
 Result:=THashExists.Create;
 arr:=MainListValue[n];
 Co:=arr.Count;
 if Co>0 then begin
  Result.FAIndex.SetCapacity(Co);
  Result.FAIndex.FCount:=Co;
  memcpy(arr.FAIndex.FValues,Result.FAIndex.FValues,Co*Result.FAIndex.FItemSize);
 end else begin
  Result.Free;
  Result:=nil;
 end;
end;

function THash2Exists.CreateHash(Index:integer):THashExists;
var i:integer;
begin
 Result:=THashExists.Create;
 for i:=0 to MainListIndex.Count-1 do begin
  if THashExists(MainListValue[i])[Index] then Result.FAIndex.AddValue(MainListIndex[i]);
 end;
 if Result.Count=0 then begin
  Result.Free;
  Result:=nil;
 end;
end;

 { THash2Currency }

procedure THash2Currency.Clear;
var i:integer;
begin
 for i:=0 to MainListValue.Count-1 do begin
  THashCurrency(MainListValue[i]).Free;
 end;
 MainListValue.Clear;
 MainListIndex.Clear;
end;

procedure THash2Currency.SetValue(MainIndex,Index:integer;Value:Currency);
var arr:THashCurrency;
begin
 arr:=THashCurrency(GetChildHash(MainIndex));
 if arr=nil then begin
  arr:=THashCurrency.Create;
  MainListIndex.AddValue(MainIndex);
  MainListValue.AddValue(arr);
 end;
 arr[Index]:=Value;
end;

procedure THash2Currency.Inc(MainIndex,Index:integer;Value:Currency);
var c: currency;
begin
 c:=GetValue(MainIndex,Index);
 SetValue(MainIndex,Index,Value+c);
end;

function THash2Currency.GetValue(MainIndex,Index:integer):Currency;
var arr:THashCurrency;
begin
 Result:=0;
 arr:=THashCurrency(GetChildHash(MainIndex));
 if arr=nil then exit;
 Result:=arr[Index];
end;

function THash2Currency.CreateMainHash(MainIndex:integer):THashCurrency;
var arr:THashCurrency;
    Co:integer;
    n:integer;
begin
 Result:=nil;
 n:=MainListIndex.IndexOf(MainIndex);
 if n=-1 then exit;
 Result:=THashCurrency.Create;
 arr:=MainListValue[n];
 Co:=arr.Count;
 if Co>0 then begin
  Result.FAIndex.SetCapacity(Co);
  Result.FAIndex.FCount:=Co;
  Result.FAValues.SetCapacity(Co);
  Result.FAValues.FCount:=Co;
  memcpy(arr.FAIndex.FValues,Result.FAIndex.FValues,Co*Result.FAIndex.FItemSize);
  memcpy(arr.FAVa