VPF::Upload через браузер - Форум программистов

lukash256

Дата 24.7.2007, 03:12 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 107
Регистрация: 23.7.2007
Где: Гомель/Беларусь

Репутация: нет
Всего: нет

Доброго времени суток, товарищи!
пишу сервер с возможностью upload-а. видел здесь и не только сдесь и не только массу вариантов решения но што-то не заладилось. 3-й день далблюсь. народ! HELP me !!!

для отправки файла на сервер использую след. код

Код


<body>
<form action="http://localhost/" method=post>
<INPUT TYPE="file" NAME="Opinion-File" SIZE="30"> 
<INPUT TYPE="submit" VALUE="send file">
</form>
</body>

для получения его на сервере (код Snowy)

Код


procedure TForm1.IdHTTPServer1CommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  s: string;
  fs: TFileStream;
begin
  s:='/upload'+ARequestInfo.Document;
  fs:=nil;
  try
    try
      fs:=TFileStream.Create(s,$40);
      SetLength(s,fs.size); fs.Read(s[1],fs.Size);
      AResponseInfo.ContentText:=s;
      AResponseInfo.ContentType:=idhttpserver1.MIMETable.GetFileMIMEType(s);
    except
      AResponseInfo.ResponseNo:=404;
    end;
  finally
    fs.Free;
  end;
end;

-404 ни куда не сохраняет ((

далее пробовал от такой вариант

Код


procedure TForm1.ServerCommandGet(AThread: TIdPeerThread; 
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 
Var PostedFile:TMemoryStream; 
begin 

  If ARequestInfo.Document='/' Then begin 
    With AResponseInfo do begin 
      ContentText:=HtmlForm; 
      WriteContent; 
    end; 
  end else if ARequestInfo.Document='/upload/' then begin 
    PostedFile:=TMemoryStream.Create; 
    Try 
      Try 
        PostedFile.LoadFromStream(ARequestInfo.PostStream); 
        PostedFile.SaveToFile('.\'+(DateToStr(now)+' '+TimeToStr(now)+' '+AThread.Connection.Socket.Binding.PeerIP)); 
        With AResponseInfo do begin 
          ContentText:=HtmlForm('Upload Successful!'); 
          WriteContent; 
        end; 
      except 
        With AResponseInfo do begin 
          ContentText:=HTMLForm('Upload Error!'); 
          WriteContent; 
        end; 
      end; 
    finally 
      PostedFile.Free; 
    end; 
  end; 
end;

-не пашол((

буду признателен за хелп

MetalFan

Дата 24.7.2007, 08:11 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 14
Всего: 128

Цитата(lukash256 @ 24.7.2007, 03:12

)

-404 ни куда не сохраняет ((

Цитата(lukash256 @ 24.7.2007, 03:12

)

fs:=TFileStream.Create(s,$40);
SetLength(s,fs.size); fs.Read(s[1],fs.Size);

ой, шоэто? шо за $40?? константами не понятнее прописать?
и зачем ты читать пытаешься из файла? уверен, что путь верный? почему слэш в начале?

Цитата(lukash256 @ 24.7.2007, 03:12

)

-не пашол((

и куда не пошол? ну так пошли его посильнее!
з.ы. в какой строке ошибка возникает и какая???

--------------------

There are always someone smarter than you...

lukash256

Дата 25.7.2007, 03:08 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 107
Регистрация: 23.7.2007
Где: Гомель/Беларусь

Репутация: нет
Всего: нет

Здарова MetalFan !
спасибо што откликнулся.

1) походу нада юзать fmcreate

2)

Цитата

и зачем ты читать пытаешься из файла?

я просто положил код SNOWY и произвёл там ченджи на какие он указывал в одном из топикав

http://forum.vingrad.ru/forum/topic-93066/...rver/index.html

lukash256

Дата 9.11.2007, 00:10 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 107
Регистрация: 23.7.2007
Где: Гомель/Беларусь

Репутация: нет
Всего: нет

если каму тикава вот 100% рабочи, но со сваими недостатками, код
недостатки:
--зависимость от доступной на машине памяти
--файлы заливаюццо со служебной инфой.
но при жалании ис тем и с другим справиицо можна (автар был кой-та немец) smile

Код


unit Push_main; 

interface 

uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdCustomHTTPServer, 
  IdHTTPServer, StdCtrls, ToolBox; 

type 
  TForm1 = class(TForm) 
    Server: TIdHTTPServer; 
    Active: TCheckBox; 
    Port: TEdit; 
    procedure ServerCommandGet(AThread: TIdPeerThread; 
      ARequestInfo: TIdHTTPRequestInfo; 
      AResponseInfo: TIdHTTPResponseInfo); 
    procedure ServerCreatePostStream(ASender: TIdPeerThread; 
      var VPostStream: TStream); 
    procedure FormCreate(Sender: TObject); 
    procedure ActiveClick(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 

var 
  Form1: TForm1; 

implementation 

uses IdHTTPHeaderInfo; 

{$R *.dfm} 

//function fib(n:Integer):Integer; begin if (n <= 2) then result:=1 else result:=fib(n-1) + fib(n-2); end; 

function HtmlForm:string; 
begin 
Result:= 
  '<html><head><title>Upload</title></head><body>'+ 
  '<center><h1>File Upload</h1><hr>'+ 
  '<form action="/upload/" method=post enctype="multipart/form-data">'+ 
  '<input type=file name=file><input type=submit value=Upload></form>'+ 
  '</center></body></html>'; 
end; 

function HTMLMessage(msg:String):string; 
begin 
Result:= 
  '<html><head><title>Upload</title></head><body>'+ 
  '<center><h1>File Upload</h1><hr>'+msg+'<hr>'+ 
  '<a href=/>Click here to continue</a></center></body></html>'; 
end; 

procedure TForm1.ServerCommandGet(AThread: TIdPeerThread; 
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 
Var TheFile:TMemoryStream; 
    FN:String; 
begin 

  If ARequestInfo.Document='/' Then begin 
    With AResponseInfo do begin 
      ContentText:=HtmlForm; 
      WriteContent; 
    end; 
  end else if ARequestInfo.Document='/upload/' then begin 
    TheFile:=TMemoryStream.Create; 
    try 
      try 
        TheFile.LoadFromStream(ARequestInfo.PostStream); 
        TheFile.SaveToFile('.\'+DateToStr(now)+' '+TimeToStr(now)+' '+ARequestInfo.RemoteIP+' '+FN); 
        With AResponseInfo do begin 
          ContentText:=HtmlMessage('Upload Successful!'); 
          WriteContent; 
        end; 
      except 
        With AResponseInfo do begin 
          ContentText:=HTMLMessage('Upload Error!'); 
          WriteContent; 
        end; 
      end; 
    finally 
      TheFile.Free; 
    end; 
  end; 
end; 

procedure TForm1.ServerCreatePostStream(ASender: TIdPeerThread; 
  var VPostStream: TStream); 
begin 
VPostStream:=TMemoryStream.Create; 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
LongTimeFormat:='hhmmss'; 
ShortDateFormat:='yyMMdd'; 
end; 

procedure TForm1.ActiveClick(Sender: TObject); 
begin 
  Try 
    If Active.Checked then begin 
      Server.DefaultPort:=StrTointDef(Port.Text,80); 
    end; 
    Server.Active:=Active.Checked; 
  Finally 
    Active.Checked:=Server.Active; 
  end; 
end; 

end.

Это сообщение отредактировал(а) lukash256 - 9.11.2007, 00:12

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »