msgtypes.pas

Delphi MsgCommunicator 2-10 component.I ve used, really good job. can be Server-Client message appl

begin 
 AllocBy := DefaultAllocBy; // default alloc 
 deAllocBy := DefaultAllocBy; // default dealloc 
 MaxAllocBy := MaximumAllocBy; // max alloc 
 AllocItemCount := 0; 
 SetSize(size);
end;//TMsgIntegerArray.Create
 
	
//------------------------------------------------------------------------------
// Destruct array (free mem)
//------------------------------------------------------------------------------ 
destructor TMsgIntegerArray.Destroy; 
begin
 Items := nil; 
 inherited Destroy; 
end;//TMsgIntegerArray.Destroy; 
	
	
//------------------------------------------------------------------------------ 
// Set length of array to specified size 
//------------------------------------------------------------------------------ 
procedure TMsgIntegerArray.Assign(v: TMsgIntegerArray); 
var 
  i: Integer; 
begin
  SetSize(v.ItemCount); 
  for i := 0 to ItemCount-1 do 
    items[i] := v.items[i]; 
end;// Assign 
 
 
//------------------------------------------------------------------------------ 
// Set length of array to specified size 
//------------------------------------------------------------------------------ 
procedure TMsgIntegerArray.SetSize(newSize: Integer);
begin
 if (newSize = 0) then
  begin
   ItemCount := 0; 
   allocItemCount := 0;
   Items := nil;
   Exit; 
  end;
	
 if (newSize > allocItemCount) then 
  begin 
     AllocBy := AllocBy * 2; 
     if (AllocBy > MaxAllocBy) then 
      AllocBy := MaxAllocBy; 
     if (allocItemCount + AllocBy > newSize) then 
      allocItemCount := allocItemCount + AllocBy 
     else
      allocItemCount := newSize;
     SetLength(Items,allocItemCount); 
  end
 else 
  if (newSize < ItemCount) then 
   if (allocItemCount-newSize > deAllocBy) then
    begin 
     deAllocBy := deAllocBy * 2;
     if (deAllocBy > MaxAllocBy) then 
      deAllocBy := MaxAllocBy; 
     SetLength(Items,newSize);
     allocItemCount := newSize;
    end;

 ItemCount := newSize;
end;//TMsgIntegerArray.SetSize


//------------------------------------------------------------------------------
// inserts an element to the end of items array
//------------------------------------------------------------------------------
procedure TMsgIntegerArray.Append(value: Integer);
begin
 Inc(ItemCount);
 SetSize(itemCount);
 Items[itemCount-1] := value;
end;//TMsgIntegerArray.Append


//------------------------------------------------------------------------------
// append new item if it is not exist
//------------------------------------------------------------------------------
procedure TMsgIntegerArray.Add(value: Integer);
begin
 if not IsValueExists(value) then
   Append(value);
end;//TMsgIntegerArray.Add


//------------------------------------------------------------------------------
// Remove first item = value
//------------------------------------------------------------------------------
procedure TMsgIntegerArray.Remove(value: Integer);
var
  i, j: Integer;
begin
 j := -1;
 for i := 0 to ItemCount-1 do
  if Items[i] = value then
   begin
    j := i;
    break;
   end;
 if j > -1 then
   Delete(j);
end;//TMsgIntegerArray.Remove


//------------------------------------------------------------------------------
// Insert an element into specified position
//------------------------------------------------------------------------------
procedure TMsgIntegerArray.Insert(itemNo: Integer; value: Integer);
begin
 inc(ItemCount);
 SetSize(ItemCount);
 if (itemCount <= 1) then
  items[0] := value
 else
 if (itemNo >= itemCount-1)
  then
   items[itemCount-1] := value
  else
   begin
    Move(items[itemNo],items[itemNo+1],
        (itemCount - itemNo-1) * sizeOf(Integer));
    items[itemNo] := value;
   end;
end;//TMsgIntegerArray.Insert


//------------------------------------------------------------------------------
// Delete an element at specified position
//------------------------------------------------------------------------------
procedure TMsgIntegerArray.Delete(itemNo: Integer);
begin
 if (itemNo < itemCount-1) then
  Move(items[itemNo+1],items[itemNo],
      (itemCount - itemNo-1) * sizeOf(Integer));
 dec(ItemCount);
 SetSize(ItemCount);
end;//TMsgIntegerArray.Delete


//------------------------------------------------------------------------------
// moves element to new position
//------------------------------------------------------------------------------
procedure TMsgIntegerArray.MoveTo(itemNo, newItemNo: Integer);
var value : Integer;
begin
 if (itemNo = newItemNo) then
  Exit;
 if (itemNo - newItemNo = 1) or (newItemNo-itemNo = 1) then
  begin
   value := items[itemNo];
   items[itemNo] := items[newItemNo];
   items[newItemNo] := value;
   Exit;
  end;
 if (itemNo > newItemNo) then
  begin
   value := items[itemNo];
   Move(PChar(items[newItemNo]),PChar(items[newItemNo+1]),
        (itemNo-newItemNo) * sizeof(Integer));
   items[newItemNo] := value;
  end
 else
  begin
     value := items[ItemNo];
     Move(PChar(items[ItemNo+1]),PChar(items[ItemNo]),
        (newItemNo-ItemNo-1) * sizeof(Integer));
     items[newItemNo-1] := value;
  end;
end;// MoveTo(itemNo, newItemNo : Integer);


//------------------------------------------------------------------------------
// copies itemCount elements to ar from ItmeNo
//------------------------------------------------------------------------------
procedure TMsgIntegerArray.CopyTo(
                      var ar: array of Integer;
                      itemNo, iCount: Integer
                             );
begin
 if (itemCount > 0) then
  Move (PChar(items[itemNo]),PChar(ar[0]),sizeOf(Integer)*iCount);
end;// CopyTo(ar : array of Integer; itemNo,itemCount : Integer);


//------------------------------------------------------------------------------
// returns true if value exists in Items array
//------------------------------------------------------------------------------
function TMsgIntegerArray.IsValueExists(value: Integer): Boolean;
var i: Integer;
begin
 Result := false;
 for i := 0 to ItemCount-1 do
  if Items[i] = value then
   begin
    Result := true;
    break;
   end;
end; // IsValueExists


////////////////////////////////////////////////////////////////////////////////
//
// TMsgThreadIntArray
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// Construct array of specified size
//------------------------------------------------------------------------------
constructor TMsgThreadIntArray.Create(
                                size: Integer;
                                DefaultAllocBy: Integer;
                                MaximumAllocBy: Integer
                                    );
begin
  InitializeCriticalSection(FCSect);
  inherited Create(size, DefaultAllocBy, MaximumAllocBy);
end;//TMsgThreadIntArray.Create


//------------------------------------------------------------------------------
// Destruct array (free mem)
//------------------------------------------------------------------------------
destructor TMsgThreadIntArray.Destroy;
begin
  inherited Destroy;
  DeleteCriticalSection(FCSect);
end;//TMsgThreadIntArray.Destroy;


//------------------------------------------------------------------------------
// Lock
//------------------------------------------------------------------------------
procedure TMsgThreadIntArray.Lock;
begin
  EnterCriticalSection(FCSect);
end;//TMsgThreadIntArray.Lock;


//------------------------------------------------------------------------------
// Unlock
//------------------------------------------------------------------------------
procedure TMsgThreadIntArray.Unlock;
begin
  LeaveCriticalSection(FCSect);
end;//TMsgThreadIntArray.Unlock;



function GetTemporaryName(Prefix: String): String;
var x: Integer;
begin
  x := Random(MAXINT);
  Result := Prefix + IntToStr(x);
end; // GetTemporaryName

initialization

{$IFDEF DEBUG_LOG_INIT}
aaWriteToLog('MsgTypes> initialized');
{$ENDIF}

end.