|
Registriert seit: 28. Aug 2024 10 Beiträge |
#9
Ich habe ein Beispiel gefunden und übersetzt
![]()
Delphi-Quellcode:
Funktioniert, aber während Download ist Programm frozen, bis Download fertig ist.
// < TAsyncInet >
uses WinInet, StrUtils; type TAsyncInet = class; PINET_CONTEXT = ^INET_CONTEXT; INET_CONTEXT = record Obj: TAsyncInet; Context: DWORD; end; TRequestType = ( _GET, _POST ); TAsyncInet = class const CONTEXT_CONNECT = 0; CONTEXT_REQUESTHANDLE = 1; private FhConnectEvent: THandle; FhRequestOpenEvent: THandle; FhRequestCompleteEvent: THandle; FhOpen: HINTERNET; FhConnect: HINTERNET; FhRequest: HINTERNET; FContext: INET_CONTEXT; protected public constructor Create; reintroduce; destructor Destroy; override; function Connect(UserAgent, Host: string; Timeout: DWORD = 20000): Boolean; function SendRequest(RequestType: TRequestType; Url, RequestData, Referrer: string; Timeout: DWORD = 20000): Boolean; function ReadData(Buffer: Pointer; Size: DWORD; Timeout: DWORD = 20000): DWORD; procedure Disconnect; end; constructor TAsyncInet.Create; begin inherited; FhConnectEvent := CreateEvent(nil, false, false, nil); FhRequestOpenEvent := CreateEvent(nil, false, false, nil); FhRequestCompleteEvent := CreateEvent(nil, false, false, nil); FhOpen := nil; FhConnect := nil; FhRequest := nil; FContext.Obj := nil; FContext.Context := 0; end; destructor TAsyncInet.Destroy; begin if FhConnectEvent > 0 then CloseHandle(FhConnectEvent); if FhRequestOpenEvent > 0 then CloseHandle(FhRequestOpenEvent); if FhRequestCompleteEvent > 0 then CloseHandle(FhRequestCompleteEvent); Disconnect; inherited; end; procedure StatusCallback(hInet: HINTERNET; dwContext: DWORD_PTR; dwInternetStatus: DWORD; lpvStatusInformation: Pointer; dwStatusInformationLength: DWORD); stdcall; var pContext: PINET_CONTEXT; pConnectResult, pRequestResult: PINTERNET_ASYNC_RESULT; begin pContext := PINET_CONTEXT(dwContext); case pContext^.Context of TAsyncInet.CONTEXT_CONNECT: begin if dwInternetStatus = INTERNET_STATUS_HANDLE_CREATED then begin pConnectResult := PINTERNET_ASYNC_RESULT(lpvStatusInformation); pContext^.Obj.FhConnect := HINTERNET(pConnectResult^.dwResult); SetEvent(pContext^.Obj.FhConnectEvent); end; end; TAsyncInet.CONTEXT_REQUESTHANDLE: begin case dwInternetStatus of INTERNET_STATUS_HANDLE_CREATED: begin pRequestResult := PINTERNET_ASYNC_RESULT(lpvStatusInformation); pContext^.Obj.FhRequest := HINTERNET(pRequestResult^.dwResult); SetEvent(pContext^.Obj.FhRequestOpenEvent); end; INTERNET_STATUS_REQUEST_COMPLETE: begin SetEvent(pContext^.Obj.FhRequestCompleteEvent); end; end; end; end; end; function TAsyncInet.Connect(UserAgent, Host: string; Timeout: DWORD): Boolean; begin result := false; Disconnect; ResetEvent(FhConnectEvent); ResetEvent(FhRequestOpenEvent); ResetEvent(FhRequestCompleteEvent); FhOpen := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, INTERNET_FLAG_ASYNC); if FhOpen = nil then exit; if Boolean(InternetSetStatusCallback(FhOpen, INTERNET_STATUS_CALLBACK(@StatusCallback))) then exit; FContext.Context := TAsyncInet.CONTEXT_CONNECT; FContext.Obj := self; FhConnect := InternetConnect(FhOpen, PChar(Host), INTERNET_DEFAULT_PORT, nil, nil, INTERNET_SERVICE_HTTP, INTERNET_FLAG_KEEP_CONNECTION or INTERNET_FLAG_DONT_CACHE, DWORD(@FContext)); if FhConnect = nil then begin if GetLastError = ERROR_IO_PENDING then begin if Boolean(WaitForSingleObject(FhConnectEvent, Timeout)) then exit; end; exit; end; if FhConnect = nil then exit; result := true; end; function TAsyncInet.SendRequest(RequestType: TRequestType; Url: string; RequestData, Referrer: string; Timeout: DWORD): Boolean; var verb: string; requested: Boolean; header: string; begin result := false; requested := false; FContext.Context := TAsyncInet.CONTEXT_REQUESTHANDLE; FContext.Obj := self; if RequestType = _GET then verb := 'GET' else if RequestType = _POST then verb := 'POST'; FhRequest := HttpOpenRequest(FhConnect, PChar(verb), PChar(Url), nil, PChar(Referrer), nil, INTERNET_FLAG_RELOAD or INTERNET_FLAG_KEEP_CONNECTION or INTERNET_FLAG_DONT_CACHE, DWORD(@FContext)); if FhRequest = nil then begin if GetLastError = ERROR_IO_PENDING then begin if Boolean(WaitForSingleObject(FhRequestOpenEvent, Timeout)) then exit; end; end; if FhRequest = nil then exit; if RequestType = _GET then requested := HttpSendRequest(FhRequest, nil, 0, PChar(RequestData), Length(RequestData)) else if RequestType = _POST then begin header := 'Content-Type: application/x-www-form-urlencoded'; requested := HttpSendRequest(FhRequest, PChar(header), Length(header), PChar(RequestData), Length(RequestData)); end; if not requested then begin if GetLastError = ERROR_IO_PENDING then begin if WaitForSingleObject(FhRequestCompleteEvent, Timeout) = WAIT_TIMEOUT then begin Disconnect; exit; end; end; end; result := true; end; function TAsyncInet.ReadData(Buffer: Pointer; Size: DWORD; Timeout: DWORD): DWORD; var inetBuffers: INTERNET_BUFFERS; begin result := 0; ZeroMemory(@inetBuffers, SizeOf(INTERNET_BUFFERS)); inetBuffers.dwStructSize := SizeOf(INTERNET_BUFFERS); inetBuffers.lpvBuffer := Buffer; inetBuffers.dwBufferLength := Size - 1; FContext.Context := TAsyncInet.CONTEXT_REQUESTHANDLE; FContext.Obj := self; if not InternetReadFileEx(FhRequest, inetBuffers, 0, DWORD(@FContext)) then begin if GetLastError = ERROR_IO_PENDING then begin if WaitForSingleObject(FhRequestCompleteEvent, Timeout) = WAIT_TIMEOUT then exit; end; end; result := inetBuffers.dwBufferLength; end; procedure TAsyncInet.Disconnect; begin InternetCloseHandle(FhOpen); InternetCloseHandle(FhConnect); InternetCloseHandle(FhRequest); FhOpen := nil; FhConnect := nil; FhRequest := nil; end; // < /TAsyncInet > procedure ExtractUrlTo(const Url: string; var Host, Path: string); var posLeft, posRight: Integer; begin posLeft := Pos('//www.', Url) + 6; if posLeft = 6 then begin posLeft := Pos('//', Url) + 2; if posLeft = 2 then begin posLeft := Pos('www.', Url) + 4; if posLeft = 4 then posLeft := 1; end; end; posRight := StrUtils.PosEx('/', Url, posLeft); if posRight > 0 then Path := Copy(Url, posRight, Length(Url) - posRight + 1) else begin posRight := Length(Url) + 1; Path := '/'; end; Host := Copy(Url, posLeft, posRight - posLeft); end; function DownloadAsync(const Url, FileName): Boolean; const BUFFER_SIZE = 1024 * 4; var inet: TAsyncInet; host, path: string; buff: array[0..BUFFER_SIZE - 1] of Byte; currentBytes: DWORD; f: File; begin result := false; inet := TAsyncInet.Create; try ZeroMemory(@buff[0], BUFFER_SIZE); ExtractUrlTo(Url, host, path); if inet.Connect('Test', host) then if inet.SendRequest(_GET, path, '', '') then begin AssignFile(f, FileName); Rewrite(f, 1); repeat currentBytes := inet.ReadData(@buff, BUFFER_SIZE); buff[currentBytes] := 0; BlockWrite(f, buff, currentBytes); until currentBytes = 0; CloseFile(f); result := true; end; finally inet.Free; end; end; // Call var url, filename: string; begin url := 'http://212.183.159.230/50MB.zip'; filename := 'example.zip'; DownloadAsync(url, filename); ShowMessage('Finished!'); end; Das sollte bei Async nicht passieren, oder? |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |