DELPHI使用IDHTTP显示网络图片
- 格式:doc
- 大小:103.50 KB
- 文档页数:4
Delphi客户端通过FTP服务器上传或下载文件或图片方法Delphi客户端通过FTP服务器上传或下载文件或图片方法首先在服务器端建立FTP服务器,网上有这种类型的软件,安装好后,在客户端建立服务器连接,然后再上传或下载文件或图片。
一、服务器连接procedure TForm1.ConnectButtonClick(Sender: TObject);beginif not IdFTP1.Connected then //如果与服务器断开连接begintry/doc/c312652032.html,ername:=UserI DEdit.Text;IdFTP1.Password:=PasswordEdit.Text;IdFTP1.Host:=FtpServerEdit.Text;IdFTP1.Connect; //Connect;Except //异常处理Application.MessageBox('服务器连接失败!','智博软件');end;ConnectButton.Enabled:=true;if IdFTP1.Connected thenbeginConnectButton.Caption:='断开';DebugListBox.Items.Add('主机名为:'+IdFTP1.Host);DebugListBox.Items.Add('连接成功');ConnectButton.Default:=false;end;endelsetryIdFTP1.Quit; //关闭客户端与服务器端的连接finallyConnectButton.Caption:='连接';DebugListBox.Items.Add('连接失败'); ConnectButton.Enabled:=true;ConnectButton.Default:=true;end;end;二、文件或图片上传Procedure TFrmMain.UploadFileCleck(Sender:TObject); varFileName : string;Item : TListItem;SendFileItem : TListItem;beginif not FTPClient.Connected thenexit;if ListViewLocalFile.Selected =nil thenexit;Item :=ListViewLocalFile.Selected; ListViewSendFile.Clear;//处理所有选中文件while Item <>nil dobeginSendFileItem := ListViewSendFile.Items.Add; SendFileItem.Caption := Item.Caption; //文件名SendFileItem.SubItems.Add(Item.SubItems[1]); //文件大小SendFileItem.SubItems.Add(LocaLPath); //本地路径SendFileItem.SubItems.Add('==>'); //图示SendFileItem.SubItems.Add(RemotePath); //远程路径SendFileItem.SubItems.Add(''); //状态//下一个选中的项目Item:=ListViewLocalFile.GetNextItem(Item,sdAll,[isSelected]);end;ListViewSendFile.Refresh; //刷新传送文件列表//传送文件ListViewLocalFile.Enabled :=false;DriveComboBox1.Enabled:=false;ListViewRemoteFile.Enabled:=False;IsTransFerring:=True;try//处理所有要传送的文件while ListViewSendFile.Items.Count>0 dobeginFileName:=ListViewSendFile.Item[0].Caption; //文件名ListViewSendFile.Item[0].SubItems[4]:='正在上传...';FTPClient.Put(LocalPath+'\'+FileName); //上传DisplayRemoteFileList();ListViewSendFile.items[0].Delect; //传送完毕,删除待传送文件列表ListViewSendFile.Refresh;end;//设置相关控件是否可用ListViewLocalFile.Enabled:=True;DriveComboBox1.Enabled:=True;ListVieewRemoteFile.Enabled:=True;IsTransferring:=False;exceptListViewSendFile.Items[0].SubItems[4]:='上传错误!';MessageDlg('上传文件发生错误!',mtError,[mbyes],0);//设置相关控件是否可用ListViewLocalFile.Enabled:=True;DriveCombBox1.Enabled:=True;ListViewRemoteFile.Enabled:=True;IsTransferring:=False; //没有传送状态end;end;三、文件或图片下载procedure TFrmMain.DownloadFileClick(Sender:TObject);varFileName :String;Item ,SendFileItem : TListItem;beginif not FTPClient.Connected Then //没有连接到服务器,退出exit;if ListViewRemoteFile.Selected; //得到选中的文件ListViewSendFile.Clear; //清空要传送的文件列表//处理所有选中的文件While Item <> nil dobeginSendFileItem :=ListViewSendFile.Items.Add; //增加到列表//列表项赋值SendFileItem.Caption := Item.Caption; //文件名SendFileItem.SubItems.Add(Item.SubItems[1]); //文件大小SendFileItem.SubItems.Add(LocaLPath); //本地路径SendFileItem.SubItems.Add('<=='); //图示SendFileItem.SubItems.Add(RemotePath); //远程路径SendFileItem.SubItems.Add('');//下一个选中的项目Item:=ListViewRemoteFile.GetNextItem(Item,sdAll,[isSelected]);end;ListViewSendFile.Refresh; //刷新传送文件列表//传送文件ListViewRemoteFile.Enabled:=false; //禁止操作相关控件IsTransferring:=True; //设置正在传送try//处理所有要传送的文件while ListViewSendFile.Items.Count >0 dobeginFileName := ListViewSendFile.Items[0].Caption; //文件名ListViewSendFile.Items[0].SubItems[4]:='正在下载...';ListViewSendFile.Refresh; //刷新传送文件列表if FileExists(FileName) then //判断文件是否存在beginif MessageDlg('文件己存在,继续下载吗?',mtConfirmation,[mbYes,mbNo],0)=mrYes thenFTPClient.Get(FileName,LocalPath+'\'+FileName,false,true) //续传elseFTPClient.Get(FileName,LocalPath+'\'+FileName,true,False); //覆盖endelseFTPClient.Get(FileName,LocalPath+'\'+FileName,false); //下载ListViewSendFile.items[0].Delect; //传送完毕,删除待传送文件列表ListViewSendFile.Refresh; //刷新待传送列表DisplayLocalFileList(); //刷新本地文件列表end;ListViewRemoteFile.Enabled:=true; IsTransferring:=False; //没有传送状态exceptListViewSendFile.Items[0].SubItems[4]:='下载错误'; ListViewSendFile.Refresh; //刷新待传送文件列表MessageDlg('下载文件发生错误!',mtError,[nbYes],0); ListViewRemoteFile.Enabled:=True; IsTransferring:=False; //没有传送状态end;end;以上代码在Delphi7中调试通过。
下述为新闻采集程序,在理解了新闻采集程序的基础之上就可以做出网络爬虫程序了.今天,我们讨论的是网站新闻采集程序的制作。
所谓新闻采集程序,就是自动抓取网上信息,并保存到自己网站数据库的一种程序。
现在很多大型网站都有自己的新闻采集系统,其中许多采集系统价值不菲。
通过这篇文章,我希望大家都能自己做一个采集程序,来维护自己的网站。
为了便于理解,先阐述一下本文的新闻采集程序的一些基本信息。
这里的新闻系统,是用delphi实现,并将采集到的数据保存到本地access数据库。
所以,这将是一个基与桌面的采集程序,而不是类似“动易采集”的基于浏览器。
个人认为,基于桌面的采集系统,更容易实现强大的功能,有更高的稳定和安全性能。
而经过扩展,大家完全可以把这个例子做成可以访问远程数据库的大型采集系统。
在说如何制作采集程序之前,我们先来定义一个本地access数据库,用来存取采集到的信息。
这个数据库只有一个表,表名”T_Article”,该表有ArticleID、ClassID、Title、Keyword、CopyFrom、Content六个字段,分别代表新闻的编号、类别编号、标题、关键字、出处、内容。
首先,所谓采集,第一步当然是要能抓取信息,并且是能按照用户的要求,从网上抓取相关信息。
这里假设我们要抓取/article/69/69929.shtm 的文章,加到自己网站的“delphi技术”这么一个栏目。
首先要做的,是读取/article/69/69929.shtm 上的文章列表,然后通过列表索引,逐篇将文章正文内容读到我们的网站数据库。
接下来将是关键,如何采集/article/69/69929.shtm 上的文章列表。
这里分为两步,一、利用delphi网络功能,读取69929.shtm的HTML源文件。
二、通过分析69929.shtm的源文件,截取其中列表部分。
第一步的实现,可以用delphi的indy控件族的idHTTP控件,该控件在indy Clients面板,该控件的具体使用,将在后面讲解,现在我们只要知道,给定一个URL地址,就能通过indy控件返回该URL的网页源代码。
delphi post使用方法Delphi是一种高级编程语言,它是一种面向对象的编程语言,它可以用于开发各种类型的应用程序,包括桌面应用程序、Web应用程序、移动应用程序等。
在Delphi中,post是一种常用的HTTP请求方法,它可以用于向服务器发送数据。
在本文中,我们将介绍Delphi中post的使用方法。
一、什么是post请求在HTTP协议中,有两种常用的请求方法,分别是get和post。
get请求方法用于从服务器获取数据,而post请求方法用于向服务器发送数据。
在post请求中,数据是通过HTTP请求体发送的,而不是通过URL发送的。
因此,post 请求可以发送大量的数据,而get请求则不能。
二、Delphi中post的使用方法在Delphi中,可以使用TIdHTTP组件来发送post请求。
TIdHTTP组件是一个HTTP客户端组件,它可以用于向服务器发送HTTP请求。
下面是使用TIdHTTP 组件发送post请求的步骤:1.创建TIdHTTP组件在使用TIdHTTP组件发送post请求之前,需要先创建一个TIdHTTP组件。
可以在Delphi的组件面板中找到TIdHTTP组件,将其拖拽到窗体上即可。
2.设置请求参数在发送post请求之前,需要设置请求参数。
请求参数通常是一个字符串,它包含了要发送的数据。
可以使用TStringList组件来设置请求参数。
下面是设置请求参数的代码:varParams: TStringList;beginParams := TStringList.Create;tryParams.Add('username=admin');Params.Add('password=123456');finallyParams.Free;end;end;在上面的代码中,我们创建了一个TStringList对象,并向其中添加了两个参数:username和password。
delphi xe tidcookies用法-回复Delphi XE中的TidCookies用于管理和操作HTTP协议中的Cookie信息。
Cookie是由服务器发给客户端的一小段数据,客户端将其保存并在每次请求同一服务器时将其发送回去,用于服务器端的会话状态管理。
在本文中,我们将一步一步回答"Delphi XE TidCookies用法"这个主题,探索如何使用TidCookies来处理Cookie信息。
第1步:理解Cookie的基本概念和工作原理在深入了解Delphi XE中的TidCookies之前,我们需要对Cookie的基本概念和工作原理有一个清晰的理解。
Cookie是由服务器发送给客户端的一小段数据,以便对客户端进行身份验证、数据追踪和会话状态管理。
当客户端访问服务器时,客户端会将存储在Cookie中的信息发送回服务器,从而实现持久化会话状态。
第2步:导入TidCookies单元在使用TidCookies之前,我们首先需要导入TidCookies单元。
可以通过在代码中添加以下语句来实现:uses IdCookie, IdCookieManager, IdCookieManagerEx;第3步:创建CookieManager对象在Delphi XE中,我们可以通过创建一个TIdCookieManager对象来管理和操作Cookie信息。
可以使用以下代码创建CookieManager对象:varCookieManager: TIdCookieManager;beginCookieManager := TIdCookieManager.Create(nil);第4步:设置CookieManager的属性CookieManager有一些重要的属性,可以通过设置这些属性来控制Cookie的行为。
下面是一些常用的属性和用法:4.1 CookieManager.CookieCollectionCookieCollection属性是TIdCookies对象,用于保存Cookie信息。
图片显示处理delphi7调用测试{*------------------------------------------------------------------------Filename: UntImage.pasAuthor: 张述勇Version: 1.0Date: 2004.6.2Description: 图片操作处理类功能:对于建立批量图片;建立图片、建立图片标注、图片定位。
Others:Revision history://------------------------------------------------------------------------- }unit UntImage;interfaceuses classes,Windows, SysUtils,Dialogs,Forms,Controls,Graphics,StdCtrls,ExtCtrls,jpeg,types,DBClient; constIMG_WIDTH = 100; //图片宽度IMG_HEIGHT = 100; //图片高度IMG_SPACE = 50; //图片间距DESC_HEIGHT = 45;IMG_DESC_SPACE = 5;//图片与描述之间的间距type{文件信息类记录图形文件的各种信息,如名字,路径,类型等}TImgInfo = class(Tobject)ImgPath : string; //文件路径和文件名ImgName : string; //文件名称(指文件标识)ImgType : string; //文件类型ImgAuto : Boolean; //是否自动缩放(图片控件)ImgStrect: Boolean; //是否自动缩放(图片)Remark : string; // 备注end;typeTImageOperat = Class(TObject) {图片操作类}privateBig_Img : TImage;Mem_Label:Tmemo;ImgInfoList : Tlist; {图片信息容器}ImgArr : Array of TImage; {图片信息对像数组}DescArr :Array of TMemo; {图片描述对象数组,对应每一张图片一个}{把取得图像文件的信息,压人ImgInfoList容器中}procedure ProAddImgInfo(ParamImgInfo : TImgInfo);{根据TLIST中的数据建立图形,ParamParent参数为图形的父组件}function FunCreateImg(ParamCon:TWinControl):Boolean;{根据信息建立图片的标注例如:文件名一样;ParamParent参数为图形的父组件,ParamData 参数为图形的数据}procedure ProCreateLabel(ParamCon:TWinControl;ParamData:TClientDataSet);{处理建立的图片的位置ParamParent 图形的父组件;ParamPosition 第一行图片的TOP定位}procedure ProSetImgPosition(ParamCon:TWinControl;ParamPosition:Integer);{对字符串进行拆分加入回车符ParamStr参数为整个字符;ParamLen 参数为每行的字符个数}function FunWordWarp(ParamStr:String;ParamLen:Integer):String;//procedure FunImgClick(Sender: Tobject);// procedure FunImgClick(Sender:Tobject) ;public{构造}constructor Create;{析构}destructor Destory;{取得图像文件的路径}function FunGetFilePath(FileName:String):String;{调用图片显示过程ParamParent 图形的父组件;ParamData 参数为图形的数据}procedure ProImageShow(ParamCon:TWinControl;ParamData:TClientDataSet);procedure SetBig_Img(var ParamImg:Timage;var ParamMem:TMemo);Procedure FreeImg;end;varImage :TImageOperat ;Imgpath:string;implementation//uses uImgManager;{ TImageOperat }procedure TImageOperat.FunImgClick(Sender: Tobject);varI:integer;Name:string;begintryName := (sender as TImage).Name ;I := StrToInt(copy(Name,7,length(Name)-1));Big_Img.Picture.LoadFromFile(TImgInfo(Image.ImgInfoList[I]).ImgPath);Mem_Label.Text := TImgInfo(Image.ImgInfoList[I]).ImgName;exceptApplication.MessageBox('图片打开出错,检查是否存在该图片','信息提示',MB_OK+MB_IconInformation); end;end;constructor TImageOperat.Create;beginend;destructor TImageOperat.Destory;vari : Integer;beginfor i := 0 to length(ImgArr)-1 doFreeAndNil(ImgArr[i]);if Assigned(ImgInfoList) thenbeginImgInfoList.Clear;ImgInfoList.Free;ImgInfoList := nil;end;end;procedure TImageOperat.ProAddImgInfo(ParamImgInfo : TImgInfo);beginif not Assigned(ImgInfoList) thenImgInfoList := TList.Create;ImgInfoList.Add(ParamImgInfo);end;function TImageOperat.FunGetFilePath(FileName:String): String;beginResult := ExtractFilePath(Paramstr(0))+'Jpg\'+ FileName ;end;function TImageOperat.FunCreateImg(ParamCon:TWinControl): Boolean;varI : Integer;beginsetLength(ImgArr,ImgInfoList.Count);for i := 0 to ImgInfoList.Count-1 dobeginImgArr[I] := TImage.Create(nil);ImgArr[I].parent := ParamCon;ImgArr[I].AutoSize := False;ImgArr[I].Stretch := True;ImgArr[I].Width := IMG_WIDTH;ImgArr[I].Height := IMG_HEIGHT;ImgArr[I].Name := 'ImgArr'+IntTostr(I);ImgArr[I].OnClick := FunImgClick;if FileExists(TImgInfo(ImgInfoList[i]).ImgPath) thenImgArr[I].Picture.LoadFromFile(TImgInfo(ImgInfoList[i]).ImgPath); end;end;procedure TImageOperat.ProCreateLabel(ParamCon: TWinControl; ParamData:TClientDataSet);varI : Integer;tmpLabel:Tmemo;beginSetLength(DescArr,length(ImgArr));for I := 0 to length(DescArr)-1 dobeginDescArr[I] := Tmemo.Create(nil);DescArr[I] := '宋体';DescArr[I].Font.Size := 9;DescArr[I].WordWrap := True;DescArr[I].BorderStyle := bsNone;DescArr[I].BevelInner := bvNone;DescArr[I].BevelOuter := bvNOne;DescArr[I].Parent := ParamCon;DescArr[I].Width := IMG_WIDTH;DescArr[I].Height := DESC_HEIGHT;DescArr[I].Color := cl3DLight;DescArr[I].Text := ParamData.FieldValues['Pr_name'];DescArr[I].Top := ImgArr[i].Top + ImgArr[i].Height + IMG_DESC_SPACE;DescArr[I].Left := ImgArr[i].Left;{if DescArr[I].Width > ImgArr[i].Width thenbeginDescArr[I].Width := ImgArr[i].Width;DescArr[I].Height := ((DescArr[I].Width div ImgArr[i].Width)+1)*DESC_HEIGHT;DescArr[I].Left := ImgArr[i].Left;DescArr[I].Caption := FunWordWarp(ParamData.FieldValues['Pr_name'],ImgArr[i].Width);endelsebeginDescArr[I].Left := ImgArr[i].Left+Trunc(ImgArr[i].Width-DescArr[I].Width/2);end; }end;end;procedure TImageOperat.ProSetImgPosition(ParamCon:TWinControl;ParamPosition:Integer); vari,j,k : Integer; {计数器}Row,Col: Integer; {行列}begink:= 0;Col := ParamCon.Width div (IMG_WIDTH+IMG_SPACE);Row := ImgInfoList.Count div Col;if ImgInfoList.Count mod Col >0 then Row :=Row +1;for i := 0 to Row-1 dofor j:= 0 to Col-1 dobeginImgArr[k].Top := ParamPosition+IMG_SPACE+(IMG_HEIGHT+IMG_SPACE)*i;ImgArr[k].Left := (IMG_WIDTH+IMG_SPACE)*j;k := k+1 ;if k= ImgInfoList.Count then break;end;end;procedure TImageOperat.ProImageShow(ParamCon:TWinControl;ParamData:TClientDataSet);//调用图片显示过程varI : Integer;ImgInfo : TImgInfo;begintry// for I := 0 to ParamData.RecordCount-1 doif ParamData.RecordCount= 0 then Exit;ParamData.First;while not ParamData.Eof dobeginImgInfo := TImgInfo.Create;ImgInfo.ImgPath := ParamData.FieldByName('ImageName').AsString;ImgInfo.ImgName := ParamData.FieldByName('Pr_name').AsString;Image.ProAddImgInfo(ImgInfo); //压入到图片容器中ParamData.Next;end ;{建立图片对象}Image.FunCreateImg(ParamCon);{移动图片相对位置}Image.ProSetImgPosition(ParamCon,5);Image.ProCreateLabel(ParamCon,ParamData);finally// FreeAndNil(ImgInfo);end;end;function TImageOperat.FunWordWarp(ParamStr: String; ParamLen: Integer):String; varStrLen,I : Integer;TmpStr:String;beginStrLen := Length(ParamStr);TmpStr := '';for I := 0 to Length(ParamStr)-1 dobeginif I = 0 thenTmpStr := Copy(ParamStr,I*ParamLen,ParamLen)elseTmpStr := TmpStr+#13+#10+Copy(ParamStr,I*ParamLen,ParamLen);end;Result := TmpStr;end;{procedure TImageOperat.FunImgClick(Sender: Tobject);varI:integer;Name:string;begintryName := (sender as TImage).Name ;I := StrToInt(copy(Name,7,length(Name)-1));Big_Img.Picture.LoadFromFile(TImgInfo(ImgInfoList[I]).ImgPath);exceptend;end; }procedure TImageOperat.SetBig_Img(var ParamImg:Timage;var ParamMem:TMemo); beginBig_Img := ParamImg;Mem_Label := paramMem;end;//initialization// Image :=TImageOperat.Create;//finalization// FreeAndNil(Image);procedure TImageOperat.FreeImg;vari : integer;begin{对上次所有图形标识进行释放}for i:= Length(ImgArr)-1 downto 0 do beginfreeAndNil(ImgArr[I]);FreeAndNil(DescArr[I]);end;{数据容器清空}if Assigned(ImgInfoList) thenbeginImgInfoList.Clear;ImgInfoList := nil;end;end;end.。
Delphi客户端通过FTP服务器上传或下载文件或图片方法第一篇:Delphi客户端通过FTP服务器上传或下载文件或图片方法Delphi客户端通过FTP服务器上传或下载文件或图片方法首先在服务器端建立FTP服务器,网上有这种类型的软件,安装好后,在客户端建立服务器连接,然后再上传或下载文件或图片。
一、服务器连接procedure TForm1.ConnectButtonClick(Sender: TObject);begin if not IdFTP1.Connected then //如果与服务器断开连接begintryername:=UserIDEdit.Text;IdFTP1.Password:=PasswordEdit.Text;IdFTP1.Host:=FtpServerEdit.Text;IdFTP1.Connect;//Connect;Except //异常处理Application.MessageBox('服务器连接失败!','智博软件');end;ConnectButton.Enabled:=true;if IdFTP1.Connected thenbeginConnectButton.Caption:='断开';DebugListBox.Items.Add('主机名为:'+IdFTP1.Host);DebugListBox.Items.Add('连接成功');ConnectButton.Default:=false;end;endelsetryIdFTP1.Quit;//关闭客户端与服务器端的连接finallyConnectButton.Caption:='连接';DebugListBox.Items.Add('连接失败'); ConnectButton.Enabled:=true;ConnectButton.Default:=true;end;end;二、文件或图片上传Procedure TFrmMain.UploadFileCleck(Sender:TObject); varFileName : string;Item : TListItem;SendFileItem : TListItem;beginif not FTPClient.Connected thenexit;if ListViewLocalFile.Selected =nil thenexit;Item :=ListViewLocalFile.Selected; ListViewSendFile.Clear;//处理所有选中文件while Item <>nil dobeginSendFileItem := ListViewSendFile.Items.Add; SendFileItem.Caption := Item.Caption;//文件名SendFileItem.SubItems.Add(Item.SubItems[1]);//文件大小SendFileItem.SubItems.Add(LocaLPath);//本地路径SendFileItem.SubItems.Add('==>');//图示SendFileItem.SubItems.Add(RemotePath);//远程路径SendFileItem.SubItems.Add('');//状态//下一个选中的项目Item:=ListViewLocalFile.GetNextItem(Item,sdAll,[isSelected]); end;ListViewSendFile.Refresh;//刷新传送文件列表//传送文件ListViewLocalFile.Enabled :=false;DriveComboBox1.Enabled:=false; ListViewRemoteFile.Enabled:=False;IsTransFerring:=True;try//处理所有要传送的文件while ListViewSendFile.Items.Count>0 dobeginFileName:=ListViewSendFile.Item[0].Caption;//文件名ListViewSendFile.Item[0].SubItems[4]:='正在上传...'; FTPClient.Put(LocalPath+''+FileName);//上传DisplayRemoteFileList();ListViewSendFile.items[0].Delect;//传送完毕,删除待传送文件列表ListViewSendFile.Refresh;end;//设置相关控件是否可用ListViewLocalFile.Enabled:=True;DriveComboBox1.Enabled:=True; ListVieewRemoteFile.Enabled:=True; IsTransferring:=False;exceptListViewSendFile.Items[0].SubItems[4]:='上传错误!'; MessageDlg('上传文件发生错误!',mtError,[mbyes],0);//设置相关控件是否可用ListViewLocalFile.Enabled:=True;DriveCombBox1.Enabled:=True; ListViewRemoteFile.Enabled:=True;IsTransferring:=False;//没有传送状态end;end;三、文件或图片下载procedure TFrmMain.DownloadFileClick(Sender:TObject); varFileName :String;Item ,SendFileItem : TListItem;beginif not FTPClient.Connected Then//没有连接到服务器,退出exit;if ListViewRemoteFile.Selected;//得到选中的文件ListViewSendFile.Clear;//清空要传送的文件列表//处理所有选中的文件While Item <> nil dobeginSendFileItem :=ListViewSendFile.Items.Add;//增加到列表//列表项赋值SendFileItem.Caption := Item.Caption;//文件名SendFileItem.SubItems.Add(Item.SubItems[1]);//文件大小SendFileItem.SubItems.Add(LocaLPath);//本地路径SendFileItem.SubItems.Add('<==');//图示SendFileItem.SubItems.Add(RemotePath);//远程路径SendFileItem.SubItems.Add('');//下一个选中的项目Item:=ListViewRemoteFile.GetNextItem(Item,sdAll,[isSelecte d]);end;ListViewSendFile.Refresh;//刷新传送文件列表//传送文件ListViewRemoteFile.Enabled:=false;//禁止操作相关控件IsTransferring:=True;//设置正在传送try//处理所有要传送的文件while ListViewSendFile.Items.Count >0 dobeginFileName := ListViewSendFile.Items[0].Caption;//文件名ListViewSendFile.Items[0].SubItems[4]:='正在下载...';ListViewSendFile.Refresh;//刷新传送文件列表if FileExists(FileName)then //判断文件是否存在beginif MessageDlg('文件己存在,继续下载吗?',mtConfirmation,[mbYes,mbNo],0)=mrYes thenFTPClient.Get(FileName,LocalPath+''+FileName,false,true) //续传elseFTPClient.Get(FileName,LocalPath+''+FileName,true,False);//覆盖endelseFTPClient.Get(FileName,LocalPath+''+FileName,false);//下载ListViewSendFile.items[0].Delect;//传送完毕,删除待传送文件列表ListViewSendFile.Refresh;//刷新待传送列表DisplayLocalFileList();//刷新本地文件列表end;ListViewRemoteFile.Enabled:=true;IsTransferring:=False;//没有传送状态exceptListViewSendFile.Items[0].SubItems[4]:='下载错误';ListViewSendFile.Refresh;//刷新待传送文件列表MessageDlg('下载文件发生错误!',mtError,[nbYes],0);ListViewRemoteFile.Enabled:=True;IsTransferring:=False;//没有传送状态end;end;以上代码在Delphi7中调试通过。
delphiidhttp实战用法以delphi xe2 自带indy(10.5.8.0)组件为例,分享实战中遇到的问题及解决方法。
Idhttp 重要属性HTTPOptions := [];属性设为空,禁止idhttp自动为post的TStringList参数编码,因为自动编码使用的是HttpApp单元下的HttpEncode,但此函数有误,未将+,$,@这3个符号编成UrlCode。
请自行改造此函数然后使用。
HTTPOptions := [hoNoParseMetaHTTPEquiv];当遇到Get某个网页,idhttp一直会卡住的时候,请尝试此值。
提供一个会卡住的网址给大家测试:/Company/Detail/23284.html此网址来之不易,请善加保存!哈哈!Request.RawHeaders.FoldLength := 8192;参数头的总长度限制,如果post的TStringList参数过长,请加大此值。
否则,超长部分将不会被post。
FIdCookieMgr := TIdCookieMgr.Create(self); //TIdCookieMgrCookieManager := FIdCookieMgr;AllowCookies := true;TIdCookieMgr是我改进了的TIdCookieManager,增加了保存Cookie与加载Cookie的方法。
后面详细写出。
IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(self);此为Https功能必备,它需要两个文件 libeay32.dll和ssleay32.dll, 这两个文件在阿里旺旺的安装目录里能够找到。
大家不必满世界找了。
Request.AcceptEncoding := ‘gzip‘;在Get与Post的时候,告诉服务器,请把数据压缩后再传给我。
Idhttp自带的解压缩功能是错误的,需要自己去下载一个 Zlib 库,然后自己解压缩。
delphiJPG或BMP图片透明显示delphi JPG或BMP图片透明显示时间:2011-6-2来源:yang 作者: peng点击: 32次procedure SaveBmpAsIcon(const Bmp: TBitmap; const Icon: string; const SmallIcon: Boolean;const Transparent: Boolean; const X, Y: Integer);// Bmp : Bitmap图片// Icon : 最终输出的icon文件全路径和文件名。
如果文件已经存在则会将其覆盖// SmallIcon : True: 16x16 图标, False: 32x32 图标// Transparent: 确定是否按照参数X,Y的坐标色生成透明图标// X, Y : 此参数指明坐标下的色值将会作为透明色替换全图varPBI, MPBI: PBitmapInfo;IHS, MIHS, ImageSize, MImageSize: DWord;bmBuffer, MaskBuffer: Pointer;TID: TIconDir;TBIH: TBitmapInfoHeader;Bmx, Bmm: TBitmap;TranspCol: TColor;I, J: Integer;beginBmx:= TBitmap.Create;Bmm:= TBitmap.Create;tryif SmallIcon thenbeginBmx.Width:= GetSystemMetrics(SM_CXSMICON);Bmx.Height:= GetSystemMetrics(SM_CYSMICON);endelsebeginBmx.Width:= GetSystemMetrics(SM_CXICON);Bmx.Height:= GetSystemMetrics(SM_CYICON);end;bmx.pixelformat:=pf24bit;Bmx.Canvas.StretchDraw(Rect(0, 0, Bmx.Width, Bmx.Height), Bmp);TranspCol:= Bmx.Canvas.Pixels[X, Y];//TranspCol:= clWhite;Bmm.Assign(Bmx);Bmm.Mask(TranspCol);GetDIBSizes(Bmm.Handle, MIHS, MImageSize);GetDIBSizes(Bmx.Handle, IHS, ImageSize);MaskBuffer:= AllocMem(MImageSize);bmBuffer:= AllocMem(ImageSize);MPBI:= AllocMem(MIHS);PBI:= AllocMem(IHS);tryif Transparent thenbeginfor I:=0 to Bmx.Width-1 dofor J:=0 to Bmx.Height-1 doif Bmx.Canvas.Pixels[I, J] = TranspCol then Bmx.Canvas.Pixels[I, J]:= 0;with MPBI^.bmiHeader dobeginbiSize:= SizeOf(TBitmapInfoHeader);biWidth:= Bmm.Width;biHeight:= Bmm.Height;biPlanes:= 1;biBitCount:= 1;biCompression:= BI_RGB;biSizeImage:= MImageSize;biXPelsPerMeter:= 0;biYPelsPerMeter:= 0;biClrUsed:= 2;biClrImportant:= 2;end;GetDIBits(Bmm.Canvas.Handle, Bmm.Handle, 0, Bmm.height, MaskBuffer, MPBI^, DIB_RGB_COLORS);end;with PBI^.bmiHeader dobeginbiSize:= SizeOf(TBitmapInfoHeader);biWidth:= Bmx.Width;biHeight:= Bmx.Height;biPlanes:= 1;biBitCount:= 24;biCompression:= BI_RGB;biSizeImage:= ImageSize;biXPelsPerMeter:= 0;biYPelsPerMeter:= 0;biClrUsed:= 0;biClrImportant:= 0;end;GetDIBits(Bmx.Canvas.Handle, Bmx.Handle, 0, Bmx.Height, bmBuffer, PBI^, DIB_RGB_COLORS);with TBIH dobiSize:= 40;biWidth:= Bmx.Width;biHeight:= Bmx.Height * 2;biPlanes:= 1;biBitCount:= 24;biCompression:= 0;biSizeImage:= ImageSize;biXPelsPerMeter:= 0;biYPelsPerMeter:= 0;biClrUsed:= 0;biClrImportant:= 0;end;with TID dobeginidReserved:=0;idType:=1;idCount:=1;with idEntries[1] dobeginbWidth:=bmx.width;bHeight:=bmx.height;bColorCount:=0;bReserved:=0;wPlanes:=1;wBitCount:=24;dwBytesInRes:= SizeOf(TBitmapInfoHeader) + TBIH.biSizeImage + MImageSize;dwImageOffset:= 6 + TID.idCount * SizeOf(TIconDirEntry);end;with TFileStream.Create(Icon, fmCreate) dotryWrite(TID, 6 + TID.idCount * SizeOf(TIconDirEntry)); Write(TBIH, SizeOf(TBitmapInfoheader));Write(bmBuffer^, TBIH.biSizeImage);Write(maskBuffer^, MImageSize);finallyFree;end;finallyFreeMem(MaskBuffer);FreeMem(bmBuffer);FreeMem(MPBI);FreeMem(PBI);end;finallyBmx.free;Bmm.free;end;end;。
大家应该见过很多网管程序,这类程序其中有一个功能就是监控远程电脑的屏幕。
实际上,这也是利用流操作来实现的。
下面我们给出一个例子,这个例子分两个程序,一个服务端,一个是客户端。
程序编译后可以直接在单机、局部网或者互联网上使用。
程序中已经给出相应注释。
后面我们再来作具体分析。
新建一个工程,在Internet 面版上拖一个ServerSocket 控件到窗口,该控件主要用于监听客户端,用来与客户端建立连接和通讯。
设置好监听端口后调用方法Open 或者Active:=True 即开始工作。
注意:跟前面的NMUDP 不同,当Socket 开始监听后就不能再改变它的端口,要改变的话必须先调用Close 或设置Active 为False,否则将会产生异常。
另外,如果该端口已经打开的话,就不能再用这个端口了。
所以程序运行尚未退出就不能再运行这个程序,否则也会产生异常,即弹出出错窗口。
实际应用中可以通过判断程序是否已经运行,如果已经运行就退出的方法来避免出错。
当客户端有数据传入,将触发ServerSocket1ClientRead 事件,我们可以在这里对接收的数据进行处理。
在本程序中,主要是接收客户端发送过来的字符信息并根据事先的约定来进行相应操作。
unit Unit1;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ScktComp ,jpeg;typeTForm1 = class(TForm)ServerSocket1: TServerSocket;procedure FormCreate(Sender: TObject);procedure FormClose(Sender: TObject; var Action: TCloseAction);procedure ServerSocket1ClientRead(Sender: TObject;Socket: TCustomWinSocket);privateprocedure Cjt_GetScreen(var Mybmp: Tbitmap; DrawCur: Boolean); {自定义抓屏函数,DrawCur表示抓鼠标图像与否}{ Private declarations }public{ Public declarations }end;varForm1: TForm1;MyStream: Tmemorystream;{内存流对象}implementation{$R *.DFM}{ TForm1 }procedure TForm1.Cjt_GetScreen(var Mybmp: Tbitmap; DrawCur: Boolean);varCursorx, Cursory: integer;dc: hdc;Mycan: Tcanvas;R: Trect;DrawPos: Tpoint;MyCursor: Ticon;hld: hwnd;Threadld: dword;mp: tpoint;pIconInfo: TIconInfo;beginMybmp := Tbitmap.Create; {建立BMPMAP }Mycan := Tcanvas.Create; {屏幕截取}dc := GetWindowDC(0);tryMycan.Handle := dc;R := Rect(0, 0, screen.Width, screen.Height);Mybmp.Width := R.Right;Mybmp.Height := R.Bottom;Mybmp.Canvas.CopyRect(R, Mycan, R);finallyreleaseDC(0, DC);end;Mycan.Handle := 0;Mycan.Free;if DrawCur then {画上鼠标图象}beginGetCursorPos(DrawPos);MyCursor := Ticon.Create;getcursorpos(mp);hld := WindowFromPoint(mp);Threadld := GetWindowThreadProcessId(hld, nil);AttachThreadInput(GetCurrentThreadId, Threadld, True);MyCursor.Handle := Getcursor();AttachThreadInput(GetCurrentThreadId, threadld, False);GetIconInfo(Mycursor.Handle, pIconInfo);cursorx := DrawPos.x - round(pIconInfo.xHotspot);cursory := DrawPos.y - round(pIconInfo.yHotspot);Mybmp.Canvas.Draw(cursorx, cursory, MyCursor); {画上鼠标}DeleteObject(pIconInfo.hbmColor);{GetIconInfo 使用时创建了两个bitmap对象. 需要手工释放这两个DeleteObject(pIconInfo.hbmMask);{否则,调用他后,他会创建一个bitmap,多次调用会产生多个,直至资源耗尽}Mycursor.ReleaseHandle; {释放数组内存}MyCursor.Free; {释放鼠标指针}end;end;procedure TForm1.FormCreate(Sender: TObject);beginServerSocket1.Port := 3000; {端口}ServerSocket1.Open; {Socket开始侦听}end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);beginif ServerSocket1.Active then ServerSocket1.Close; {关闭Socket}end;procedure TForm1.ServerSocket1ClientRead(Sender: TObject;Socket: TCustomWinSocket);varS, S1: string;MyBmp: Tbitmap;Myjpg: Tjpegimage;beginS := Socket.ReceiveText;if S = 'cap' then {客户端发出抓屏幕指令}begintryMyStream := Tmemorystream.Create;{建立内存流}MyBmp := Tbitmap.Create;Myjpg := Tjpegimage.Create;Cjt_GetScreen(MyBmp, True); {True表示抓鼠标图像}Myjpg.Assign(MyBmp); {将BMP图象转成JPG格式,便于在互联网上传输}pressionQuality := 10; {JPG文件压缩百分比设置,数字越大图像越清晰,但数据也越大}Myjpg.SaveToStream(MyStream); {将JPG图象写入流中}Myjpg.free;MyStream.Position := 0;{注意:必须添加此句}s1 := inttostr(MyStream.size);{流的大小}Socket.sendtext(s1); {发送流大小}finallyMyBmp.free;end;if s = 'ready' then {客户端已准备好接收图象}beginMyStream.Position := 0;Socket.SendStream(MyStream); {将流发送出去}end;end;end.上面是服务端,下面我们来写客户端程序。
DELPHI使用IDHTTP显示网络图片:
程序代码:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, V ariants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent, GifImage, Jpeg, IdTCPConnection, IdTCPClient, IdHTTP;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Image1: TImage;
IdHTTP1: TIdHTTP;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
imagestream:TMemoryStream;
Buffer:Word;
jpg:TjpegImage;
gif:TgifImage;
begin
image1.Picture.Graphic:=nil ;
imagestream := TMemoryStream.Create();
try
IdHTTP1.Request.Accept := '*/*';
IdHTTP1.Request.AcceptLanguage := 'zh-cn';
erAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)';
IdHTTP1.Request.Connection := 'Keep-Alive';
IdHTTP1.HTTPOptions:=IdHTTP1.HTTPOptions+[hoKeepOrigProtocol];
IdHTTP1.ProtocolV ersion:=pv1_1;
try
idhttp1.Get(Edit1.Text,imagestream);
except
showmessage('连接失败!');
exit;
end;
imagestream.Position:=0;
if imagestream.Size = 0 then
begin
imagestream.Free;
ShowMessage('错误!');
exit;
end;
imagestream.ReadBuffer(Buffer,2);
imagestream.Position:=0;
if Buffer=$4D42 then //bmp
begin
image1.Picture.Bitmap.LoadFromStream(imagestream);
end
else if Buffer=$D8FF then //jpg begin
jpg:=TjpegImage.Create;
jpg.LoadFromStream(imagestream); image1.Picture.Assign(jpg);
jpg.Free;
end
else if Buffer=$4947 then //gif begin
gif:=TGifImage.Create;
gif.LoadFromStream(imagestream); image1.Picture.Assign(gif);
gif.Free;
end
else if Buffer=$050A then
begin
ShowMessage('PCX');
end
else if Buffer=$5089 then
begin
ShowMessage('PNG');
end
else if Buffer=$4238 then
begin
ShowMessage('PSD');
end
else if Buffer=$A659 then
begin
ShowMessage('RAS');
end
else if Buffer=$DA01 then
begin
ShowMessage('SGI');
end
else if Buffer=$4949 then
begin
ShowMessage('TIFF');
end
else
begin
ShowMessage('ERROR');
end;
finally
imagestream.Free;
end;
end;
end.
运行效果:。