卖掉＜桌面开屏＞软件客户端源码(200分)

linuxping · 2008-02-27

低价出售 参见网址　www.duping.net.cn 其实更多的功能被屏蔽掉了． 比如： 　　支持Socks代理，http代理，ftp代理． 　　可以在桌面上随便写留言条． 　　支持多个服务器的负荷均衡 　　支持服务器向客户端定点发送信息等．

linuxping · 2008-02-27

linuxping · 2008-02-28

? 郁闷。。。。。。。。。

kinneng · 2008-02-28

不知道是什么好东西？帮您顶

huanghq123 · 2008-02-28

只见过孔雀开屏，还真没见过桌面开屏

幸福人生1 · 2008-02-28

这个不是和“开屏桌面画报”一样吗 我用它几个月了，无聊时可以看看那些精美图片，看一些时尚信息，我用着挺好用的， 但值多少钱我就不敢说了，因为我对这个不敢贸然揣测，至少值几万元吧

迷路人 · 2008-02-28

个人觉得要发展这个软件要在开出来的图片里加入广告，靠广告收入

linuxping · 2008-02-29

to 幸福人生1: 　确实就是　开屏桌面画报 to 迷路人:   你的观点我很同意． 　但我是个人，靠广告收入，很难推广． 　另外，可以和电信，水厂什么的绑定，用来查询话费，水费等． 　当然还有其他用途，仁者见仁了．

无欲则刚 · 2008-02-29

新鲜玩意？

kinneng · 2008-03-03

弹出窗口？

linuxping · 2008-03-03

多谢无欲则刚 kinneng 2位关心             不是什么新鲜玩意也没有弹出窗口。

xifengge · 2008-03-05

很漂亮，做得相当不错哈。 不过我的卡巴斯基主动防御有这个警告： 【进程试图更改删除这个在注册表中属于组 Kaspersky Settings. 键值: HKEY_LOCAL_MACHINE/SOFTWARE/CLASSES/CLSID/{51D33728-411D-423D-B1C3-92717AB6970A}/Control】 源码目前对我来说还是没用，先帮你顶一下。

linuxping · 2008-03-05

多谢xifengge 我会注意你出现的问题。

dcs_dcs · 2008-03-05

什么都是钱。

linuxping · 2008-03-06

为了生活

kinneng · 2008-03-06

写软件不是为赚钱就是为了出名，难道为了自娱自乐，写软件也要投入，也要成本的， 而且好软件的成本也相应巨大，别又天真又傻了。

linuxping · 2008-06-14

就说www.duping.net.cn吧 不给俺钱，俺的东西还挂着~  我靠~~

linuxping · 2008-06-14

发点源代码： {*******************************************************} {                                                       } {                  解析XML文件单元                      } {                                                       } {*******************************************************} unit XMLReader; interface uses SysUtils, Variants, Classes, Dialogs, Forms,xmldom, XMLIntf, msxmldom, XMLDoc,Types,Graphics,SyncObjs; const DefBkColor=clyellow;       DefFontColor=ClRed;       DefFontSize=8; type   TUrlCollection=class;   TUrlItem=class;   IUpdateFileXmlReader=Interface     procedure ChannelFiles(PlayType,Channel:string;var List,ListTime,ListURL:TStrings;IsLocal:Boolean=True);     procedure ChannelUpdateFiles(PlayType,Channel:string;var List,ListTime,ListURL:TStrings);     procedure AddFile(PlayType,Channel:string;FileName:string;URLFileName:string;LastModifyTime:string);     procedure FileUrls(PlayType,Channel,FileName:string;var URLs:TUrlCollection);   end;   ITopicFileXmlReader=Interface      procedure AllPlayTypes(List:TStrings);      procedure ChannelsOfPlayType(PlayTypeName:String;List:TStrings);   end;   TBaseXmlReader=class(TInterfacedObject)     private       FXmlDoc:TXMLDocument;       FPath:string;       procedure SetDocText(Text:string);       function GetDocText:string;     public       procedure SaveToFile;overload;       procedure EnumChildNodes(Node:IXMLNode;var Lst:TStrings); //枚举一个节点下的所有子节点。       procedure EnumChildNodesAttr(Node:IXMLNode;AttrName:string;var Lst:TStrings);//枚举一个节点下的所有子节点的某一属性的值       function FindNode(ParentNode:IXMLNode;tagName:string):IXMLNode;overload; //查找一个节点下的所有子节点中       function FindNode(ParentNode:IXMLNode;tagName:string;AttributeName,AttributeValue:WideString):IXMLNode;overload;       function FindNode(ParentNode:IXMLNode;tagName:string;                         AttributeName1,AttributeValue1:WideString;                         AttributeName2,AttributeValue2:WideString):IXMLNode;overload;       function FindNodeNext(Sibling:IXMLNode;tagName:string):IXMLNode;overload;       function FindNodeNext(Sibling:IXMLNode;tagName:string;AttributeName,AttributeValue:WideString):IXMLNode;overload;       function FindNodeNext(Sibling:IXMLNode;tagName:string;                             AttributeName1,AttributeValue1:WideString;                             AttributeName2,AttributeValue2:WideString):IXMLNode;overload;     public       constructor Create(APath:string);overload;       constructor Create;overload;       destructor Destroy;override;       procedure WriteToXML(APath:string; AStr:String); //将字符串写入到xml文件。原文件将被覆盖。       function FirstNode:IXMLNode;       function Root:IXMLNode;       function  AddChild(Node:IXMLNode;ChildNodeName:WideString):IXMLNode; // 添加一个子节点       procedure AddAttribute(Node:IXMLNode;AttributeName,AttributeValue:WideString); // 给节点添加一个属性       procedure SetText(Node:IXMLNode;AText:WideString);  //给节点设置一个文本值。       function GetNodeAttributeValue(Node:IXMLNode;AttributeName:WideString):WideString;       function GetNodeText(Node:IXMLNode):WideString;       procedure SaveToFile(APath:string);overload;  //XmlDoc的内容保存到文件       property  DocText:string  read GetDocText write SetDocText;   end;   TUpdateFileXmlReader=class(TInterfacedObject,IUpdateFileXmlReader)   private     FUpdateFile,FLocalFile:TBaseXmlReader;     FUpdateFilePath,FLocalFilePath:string;   public     constructor Create(AUpdateFilePath,ALocalFilePath:String);     destructor Destroy;override;     procedure ChannelFiles(PlayType,Channel:string;var List,ListTime,ListURL:TStrings;IsLocal:Boolean=True);     procedure ChannelUpdateFiles(PlayType,Channel:string;var List,ListTime,ListURL:TStrings);     procedure AddFile(PlayType,Channel:string;FileName:string;URLFileName:string;LastModifyTime:string);     procedure FileUrls(PlayType,Channel,FileName:string;var URLs:TUrlCollection);     //procedure Reload;   end;   TTopicFileXmlReader=class(TBaseXmlReader,ITopicFileXmlReader)   public      procedure AllPlayTypes(List:TStrings);      procedure ChannelsOfPlayType(PlayTypeName:String;List:TStrings);   end; //-------------------------------------------------------------   TUrlItem=class(TCollectionItem)   protected     procedure AssignTo(Dest: TPersistent);override;   public     Text,Src:String;     Position:TRect;     Font:TFont;     BkColor:TColor;     constructor Create(Collection: TCollection);override;     destructor Destroy;override;   end;   TUrlItemClass=class of TUrlItem;   TUrlCollection=class(TCollection)     protected       procedure ParseUrl(APath:string);virtual;     public       constructor Create(APath:string);reintroduce;   end;   //---------------------------------------------   function ParserColor(C:String):TColor;   function PaserToHtml(AText:String):string; //替换掉一些字符，使之成为html格式。 implementation uses StrUtils; var      FCS:TCriticalSection;   function PaserToHtml(AText:String):string; //替换掉一些字符，使之成为html格式。   begin     AText:= StringReplace(AText,'(','<',[rfReplaceAll , rfIgnoreCase]);     Result:= StringReplace(AText,')','>',[rfReplaceAll , rfIgnoreCase]);   end;   //  #AAFFCC---->$AAFFCC   function ParserColor(C:String):TColor;   begin     if LeftStr(C,1)='#' then       AnsiReplaceStr(C,'#','$');     Result:=StrToIntDef(C,clWhite);   end; { TBaseXmlReader } procedure TBaseXmlReader.AddAttribute(Node: IXMLNode; AttributeName,   AttributeValue: WideString); begin   FXMLDoc.Active:=True;   Node.Attributes[AttributeName]:=AttributeValue; end; function TBaseXmlReader.AddChild(Node: IXMLNode;   ChildNodeName: WideString): IXMLNode; begin   FXMLDoc.Active:=True;   Result:=Node.AddChild(ChildNodeName); end; procedure TBaseXmlReader.SetText(Node: IXMLNode; AText: WideString); begin   FXMLDoc.Active:=True;   Node.Text:=AText; end; constructor TBaseXmlReader.Create(APath:string); begin   FXMLDoc:=TXMLDocument.Create(Application);   FPath:=APath;   FXmlDoc.LoadFromFile(APath);   try     FXMLDoc.Active:=True;   except    //;   end;   FXMLDoc.Encoding:='GB2312';   FXMLDoc.Options:=[doNodeAutoCreate,doNodeAutoIndent ,doAutoSave,doAttrNull];   FXmlDoc.ParseOptions:=FXmlDoc.ParseOptions+[poAsyncLoad];   if FXMLDoc.IsEmptyDoc then   begin     FXMLDoc.Active:=False;     FXMLDoc.XML.Text:='<?xml version="1.0" encoding="GB2312"?> <Root></Root>  ';     FXMLDoc.Active:=True;   end; end; constructor TBaseXmlReader.Create; begin   FXMLDoc:=TXMLDocument.Create(Application);   if FXMLDoc.IsEmptyDoc then   begin     FXMLDoc.Active:=False;     FXMLDoc.XML.Text:='<?xml version="1.0" encoding="GB2312"?><Root></Root>  ';     FXMLDoc.Active:=True;   end;   FXMLDoc.Encoding:='GB2312';   FXMLDoc.Options:=[doNodeAutoCreate,doNodeAutoIndent ,doAutoSave]; end; destructor TBaseXmlReader.Destroy; begin   FXMLDoc.Active:=False;   FXMLDoc:=nil;   inherited; end; procedure TBaseXmlReader.WriteToXML(APath, AStr: String); begin   SetDocText(AStr);   SaveToFile(APath);   FXmlDoc.LoadFromFile(APath); end; procedure TBaseXmlReader.SetDocText(Text: string); begin   try     FXMLDoc.Active:=False;     FXMLDoc.XML.Text:=Text;     FXMLDoc.Active:=True;   Except     MessageDlg('错误的XML文件格式！', mtError,[mbYes],0);     Abort;   end; end; procedure TBaseXmlReader.SaveToFile(APath: string); begin      //Encoding NOT Write!!!   FXMLDoc.NodeIndentStr:=#32#32;   FXMLDoc.Active:=True;   FXmlDoc.SaveToFile(APath); end; function TBaseXmlReader.GetNodeAttributeValue(Node: IXMLNode;   AttributeName:WideString): WideString; begin   Result:=Node.Attributes[AttributeName];   //if AttributeName NOT Exist, Return Empty str . end; function TBaseXmlReader.GetNodeText(Node: IXMLNode): WideString; begin            //if TextNodes NOT Found, Error Occur .   Result:=Node.Text; end; function TBaseXmlReader.GetDocText: string; begin   FXMLDoc.Active:=True;   Result:=FXMLDoc.XML.Text; end; function TBaseXmlReader.FirstNode: IXMLNode; begin    Result:=nil;    if root.HasChildNodes then        Result:=root.ChildNodes[0]; end; function TBaseXmlReader.Root: IXMLNode; begin   try     Result :=FXMLDoc.ChildNodes.Get(1);   except     Result:=nil;   end;  //if FirstNode Not Exsit , An Error occur. end; procedure TBaseXmlReader.EnumChildNodes(Node: IXMLNode; var Lst: TStrings); var   I:Integer; begin   for I:=0 to Node.ChildNodes.Count-1 do     Lst.Add(Node.ChildNodes.NodeName) end; function TBaseXmlReader.FindNode(ParentNode: IXMLNode;  tagName: string): IXMLNode; begin   if ParentNode=nil then Exit;   Result:=ParentNode.ChildNodes.FindNode(tagName); end; function TBaseXmlReader.FindNode(ParentNode: IXMLNode; tagName: string;   AttributeName1, AttributeValue1, AttributeName2,   AttributeValue2: WideString): IXMLNode; var  N:IXMLNode; begin   Result:=Nil;   N:=FindNode(ParentNode,tagName);   if N=nil then Exit;   while N<>nil do   begin     if (N.NodeName=tagName) AND(N.Attributes[AttributeName1]=AttributeValue1) and (N.Attributes[AttributeName2]=AttributeValue2) then     begin       Result:=N;       Exit;;     end;     N:=N.NextSibling;   end; end; function TBaseXmlReader.FindNode(ParentNode: IXMLNode; tagName: string;   AttributeName, AttributeValue: WideString): IXMLNode; var  N:IXMLNode; begin   Result:=Nil;   N:=FindNode(ParentNode,tagName);   if N=nil then Exit;   while N<>nil do   begin     //ShowMessage((WideCharToString(PWideChar(WideUpperCase(N.NodeName)))));     //ShowMessage(WideUpperCase(N.Attributes[AttributeName]));     if ((WideCharToString(PWideChar(WideUpperCase(N.NodeName))))=UpperCase(tagName)) AND (WideUpperCase(N.Attributes[AttributeName])=WideUpperCase(AttributeValue)) then     begin       Result:=N;       Exit;;     end;     //while (N<>nil) and (N.NodeName<>tagName)do     N:=N.NextSibling;   end; end; function TBaseXmlReader.FindNodeNext(Sibling: IXMLNode;   tagName: string): IXMLNode; var  N:IXMLNode; begin   Result:=Nil;   N:=Sibling.NextSibling;   if N=nil then Exit;   while N<>nil do   begin     if UpperCase(N.NodeName)=UpperCase(tagName) then     begin       Result:=N;       Exit;;     end;     N:=N.NextSibling;   end; end; function TBaseXmlReader.FindNodeNext(Sibling: IXMLNode; tagName: string;   AttributeName1, AttributeValue1, AttributeName2,   AttributeValue2: WideString): IXMLNode; var  N:IXMLNode; begin   Result:=Nil;   N:=FindNode(Sibling.ParentNode,tagName);   if N=nil then Exit;   N:=N.NextSibling;   while (N<>nil) or (N.NodeName<>tagName) or (N.Attributes[AttributeName1]<>AttributeValue1) or (N.Attributes[AttributeName2]<>AttributeValue2) do     N:=N.NextSibling;   Result:=N; end; function TBaseXmlReader.FindNodeNext(Sibling: IXMLNode; tagName: string;   AttributeName, AttributeValue: WideString): IXMLNode; var  N:IXMLNode; begin   Result:=Nil;   N:=FindNode(Sibling.ParentNode,tagName);   if N=nil then Exit;   N:=N.NextSibling;   while (N<>nil) or (N.NodeName<>tagName) or (N.Attributes[AttributeName]<>AttributeValue) do     N:=N.NextSibling;   Result:=N; end; procedure TBaseXmlReader.EnumChildNodesAttr(Node: IXMLNode;AttrName:string;   var Lst: TStrings); var   I:Integer; begin   for I:=0 to Node.ChildNodes.Count-1 do     Lst.Add(WideCharToString(PWideChar(VarToWideStr(Node.ChildNodes.Attributes[AttrName])))); end; procedure TBaseXmlReader.SaveToFile; begin   FXmlDoc.SaveToFile(Self.FPath); end; { TTopicFileXmlReader } procedure TTopicFileXmlReader.AllPlayTypes(List: TStrings); var   N:IXMLNode; begin   Assert(Assigned(List),Format('类%S的方法%S的参数%S未赋值。',[Self.ClassName,'AllPlayTypes','List']));   List.Clear;   N:=Self.FirstNode;   if N=nil then  Exit;   while N<>nil do   begin     if N.HasAttribute('TypeName') then       List.Add(N.Attributes['TypeName']);     N:=Self.FindNodeNext(N,'PlayType');   end; end; procedure TTopicFileXmlReader.ChannelsOfPlayType(PlayTypeName: String;   List: TStrings); var   N,C:IXMLNode; begin   Assert(Assigned(List),Format('类%S的方法%S的参数%S未赋值。',[Self.ClassName,'ChannelsOfPlayType','List']));   List.Clear;   N:=Self.FirstNode;   if N=nil then  Exit;   while N<>nil do   begin     if N.HasAttribute('TypeName') and (UpperCase(N.Attributes['TypeName'])=UpperCase(PlayTypeName)) then     begin       C:=nil;       if N.HasChildNodes then         C:=N.ChildNodes[0];       while C<>nil do       begin         if C.HasAttribute('id') then           List.Add(C.Attributes['id']);         C:=Self.FindNodeNext(C,'txt');       end;     end;     N:=Self.FindNodeNext(N,'PlayType');   end; end; { TUrlItem } procedure TUrlItem.AssignTo(Dest: TPersistent); begin   if  Dest is TUrlItem then   begin     TUrlItem(Dest).Text:=Self.Text;     TUrlItem(Dest).Src:=Self.Src;     TUrlItem(Dest).Position:=Self.Position;     TUrlItem(Dest).Font.Assign(Self.Font);   end   else     inherited; end; constructor TUrlItem.Create(Collection: TCollection); begin   inherited;   Font:=TFont.Create;   Font.Color:=clRed;   BkColor:=clWhite;   Text:='';   Position.Left:=0;   Position.Top:=0;   Position.Right:=0;   Position.Bottom:=0;   Src:=''; end; destructor TUrlItem.Destroy; begin   if Font<>nil then Font.Free;   inherited; end; { TUrlCollection } constructor TUrlCollection.Create(APath:string); begin   inherited Create(TUrlItem);   //解析url   try     ParseUrl(APath);   except   end;   end; procedure TUrlCollection.ParseUrl(APath:string); var   FXmlReader:TBaseXmlReader;   First,Sec:IXMLNode;   Item:TUrlItem;   //Font:TFont; begin   FXmlReader:=TBaseXmlReader.Create(APath);   try     First:=FXmlReader.FirstNode; //urlinfo Node     if First=nil then Exit;     while First<>nil do     begin       Item:=TUrlItem(Self.Add);       Sec:=FXmlReader.FindNode(First,'Position');       if Sec<>nil then       begin         if Sec.HasAttribute('Left') then           Item.Position.Left:=Sec.Attributes['Left'];         if Sec.HasAttribute('Top') then           Item.Position.Top:=Sec.Attributes['Top'];         if Sec.HasAttribute('Width') then           Item.Position.Right:=Sec.Attributes['Width'];         if Sec.HasAttribute('Height') then           Item.Position.Bottom:=Sec.Attributes['Height'];       end;       Sec:=FXmlReader.FindNode(First,'font');       if Sec<>nil then       begin         Item.Font.Size:=DefFontSize;         if Sec.HasAttribute('bkcolor') then           if ParserColor(Sec.Attributes['bkcolor'])=clwhite then             Item.BkColor:=DefBkColor           else             Item.BkColor:=ParserColor(Sec.Attributes['bkcolor']);         if Sec.HasAttribute('Fontcolor') then           if (ParserColor(Sec.Attributes['Fontcolor'])=clwhite) or (ParserColor(Sec.Attributes['Fontcolor'])=Item.BkColor) then             Item.Font.Color:=DefFontColor           else             Item.Font.Color:=ParserColor(Sec.Attributes['Fontcolor']);       end;       Sec:=FXmlReader.FindNode(First,'text');       if Sec<>nil then         if Sec.HasAttribute('data') then           Item.Text:=Sec.Attributes['data'];       Sec:=FXmlReader.FindNode(First,'link');       if Sec<>nil then         if Sec.HasAttribute('Src') then           Item.Src:=Sec.Attributes['Src'];       First:=FXmlReader.FindNodeNext(First,'URLInfo');     end;   finally     FXmlReader.Free;   end; end; { TUpdateFileXmlReader } procedure TUpdateFileXmlReader.AddFile(PlayType, Channel, FileName,   URLFileName, LastModifyTime: string); var   nPlayType,nChannel,nFile:IXMLNode;   //I:Integer; begin   if  Trim(PlayType)='' then Exit;   nPlayType:=FLocalFile.FindNode(FLocalFile.Root,'PlayType','TypeName',PlayType);   if nPlayType=nil then   begin     nPlayType:=FLocalFile.Root.AddChild('PlayType');     nPlayType.Attributes['TypeName']:=PlayType;   end;   if Trim(Channel)='' then Exit;   nChannel:=FLocalFile.FindNode(nPlayType,'Channel','ChannelName',Channel);   if nChannel=nil then   begin     nChannel:=nPlayType.AddChild('Channel');     nChannel.Attributes['ChannelName']:=Channel;   end;   if Trim(FileName)='' then Exit;   nFile:=FLocalFile.FindNode(nChannel,'File','FileName',FileName);   if nFile =nil then nFile:=nChannel.AddChild('File');   nFile.Attributes['FileName']:=FileName;   nFile.Attributes['LastModifyTime']:=LastModifyTime;   nFile.Attributes['url']:=URLFileName;   //FLocalFile.SaveToFile; end; procedure TUpdateFileXmlReader.ChannelFiles(PlayType, Channel: string;   var List,ListTime,ListURL: TStrings; IsLocal: Boolean); var   xml:TBaseXmlReader;   nPlayType,nChannel{,nFile}:IXMLNode;   I:Integer; begin   if IsLocal then     xml:=FLocalFile   else     Xml:=FUpdateFile;   List.Clear; ListTime.Clear;ListURL.Clear;   nPlayType:=xml.FindNode(xml.Root,'PlayType','TypeName',PlayType);   if nPlayType=nil then Exit;   nChannel:=xml.FindNode(nPlayType,'Channel','ChannelName',Channel);   if nChannel=nil then Exit;   for I:=0 to nChannel.ChildNodes.Count-1 do   begin     if  nChannel.ChildNodes.HasAttribute('FileName') then     begin       List.Add(UpperCase(nChannel.ChildNodes.Attributes['FileName']));       if  nChannel.ChildNodes.HasAttribute('LastModifyTime') then         ListTime.Add(UpperCase(nChannel.ChildNodes.Attributes['LastModifyTime']))       else         ListTime.Add('');       if  nChannel.ChildNodes.HasAttribute('url') then         ListURL.Add(UpperCase(nChannel.ChildNodes.Attributes['url']))       else         ListURL.Add('');     end;   end; end; procedure TUpdateFileXmlReader.ChannelUpdateFiles(PlayType,   Channel: string; var List,ListTime,ListURL: TStrings); var   oList,oListTime,oListURL,nList,nListTime,nListURL:TStrings;   I,index:Integer;   oTime,nTime:TDateTime;   procedure FreeLists;   begin     FreeAndNil(nListURL);     FreeAndNil(nListTime);     FreeAndNil(nList);     FreeAndNil(oListURL);     FreeAndNil(oListTime);     FreeAndNil(oList);   end; begin   oList:=TStringList.Create;   oListTime:=TStringList.Create;   oListURL:=TStringList.Create;   nList:=TStringList.Create;   nListTime:=TStringList.Create;   nListURL:=TStringList.Create;   List.Clear;ListTime.Clear;ListURL.Clear;   try     Self.ChannelFiles(PlayType,Channel,oList,oListTime,oListURL,True);     //ShowMessage(oList.Text);     Self.ChannelFiles(PlayType,Channel,nList,nListTime,nListURL,False);     //ShowMessage(nList.Text);     if oList.Count=0 then  //not such PlayType OR not such Channel.     begin       List.Assign(nList);       ListTime.Assign(nListTime);       ListURL.Assign(nListURL);       FreeLists;       Exit;     end;     for I:=0 to nList.Count-1 do     begin       index:=oList.IndexOf(nList.Strings);       if index=-1 then //not found.       begin         List.Add(nList);         ListTime.Add(nListTime);         ListURL.Add(nListURL);       end       else     //Found ,but Time is New .       begin          oTime:=StrToDateTimeDef(oListTime.Strings[index],StrToDateTime('2008-1-1 00:00:00')) ;          nTime:=StrToDateTimeDef(nListTime.Strings,StrToDateTime('2008-1-1 00:00:00')) ;          if oTime <nTime then          begin            List.Add(nList);            ListTime.Add(nListTime);            ListURL.Add(nListURL);          end;       end;     end;   finally     FreeLists;   end; end; constructor TUpdateFileXmlReader.Create(AUpdateFilePath,   ALocalFilePath: String); begin   FCS.Enter;   inherited Create;   FUpdateFilePath:=AUpdateFilePath;   FLocalFilePath:=ALocalFilePath;   FUpdateFile:=TBaseXmlReader.Create(AUpdateFilePath);   FLocalFile:=TBaseXmlReader.Create(ALocalFilePath); end; destructor TUpdateFileXmlReader.Destroy; begin   FreeAndNil(FLocalFile);   FreeAndNil(FUpdateFile);   FCS.Release;   inherited; end; procedure TUpdateFileXmlReader.FileUrls(PlayType, Channel,   FileName: string; var URLs: TUrlCollection); begin end; //procedure TUpdateFileXmlReader.Reload; //begin //  try //    FUpdateFile.FXmlDoc.LoadFromFile(FUpdateFilePath); //    FLocalFile.FXmlDoc.LoadFromFile(FLocalFilePath); //  except //  end; //end; initialization   FCS:=TCriticalSection.Create; finalization   FCS.Free; end.   unit WallPaper; interface uses   Classes,Registry, WinProcs, SysUtils,CommCtrl,Graphics,Types,Forms,Dialogs,jpeg; type   TBeforePlayFile =procedure (Sender:TObject; CurFileName:string) of object;   TAfterPlayFile  =procedure (Sender:TObject; CurFileName:string) of object;   TTurnWallPaper=class(TThread)   private     FPicList:TStrings;     FCurPicIndex:Integer;     FIsPaused:Boolean;     FIsFirst,FIsLast:Boolean;     FNext:Boolean;     FDelay:Integer;     FPath:string;     FBeforePlayFile:TBeforePlayFile;     FAfterPlayFile:TAfterPlayFile;     procedure DoPlayPic;     procedure DoBeforePlayFile;     procedure DoAfterPlayFile;     function CheckIndex:Boolean;     procedure SetWallpaper(path:string);     procedure SetDelay(const Value: Integer);   public     constructor Create;     destructor Destroy;override;     procedure Play;     procedure Pause;     procedure PlayNext;     procedure PlayPrior;     procedure Execute;override;     procedure AddPic(Path:string);     procedure PicList(List:TStrings);     property IsFirst:Boolean  read FIsFirst;     property IsLast:Boolean  read FIsLast;     property IsPause:Boolean  read FIsPaused;     property  Delay:Integer  read FDelay write SetDelay;     property BeforePlayFile:TBeforePlayFile  read FBeforePlayFile write FBeforePlayFile;     property AfterPlayFile:TAfterPlayFile  read FAfterPlayFile write FAfterPlayFile;   end; function GetDesktopHand: THandle; procedure HideDeskTopIcon; procedure ShowDesktopIcon; procedure   JPEG2BMP(JPEGFileName:String); type   TWallPaperStyle=(wpsTile = 0,wpsCenter,wpsSizeToFit ,wpsXY );   procedure SetWallpaperExt(sWallpaperBMPPath : string;nStyle:TWallPaperStyle;nX, nY : integer ); implementation procedure   JPEG2BMP(JPEGFileName:String); var   JpegImage1:TJpegImage;   Bit:TBitmap; begin   JpegImage1   :=   TJpegImage.Create;   try     JpegImage1.LoadFromFile(JPEGFileName);     Bit:=TBitmap.Create;     try       Bit.Width   :=   JpegImage1.Width   ;       Bit.Height   :=   JpegImage1.Height   ;       Bit.Canvas.StretchDraw(Rect(0,0,Bit.Width,Bit.Height),JpegImage1);       Bit.SaveToFile(ChangeFileExt(JPEGFileName,'.BMP'));      finally        Bit.Free;      end;   finally      JpegImage1.Free;   end; end; procedure SetWallpaperExt(sWallpaperBMPPath : string;nStyle:TWallPaperStyle;nX, nY : integer ); var   reg    : TRegIniFile;   s1     : string;   X, Y   : integer; begin   reg := TRegIniFile.Create('Control Panel/Desktop' );   with reg do   begin     s1 := '0';     X  := 0;     Y  := 0;     case nStyle of       wpsTile : s1 := '1';       wpsCenter: nStyle := wpsTile;       wpsXY    :       begin         nStyle := wpsTile;         X := nX;         Y := nY;       end;     end;     WriteString( '','Wallpaper',sWallpaperBMPPath );     WriteString( '','TileWallpaper',s1 );     WriteString( '','WallpaperStyle',IntToStr( Integer(nStyle) ) );     WriteString( '','WallpaperOriginX',IntToStr( X ) );     WriteString( '','WallpaperOriginY',IntToStr( Y ) );   end;   reg.Free;   SystemParametersInfo(SPI_SETDESKWALLPAPER,0,Nil,SPIF_SENDWININICHANGE ); end; procedure HideDeskTopIcon; var   hdesktop:thandle; begin   hDesktop   :=   FindWindow('ProgMan',nil)   ;   showwindow(hdesktop,SW_HIDE)//显示桌面。 end; procedure ShowDesktopIcon; var   hdesktop:thandle; begin   hDesktop   :=   FindWindow('ProgMan',nil)   ;   showwindow(hdesktop,SW_SHOW)//显示桌面。 end; function GetDesktopHand: THandle; begin   Result:=FindWindow('progman',nil);   Result:=GetWindow(Result,GW_Child);   Result:=GetWindow(Result,GW_Child); end; { TTurnWallPaper } procedure TTurnWallPaper.AddPic(Path:string); var   temp:Boolean; begin   temp:=FIsPaused;   if not FIsPaused then Pause;   FPicList.Add(Path);   FCurPicIndex:=FPicList.Count-1;   FNext:=True;   DoPlayPic;   if not temp then Play; end; function TTurnWallPaper.CheckIndex:Boolean; begin   if FPicList.Count=0 then   begin     FCurPicIndex:=-1;     Result:=False;     Exit;   end;   if FNext then   begin     if FCurPicIndex>=FPicList.Count then       FCurPicIndex:=0;     {else if FCurPicIndex<=-1 then       FCurPicIndex:=FPicList.Count-1; }   end   else   begin     if FCurPicIndex<=-1 then       FCurPicIndex:=FPicList.Count-1;   end;   Result:=True; end; constructor TTurnWallPaper.Create; begin   inherited Create(True);   FPicList:=TStringList.Create;   FIsPaused:=True;   FIsFirst:=True;   FIsLast:=True;   FCurPicIndex:=-1;   Self.Priority:=tpLower;   Self.FreeOnTerminate:=False;   FNext:=True;   FDelay:=15000; end; destructor TTurnWallPaper.Destroy; begin   FPicList.Free;   inherited; end; procedure TTurnWallPaper.DoAfterPlayFile; begin   if Assigned(FAfterPlayFile) then FAfterPlayFile(Self,FPath); end; procedure TTurnWallPaper.DoBeforePlayFile; begin   if Assigned(FBeforePlayFile) then FBeforePlayFile(Self,FPath); end; procedure TTurnWallPaper.DoPlayPic; begin   if CheckIndex then   begin     FPath:=FPicList[FCurPicIndex];     if not FileExists(FPath) then Exit;     if ((UpperCase(ExtractFileExt(FPicList[FCurPicIndex])))='.JPG') or (UpperCase(ExtractFileExt(FPicList[FCurPicIndex]))='.JPEG') then     begin       FPath:=ChangeFileExt(FPicList[FCurPicIndex],'.BMP');       JPEG2BMP(FPicList[FCurPicIndex]);     end;     Synchronize(DoBeforePlayFile);     SetWallpaper(FPath);     Synchronize(DoAfterPlayFile);   end; end; procedure TTurnWallPaper.Execute; var   I:Integer; begin   while not Self.Terminated do   begin     while not Self.Suspended do     begin       if Self.Terminated then Exit;       FNext:=True;       Inc(FCurPicIndex);       DoPlayPic;       if Self.Terminated then Exit;       if Self.Suspended then Break;       Application.ProcessMessages;       for I:=0 to FDelay div 500 do       begin         if (not Self.Suspended) and (not Self.Terminated) then Sleep(500);         if Self.Terminated then Exit;         //if not Self.Suspended then Break;         Application.ProcessMessages;       end;       if Self.Terminated then Exit;       //if not Self.Suspended then Break;       Application.ProcessMessages;     end;     Sleep(300);     Application.ProcessMessages;   end; end; procedure TTurnWallPaper.Pause; begin   Self.Suspend;   FIsPaused:=True; end; procedure TTurnWallPaper.PicList(List: TStrings); var   temp:Boolean; begin   temp:=FIsPaused;   Pause;   FPicList.Assign(List);   FCurPicIndex:=-1;   if List.Count>0 then   PlayNext;   if not temp then Play; end; procedure TTurnWallPaper.Play; begin   Self.Resume;   FIsPaused:=False; end; procedure TTurnWallPaper.PlayNext; begin   FNext:=True;   Inc(FCurPicIndex);   DoPlayPic; end; procedure TTurnWallPaper.PlayPrior; begin  FNext:=False;  Dec(FCurPicIndex);  DoPlayPic; end; procedure TTurnWallPaper.SetDelay(const Value: Integer); begin   if Value<=6 then     FDelay:=6   else     FDelay := Value; end; procedure TTurnWallPaper.SetWallpaper(path: string); begin   SetWallpaperExt(path,wpsSizeToFit,0,0); end; end.

卖掉＜桌面开屏＞软件客户端源码(200分)

linuxping

Unregistered / Unconfirmed

linuxping

Unregistered / Unconfirmed

linuxping

Unregistered / Unconfirmed

kinneng

Unregistered / Unconfirmed

huanghq123

Unregistered / Unconfirmed

幸福人生1

Unregistered / Unconfirmed

迷路人

Unregistered / Unconfirmed

linuxping

Unregistered / Unconfirmed

无欲则刚

Unregistered / Unconfirmed

kinneng

Unregistered / Unconfirmed

linuxping

Unregistered / Unconfirmed

xifengge

Unregistered / Unconfirmed

linuxping

Unregistered / Unconfirmed

dcs_dcs

Unregistered / Unconfirmed

linuxping

Unregistered / Unconfirmed

kinneng

Unregistered / Unconfirmed

linuxping

Unregistered / Unconfirmed

linuxping

Unregistered / Unconfirmed

Similar threads