وبلاگ شخصی حامد شیرزاد
وبلاگ شخصی حامد شیرزاد
صفحات وبلاگ
نویسنده: حامد شیرزاد - ۱۳٩٠/۸/۱٢
function ExtractHtmlTagValues(const HtmlText: string; TagName, AttribName: string; var Values: TStrings): 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;
نویسنده: حامد شیرزاد - ۱۳٩٠/۸/۱٢
 
(* ------------------------------
 If you need to know if 
there is any text
 selected in a TWebbrowser use this code:
 Required unit: MSHTML
// *)
 
function 
              HasSelection(Document: IHTMLDocument2): 
Boolean;
var
 LEnabled: Boolean;
 
pSel: IHTMLSelectionObject;
 
pRange: IHTMLTxtRange;
begin
 LEnabled 
:= False;
 if Document <
              > nil 
then
 
begin
 pSel := 
Document.selection as IHTMLSelectionObject;
 if pSel <
              > nil 
then
 
begin
 
if pSel.type_ = 'Text' 
then
 
begin
 
pRange := pSel.createRange as 
IHTMLTxtRange;
 
if (pRange <
              > nil) and (Length(Trim(pRange.text)) > 0) 
then
 
LEnabled := 
True;
 
end;
 
end;
 end;
 Result := LEnabled;
end;
 
// --------
// Usage:
// --------
if 
HasSelection(WebBrowser1.Document as IHTMLDocument2) 
then
begin
 // ...
end;
نویسنده: حامد شیرزاد - ۱۳٩٠/۸/٩
// Extract plain text from html string
 
function StripHTMLTags(const strHTML: string): string;
var
   P: PChar;
   InTag: Boolean;
   i, intResultLength: Integer;
begin
     P := PChar(strHTML);
     Result := '';
 
     InTag := False;
     repeat
           case P^ of
              '<': InTag := True;
              '>': InTag := False;
              #13, #10: ; {do nothing}
           else
               if not InTag then
               begin
                    if (P^ in [#9, #32]) and ((P+1)^ in [#10, #13, #32, #9, '<']) then
                    else
                        Result := Result + P^;
               end;
           end;
 
           Inc(P);
     until (P^ = #0);
 
     {convert system characters}
     Result := StringReplace(Result, '"', '"',  [rfReplaceAll]);
     Result := StringReplace(Result, '&
              apos;', '''', [rfReplaceAll]);
     Result := StringReplace(Result, '>',   '>',  [rfReplaceAll]);
     Result := StringReplace(Result, '<',   '<',  [rfReplaceAll]);
     Result := StringReplace(Result, '&',  '&',  [rfReplaceAll]);
     {here you may add another symbols from RFC if you need}
end;
نویسنده: حامد شیرزاد - ۱۳٩٠/۸/٩
(* ------------------------------
  Check if connected to
  the network / internet or not
------------------------------ *)
 
const
   INTERNET_CONNECTION_MODEM          = 1;
   INTERNET_CONNECTION_LAN            = 2;
   INTERNET_CONNECTION_PROXY          = 4;
   INTERNET_CONNECTION_MODEM_BUSY     = 8;
 
function InternetGetConnectedState(lpdwFlags: LPDWORD;
         dwReserved: DWORD): BOOL; stdcall; external 'WININET.DLL';
 
function IsConnectedToInternet() : boolean;
var
   dwConnectionTypes: Integer;
begin
     try
        dwConnectionTypes := INTERNET_CONNECTION_MODEM +
                             INTERNET_CONNECTION_LAN +
                             INTERNET_CONNECTION_PROXY;
 
        if InternetGetConnectedState(@dwConnectionTypes, 0) then
           Result := true
        else
            Result := false;
     except
           Result := false;
     end;
end;
 
// ---------
// Usage:
// ---------
 
if IsConnectedToInternet then
   // do something, we are connected
else
    // No active connection
مطالب قدیمی تر »
نویسندگان وبلاگ:
مطالب اخیر:
کدهای اضافی کاربر :