httputil.pas

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

unit HTTPutil;

interface

uses
  StrUtils, Classes, SysUtils, Forms, Registry, Windows, IniFiles, StdCtrls, ComCtrls, 
  CPUid, AES, 
  Dialogs;

const
  MY_USER_AGENT            =       'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; Alexa Toolbar; mxie; .NET CLR 1.1.4322)';

  LSTB_MAX_LINE            =       500;

  RD_ST_CN = '{';
  RD_ED_CN = '}';
  RD_ST_EN = '(';
  RD_ED_EN = ')';

  DT_CN : array[0..31] of String[3] =(' - ',' 8 ',' @ ',' * ',
                                      ' _ ',' + ',' = ',' ^ ',
                                      ' : ',' . ',' ! ',' 0 ',
                                      ' I ',' o ',' O ',' U ',
                                      ' X ',' x ',' v ',' V ',
                                      ' M ',' m ',' T ',' Y ',
                                      ' A ',' H ',' # ',' % ',
                                      ' ~ ',' < ',' > ',' ? '
                                      );
  DT_NM : array[0..9] of String[2] = ('０','１','２','３',
                                      '４','５','６','７',
                                      '８','９');
  DT_EN : array[0..25] of String[2] = ('ａ','ｂ','ｃ','ｄ',
                                      'ｅ','ｆ','ｇ','ｈ',
                                      'ｉ','ｊ','ｋ','ｌ',
                                      'ｍ','ｎ','ｏ','ｐ',
                                      'ｑ','ｒ','ｓ','ｔ',
                                      'ｕ','ｖ','ｗ','ｘ',
                                      'ｙ','ｚ'
                                      );

  procedure RemoveEnter(var s : string);
  procedure GetIniSecStrings(Ini : TiniFile; Sec : String; Strs : TStrings);
  function MsgBox(Info: String; Style: integer): integer;
  function GetValByName(S,Sub: string) : string;
  function ExtractHtmlTagValues(const HtmlText: string; TagName, AttribName: string; var Values: TStringList): integer;
  function URLEncode(const msg : String) : String;
  function UrlDecode(const EncodedStr: String): String;
  Function HexToInt(Hex :String):Int64;

  function GetHexCPUid : string;
  function ClearRegCode : boolean;
  function ReadRegCode : boolean;
  function WriteRegCode : boolean;
  procedure CheckRegCode(Code : string);

  function GetRndDisTurbStrs(Content : String; Strs : TStringList; Cn : boolean) : String ;
  function GenRndDisturb(Str : String; Cn : boolean): String;
  function AnaUserLine(Line,User,RpStr : String) : String ;
  function DisTurbContent(Content : String):String;
  function FormatStrNum(Num : Integer; Len : Byte): String;
  procedure GetColumnFromLstV(LstV : TListView; Sl : TStringList; idx : Byte);
  function LStrDiv(Str,Spl : string): string;
  function RStrDiv(Str,Spl : string): string;
  function ExStrSeg(Str,Spl : string; Idx : Integer): string;
  function GenRndUSR(Prefix,Tail : string; Len : Byte): string;
  function BoolToStr(b : boolean): string;
  function IsNum(s : string): boolean;
  function GetLinkTextByURL(HTML,URL : string):string;

  procedure AddLstBPro(ListBox : TListBox; str : String; Insert : boolean; MaxLine : Integer);
  procedure AddLstVitemPro(LstV : TListView; Subs : TStringList; Data: Pointer=nil);
  procedure ChkLstV(LstV : TListView; Chk : Boolean);
  procedure RfhLstV(LstV : TListView);

implementation

uses
  Define;

procedure RemoveEnter(var s : string);
var
  i : integer;
  DelOne : boolean;
begin
  Repeat
    DelOne := false;
    for i:=1 to length(s)-1 do
    if (Ord(s[i]) = $0d) and (Ord(s[i+1]) = $0a) then
    begin
      Delete(s,i,2);
      DelOne := true;
      break;
    end;
  Until not DelOne;
end;

procedure GetIniSecStrings(Ini : TiniFile; Sec : String; Strs : TStrings);
var
  i,j : Integer;
  Keys : TStringList;
  Value : String;
begin
  Strs.Clear;
  Keys := TStringList.Create;
  Ini.ReadSection(Sec,Keys);
  for i:=0 to Keys.Count-1 do
  begin
    Value := Ini.ReadString(Sec,Keys[i],'');
    Strs.Add(Value);
  end;
  Keys.Free;
end;

function MsgBox(Info: String; Style: integer): integer;
begin
  with Application do
  begin
    NormalizeTopMosts;
    Result := MessageBox(PChar(Info), '信息提示',Style);
    RestoreTopMosts;
  end;
end;

function GetValByName(S, Sub: string) : string;
var
  EleS,EleE,iPos: Integer;
  ELeStr,ValSt: String;
  St,Ct : Integer;
  function FindEleRange(str: string ; front : boolean; posi : integer): Integer;
  var
    i: integer;
  begin
    if Front then
    begin
      for i:=posi-1 downto 1 do
      if Str[i]='<' then
      begin
        Result := i;
        break;
      end;
    end else begin
      for i := posi+1 to length(Str) do
      if Str[i]='>' then
      begin
        Result := i;
        break;
      end;
    end;
  end;
  function FindEnd (str : string; posi : integer) : Integer;
  var
    i: integer;
  begin
    for i:=posi to length(str) do
    begin
      if (str[i] ='"') or (str[i] ='''') or (str[i] =' ') then
      begin
        result := i-1;
        break;
      end;
    end;
  end;
begin
  iPos := Pos('name="'+lowercase(Sub)+'"',lowercase(S));
  if iPos = 0 then iPos := Pos('name='+lowercase(Sub),lowercase(S));
  if iPos = 0 then iPos := Pos('name='''+lowercase(Sub)+'''',lowercase(S));
  if iPos = 0 then exit;
  EleS := FindEleRange(S,TRUE,iPos);
  EleE := FindEleRange(S,FALSE,iPos);
  EleStr := Copy(S,EleS,EleE-EleS+1);
  ValSt := 'value="';
  iPos := Pos(ValSt,EleStr);
  if iPos = 0 then
  begin
    ValSt := 'value=''';
    iPos := Pos(ValSt,EleStr);
  end;
  if iPos = 0 then
  begin
    ValSt := 'value=';
    iPos := Pos(ValSt,EleStr);
  end;
  St := iPos+length(ValSt);
  Ct := FindEnd(EleStr,St)-St+1;
  Result := Copy(EleStr,St,Ct);
end;


function ExtractHtmlTagValues(const HtmlText: string; TagName, AttribName: string; var Values: TStringList): integer;

function FindFirstCharAfterSpace(const Line: string; StartPos: integer): Integer;
var i: integer; 
begin 
  Result := -1; 
  for i := StartPos to Length(Line) do 
  begin 
    if (Line[i] <> ' ') then 
    begin 
      Result := i; 
      exit; 
    end; 
  end; 
end; 

function FindFirstSpaceAfterChars(const Line: string; StartPos: integer): Integer; 
begin 
  Result := PosEx(' ', Line, StartPos);
end; 

function FindFirstSpaceBeforeChars(const Line: string; StartPos: integer): Integer;
var i: integer; 
begin 
  Result := 1; 
  for i := StartPos downto 1 do 
  begin 
    if (Line[i] = ' ') then 
    begin 
      Result := i; 
      exit; 
    end; 
  end; 
end; 

var InnerTag: string; 
    LastPos, LastInnerPos: Integer; 
    SPos, LPos, RPos: Integer; 
    AttribValue: string; 
    ClosingChar: char; 
    TempAttribName: string; 
begin 
  Result := 0;
  LastPos := 1;
  while (true) do
  begin
    // find outer tags '<' & '>'
    LPos := PosEx('<', HtmlText, LastPos);
    if (LPos <= 0) then break;
    RPos := PosEx('>', HtmlText, LPos+1);
    if (RPos <= 0) then
      LastPos := LPos + 1
    else
      LastPos := RPos + 1; 

    // get inner tag 
    InnerTag := Copy(HtmlText, LPos+1, RPos-LPos-1); 
    InnerTag := Trim(InnerTag); // remove spaces 
    if (Length(InnerTag) < Length(TagName)) then continue; 

    // check tag name 
    if (SameText(Copy(InnerTag, 1, Length(TagName)), TagName)) then 
    begin 
      // found tag 
      AttribValue := ''; 
      LastInnerPos := Length(TagName)+1; 
      while (LastInnerPos < Length(InnerTag)) do 
      begin 
        // find first '=' after LastInnerPos 
        RPos := PosEx('=', InnerTag, LastInnerPos); 
        if (RPos <= 0) then break; 

        // this way you can check for multiple attrib names and not a specific attrib 
        SPos := FindFirstSpaceBeforeChars(InnerTag, RPos); 
        TempAttribName := Trim(Copy(InnerTag, SPos, RPos-SPos)); 
        if (true) then 
        begin 
          // found correct tag 
          LPos := FindFirstCharAfterSpace(InnerTag, RPos+1); 
          if (LPos <= 0) then 
          begin 
            LastInnerPos := RPos + 1; 
            continue; 
          end; 
          LPos := FindFirstCharAfterSpace(InnerTag, LPos); // get to first char after '=' 
          if (LPos <= 0) then continue; 
          if ((InnerTag[LPos] <> '"') and (InnerTag[LPos] <> '''')) then 
          begin 
            // AttribValue is not between '"' or ''' so get it 
            RPos := FindFirstSpaceAfterChars(InnerTag, LPos+1); 
            if (RPos <= 0) then 
              AttribValue := Copy(InnerTag, LPos, Length(InnerTag)-LPos+1) 
            else 
              AttribValue := Copy(InnerTag, LPos, RPos-LPos+1); 
          end 
          else 
          begin 
            // get url between '"' or ''' 
            ClosingChar := InnerTag[LPos]; 
            RPos := PosEx(ClosingChar, InnerTag, LPos+1); 
            if (RPos <= 0) then 
              AttribValue := Copy(InnerTag, LPos+1, Length(InnerTag)-LPos-1) 
            else 
              AttribValue := Copy(InnerTag, LPos+1, RPos-LPos-1) 
          end; 

          if (SameText(TempAttribName, AttribName)) and (AttribValue <> '') then 
          begin 
            Values.Add(AttribValue);
            inc(Result); 
          end; 
        end; 

        if (RPos <= 0) then 
          LastInnerPos := Length(InnerTag) 
        else 
          LastInnerPos := RPos+1; 
      end; 
    end; 
  end; 
end;

function URLEncode(const msg : String) : String;
var
    I : Integer;
begin
    Result := '';
    for I := 1 to Length(msg) do begin
        if msg[I] = ' ' then
            Result := Result + '+'
        else if msg[I] in ['a'..'z', 'A'..'Z', '0'..'9'] then
            Result := Result + msg[I]
        else
            Result := Result + '%' + IntToHex(ord(msg[I]), 2);
    end;
end;


function UrlDecode(const EncodedStr: String): String;
var
  I: Integer;
begin
  Result := '';
  if Length(EncodedStr) > 0 then
  begin
    I := 1;
    while I <= Length(EncodedStr) do
    begin
      if EncodedStr[I] = '%' then
        begin
          Result := Result + Chr(HexToInt(EncodedStr[I+1]
                                       + EncodedStr[I+2]));
          I := Succ(Succ(I));
        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;