httputil.pas

Delphi中处理线程池的一个组件,非常好用.

        end
      else if EncodedStr[I] = '+' then
        Result := Result + ' '
      else
        Result := Result + EncodedStr[I];

      I := Succ(I);
    end;
  end;
end;

Function HexToInt(Hex :String):Int64;
Var Sum : Int64;
    I,L : Integer;
Begin
L := Length(Hex);
Sum := 0;
For I := 1 to L Do
   Begin
   Sum := Sum * 16;
   If ( Ord(Hex[I]) >= Ord('0')) and (Ord(Hex[I]) <= Ord('9')) then
      Sum := Sum + Ord(Hex[I]) - Ord('0')
   else If ( Ord(Hex[I]) >= Ord('A') ) and (Ord(Hex[I]) <= Ord('F')) then
      Sum := Sum + Ord(Hex[I]) - Ord('A') + 10
   else If ( Ord(Hex[I]) >= Ord('a') ) and ( Ord(Hex[I]) <= Ord('f')) then
      Sum := Sum + Ord(Hex[I]) - Ord('a') + 10
   else
      Begin
      Sum := -1;
      break;
      End;
   End;
Result := Sum;
End;



procedure AddLstBPro(ListBox : TListBox; str : string; Insert : boolean; MaxLine : Integer);
var
  Ct : Integer;
begin
  with ListBox do
  begin
    Ct := Count;
    if InSert then
    begin
      if Ct > MaxLine then
      Items.Delete(Ct-1);
      Items.Insert(0,str);
    end else begin
      if Ct > MaxLine then
      Items.Delete(0);
      Items.Add(str);
    end;
  end;
end;


function FormatStrNum(Num : Integer; Len : Byte): String;
var
  i,ct : Byte;
  Zeros,sNum : String;
begin
  sNum := IntToStr(Num);
  ct := Len - Length(sNum);
  if ct > 0 then
    for i:=1 to ct do
      Zeros := Zeros + '0';
  Result := Zeros + IntToStr(Num);
end;

procedure GetColumnFromLstV(LstV : TListView; Sl : TStringList; idx : Byte);
var
  i : Byte;
begin
  with LstV do
  for i:=0 to Items.Count-1 do
  Sl.Add(Items[i].SubItems[idx]);
end;

function LStrDiv(Str,Spl : string): string;
var
  iPos : Integer;
begin
  iPos := Pos(Spl,Str);
  if iPos>0 then
  Result := Copy(Str,1,iPos-1);
end;

function RStrDiv(Str,Spl : string): string;
var
  iPos : Integer;
begin
  iPos := Pos(Spl,Str);
  if iPos>0 then
  begin
    Delete(Str,1,iPos+Length(Spl)-1);
    Result := Str;
  end;
end;

function ExStrSeg(Str,Spl : string; Idx : Integer): string;
var
  Values : TStringList;
begin
  Values := TStringList.Create;
  ExtractStrings([Spl[1]],[],PChar(Str),Values);
  if Values.Count >= Idx then
  Result := Values[Idx-1];
  Values.Free;
end;

function RndStr(Len : Byte): string;
var
  i : Byte;
begin
  Result := '';
  for i:=1 to Len do
  Result := Result + chr(Random(26)+97);
end;

function RndStrNum(Len : Byte): string;
var
  i : Byte;
  NumOrStr : boolean;
begin
  Result := '';
  for i:=1 to Len do
  begin
    NumOrStr := Random(2)=1;
    if NumOrStr then
      Result := Result + RndStr(1)
    else
      Result := Result + RndNum(1);
  end;
end;

function RndCnChr(dLen : Byte):string;
var
  i: Integer;
begin
  Result := '';
  for i:=1 to dLen*2 do
  Result := Result + Chr(Random($fe-$a1)+$a1);
end;

function RndIdx(Range : Integer): Integer;
begin
  if Range>1 then
  begin
    Randomize;
    Result := Random(Range);
  end else
    Result := 0;
end;

function RndSlItem(sl : TStringList):string;
var
  idx : Integer;
begin
  if sl.Count > 1 then
    idx := Random(sl.Count)
  else
    idx := 0;
  Result := sl[idx];
end;


function RndNum(Len : Byte):string;
var
  i : Byte;
begin
  Result := '';
  for i:=1 to Len do
  Result := Result + chr(Random(10)+48);
end;

function BoolToStr(b : boolean): string;
begin
  if b then Result := '成功' else
  Result := '失败';
end;

function BoolToInt(b : boolean): SmallInt;
begin
  if b then Result := 0
  else Result := 1;
end;

function IsNum(s : string): boolean;
var
  i : Byte;
begin
  if Trim(s) = '' then
  begin
    Result := False;
    exit;
  end;
  Result := true;
  for i:=1 to length(s) do
  result := result and (Ord(s[i]) in [48..57]);
end;

function ExtractNum(s : string; pos : integer): Integer;
var
  strNum : string;
  bNum : boolean;
begin
  strNum := '';
  repeat
    bNum := IsNum(s[pos]);
    if bNum then
    strNum := strNum + s[pos];
    Inc(pos);
  until not bNum;
  if strNum = '' then
  Result := -1 else
  Result := StrToInt(strNum);
end;

function MemoToStr(Strs : TStrings ; Sp : string): string;
var
  j,Temp : integer;
begin
  Result := '';
  Temp := Strs.Count-1;
  for j:=0 to Temp do
    if Trim(Strs[j])<>'' then
    Result := Result + Strs[j] + Sp;
  Result := Copy(Result,1,Length(Result)-1);
end;

//Get Nums or ip addr in front of or behind the first position  of a specific string in a given string
function GetDigAt(s, sp : string; front : boolean): string;
var
  iPos,i : integer;
  SubStr,chr : String;
begin
  iPos := Pos(sp,s);
  if iPos > 0 then
  begin
    if front then
    SubStr := copy(s,1,iPos-1)
    else
    SubStr := copy(s,iPos+length(sp),Length(s)-length(sp)-1);
    i := 1;
    while true do
    begin
      if front then
        chr := copy(SubStr,length(SubStr)-i+1,1)
      else
        chr := copy(SubStr,i,1);
      if (IsNum(chr) or (chr = '.') or (chr = ' ')) and (i-1<length(SubStr)) then
        Inc(i)
      else begin
        if front then
          Result := trim(copy(SubStr,length(SubStr)-i+2,i-1))
        else
          Result := trim(copy(SubStr,1,i-1));
        break;
      end;
    end;
  end;
end;

function ParseUrl(Url : string; Host : Boolean) : string;
var
  iPos : integer;
const
  Prefix : string = 'http://';
begin
  Result := Url;
  iPos := Pos(Prefix,Url);
  if iPos = 1 then
  Delete(Result,1,length(Prefix));
  iPos := Pos('/',Result);
  if iPos > 0 then
  begin
    if Host then
      Delete(Result,iPos,length(Result)-iPos+1)
    else
      Delete(Result,1,iPos-1);
  end else begin
    if not Host then
    Result := '/';
  end;
end;

function GetLinkTextByUniqueURL(HTML,URL : string):string;
var
  iPos : Integer;
begin
  iPos := Pos(URL,HTML);
  if iPos > 0 then
  begin
    Delete(HTML,1,iPos);
    iPos := Pos('>',HTML);
    if iPos>0 then
    begin
      Delete(HTML,1,iPos);
      iPos := Pos('<',HTML);
      if iPos>0 then
      Result := Trim(Copy(HTML,1,iPos-1));
    end;
  end;
end;

procedure ChkLstV(LstV : TListView; Chk : Boolean);
var
  i: Integer;
begin
  for i:=0 to LstV.Items.Count-1 do
  LstV.Items[i].Checked := Chk;
end;

function ChkSelLstV(LstV : TListView; Chk : Boolean): Integer;
var
  Item: TListItem;
begin
  Result := 0;
  Item := LstV.Selected;
  while Item <> nil do
  begin
    Inc(Result);
    Item.Checked := Chk;
    Item := LstV.GetNextItem(Item, sdAll, [isSelected]);
  end;
end;

procedure RfhLstV(LstV : TListView);
var
  i : Integer;
begin
  for i:=0 to LstV.Items.Count-1 do
  LstV.Items[i].Caption := IntToStr(i+1);
end;

procedure eplstV(lst : TListView; FileName,Sp : String);
var
  F: TextFile;
  S: string;
  i: integer;
begin
  with lst do
  begin
     Assignfile(F,FileName);
     Rewrite(F);
     try
       for i:=0 to Items.Count - 1 do
       begin
          S := MemoToStr(Items[i].SubItems,Sp);
          Writeln(F,S);
       end;
     finally
       CloseFile(F);
     end;
  end;
end;


function CopyLv(lv : TListView) : Integer;
var
  Item: TListItem;
  Items : TStringList;
begin
  Result := 0;
  Item := lv.Selected;
  Items := TStringList.Create;
  while Item <> nil do
  begin
    Items.Add(MemoToStr(Item.SubItems,' '));
    Item := lv.GetNextItem(Item, sdAll, [isSelected]);
  end;
  Clipboard.AsText := Items.Text;
  Items.Free;
end;


procedure AddLv(Lv : TListView; SubItems: TStringList; MakeVisible : Boolean = True; Checked : Boolean = True; ImgIdx : SmallInt= -1; Data : Pointer= nil);
var
  i : Integer;
  Item : TListItem;
begin
  with Lv do
  begin
    Item := Items.Add;
    Item.Caption := IntToStr(Items.Count);
    for i:=0 to SubItems.Count-1 do
    Item.SubItems.Add(SubItems[i]);
    if ImgIdx >= 0 then
    Item.ImageIndex := ImgIdx;
    Item.Checked := Checked;
    if MakeVisible then
    Item.MakeVisible(False);
    if Data<>nil then
    Item.Data := Data;
  end;
end;

procedure RfhLvItem(Lv : TListView; NewText : string ;Row : Integer; Col : Byte; MakeVisible : Boolean = True; Checked : Boolean = True; ImgIdx : SmallInt= -1; Data : Pointer= nil);
var
  Item : TListItem;
begin
  with Lv do
  begin
    if Row < Items.Count then
    begin
      Item := Items[Row];
      if Col = 0 then
        Item.Caption := NewText
      else if Col < Columns.Count then
        Item.SubItems[Col-1] := NewText;
      if ImgIdx >= 0 then
      Item.ImageIndex := ImgIdx;
      Item.Checked := Checked;
      if MakeVisible then
      Item.MakeVisible(False);
      if Data<>nil then
      Item.Data := Data;
    end;
  end;
end;


end.