uconstants.pas

自己写的一个 RSS 阅读器

unit uConstants;

interface
uses MSXML2_TLB,ComCtrls;

procedure SetNodeBoldState(Node: TTreeNode; Value: Boolean);
procedure StrToFile(fileName, data: string);
function GetNodeVal(node : IXmlDomNode; xPath : string): Widestring;
procedure SetNodeVal(node : IXmlDomNode; xPath,Value : string);
function GetNodeAttrVal(node : IXmlDomNode; xAttrName : string): Widestring;
procedure SetNodeAttrVal(node:IXMLDOMNode;xAttrName: string;Value:OleVariant);
procedure CreateEmptyRssXml(Dir,Filename:string);
function replaceUrl(UrlBase,HTML:string):string;
function GetProxySettingsFromIE(var Host: string; var Port: integer; var ProxyEnabled: boolean): boolean;

implementation
uses Windows,Classes,MProperties,RegExpr,FastStrings,CommCtrl,Registry,SysUtils;

function GetProxySettingsFromIE(var Host: string; var Port: integer; var ProxyEnabled: boolean): boolean;
var
  s, sporttmp: string;
  p: integer;
begin
  with TRegistry.Create do
  begin
    RootKey := HKEY_CURRENT_USER;
    ProxyEnabled := false;
    s := '';
    OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet Settings',
      True);
    if ValueExists('ProxyServer') then
      s := ReadString('ProxyServer');

    if s <> '' then
    begin
      p := pos(':', s);
      if p = 0 then
        p := length(s) + 1;
      Host := copy(s, 1, p - 1);
      try
        Port := StrToInt(copy(s, p + 1, 999));
      except
        Port := 80;
      end;

      ProxyEnabled := true;
    end;

    if ValueExists('ProxyEnable') then
    begin
      case GetDataType('ProxyEnable') of
        rdString,
          rdExpandString:
          begin
            sPortTmp := AnsiLowerCase(ReadString('ProxyEnable'));
            ProxyEnabled := true;
            if pos(' ' + sPortTmp + ' ', ' yes true t enabled 1 ') > 0 then
              ProxyEnabled := true
            else if pos(' ' + sPortTmp + ' ', ' no false f none disabled 0 ') > 0
              then
              ProxyEnabled := false
          end;
        rdInteger:
          begin
            ProxyEnabled := ReadBool('ProxyEnable');
          end;
        rdBinary:
          begin
            ProxyEnabled := true;
            ReadBinaryData('ProxyEnable', ProxyEnabled, 1);
          end;
      end;
    end;

    Free;
  end;
  
  Result := s <> '';
end;

procedure SetNodeBoldState(Node: TTreeNode; Value: Boolean);
var
  TVItem: TTVItem;
begin
  if not Assigned(Node) then Exit;

  with TVItem do
  begin
    mask := TVIF_STATE or TVIF_HANDLE;
    hItem := Node.ItemId;
    //stateMask := TVIS_BOLD;
    if Value then
      state := TVIS_BOLD
    else
      state := 0;
    TreeView_SetItem(Node.Handle, TVItem);
  end;
end;

procedure SetNodeVal(node : IXmlDomNode; xPath,Value : string);

begin
  if assigned(node.selectSingleNode(xPath)) then
	  node.selectSingleNode(xPath).text := Value
  else
    node.appendChild(node.ownerDocument.createElement(xPath)).text:=Value;
end;

function GetNodeVal(node : IXmlDomNode; xPath : string): Widestring;
var
	n : IXmlDomNode;
begin
	n := node.selectSingleNode(xPath);
  if Assigned(n) then
  	Result := n.Text
  else
  	Result := '';
end;

function GetNodeAttrVal(node : IXmlDomNode; xAttrName : string): Widestring;
var
	n : IXmlDomNode;
begin
	n := node.attributes.getNamedItem(xAttrName);
  if Assigned(n) then
  	Result := n.Text
  else
  	Result := '';
end;
procedure SetNodeAttrVal(node:IXMLDOMNode;xAttrName : string;Value:OleVariant);
begin
  (node as IXMLDOMElement).setAttribute(xAttrName,Value);
end;

procedure StrToFile(fileName, data: string);
var
	f : TextFile;
begin
  AssignFile(f, fileName);
  Rewrite(f);
  Write(f, data);
  Flush(f);
  CloseFile(f);
end;

function CurrentLocalBias: TDateTime;
const 
  MinsInDay = 1440; 
var 
  TZInfo: TTimeZoneInformation;
begin
  case GetTimeZoneInformation(TZInfo) of 
    TIME_ZONE_ID_DAYLIGHT:
      Result := (TZInfo.Bias + TZInfo.DaylightBias) / MinsInDay;
    TIME_ZONE_ID_STANDARD:
      Result := (TZInfo.Bias + TZInfo.StandardBias) / MinsInDay; 
    TIME_ZONE_ID_UNKNOWN: 
      Result := TZInfo.Bias / MinsInDay; 
  else 
   Result := TZInfo.Bias / MinsInDay; 
  end; 
end;

procedure CreateEmptyRssXml(Dir,Filename:string);
var resStream:TResourceStream;
begin
  resStream:=TResourceStream.Create(HInstance, 'RSSXML', 'XML');
  try
    resStream.SaveToFile(Dir+FileName);
  finally
    resStream.Free;
  end;
end;

function replaceUrl(UrlBase,HTML:string):string;
const
  regImgStr =   'src=["|'']([\w- ./?%&=]*)["|'']';
  regHrefStr = 'href=["|'']([\w- ./?%&=]*)["|'']';
var
  r:TRegExpr;
  URLPath,sHtml:string;
  len:Integer;
begin
  //========================================================
  // 替换相对URL为绝对URL
  //========================================================
  r:=TRegExpr.Create;
  r.ModifierI:=True;
  r.Expression:=regImgStr;
  len:=0;
  URLPath:=ExtractURLPath(UrlBase);
  sHtml:=HTML;
  if r.Exec (sHTML) then
  repeat
    Insert(URLPath,sHTML,r.MatchPos[0]+5+len);
    len:=len+Length(URLPath);
  until not r.ExecNext;
  len:=0;
  r.Expression:=regHrefStr;
  if r.Exec (sHTML) then
  repeat
    Insert(URLPath,sHTML,r.MatchPos[0]+6+len);
    len:=len+Length(URLPath);
  until not r.ExecNext;
  r.Free;
  result := sHTML;
  //========================================================
end;


end.