Ma ktoś pomysł, jak można w delphi przesłać plik na formularz na danej stronie w internecie? Mam formularz na stronie, i chce do niego przekazac zmienna ze sciezka pliku, aby skopiować ten plik na serwer. Chciałbym napisaćprogram do zarządzania moja stroną www. Obmyślałem już wszystko, pozostało mi jeszcze wgrywanie plików an serwer. Jest to w ogóle możliwe?
0
0
chyba generalnie podejscie i sam poczatkowy pomysl nie byl zadobry.
Najwygodniej zawsze takie rzeczy pisze sie w "golym" PHP. Nakladki w Deplhi maja sens gdy przesylaja dane do serwera imitujac zachowanie przegladarki internetowej albo przez komponent webbrowser. Aby imitowac przegladarke trzeba obsluzyc protokoly przesylu danych. Osobiscie jednak zrobilbym to w formularzach html i php. Nie dosc wtedy, ze masz pelna funkcjonalnosc to jeszcze dziala przejrzyscie, prosto i wszedzie na swiecie :) zas Twoja metoda to jakby zakladac majtki przez glowe...
0
No tak nie do końca. Czasem przesyłanie danych z programu jest bardzo wygodne (przykład - CubeCVS, program, który piszę wraz z paroma osobami aktualnie). Ja do tego napisałem całą klasę THTTP (niestety przesyłanie plików przez Indy nie działało). Wygląda ona mniej więcej tak:
unit Http;
{
Unit odpowiadający za obsługę wysyłania informacji do serwera HTTP.
Obsługuje formularze wysyłane metodą POST zawierające pola typu FILE.
Stworzone na potrzeby projektu CUBE.
Obiekt oparty na czystych gniazdkach.
Przykład użycia załączony wraz z biblioteką, jesli nie, to zajrzyj na www.pilotmp3.devtown.net/forum/.
Autor: Adam Pilorz.
Copyright (C) 2005 by Adam Pilorz.
Unit rozprowadzany jest na zasadach licencji GNU GPL.
ChangeLog:
2005-01-19 : -> [Adam Pilorz] : Powstanie pierwszej wersji biblioteki.
2005-01-20 : -> [Adam Pilorz] : Dodanie metod GetHost i GetPort oraz lekka reorganizacja przekazywania URL'a.
-> [Adam Pilorz] : Zabezpieczenie przed błędami w sytuacji, gdy ktos próbuje wysłac zapytanie bez dodania zawartosci.
-> [Adam Pilorz] : Zamiana obiektów na klasy
-> [Adam Pilorz] : Zamiana Value na TStringList ze String'a w AddFile w celu uniknięcia błędu wynikającego z przeciążenia funkcji o wartosciach domyslnych
-> [Adam Pilorz] : Dodanie obsługi różnych klientów (Dotychczas dostępny był tylko Cube 1.0), teraz ustawia się to w konstruktorze, domyslnie THttp 1.0 (wersję podaje się bez kropek, tak jak jest to wysyłanie do serwera)
2005-01-30 : -> [Adam Pilorz] : Dodanie procedurey THttp.Reset mającej na celu wyzerowanie wszystkich własciwosci
-> [Adam Pilorz] : Drobna zmiana w konstruktorze
}
interface
uses
SysUtils, Classes, ScktComp, Math;
type
THTTPClient = record
Name: String;
Version: Integer;
end;
THTTPContentItem = record
Name: String;
Value: String;
end;
THTTPContentFile = record
Name: String;
FileName: String;
Value: String;
MimeType: String;
end;
THTTPContent = class(TObject)
Items: Array of THTTPContentItem;
Files: Array of THTTPContentFile;
Function Add(Name, Value: String): Word;
Function AddFile(Name, FileName: String; Value: TStringList; MimeType: String = 'text/plain'): Word; overload;
Function AddFile(Name, FileName: String; MimeType: String = 'text/plain'): Word; overload;
Function ContentLength: Integer;
Function Count: Word;
Function FilesCount: Word;
end;
THTTP = class(TObject)
Boundary: String;
Content: THTTPContent;
URL: String;
Client: THTTPClient;
Procedure CreateBoundary;
Procedure Get(Socket: TCustomWinSocket);
Procedure Post(Socket: TCustomWinSocket);
Function GetHost: String;
Function GetPort: Integer;
Procedure Reset(ClientName: String = 'THttp'; ClientVersion: Integer = 10);
Constructor Create(ClientName: String = 'THttp'; ClientVersion: Integer = 10);
end;
implementation
Function THTTPContent.Add(Name, Value: String): Word;
Var
Item: THTTPContentItem;
Begin
Item.Name:=Name;
Item.Value:=Value;
SetLength(Items, Length(Items)+1);
Items[Length(Items)-1]:=Item;
Result:=Length(Items)-1;
end;
Function THTTPContent.AddFile(Name, FileName: String; Value: TStringList; MimeType: String): Word;
Var
Item: THTTPContentFile;
Begin
Item.Name:=Name;
Item.FileName:=ExtractFileName(FileName);
Item.Value:=Value.Text;
Item.MimeType:=MimeType;
SetLength(Files, Length(Files)+1);
Files[Length(Files)-1]:=Item;
Result:=Length(Files)-1;
end;
Function THTTPContent.AddFile(Name, FileName, MimeType: String): Word;
Var
Item: THTTPContentFile;
FileLines: TStringList;
Begin
FileLines:=TStringList.Create;
FileLines.LoadFromFile(FileName);
Item.Name:=Name;
Item.FileName:=ExtractFileName(FileName);
Item.Value:=FileLines.Text;
Item.MimeType:=MimeType;
FileLines.Free;
SetLength(Files, Length(Files)+1);
Files[Length(Files)-1]:=Item;
Result:=Length(Files)-1;
end;
Function THTTPContent.ContentLength: Integer;
Var
I: Word;
Begin
Result:=0;
If Length(Items)>0 then for I:=0 to Length(Items)-1 do Result:=Result+87+Length(Items[I].Name)+Length(Items[I].Value);
If Length(Files)>0 then for I:=0 to Length(Files)-1 do Result:=Result+120+Length(Files[I].Name)+Length(Files[I].FileName)+Length(Files[I].MimeType)+Length(Files[I].Value);
Result:=Result+40;
end;
Function THTTPContent.Count: Word;
Begin
Result:=Length(Items);
end;
Function THTTPContent.FilesCount: Word;
Begin
Result:=Length(Files);
end;
Procedure THTTP.CreateBoundary;
Var I: Byte;
Begin
Randomize;
Boundary:='---------------------------';
Boundary:=Boundary+IntToStr(RandomRange(1, 9));
For I:=2 to 11 do Boundary:=Boundary+IntToStr(RandomRange(0, 9));
end;
Procedure THTTP.Get(Socket: TCustomWinSocket);
Begin
If Pos('http://', URL)=1 then Delete(URL, 1, 7);
try
Socket.SendText('GET /'+Copy(URL, Pos('/', URL)+1, Length(URL)-Pos('/', URL))+' HTTP/1.1'+#13+#10);
Socket.SendText('Host: '+Copy(URL, 1, Pos('/', URL)-1)+#13+#10);
Socket.SendText('User-Agent: Mozilla/5.0 (compatible; '+Client.Name+'; Windows) '+Client.Name+'/'+IntToStr(Client.Version)+#13+#10);
Socket.SendText('Accept: application/x-shockwave-flash,text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,image/jpeg,image/gif;q=0.2,*/*;q=0.1'+#13+#10);
Socket.SendText('Accept-Language: pl-pl,en-us,en;q=0.5'+#13+#10);
Socket.SendText('Keep-Alive: 300'+#13+#10);
Socket.SendText('Connection: keep-alive'+#13+#10+#13+#10);
except
raise Exception.Create('Błąd podczas wysyłania zapytania!');
end;
end;
Procedure THTTP.Post(Socket: TCustomWinSocket);
Var
I: Word;
Begin
If Pos('http://', URL)=1 then Delete(URL, 1, 7);
If (Content.Count>0) or (Content.FilesCount>0) then try
Socket.SendText('POST /'+Copy(URL, Pos('/', URL)+1, Length(URL)-Pos('/', URL))+' HTTP/1.1'+#13+#10);
Socket.SendText('Host: '+Copy(URL, 1, Pos('/', URL)-1)+#13+#10);
Socket.SendText('User-Agent: Mozilla/5.0 (compatible; '+Client.Name+'; Windows) '+Client.Name+'/'+IntToStr(Client.Version)+#13+#10);
Socket.SendText('Accept: application/x-shockwave-flash,text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,image/jpeg,image/gif;q=0.2,*/*;q=0.1'+#13+#10);
Socket.SendText('Accept-Language: pl-pl,en-us,en;q=0.5'+#13+#10);
Socket.SendText('Keep-Alive: 300'+#13+#10);
Socket.SendText('Connection: keep-alive'+#13+#10);
Socket.SendText('Content-Type: multipart/form-data; boundary='+Boundary+#13+#10);
Socket.SendText('Content-Length: '+IntToStr(Content.ContentLength)+#13+#10+#13+#10);
If Content.Count>0 then for I:=0 to Content.Count-1 do begin
Socket.SendText('--'+Boundary+#13+#10);
Socket.SendText('Content-Disposition: form-data; name="'+Content.Items[I].Name+'"'+#13+#10+#13+#10);
Socket.SendText(Content.Items[I].Value+#13+#10);
end;
If Content.FilesCount>0 then for I:=0 to Content.FilesCount-1 do begin
Socket.SendText('--'+Boundary+#13+#10);
Socket.SendText('Content-Disposition: form-data; name="'+Content.Files[I].Name+'"; filename="'+Content.Files[I].FileName+'"'+#13+#10+'Content-Type: '+Content.Files[I].MimeType+#13+#10+#13+#10);
Socket.SendText(Content.Files[I].Value+#13+#10);
end;
Socket.SendText('--'+Boundary+'--'+#13+#10);
except
raise Exception.Create('Błąd podczas wysyłania zapytania!');
end
else raise Exception.Create('Błąd: próba wysłania zapytania bez zawartosci!');
end;
Function THTTP.GetHost: String;
Begin
Result:=URL;
If Pos('http://', Result)=1 then Delete(Result, 1, 7);
Result:=Copy(Result, 1, Pos('/', Result)-1);
If Pos(':', Result)>0 then Result:=Copy(Result, 1, Pos(':', Result)-1);
end;
Function THTTP.GetPort: Integer;
Var
Host: String;
Begin
Host:=URL;
If Pos('http://', Host)=1 then Delete(Host, 1, 7);
Host:=Copy(Host, 1, Pos('/', Host)-1);
If Pos(':', Host)>0 then Result:=StrToInt(Copy(Host, Pos(':', Host)+1, Length(Host)-Pos(':', Host))) else Result:=80;
end;
Procedure THTTP.Reset(ClientName: String; ClientVersion: Integer);
Begin
Content.Free;
Content:=THTTPContent.Create;
SetLength(Content.Items, 0);
SetLength(Content.Files, 0);
URL:='';
Client.Name:=ClientName;
Client.Version:=ClientVersion;
CreateBoundary;
end;
Constructor THTTP.Create(ClientName: String; ClientVersion: Integer);
Begin
Inherited Create;
Content:=THTTPContent.Create;
SetLength(Content.Items, 0);
SetLength(Content.Files, 0);
URL:='';
Client.Name:=ClientName;
Client.Version:=ClientVersion;
CreateBoundary;
end;
end.
P.S. Tutaj by się przydało zwijanie albo przewijanie kodu ;)
No i wspomniany wyżej przykład użycia:
//Wycinek z Unitu z formą, jest na niej tylko ClientSocket i nic więcej:
implementation
uses
Http;
{$R *.dfm}
var
Http1: THttp;
procedure TForm1.FormCreate(Sender: TObject);
begin
Http1:=THttp.Create; //Tworzenie klasy
Http1.Content.Add('tmptextarea', 'blabla'); //Dodawanie pola TextArea. Podajemy nazwę i zawartość.
Http1.Content.Add('MAX_FILE_SIZE', '102400'); //J.W., tyle, że tym razem pole hidden typowe dla formularza WWW z plikiem
Http1.Content.Add('hehe', 'A co teraz?'); //Zwykłe pole tekstowe
Http1.Content.AddFile('pliczek', 'D:\Documents and Settings\Adam\Moje Dokumenty\imiona.txt'); //No i dodajemy plik. Dodatkowo można podać zawartość pliku (wtedy nie będzie on ładowany lub/i typ MIME.
Http1.URL:='http://localhost/cvs/tmpfileinterpreter.php'; //Podajemu URL
ClientSocket1.Host:=Http1.GetHost; //Przypisujemy automatycznie odczytany z URL'a host
ClientSocket1.Port:=Http1.GetPort; //...i port
ClientSocket1.Open; //Nawiązujemy połączenie
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Http1.Post(Socket); //Przy nawiązaniu połączenia wysyłamy zapytanie
end;
0
Witam. Bawię się troszkę tym komponentem który przygotowaliście i mam pewien problem z nim. Wszystko działa niby tak jak powinno ale przesyła mi jedynie 6bajtów pliku. Formularz na stronie działa jak najbardziej poprawnie i ręcznie przesyła pliki w całości jednak przy próbie wykorzystania do tego programu plik zostaje pomyślnie przesłany ale niestety także odchudzony. Jest tak zarówno na localhoscie jak i na serwerze sieciowym. Macie może pomysł czego to może być wina? Może jakaś konfiguracja clinetsocket? Pozdrawiam i dzięki z góry za pomoc.
// nie odświeżaj starych postów - napisz nowy, albo zapytaj autora tego komponentu