使用纯正的Win Api 下载 http文档 |
|
dg822
一般會員 發表:14 回覆:38 積分:10 註冊:2004-12-16 發送簡訊給我 |
小弟第一次发文章,望各位大大支持一下:) 在这里,想向大家讲述一下如何使用纯正的API(不使用任何的VCL或他人编写的物件)接受http文档。 首先要编写几个procedure:
1、Int2Str -- 由整型转为字串型
Str2Int -- 由字串型转为整型
Power -- 数学乘方
2、ParmURL -- 分析URL字串
GetIEPROXY -- 取得当前IE使用的PROXY设置
GetIPFromName -- 从域名获得其IP值
GetHttpFile --。。。就是这个了
因为没有USE相当的UNIT,所以需要的这些基本的PROCEDURE都自己写或从相关的UNIT取得,如果觉得烂,别见笑。 下面是代码:
Int2Str: function Int2Str(Value: Integer): string; asm XOR ECX, ECX PUSH ECX ADD ESP, -0Ch PUSH EBX LEA EBX, [ESP 15 4] PUSH EDX CMP EAX, ECX PUSHFD JGE @@1 NEG EAX @@1: MOV CL, 10 @@2: DEC EBX CDQ IDIV ECX ADD DL, 30h MOV [EBX], DL TEST EAX, EAX JNZ @@2 POPFD JGE @@3 DEC EBX MOV byte ptr [EBX], '-' @@3: POP EAX MOV EDX, EBX CALL System.@LStrFromPChar POP EBX ADD ESP, 10h end; function Str2Int(sValue: string): Integer; var i: integer; ret: Integer; f: Boolean; nLen: Integer; nn: integer; p: pchar; begin result := 0; p := pointer(sValue); sValue := p; while sValue <> '' do if sValue[1] = ' ' then Delete(sValue, 1, 1) else break; if (sValue = '') then exit; if sValue[1] = '-' then begin f := true; delete(sValue, 1, 1); end else begin f := false; end; ret := 0; nLen := length(sValue); for i := 1 to nLen do begin if sValue[i] = #0 then break; nn := power(10, (nLen - i)); ret := ret (ord(sValue[i]) - 48) * nn; end; if f then result := -ret else result := ret; end; Power: function Power(n, m: integer): integer; var i: integer; begin result := 1; for i := 1 to m do begin result := result * n; end; end; ParmURL:从输入的URL取得其Host与Port值。 function ParmURL(URL: string; var Host: string; var Port: integer): Boolean; const C_HEADER = 'http://'; var sk: integer; begin result := false; if length(URL) < length(C_HEADER) then EXIT; delete(url, 1, length(C_HEADER)); sk := pos('/', url); if sk = 0 then exit; host := copy(url, 1, sk - 1); delete(url, 1, sk - 1); sk := pos(':', host); if sk <> 0 then begin port := str2int(copy(host, sk 1, length(host) - sk)); host := copy(host, 1, sk - 1); end else port := 80; result := true; end; GetIEPROXY:用API打开Registry取得IE proxy相关的数值。 function GetIEPROXY(var EnabledProxy: Boolean; var host: string; var Port: integer): Boolean; const C_ProxyEnable = 'ProxyEnable'; C_ProxyServer = 'ProxyServer'; var key: HKEY; DataType: DWORD; dwsize: DWORD; _dwProxyEnabled: DWORD; BUF: string; begin result := false; host := ''; Port := 0; if RegOpenKeyEx(HKEY_CURRENT_USER, pchar('Software\Microsoft\Windows\CurrentVersion\Internet Settings'), 0, KEY_ALL_ACCESS, Key) <> ERROR_SUCCESS then EXIT; try result := true; DataType := REG_DWORD; RegQueryValueEx(Key, pchar(C_ProxyEnable), nil, @DataType, nil, @dwsize); if RegQueryValueEx(key, pchar(C_ProxyEnable), nil, @DataType, @_dwProxyEnabled, @dwsize) <> ERROR_SUCCESS then EXIT; if _dwProxyEnabled = 0 then EnabledProxy := false else EnabledProxy := true; try DataType := REG_SZ; if (RegQueryValueEx(Key, pchar(C_ProxyServer), nil, @DataType, nil, @dwsize) <> ERROR_SUCCESS) or (dwsize = 0) then begin {host:=''; Post:=0;} end else begin SetLength(buf, dwsize); if RegQueryValueEx(key, pchar(C_ProxyServer), nil, @DataType, @BUF[1], @dwsize) <> ERROR_SUCCESS then else begin //成功取得代理 host := copy(BUF, 1, pos(':', BUF) - 1); delete(buf, 1, pos(':', BUF)); port := Str2Int(BUF); end; end except end; finally RegCloseKey(key); end; end; GetIPFromName:gethostbyname api取得域的IP。 function GetIPFromName(Name: string): string; var WSAData: TWSAData; HostEnt: PHostEnt; begin result := ''; if name = '' then exit; WSAStartup(2, WSAData); HostEnt := gethostbyname(PChar(Name)); if HostEnt <> nil then with HostEnt^ do {Result := Format('%d.%d.%d.%d', [Byte(h_addr^[0]), Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]); } result := int2str(byte(h_addr^[0])) '.' int2str(byte(h_addr^[1])) '.' int2str(byte(h_addr^[2])) '.' int2str(byte(h_addr^[3])); WSACleanup; end; 主要是这个了,AUrl就是要下载的HTTP文档,如http://www.xxx.org/downloads/test.rar,aFileName为down到本机硬碟具体 文档名称,CallBackOnDownBufferOutProc指定callback(可以为空),UseProxy是否使用IE的proxy,CheckFileOnly是否只是验证AUrl的存在,返回值为Boolean。 function GetHttpFile(AUrl: string; aFileName: string; CallBackOnDownBufferOutProc: TOnDownBufferOut; UseProxy: Boolean = false; CheckFileOnLy: Boolean = false): Boolean; function _WriteLn(S: TSocket; Str: string): integer; begin Str := Str #$D#$A; result := send(S, Str[1], length(Str), 0); end; const C_LEN = 'Content-Length:'; BufSize: integer = 32768; var s: tsocket; wsa: twsadata; server: tsockaddr; errorcode, count: integer; EnabledProxy: Boolean; Proxy, Host: string; Port: integer; BUF: string; sk: integer; rsize: dword; dwrecSize: integer; dwWSize: integer; dwOldSize: dword; //FileBuf: string; FileHandle: THandle; begin wsastartup($0101, wsa); result := false; try s := socket(af_inet, sock_stream, 0); if s = invalid_socket then begin exit; end; try server.sin_family := af_inet; if (UseProxy) and GetIEPROXY(EnabledProxy, Proxy, Port) and (EnabledProxy) and (Proxy <> '') and (Port <> 0) then begin server.sin_addr.S_addr := inet_addr(pchar(getipfromname(Proxy))); server.sin_port := htons(Port); end else begin if not ParmURL(AUrl, Host, Port) then exit; server.sin_addr.S_addr := inet_addr(pchar(getipfromname(Host))); server.sin_port := htons(Port); UseProxy:=false; end; errorcode := connect(s, server, sizeof(server)); if errorcode <> 0 then begin if EnabledProxy then begin //如果用代理,又失败的话,再次尝试直接下载 result := GetHttpFile(AUrl, aFileName, CallBackOnDownBufferOutProc, false,CheckFileOnLy); end; exit; end; _WriteLn(s, 'GET ' Aurl ' HTTP/1.0'); _WriteLn(s, 'Host: ' host); _WriteLn(s, 'Accept: text/html, */*'); _WriteLn(s, 'User-Agent: Mozilla/3.0'); _WriteLn(s, ''); setlength(BUF, BufSize); dwrecSize := recv(s, buf[1], length(BUF), 0); if (dwrecSize = SOCKET_ERROR) or (dwrecSize = 0) then exit; // local disk op if (@CallBackOnDownBufferOutProc = nil) and (not CheckFileOnLy) then begin FileHandle := Integer(CreateFile(PChar(aFileName), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)); if FileHandle = INVALID_HANDLE_VALUE then exit; end; try setlength(Buf, dwrecSize); delete(Buf, 1, pos(' ', Buf)); sk := str2int(copy(Buf, 1, pos(' ', Buf) - 1)); if sk = 404 then //没找到该文件的代码 exit; if (sk=200) and CheckFileOnLy then begin Result:=true; exit; end; sk := pos(C_LEN, buf); if sk = 0 then exit; delete(buf, 1, sk length(C_LEN) - 1); sk := pos(#13#10, buf); rsize := Str2Int(copy(buf, 1, sk - 1)); delete(buf, 1, pos(#$D#$A#$D#$A, buf) 3); if @CallBackOnDownBufferOutProc = nil then begin if not WriteFile(FileHandle, buf[1], length(buf), LongWord(dwWSize), nil) then exit; end else CallBackOnDownBufferOutProc(Buf[1], length(buf)); //setString(FileBuf, pchar(Buf), length(buf)); while true do begin setlength(BUF, BufSize); //fillchar(Buf[1], length(Buf), 0); dwrecSize := recv(s, buf[1], length(BUF), 0); if (dwrecSize = SOCKET_ERROR) or (dwrecSize = 0) then BREAK; {dwOldSize := length(FileBuf); //如果是全部读入再写的时候就用这段代码 SetLength(FileBuf, dwOldSize dwrecSize); move(buf[1], FileBuf[dwOldSize 1], dwrecSize);} if @CallBackOnDownBufferOutProc = nil then begin if not WriteFile(FileHandle, buf[1], dwrecSize, LongWord(dwWSize), nil) then exit; end else CallBackOnDownBufferOutProc(Buf[1], dwrecSize); end; //如果是全部读入再写的时候就用这段代码 //if Length(FileBuf) <> rsize then exit; //DeleteFile(pchar(aFileName)); //result := WriteFile(FileHandle, FileBuf[1], length(FileBuf), LongWord(rsize), nil); //result := result and (rsize = length(FileBuf)); if @CallBackOnDownBufferOutProc = nil then result := GetFileSize(FileHandle, nil) = rsize else result := true; finally if (@CallBackOnDownBufferOutProc = nil) and (not CheckFileOnLy) then CloseHandle(FileHandle); end; finally closesocket(s); end; finally wsacleanup; end; end;差点忘了,要在unit的前面加上这个新建的TYPE: type TOnDownBufferOut = procedure(var Buf; dwSize: dword); 此unit只需要uses windows, winsock。 写得有点仓促,不过很实用,最主要是生成的CODE很少,很适宜编写tiny program。 發表人 - dg822 於 2004/12/21 12:00:38 |
ddy
站務副站長 發表:262 回覆:2105 積分:1169 註冊:2002-07-13 發送簡訊給我 |
感謝發表,但程式碼未縮排可讀性低,請配合
詳見公告】程式碼張貼規則與方法
|
dg822
一般會員 發表:14 回覆:38 積分:10 註冊:2004-12-16 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |