1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
| unit PostContent; // Profi-Version
{*****************************************************************************
* enthält die Funktion GetPostedContent(), die in Webapplikationen vom Typ *
* ISAPI oder CGI (in Delphi Client/Server) die mittels der Formularmethode *
* POST geschickten Daten entgegennimmt und verarbeitet. *
* Verarbeiten bedeutet: *
* - alle Textfelder, Radiobuttons, Checkboxen, Buttons nach RFC 1867 oder *
* RFC 1866 dekodieren und in Parameter "List" als name=wert eintragen *
* - alle <input type="file"> mit dem gesendeten Dateinamen unter Parameter *
* "Path" auf dem Server abspeichern *
* *
* freigegeben: Jürgen Hummel * www.hummel1.de * post@hummel1.de *
* *
* Stand: 01-07-30 *
*****************************************************************************}
{$H+}
interface
uses Windows, Classes, SysUtils, HTTPApp;
function GetPostedContent(Request: TWebRequest; var List: TStringList; Path: TFileName): Boolean;
implementation
function HxToInt(c: Char): Byte; //Hilfsfunktion Dezimalwert eines Hex-Zeichens
begin if c<='9' then HxToInt:=Ord(c)-48 else HxToInt:=Ord(UpCase(c))-55 end;
function GetPostedContent(Request: TWebRequest; var List: TStringList; Path: TFileName): Boolean;
var sContent, sBuf, sField, sType, sBoundary, sBound2: String;
cBuf: array[0..4095] of Char; // bei CGI keine größeren Blöcke möglich!!!, bei ISAPI schaffen manche Server auch 8KByte
nContLen, nP, nRead: Integer;
UpFile: TFileStream;
begin
GetPostedContent:=true;
if UpperCase(Request.Method)='POST' then begin // bei Methode POST
sBuf:=Request.ContentType;
nContLen:=Request.ContentLength; nRead:=Length(Request.Content);
SetLength(sContent,nContLen); // Pufferspeicher anlegen, dann füllen
Move(Request.Content[1],sContent[1],nRead); nP:=nRead+1; Dec(nContLen,nRead);
while nContLen>0 do begin // Rest vom Browser einlesen
nRead:=Request.ReadClient(cBuf,SizeOf(cBuf)); // das direkte Lesen in sContent[nP] geht nur manchmal?
if nRead>0 then begin
Move(cBuf,sContent[nP],nRead); Dec(nContLen,nRead); Inc(nP,nRead)
end else nContLen:=0;
end;
if Pos('multipart/form-data',LowerCase(sBuf))=1 then begin // für Form-Data
if Path<>'' then if Path[Length(Path)]<>'\' then Path:=Path+'\'; // Speicher
sBoundary:='--'+Copy(sBuf,Pos('boundary=',LowerCase(sBuf))+9,199);
nP:=Pos(sBoundary,sContent); if nP=0 then GetPostedContent:=false;
while nP>0 do begin // solange Feld-Abschnitte
Delete(sContent,1,nP); // bis dahin kürzen
sBuf:=Copy(sContent,1,255); nP:=Pos('name=',LowerCase(sBuf));
if nP>0 then begin // Feldname "name= " gefunden
sBuf:=Copy(sContent,nP,255); // nächste 2..4 Zeilen ab "name= "
sType:=Copy(sBuf,Pos(#10,sBuf)+1,255); // 2. Zeile extrahieren
Delete(sType,Pos(#13,sType),255);
Delete(sBuf,Pos(#13,sBuf),255); // Zeilenrest ab "name= " verbleibt
sField:=Copy(sBuf,Pos('"',sBuf)+1,199); // FeldNamen extrahieren
Delete(sField,Pos('"',sField),199);
if (Pos('/mixed',LowerCase(sType))>0) and (Pos('boundary=',LowerCase(sType))>0) then begin
sBound2:='--'+Copy(sType,Pos('boundary=',LowerCase(sType))+9,199);
sType:=''; // für Dateinamen missbrauchen
nP:=Pos(sBound2,sContent); // erste eingebettete Datei suchen
while nP>0 do begin
Delete(sContent,1,nP); // bis dahin kürzen
sBuf:=Copy(sContent,1,255); // Dateinamen gewinnen
Delete(sBuf,1,Pos('filename=',LowerCase(sBuf))); Delete(sBuf,1,Pos('=',sBuf));
Delete(sBuf,1,Pos('"',sBuf)); if Pos('"',sBuf)>0 then Delete(sBuf,Pos('"',sBuf),199);
if Length(sType)>0 then sType:=sType+'; '; sType:=sType+sBuf; sBuf:=ExtractFilename(sBuf);
nP:=Pos(#13#10#13#10,sContent); Delete(sContent,1,nP+3); // Dateianfang
nP:=Pos(sBound2,sContent)-2; // Ende Dateiabschnitt ohne CR/LF
if sBuf>'' then try // unter Dateinamen speichern
UpFile:=TFileStream.Create(Path+sBuf,fmOpenWrite or fmCreate);
try UpFile.Write(sContent[1],nP-1) except GetPostedContent:=false end;
UpFile.Free;
except GetPostedContent:=false end;
if Copy(sContent,nP+2+Length(sBound2),2)='--'then nP:=0; // Ende multipart/mixed
end;
sBuf:=''; // Kennzeichen, dass multipart/mixed war
end; // multipart/mixed
nP:=Pos(#13#10#13#10,sContent); if nP>0 then Delete(sContent,1,nP+3); // Anfang Datenabschnitt
nP:=Pos(sBoundary,sContent)-2; // Ende Datenabschnitt ohne CR/LF
if Pos('filename=',LowerCase(sBuf))=0 then begin // kein Type File
if sBuf<>'' then List.Add(sField+'='+Copy(sContent,1,nP-1)) //normalerweise
else List.Add(sField+'='+sType); // von /mixed kommende Dateinamen
end else begin // Type File
Delete(sBuf,1,Pos('filename=',LowerCase(sBuf))+8); // Dateinamen gewinnen
Delete(sBuf,1,Pos('"',sBuf)); if Pos('"',sBuf)>0 then Delete(sBuf,Pos('"',sBuf),199);
List.Add(sField+'='+sBuf); sBuf:=ExtractFilename(sBuf);
if sBuf>'' then try // unter Dateinamen speichern
UpFile:=TFileStream.Create(Path+sBuf,fmOpenWrite or fmCreate);
try if nP>1 then UpFile.Write(sContent[1],nP-1) except GetPostedContent:=false end;
UpFile.Free;
except GetPostedContent:=false end;
end;
end else begin Delete(sContent,1,1); nP:=Pos(sBoundary,sContent) end; // kein FeldName
end; // while Pos(sBoundary)
end else begin // bei www-form-urlencoded-Data
nContLen:=Length(sContent); sBuf:=''; nP:=1;
while nP<=nContLen do begin // Zeichen für Zeichen
case sContent[nP] of // Sonderzeichen behandeln
'+': sBuf:=sBuf+' ';
'%': begin sBuf:=sBuf+Chr((HxToInt(sContent[nP+1])shl 4)+HxToInt(sContent[nP+2])); Inc(nP,2) end;
'&': begin List.Add(sBuf); sBuf:='' end;
else sBuf:=sBuf+sContent[nP]; // Normalzeichen
end;
Inc(nP); // nächstes Eingabe-Zeichen
end;
List.Add(sBuf);
end; // Ende Datenbehandlung
end else GetPostedContent:=false; // Methode anders als POST
end;
end. |
