|
Registriert seit: 22. Sep 2008 6 Beiträge Delphi 2007 Professional |
#6
Ok, sorry, das .free für die Stringlists übernimmt das die .Send-Funktion, kA warum aber irgendeinen Sinn wird das schon gehabt haben. Die .Send kann ich nat. posten, aber dadurch wird's halt nicht kürzer ...
![]()
Delphi-Quellcode:
function TFormHTTPV2.Send(ErrorHint: string): integer;
var E, I, FS: integer; FileStream: TFileStream; MemoryLst: TStringList; ActiveCursor: TCursor; ErrorMsg: string; HTTPRequest: TclHttpRequest; Rec: TRect; begin ModalResult := mrNone; LastReasonPhrase := 'OK'; // Leave on demo mode if FIsDemoMode then begin Result := -10000; Hide; exit; end; if Visible then begin Rec := Rect(left, top, width - left, height - top); MouseFencer.ExecuteEnh(Rec); end; Result := -1; ErrorMsg := ''; ActiveCursor := Screen.Cursor; if Length(FV2Requests) > 1 then MaxValue := Length(FV2Requests) else MaxValue := 60; UserValue := 0; Busy := False; // Load error message if ErrorHint <> '' then LoadErrorHint(ErrorHint); // Set minimum timeout (30000) if visible, or not timeout (100 sec) if file exists if FileExists(ExtractFilePath(application.exename) + '~notimeout.txt') then HTTP.TimeOut := 100000 else if Visible then HTTP.TimeOut := Max(HTTP.Timeout, FMiddleTimeOut); // Init I := 0; repeat if HTTP.Active then try HTTP.Close; except end; ModalResult := mrNone; // Change cursor if invisible if not Visible then Screen.Cursor := crHourGlass; // Reset controls Notebook.PageIndex := 0; LabelError1.Hide; LabelProxy.Hide; LabelProxy2.Hide; ButtonOK.Hide; ButtonAbort.Caption := '&Abbrechen'; UserValue := 0; if Length(FV2Requests) > 1 then MaxValue := Length(FV2Requests) else MaxValue := HTTP.TimeOut div 25; Application.ProcessMessages; TimerTime.Enabled := True; if not IsConnectedToInternet then begin Result := INTERNET_STATE_DISCONNECTED; ErrorMsg := 'HTTP-Fehler: Keine bestehende Internetverbindung gefunden'; end else begin SetProxySettings; FWebAccess := noSuccess; while I <= High(FV2Requests) do begin if Length(FV2Requests) <= 1 then begin UserValue := 0; if Visible then Sleep(250); end; HTTPRequest := TclHttpRequest.Create(self); HTTPRequest.Header.Accept := '*/*'; //HTTPRequest.Header.CharSet := 'UTF-8'; HTTPRequest.Header.ContentType := 'multipart/form-data'; // Replace spaces if Pos('?', FV2Requests[i].URL) > 0 then FV2Requests[i].URL := ReplaceStr(FV2Requests[i].URL, #32, '%20'); DebugOut('DL # ' + inttostr(i) + ': ' + FV2Requests[i].URL); try // Reset controls MemoryLst := Nil; FileStream := Nil; // Prepare request if Pos('=', FV2Requests[i].LocalFile) > 0 then HTTPRequest.AddSubmitFile(StrBefore('=', FV2Requests[i].LocalFile), StrAfter('=', FV2Requests[i].LocalFile)); for e := 0 to FV2Requests[i].RequestVars.count - 1 do HTTPRequest.AddFormField(StrBefore('=', FV2Requests[i].RequestVars[e]), StrAfter('=', FV2Requests[i].RequestVars[e])); for e := 0 to HTTPRequest.Count - 1 do HTTPRequest.Items[e].Canonicalized := False; // Prepare stringlist/stream if (FV2Requests[i].RequestType = httpGet) and (FV2Requests[i].LocalFile <> '') then FileStream := TFileStream.create(FV2Requests[i].LocalFile, fmCreate) else MemoryLst := TStringList.create; try FV2Requests[i].Res := 0; FV2Requests[i].HTTPContent := ''; Busy := True; if FV2Requests[i].LocalFile = '' then begin if FV2Requests[i].RequestType = httpGet then HTTP.Get(FV2Requests[i].URL, MemoryLst) else HTTP.Post(FV2Requests[i].URL, HTTPRequest, MemoryLst); end else begin if FV2Requests[i].RequestType = httpGet then HTTP.Get(FV2Requests[i].URL, FileStream) else HTTP.Post(FV2Requests[i].URL, HTTPRequest, MemoryLst); end; Busy := False; if MemoryLst <> Nil then FV2Requests[i].HTTPContent := MemoryLst.Text else if FileStream <> Nil then FV2Requests[i].HTTPContent := 'FILE'; Result := 200; FV2Requests[i].Res := Result; LastReasonPhrase := 'OK'; ErrorMsg := '200: OK'; if HTTP.ProxySettings.Server <> '' then FWebAccess := proxySuccess else FWebAccess := directSuccess; if MemoryLst <> Nil then LogHTTPMessage(ErrorMsg, Length(MemoryLst.Text)) else if FileStream <> Nil then LogHTTPMessage(ErrorMsg, FileStream.Size); finally if MemoryLst <> Nil then MemoryLst.Free else if FileStream <> Nil then begin FS := FileStream.Size; FileStream.free; if FS = 0 then if FV2Requests[i].RequestType = httpGet then if FV2Requests[i].LocalFile <> '' then if FileExists(FV2Requests[i].LocalFile) then if FS = 0 then DeleteFile(FV2Requests[i].LocalFile); end; if HTTPRequest <> Nil then HTTPRequest.Free; HTTPRequest := Nil; end; except on E: EclSocketError do begin Busy := False; Result := E.ErrorCode; LastReasonPhrase := E.Message; ErrorMsg := Format('%s #%d: %s', ['EclSocketError', E.ErrorCode, E.Message]); FV2Requests[i].Res := Result; LogHTTPMessage(ErrorMsg, 0); if E.ErrorCode = 404 then begin // not found Result := 200; LastReasonPhrase := 'OK'; FV2Requests[i].Res := Result; ErrorMsg := '200: OK'; end else if HTTP.ProxySettings.Server <> '' then begin // Try without proxy UserValue := 0; HTTP.ProxySettings.Server := ''; Abort; Continue; end else break; end; on E: EclHttpError do begin Busy := False; Result := E.ErrorCode; LastReasonPhrase := E.ResponseText; FV2Requests[i].Res := Result; ErrorMsg := Format('%s #%d: %s', ['EclHttpError', E.ErrorCode, E.ResponseText]); LogHTTPMessage(ErrorMsg, 0); break; end; on E: Exception do begin Busy := False; Result := E.HelpContext; LastReasonPhrase := E.Message; FV2Requests[i].Res := Result; ErrorMsg := Format('%s #%d: %s', ['Exception', E.HelpContext, E.Message]); LogHTTPMessage(ErrorMsg, 0); break; end; end; if Length(FV2Requests) <= 1 then UserValue := ProgressBar.MaxValue else UserValue := UserValue + 1; Inc(i); end; end; Busy := False; // Set progress to max TimerTime.Enabled := False; UserValue := ProgressBar.MaxValue; // Set error messages LabelError1.caption := ErrorMsg; LabelError1.hint := ErrorMsg; LabelError2.caption := ErrorMsg; LabelError2.hint := ErrorMsg; // Change to error page if necessary if Result <> 200 then if ErrorHint <> '' then Notebook.PageIndex := 1; // Reset cursor or hide on success if not Visible then Screen.Cursor := ActiveCursor else if Result = 200 then Hide; // Wait for retry or cancel button if Result <> 200 then if Result <> INTERNET_STATE_DISCONNECTED then if Visible then if ModalResult <> mrAbort then begin LabelError1.Show; if Assigned(FOnProxyClick) then begin LabelProxy.Show; LabelProxy2.Show; end; ButtonAbort.Caption := '&Überspringen'; ButtonOK.Show; repeat Application.ProcessMessages; Sleep(1); if not Visible then ModalResult := mrAbort; until ModalResult <> mrNone; end; // Leave if: invisible, success, noInternet or Cancel-Button until (Visible = False) or (Result = 200) or (Result = INTERNET_STATE_DISCONNECTED) or (ModalResult <> mrOK); // Set timeout for next try (faster) if Result <> INTERNET_STATE_DISCONNECTED then if Result <> 200 then HTTP.TimeOut := FMinTimeOut; // Free request string lists for i := 0 to High(FV2Requests) do if FV2Requests[i].RequestVars <> Nil then FV2Requests[i].RequestVars.Free; // Run finish procedure if assigned if Assigned(FOnFinished) then FOnFinished(self); // Hide and reset Visible := False; MouseFencer.Stop; end; |
![]() |
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 |
![]() |
![]() |