idglobal.pas

网络控件适用于Delphi6

      end;
      haddoublecolon := True;
      fillzeros := 8 - colons;
      if dots > 0 then
        Dec(fillzeros, 2);
      for i := 1 to fillzeros do begin
        Result := Result + '0:'; {do not localize}
      end;
    end else begin
      num := StrToIntDef('$' + Copy(LAddr, colonpos[p - 1] + 1, colonpos[p] - colonpos[p - 1] - 1), -1);
      if (num < 0) or (num > 65535) then begin
        Result := '';
        Exit; // huh? odd number...
      end;
      Result := Result + IntToHex(num,1) + ':';
    end;
  end; // end of colon separated part

  if dots = 0 then begin
    num := StrToIntDef('$' + Copy(LAddr, colonpos[colons] + 1, MaxInt), -1);
    if (num < 0) or (num > 65535) then begin
      Result := '';
      Exit; // huh? odd number...
    end;
    Result := Result + IntToHex(num,1) + ':';
  end;

  if dots > 0 then begin
    num := StrToIntDef(Copy(LAddr, colonpos[colons] + 1, dotpos[1] - colonpos[colons] -1),-1);
    if (num < 0) or (num > 255) then begin
      Result := '';
      Exit;
    end;
    Result := Result + IntToHex(num, 2);
    num := StrToIntDef(Copy(LAddr, dotpos[1]+1, dotpos[2]-dotpos[1]-1),-1);
    if (num < 0) or (num > 255) then begin
      Result := '';
      Exit;
    end;
    Result := Result + IntToHex(num, 2) + ':';

    num := StrToIntDef(Copy(LAddr, dotpos[2] + 1, dotpos[3] - dotpos[2] -1),-1);
    if (num < 0) or (num > 255) then begin
      Result := '';
      Exit;
    end;
    Result := Result + IntToHex(num, 2);
    num := StrToIntDef(Copy(LAddr, dotpos[3] + 1, 3), -1);
    if (num < 0) or (num > 255) then begin
      Result := '';
      Exit;
    end;
    Result := Result + IntToHex(num, 2) + ':';
  end;
  SetLength(Result, Length(Result) - 1);
end;

function Max(AValueOne,AValueTwo: Integer): Integer;
begin
  if AValueOne < AValueTwo then
  begin
    Result := AValueTwo
  end //if AValueOne < AValueTwo then
  else
  begin
    Result := AValueOne;
  end; //else..if AValueOne < AValueTwo then
end;

{$IFNDEF DotNet}
function MemoryPos(const ASubStr: string; MemBuff: PChar; MemorySize: Integer): Integer;
var
  LSearchLength: Integer;
  LS1: Integer;
  LChar: Char;
  LPS,LPM: PChar;
begin
  LSearchLength := Length(ASubStr);
  if (LSearchLength = 0) or (LSearchLength > MemorySize) then begin
    Result := 0;
    Exit;
  end;

  LChar := PChar(Pointer(ASubStr))^; //first char
  LPS := PChar(Pointer(ASubStr))+1;//tail string
  LPM := MemBuff;
  LS1 := LSearchLength-1;
  LSearchLength := MemorySize-LS1;//MemorySize-LS+1
  if LS1 = 0 then begin //optimization for freq used LF
    while LSearchLength>0 do begin
      if LPM^ = LChar then begin
        Result := LPM-MemBuff + 1;
        Exit;
      end;
      Inc(LPM);
      Dec(LSearchLength);
    end;//while
  end else begin
    while LSearchLength > 0 do begin
      if LPM^ = LChar then begin
        Inc(LPM);
        if CompareMem(LPM, LPS, LS1) then begin
          Result := LPM - MemBuff;
          Exit;
        end;
      end
      else begin
        Inc(LPM);
      end;
      Dec(LSearchLength);
    end;//while
  end;//if OneChar
  Result := 0;
End;
{$ENDIF}

function Min(AValueOne, AValueTwo: Integer): Integer;
begin
  If AValueOne > AValueTwo then
  begin
    Result := AValueTwo
  end //If AValueOne > AValueTwo then
  else
  begin
    Result := AValueOne;
  end; //..If AValueOne > AValueTwo then
end;

function PosIdx(const ASubStr, AStr: AnsiString; AStartPos: Cardinal): Cardinal;
{$IFDEF DotNet}
begin
  if AStartPos = 0 then begin
    AStartPos := 1;
  end;
  Result := Pos(ASubStr, Copy(AStr, AStartPos, MaxInt));
  if Result <> 0 then begin
    Inc(Result, AStartPos - 1);
  end;
end;
{$ELSE}

  // use best register allocation on Win32
  function Find(AStartPos, EndPos: Cardinal; StartChar: AnsiChar; const AStr: AnsiString): Cardinal;
  begin
    for Result := AStartPos to EndPos do
      if AStr[Result] = StartChar then
        Exit;
    Result := 0;
  end;

  // use best register allocation on Win32
  function FindNext(AStartPos, EndPos: Cardinal; const AStr, ASubStr: AnsiString): Cardinal;
  begin
    for Result := AStartPos + 1 to EndPos do
      if AStr[Result] <> ASubStr[Result - AStartPos + 1] then
        Exit;
    Result := 0;
  end;

var
  StartChar: AnsiChar;
  LenSubStr, LenStr: Cardinal;
  EndPos: Cardinal;
begin
  if AStartPos = 0 then
    AStartPos := 1;
  Result := 0;
  LenSubStr := Length(ASubStr);
  LenStr := Length(AStr);
  if (LenSubStr = 0) or (AStr = '') or (LenSubStr > LenStr - (AStartPos - 1)) then
    Exit;

  StartChar := ASubStr[1];
  EndPos := LenStr - LenSubStr + 1;
  if LenSubStr = 1 then
    Result := Find(AStartPos, EndPos, StartChar, AStr)
  else
  begin
    repeat
      Result := Find(AStartPos, EndPos, StartChar, AStr);
      if Result = 0 then
        Break;
      AStartPos := Result;
      Result := FindNext(Result, AStartPos + LenSubStr - 1, AStr, ASubStr);
      if Result = 0 then
      begin
        Result := AStartPos;
        Exit;
      end
      else
        Inc(AStartPos);
    until False;
  end;
end;
{$ENDIF}

function SBPos(const Substr, S: string): Integer;
// Necessary because of "Compiler magic"
begin
  Result := Pos(Substr, S);
end;

procedure SetThreadPriority(AThread: TThread; const APriority: TIdThreadPriority; const APolicy: Integer = -MaxInt);
begin
  {$IFDEF LINUX}
  // Linux only allows root to adjust thread priorities, so we just ingnore this call in Linux?
  // actually, why not allow it if root
  // and also allow setting *down* threadpriority (anyone can do that)
  // note that priority is called "niceness" and positive is lower priority
  if (getpriority(PRIO_PROCESS, 0) < APriority) or (geteuid = 0) then begin
    setpriority(PRIO_PROCESS, 0, APriority);
  end;
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  AThread.Priority := APriority;
  {$ENDIF}
end;

procedure Sleep(ATime: cardinal);
{$IFDEF LINUX}
var
  LTime: TTimeVal;
begin
  // what if the user just calls sleep? without doing anything...
  // cannot use GStack.WSSelectRead(nil, ATime)
  // since no readsocketlist exists to get the fdset
  LTime.tv_sec := ATime div 1000;
  LTime.tv_usec := (ATime mod 1000) * 1000;
  Libc.Select(0, nil, nil, nil, @LTime);
end;
{$ENDIF}
{$IFDEF MSWINDOWS}
begin
  Windows.Sleep(ATime);
end;
{$ENDIF}
{$IFDEF DotNet}
begin
  Thread.Sleep(ATime);
end;
{$ENDIF}

procedure SplitColumnsNoTrim(const AData: string; AStrings: TIdStrings; const ADelim: string);
var
  i: Integer;
  LDelim: Integer; //delim len
  LLeft: string;
  LLastPos: Integer;
begin
  Assert(Assigned(AStrings));
  AStrings.Clear;
  LDelim := Length(ADelim);
  LLastPos := 1;

  i := Pos(ADelim, AData);
  while I > 0 do begin
    LLeft := Copy(AData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1    {Do not Localize}
    if LLeft <> '' then begin    {Do not Localize}
      {$IfDEF DotNet}
      AStrings.AddObject(LLeft, TObject(LLastPos));
      {$else}
      AStrings.AddObject(LLeft, Pointer(LLastPos));
      {$endif}
    end;
    LLastPos := I + LDelim; //first char after Delim
    i := PosIdx(ADelim, AData, LLastPos);
  end;
  if LLastPos <= Length(AData) then begin
    {$IfDEF DotNet}
    AStrings.AddObject(Copy(AData, LLastPos, MaxInt), TObject(LLastPos));
    {$else}
    AStrings.AddObject(Copy(AData, LLastPos, MaxInt), Pointer(LLastPos));
    {$endif}
  end;
end;
{$IFNDEF DotNet}
{$ENDIF}

{$IFDEF ALLOW_NAMED_THREADS}
{$IFDEF DotNet}
procedure SetThreadName(const AName: string);
begin
  //TODO: Add support for naming the thread
end;
{$ELSE}
procedure SetThreadName(const AName: string);
type
  TThreadNameInfo = record
    RecType: LongWord;  // Must be 0x1000
    Name: PChar;        // Pointer to name (in user address space)
    ThreadID: LongWord; // Thread ID (-1 indicates caller thread)
    Flags: LongWord;    // Reserved for future use. Must be zero
  end;
var
  LThreadNameInfo: TThreadNameInfo;
begin
  with LThreadNameInfo do begin
    RecType := $1000;
    Name := PChar(AName);
    ThreadID := $FFFFFFFF;
    Flags := 0;
  end;
  try
    // This is a wierdo Windows way to pass the info in
    RaiseException($406D1388, 0, SizeOf(LThreadNameInfo) div SizeOf(LongWord),
      PDWord(@LThreadNameInfo));
  except end;
end;
{$ENDIF}
{$ELSE}
procedure SetThreadName(const AName: string);
begin
  // Do nothing. No support in this compiler for it.
end;
{$ENDIF}

procedure SplitColumns(const AData: string; AStrings: TIdStrings; const ADelim: string);
var
  i: Integer;
  LData: string;
  LDelim: Integer; //delim len
  LLeft: string;
  LLastPos: Integer;
  LLeadingSpaceCnt: Integer;
Begin
  Assert(Assigned(AStrings));
  AStrings.Clear;
  LDelim := Length(ADelim);
  LLastPos := 1;
  LData := Trim(AData);

  LLeadingSpaceCnt := 0;
  if LData <> '' then begin //if Not WhiteStr
    while AData[LLeadingSpaceCnt + 1] <= #32 do
      Inc(LLeadingSpaceCnt);
  end
  else begin
    Exit;
  end;

  i := Pos(ADelim, LData);
  while I > 0 do begin
    LLeft:= Copy(LData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1    {Do not Localize}
    if LLeft > '' then begin    {Do not Localize}
      AStrings.AddObject(Trim(LLeft), TObject(LLastPos + LLeadingSpaceCnt));
    end;
    LLastPos := I + LDelim; //first char after Delim
    i := PosIdx (ADelim, LData, LLastPos);
  end;//while found
  if LLastPos <= Length(LData) then begin
    AStrings.AddObject(Trim(Copy(LData, LLastPos, MaxInt)), TObject(LLastPos + LLeadingSpaceCnt));
  end;
end;
{$IFNDEF DotNet}
{$ENDIF}

{$IFDEF DotNet}

{ TEvent }

constructor TEvent.Create(EventAttributes: IntPtr; ManualReset,
  InitialState: Boolean; const Name: string);
begin
  inherited Create;
  // Name not used
  if ManualReset then
    FEvent := ManualResetEvent.Create(InitialState)
  else
    FEvent := AutoResetEvent.Create(InitialState);
end;

constructor TEvent.Create;
begin
  Create(nil, True, False, '');
end;

destructor TEvent.Destroy;
begin
  FEvent.Close;
  FEvent.Free;
  inherited Destroy;
end;

procedure TEvent.SetEvent;
begin
  if (FEvent is ManualResetEvent) then
    ManualResetEvent(FEvent).&Set
  else
    AutoResetEvent(FEvent).&Set;
end;

procedure TEvent.ResetEvent;
begin
  if (FEvent is ManualResetEvent) then
    ManualResetEvent(FEvent).Reset
  else
    AutoResetEvent(FEvent).Reset;
end;

function TEvent.WaitFor(Timeout: LongWord): TWaitResult;
var
  Passed: Boolean;
begin
  try
    if Timeout = INFINITE then
      Passed := FEvent.WaitOne
    else
      Passed := FEvent.WaitOne(Timeout, True);

    if Passed then
      Result := wrSignaled
    else
      Result := wrTimeout;
  except
    Result := wrError;
  end;
end;

{ TCriticalSection }

procedure TCriticalSection.Acquire;
begin
  Enter;
end;

procedure TCriticalSection.Release;
begin
  Leave;
end;

function TCriticalSection.TryEnter: Boolean;
begin
  Result := System.Threading.Monitor.TryEnter(Self);
end;

procedure TCriticalSection.Enter;
begin
  System.Threading.Monitor.Enter(Self);
end;

procedure TCriticalSection.Leave;
begin
  System.Threading.Monitor.Exit(Self);
end;

{$ENDIF}

{ TIdLocalEvent }

constructor TIdLocalEvent.Create(const AInitialState: Boolean = False; const AManualReset: Boolean = False);
begin
  inherited Create(nil, AManualReset, AInitialState, '');    {Do not Localize}
end;

function TIdLocalEvent.WaitForEver: TWaitResult;
begin
  Result := WaitFor(Infinite);
end;

{ TIdList }

{$IFNDEF VCL6ORABOVE}