httputil.pas

用delphi 编写的 验证码识别程序

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;

procedure AddLstVitemPro(LstV : TListView; Subs : TStringList; Data: Pointer=nil);
var
  item : TListItem;
begin
  with LstV do
  begin
    //Items.BeginUpdate;
    item := items.Add;
    item.Caption := IntToStr(items.Count);
    item.SubItems.Assign(Subs);
    if Data <> nil then
    item.Data := Data;
    //Items.EndUpdate;
  end;
end;

function GetHexCPUid: string;
var
  i : Byte;
  Id : TCPUID;
begin
  Id := GetCPUID;
  Result := '';
  for i:=low(Id) to High(Id) do
  Result := Result + IntToHex(Id[i],8);
end;

function ClearRegCode : boolean;
var
  ARegistry : TRegistry;
begin
  Result := True;
  ARegistry := TRegistry.Create;
  with ARegistry do
  begin
    try
      RootKey:=HKEY_LOCAL_MACHINE;
      try
        if OpenKey('Software\MicroSoft\Windows\CurrentVersion\'+PRODUCT_NAME,false) then
          WriteString('RegCode','');
      except
        Result := False;
      end;
    finally
      Free;
    end;
  end;
end;

function ReadRegCode : boolean;
var
  ARegistry : TRegistry;
begin
  Result := True;
  ARegistry := TRegistry.Create;
  with ARegistry do
  begin
    try
      RootKey:=HKEY_LOCAL_MACHINE;
      try
        if OpenKey('Software\MicroSoft\Windows\CurrentVersion\'+PRODUCT_NAME,false) then
          strRegCode:=ReadString('RegCode');
      except
        Result := False;
      end;
    finally
      Free;
    end;
  end;
end;

function WriteRegCode: boolean;
var
  ARegistry : TRegistry;
begin
  Result := True;
  ARegistry := TRegistry.Create;
  with ARegistry do
  begin
    try
      RootKey:=HKEY_LOCAL_MACHINE;
      try
        if OpenKey('Software\MicroSoft\Windows\CurrentVersion\'+PRODUCT_NAME,True) then
          WriteString('RegCode',EncryptString(GetHexCPUid,REG_KEY));
      except
        Result := False;
      end;
    finally
      Free;
    end;
  end;
end;

procedure CheckRegCode(Code : string);
begin
  bIsReg := EncryptString(GetHexCPUid,REG_KEY) = Code;
end;

//取得发贴内容中所有需要智能扰码的词组
function GetRndDisTurbStrs(Content : String; Strs : TStringList; Cn : boolean) : String ;
var
  iPos: integer;
  RD_ED,RD_ST : Char;
begin
  Strs.Clear;
  if Cn then
  begin
    RD_ED := RD_ED_CN;
    RD_ST := RD_ST_CN;
  end else begin
    RD_ED := RD_ED_EN;
    RD_ST := RD_ST_EN;
  end;
  Repeat
    iPos := Pos(RD_ST,Content);
    if iPos > 0 then
    begin
      Delete(Content,1,iPos);
      iPos := Pos(RD_ED,Content);
      if iPos > 0 then
      begin
        Strs.Add(Copy(Content,1,iPos-1));
        Delete(Content,1,iPos);
      end;
    end
  Until iPos = 0;
end;

//生成扰码词组
function GenRndDisturb(Str : String; Cn : boolean): String;
var
  i : integer;
  InsertStep : Byte;
  sl : TStringList;
  c : Char;
begin
  Str := Copy(Str,2,Length(Str)-2);
  Result := '';
  if Cn then InsertStep :=2
  else InsertStep := 1;
  sl := TStringList.Create;
  for i:=1 to Length(Str)div InsertStep do
  sl.Add(Copy(Str,(i-1)*InsertStep+1,InsertStep));
  if Cn then
  begin
    for i:=0 to Sl.Count-1 do
    Result := Result + DT_CN[Random(High(DT_CN))]+Sl[i];
    Result := Result + DT_CN[Random(High(DT_CN))];
  end else begin
    for i:=0 to Sl.Count-1 do
    begin
      c := Sl[i][1];
      if Random(2)=1 then
      if c in ['0'..'9'] then
      begin
        Sl[i] := DT_NM[StrToInt(c)];
      end else if c in ['a'..'z'] then
      begin
        Sl[i] := DT_EN[Ord(c)-97];
      end else if c in ['A'..'Z'] then
      begin
        Sl[i] := DT_EN[Ord(c)-65];
      end else
        case c of
        '.': Sl[i]:= '．';
        ':': Sl[i]:= '：';
        '/': Sl[i]:= '／';
        '@': Sl[i]:= '＠';
        end;
    end;
    for i:=0 to Sl.Count-1 do
    Result := Result + Sl[i];
  end;
  SL.Free;
end;

function AnaUserLine(Line,User,RpStr : String) : String ;
var
  iPos: integer;
  Sub,StringI : String;
begin
  StringI := Line;
  Repeat
    iPos := Pos(RpStr,StringI);
    if iPos > 0 then
    begin
      Sub := Sub + Copy(StringI,1,iPos-1) + User;
      StringI := Copy(StringI,iPos+length(RpStr),length(StringI));
    end
  Until iPos = 0;
  Result := Sub + StringI;
end;

function NewSectionName(pre: String ; len: integer) : String;
var
  i : integer;
  Temp : String;
begin
  Randomize;
  Result := '1';
  for i:=1 to len do
  Result := Result + '0';
  Result := IntToStr(Random(StrToInt(Result)));
  for i:=1 to len-length(Result) do
  Temp := '0'+ Temp;
  Result := pre + Temp + Result;
end;

function DisTurbContent(Content : String):String;
var
  Words : TStringList;
  i : Integer;
  Word : String;
  Debug : String;
begin
  Content := AnaUserLine(Content,NewSectionName('',5),'[random]');
  Words := TStringList.Create;
  GetRndDisTurbStrs(Content,Words,True);
  Debug := Words.Text;
  for i:=0 to Words.Count-1 do
  begin
    Word := RD_ST_CN+Words[i]+RD_ED_CN;
    Content := AnaUserLine(Content,GenRndDisturb(Word,true),Word);
  end;
  GetRndDisTurbStrs(Content,Words,False);
  for i:=0 to Words.Count-1 do
  begin
    Word := RD_ST_EN+Words[i]+RD_ED_EN;
    Content := AnaUserLine(Content,GenRndDisturb(Word,False),Word);
  end;
  Words.Free;
  Result := Content;
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 GenRndUSR(Prefix,Tail : string; Len : Byte): string;
var
  i : Byte;
begin
  Result := '';
  Randomize;
  for i:=1 to Len do
  Result := Result + chr(Random(26)+97);
  Result := Prefix + Result + Tail;
end;

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

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

function GetLinkTextByURL(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;

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;


end.