httputil.pas

ThreadPro 是本人开发的一套用于多线程编程的 Delphi 基础类库

function FormatStrNum(Num : Integer; Len : ShortInt): String;
var
  i,ct : ShortInt;
  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;

procedure RmHtmlTags(var src : string);
  function DelTag(var src : string):boolean;
  var
    iPosS,iPosE : Integer;
  begin
    Result := False;
    iPosS := Pos('<',src);
    if iPosS>0 then
    begin
      iPosE := Pos('>',src);
      Result := iPosE>iPosS;
      if Result then
      Delete(src,iPosS,iPosE-iPosS+1);
    end;
  end;
begin
  src := LowerCase(src);
  repeat
  Until not DelTag(src);
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('</a>',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;

procedure InitProgressBar(pb : TProgressBar; Max : Integer);
begin
  pb.Min := 0;
  pb.Max := Max;
  pb.Step := 1;
  pb.Position := 0;
end;

function CheckLvDupItem(Lv : TListView; Item : string; Col : Byte):Boolean;
var
  i : Integer;
  ItemToCheck : string;
begin
  Result := True;  //no duplicate item
  with lv do
  for i:=0 to Items.Count-1 do
  begin
    if Col<=Columns.Count then
      if Col=0 then
      ItemToCheck := Items[i].Caption
      else
      ItemToCheck := Items[i].SubItems[Col-1];
    if Item = ItemToCheck then
    begin
      Result := False;
      break;
    end;
  end;
end;

procedure SaveDialogSlExec(Owner : TComponent; FileType,FileExt : string;Items : TStrings);
var
  Dialog : TSaveDialog;
begin
  if Items.Count = 0 then Exit;
  Dialog := TSaveDialog.Create(Owner);
  try
    with Dialog do
    begin
      Filter := Format('%s??(*%s)|*%s',[FileType,FileExt,FileExt]);
      DefaultExt := FileExt;
      if Execute then
      Items.SaveToFile(FileName);
    end;
  finally
    Dialog.Free;
  end;
end;

procedure OpenDialogSlExec(Owner : TComponent; FileType,FileExt : string;Items : TStrings);
var
  Dialog : TOpenDialog;
begin
  Dialog := TOpenDialog.Create(Owner);
  try
    with Dialog do
    begin
      Filter := Format('%s??(*%s)|*%s',[FileType,FileExt,FileExt]);
      DefaultExt := FileExt;
      if Execute then
      Items.LoadFromFile(FileName);
    end;
  finally
    Dialog.Free;
  end;
end;

procedure ClrPopLst(PM : TPopupMenu);
begin
  (PM.PopupComponent as TListBox).Clear;
end;

procedure CheckChkLst(ChkLst : TCheckListBox; check : Boolean);
var
  i : Integer;
begin
  with ChkLst do
  for i:=0 to Items.Count-1 do
  Checked[i] := check;
end;

procedure OpenUrlLv(Lv : TListView; Col : Byte; Prefix : string = '');
var
  Url : string;
  Item : TListItem;
begin
  Item := Lv.Selected;
  if Item = nil then exit;
  if Col = 0 then
    Url := Item.Caption
  else if Col < Lv.Columns.Count then
    Url := Item.SubItems[Col-1];
  Url := Prefix + Url;
  OpenUrl(Url);
end;

procedure OpenUrlLst(Lst : TListBox);
begin
  if Lst.ItemIndex <0 then exit;
  OpenUrl(Lst.Items[Lst.ItemIndex]);
end;

procedure OpenUrl(Url : string);
begin
  ShellExecute(Application.Handle, 'open', PChar(Url), nil, nil, SW_MAXIMIZE);
end;

end.