Isapi + Upload

[André Stahl]

Hallo zusammen,

ich schreibe (mit D7 Prof) an einer Isapi-Anwendung mit Interbasedatenbank. Nun möchte ich ein Upload für Jpg´s anbieten.

Im HTML-Formular habe ich

enctype="multipart/form-data" encoding="multipart/form-data"

angegeben.

Die Auswertung von Request.Content gelingt mir jedoch nicht. Kann das "D7 Prof" vielleicht mit bordeigenen Mitteln immer noch nicht? Die Komponente "TMultipartContent", die Andreas Kosch hier einmal erwähnt hat, habe ich nirgends gefunden.

So etwa sieht Request.Content aus. Die JPG-Daten werden also offenbar mit übertragen:

-----------------------------7d33cd7053e Content-Disposition: form-data; name="F_BildLoad"; filename="C:\Dokumente und Einstellungen\André Stahl\Eigene Dateien\Eigene Bilder\opel1.JPG" Content-Type: image/pjpeg ÿØÿàJFIF``ÿÛC $.' ",#(7),01444'9=82<.342ÿÛC 2!!222222222222222222222222222222222222222222222 22222ÿÀ.....

Danke im Voraus
von André

[Andreas Kosch]

Hallo,

bei mir speichert die folgende Implementierung den binären Inhalt der hochgeladenen Datei problemlos ab (method=post encType=multipart/form-data):

<pre>

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
sFilePath : String;
sTemplate : String;
begin
if Pos('MULTIPART', UpperCase(Request.ContentType)) > 0 then
with TMultipartContent.Create(TISAPIRequest(Request)) do
try
Parse;
sFilePath := Values['TARGETDIR'];
sTemplate := Values['OKTEMPLATE'];
Fields['UploadedFile'].SaveToFile(
sFilePath + ExtractFileName(Values['UploadedFile']));
finally
Free;
end
else
with Request.ContentFields do
begin
// normale Auswertung (kein Multipart-Formular)
end;
PageProducerForm.HTMLFile := sTemplate;
Response.Content := PageProducerForm.Content;
end;

</pre>

Borland stellt die Klasse <i>TMultipartContent</i> meines Wissens nach nur in den Enterprise-Versionen zur Verfügung.

Für die Professional-Version von Delphi 5/6/7 sollte der folgende "Plan B" funktionieren:

<pre>

{ ************************************************** **************
Source File Name : FileUpload
Typ : ISAPI-DLL
Autor : Andreas Kosch
Erstellt am : 27.04.2000
Compiler : Delphi 5.01 (UpdatePack#1)
Betriebssystem : Windows NT 4
Beschreibung : ISAPI-Erweiterung für den IIS stellt eine
Upload-Maske zur Verfügung und speichert
die vom Client ausgewählte Datei auf dem
Server ab.
Revisionen :
************************************************** ************** }

unit FileUploadImpl;

interface

uses
Windows, Messages, SysUtils, Classes, HTTPApp, ISAPIApp;

type
TWebModule1 = class(TWebModule)
procedure WebModule1waUploadFormAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
function ExtractFileNameFromHTTPHeader(sHeaderData: string): string;
procedure RemoveHTTPHeaders(TempStrm : TMemoryStream);
{ Private declarations }
public
{ Public declarations }
end;

var
WebModule1: TWebModule1;

implementation

{$R *.DFM}

{ ################################################## ############
# Achtung: Ablagepfad für die übertragenen Dateien #
################################################## ############ }

const
ISAPI_EXPORT_PATH = 'F:\Webshare\OSWeb\Upload\';

procedure TWebModule1.WebModule1waUploadFormAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
Response.Content := ... (HTML-Maske als String codieren)...
end;

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
const
BufferSize = 8192;
var
TotalBytes : DWORD;
AvailableBytes : DWORD;
ExtraBytes : DWORD;
ExtraBytesRead : Integer;
pBuffer : PChar;
extBuffer : PChar;
Strm : TMemoryStream;
begin
try
TotalBytes := Request.ContentLength;
GetMem(pBuffer, TotalBytes + 2);
pBuffer^ := Char(0);
Strm := TMemoryStream.Create;
try
AvailableBytes := TISAPIRequest(Request).ECB.cbAvailable;
// Inhalt aus Request.Content nach pBuffer übernehmen
pBuffer := TISAPIRequest(Request).ECB.lpbData;
Strm.Write(pBuffer^,AvailableBytes);
// HTTP Content > Request.Content ? ( > 48 kByte?)
if TotalBytes > AvailableBytes then
begin
ExtraBytes := TotalBytes - AvailableBytes;
GetMem(extBuffer, ExtraBytes + 2);
extBuffer^ := Chr(0);
repeat
ExtraBytesRead := Request.ReadClient(extBuffer^,BufferSize);
Strm.Write(extBuffer^,ExtraBytesRead);
until ExtraBytesRead = -1;
end;
// Daten speichern
RemoveHTTPHeaders(Strm);
Response.Content := '< H3 >Datei-Upload war erfolgreich.< /H3 >';
finally
Strm.Free;
end;
except
on E : Exception do
Response.Content := '< H3 >Fehler: < / H3>< BR >' + E.Message;
end;
end;

{ -------------------------------------------------------------- }
{ Private Methoden }
{ -------------------------------------------------------------- }

procedure TWebModule1.RemoveHTTPHeaders(TempStrm : TMemoryStream);
var
sHeaderData : String;
sDelimiter : String;
Buffer : Char;
BinDataStartPos : Integer;
BinDataEndPos : Integer;
FileName : String;
MemStrm : TMemoryStream;
FileSize : LongInt;
DataBuffer : PChar;
begin
BinDataStartPos:= 0;
TempStrm.Position := 0;
repeat
TempStrm.Read(Buffer,1);
Inc(BinDataStartPos);
sHeaderData := sHeaderData + Buffer;
until (Copy(sHeaderData, Length(sHeaderData)-4, 4) = #13#10#13#10);

dec(BinDataStartPos,1);
Delete(sHeaderData,Length(sHeaderData)-1,1);
FileName := ExtractFileNameFromHTTPHeader(sHeaderData);
sDelimiter := Copy(sHeaderData, 1, Pos(#13#10,sHeaderData)-1);
BinDataEndPos := TempStrm.Size - (Length(sDelimiter) + 6);

FileSize := BinDataEndPos - BinDataStartPos;
MemStrm := TMemoryStream.Create;
GetMem(DataBuffer, FileSize);
try
TempStrm.Position := BinDataStartPos;
TempStrm.Read(DataBuffer^,FileSize);
MemStrm.Write(DataBuffer^,FileSize);
MemStrm.SaveToFile(ISAPI_EXPORT_PATH + FileName);
finally
MemStrm.Free;
FreeMem(DataBuffer, FileSize);
end;
end;

function TWebModule1.ExtractFileNameFromHTTPHeader(sHeaderD ata : string) : string;
begin
Result := Copy(sHeaderData,Pos('filename="',sHeaderData) + 10,
Length(sHeaderData));
Result := ExtractFileName(Copy(Result,1,Pos('"',Result)-1));
end;

end.

</pre>

P.S: Für derartige Aufgaben würde ich sofort zu ASP.NET welchseln, denn dort stehen die Klassen über das Framework uneingeschränkt und kostenfrei zur Verfügung. Und mit WebMatrix gibt es auch die Entwicklungsumgebung kostenfrei dazu (siehe <i>http://www.asp.net/webmatrix/ </i>). Da unter .NET die verwendete Sprache keine Rolle spielt, kann man auch Delphi.NET aus der zusammen mit Delphi 7 ausgelieferten Preview nutzen :-)

In VB.NET würde das Speichern der hochgeladenen Datei so aussehen:

<pre>

If Not File1.PostedFile Is Nothing Then
File1.PostedFile.SaveAs(Me.Server.MapPath(sURL))

</pre>
&#10

[André Stahl]

Hallo Andreas,

vielen Dank für die Hilfe, das funktioniert so wunderbar!
Nun muss ich die Datei statt auf die Platte nur noch in die Interbase-Datenbank speichern. Aber dank des Buches "Interbase Datenbankentwicklung mit Delphi" sollte mir das sicher gelingen! ;-))

<i> "Borland stellt die Klasse TMultipartContent meines Wissens nach nur in den Enterprise-Versionen zur Verfügung."</i>

Manchmal stellt sich Borland selbst ein Bein. Die Prof-Version ist doch nun auch nicht für lau.
Nach meinem Verständlis bietet das "überprofessionelle" Delphi 7 direkt die Eigenschaft TWebRequest.Files an, die dann die hochgeladenen Dateien enthält. Das wäre natürlich <b>sehr</b> komfortabel.

<i> "Für die Professional-Version von Delphi 5/6/7 sollte der folgende "Plan B" funktionieren:"</i>

Den Ansatz hatte ich mir in etwa schon überlegt. Das hätte aber Wochen gedauert!

<i> "P.S: Für derartige Aufgaben würde ich sofort zu ASP.NET welchseln..."</i>

Was der Bauer nicht kennt... Delphi kenne ich ganz gut. Mit Neuem und vor allem dem Englisch tue ich mich leider immer etwas schwer. Dank einiger Hilfen komme ich inzwischen mit Delphi bei meiner Isapi-Anwendung sehr gut zurecht. Die Vorlagen dazu mache ich mit Frontpage.

Danke von André Stah

[André Stahl]

Hallo,

ich habe den o.g. "Plan B" inzwischen etwas erweitert und an mein Projekt angepasst. Falls es für jemanden von Interesse ist, hänge ich den Quelltext an. Vielleicht ist manches nicht genial gelöst, aber es funktioniert soweit.

Die Änderungen sind:
- neben dem UploadFile werden auch anzugebende Formularfelder ausgelesen
- das UploadFile ist nicht länger als das Original
- das UploadFile wird im Stream zurückgegeben
- nur wenn ein Speicherordner angegeben wird, wird das UploadFile dorthin geschrieben

Weiterhin wird
- das UploadFile (Jpg) gleich noch in ein Interbase-Blobfeld "BildGross" gespeichert
- und dann noch einmal minimiert in das Feld "BildKlein"

Mein Problem ist nur noch, dass es mir nicht gelingt, dias hochgeladene Jpg ohne Zwischenspeicherung auf die Platte in die Datenbank zu speichern. Assign und LoadFromStream führt immer zu Fehlern. Ansonsten funktioniert das sehr gut.

Vielleicht kann es mal jemand brauchen.

Gruß André

---------------------schnipp-----------------------

procedure JpgResize(J:TJPEGImage;MaxWidth,MaxHeight:Integer) ;
var B1,B2:TBitmap;
Fouble;
begin
if (MaxWidth>0) or (MaxHeight>0) then begin
if (MaxWidth<=0) then begin
F:=J.Height/MaxHeight;
MaxWidth:=Round(J.Width/F);
end;
if (MaxHeight<=0) then begin
F:=J.Width/MaxWidth;
MaxHeight:=Round(J.Height/F);
end;
B1:=TBitmap.Create;
try
B1.Assign(J);
B2:=TBitmap.Create;
try
with B2 do begin
Width:=MaxWidth ;
Height:=MaxHeight;
Canvas.StretchDraw(Rect(0,0,MaxWidth,MaxHeight),B1 );
end;
J.Assign(B2);
finally
B2.Free;
end;
finally
B1.Free;
end;
end;
end;

function ExtractFileNameFromHTTPHeader(sHeaderData : string) : string;
begin
Result := Copy(sHeaderData,Pos('filename="',sHeaderData) + 10,
Length(sHeaderData));
Result := ExtractFileName(Copy(Result,1,Pos('"',Result)-1));
end;

procedure RemoveHTTPHeaders(TempStrm:TMemoryStream; SL:TStringList; ISAPI_EXPORT_PATH:String);
var
sHeaderData : String;
sDelimiter : String;
Buffer : Char;
BinDataStartPos : Integer;
BinDataEndPos : Integer;
FileName : String;
MemStrm : TMemoryStream;
FileSize : LongInt;
DataBuffer : PChar;
I,P1,P2,L : Integer;
SFields,S : String;
B : Boolean;
begin
BinDataStartPos:= 0;
TempStrm.Position := 0;
repeat
TempStrm.Read(Buffer,1);
Inc(BinDataStartPos);
sHeaderData := sHeaderData + Buffer;
until (Copy(sHeaderData, Length(sHeaderData)-4, 4) = #13#10#13#10);
Dec(BinDataStartPos,1);
Delete(sHeaderData,Length(sHeaderData)-1,1);
FileName := ExtractFileNameFromHTTPHeader(sHeaderData);
sDelimiter := Copy(sHeaderData, 1, Pos(#13#10,sHeaderData)-1);
BinDataEndPos:=Pred(BinDataStartPos);
B:=False;
L:=Length(sDelimiter);
P2:=TempStrm.Size-L;
while (BinDataEndPos<P2) and (not B) do begin
Inc(BinDataEndPos);
TempStrm.Position:=BinDataEndPos;
I:=1;
B:=True;
while (I<=L) and (B) do begin
if (TempStrm.Read(Buffer,1)=1) then begin
B:=(sDelimiter[I]=Buffer);
end;
Inc(I);
end;
end;
FileSize := BinDataEndPos - BinDataStartPos;
MemStrm := TMemoryStream.Create;
GetMem(DataBuffer, FileSize);
try
TempStrm.Position := BinDataStartPos;
TempStrm.Read(DataBuffer^,FileSize);
MemStrm.Write(DataBuffer^,FileSize);
TempStrm.Position := BinDataEndPos;
SFields:='';
while (TempStrm.Position<TempStrm.Size) do begin
if (TempStrm.Read(Buffer,1)=1) then SFields:=SFields+Buffer;
end;
if (ISAPI_EXPORT_PATH<>'') then MemStrm.SaveToFile(ISAPI_EXPORT_PATH + FileName);
TempStrm.LoadFromStream(MemStrm);
for I:=0 to SL.Count-1 do begin
S:='"'+SL[I]+'"';

[André Stahl]

Hallo,

ich habe den o.g. "Plan B" inzwischen etwas erweitert und an mein Projekt angepasst. Falls es für jemanden von Interesse ist, hänge ich den Quelltext an. Vielleicht ist manches nicht genial gelöst, aber es funktioniert soweit.

Die Änderungen sind:
- neben dem UploadFile werden auch anzugebende Formularfelder ausgelesen
- das UploadFile ist nicht länger als das Original
- das UploadFile wird im Stream zurückgegeben
- nur wenn ein Speicherordner angegeben wird, wird das UploadFile dorthin geschrieben

Weiterhin wird
- das UploadFile (Jpg) gleich noch in ein Interbase-Blobfeld "BildGross" gespeichert
- und dann noch einmal minimiert in das Feld "BildKlein"

Mein Problem ist nur noch, dass es mir nicht gelingt, dias hochgeladene Jpg ohne Zwischenspeicherung auf die Platte in die Datenbank zu speichern. Assign und LoadFromStream führt immer zu Fehlern. Ansonsten funktioniert das sehr gut.

Vielleicht kann es mal jemand brauchen.

Gruß André

---------------------schnipp-----------------------
<PRE>
procedure JpgResize(J:TJPEGImage;MaxWidth,MaxHeight:Integer) ;
var B1,B2:TBitmap;
Fouble;
begin
if (MaxWidth>0) or (MaxHeight>0) then begin
if (MaxWidth<=0) then begin
F:=J.Height/MaxHeight;
MaxWidth:=Round(J.Width/F);
end;
if (MaxHeight<=0) then begin
F:=J.Width/MaxWidth;
MaxHeight:=Round(J.Height/F);
end;
B1:=TBitmap.Create;
try
B1.Assign(J);
B2:=TBitmap.Create;
try
with B2 do begin
Width:=MaxWidth ;
Height:=MaxHeight;
Canvas.StretchDraw(Rect(0,0,MaxWidth,MaxHeight),B1 );
end;
J.Assign(B2);
finally
B2.Free;
end;
finally
B1.Free;
end;
end;
end;

function ExtractFileNameFromHTTPHeader(sHeaderData : string) : string;
begin
Result := Copy(sHeaderData,Pos('filename="',sHeaderData) + 10,
Length(sHeaderData));
Result := ExtractFileName(Copy(Result,1,Pos('"',Result)-1));
end;

procedure RemoveHTTPHeaders(TempStrm:TMemoryStream; SL:TStringList; ISAPI_EXPORT_PATH:String);
var
sHeaderData : String;
sDelimiter : String;
Buffer : Char;
BinDataStartPos : Integer;
BinDataEndPos : Integer;
FileName : String;
MemStrm : TMemoryStream;
FileSize : LongInt;
DataBuffer : PChar;
I,P1,P2,L : Integer;
SFields,S : String;
B : Boolean;
begin
BinDataStartPos:= 0;
TempStrm.Position := 0;
repeat
TempStrm.Read(Buffer,1);
Inc(BinDataStartPos);
sHeaderData := sHeaderData + Buffer;
until (Copy(sHeaderData, Length(sHeaderData)-4, 4) = #13#10#13#10);
Dec(BinDataStartPos,1);
Delete(sHeaderData,Length(sHeaderData)-1,1);
FileName := ExtractFileNameFromHTTPHeader(sHeaderData);
sDelimiter := Copy(sHeaderData, 1, Pos(#13#10,sHeaderData)-1);
BinDataEndPos:=Pred(BinDataStartPos);
B:=False;
L:=Length(sDelimiter);
P2:=TempStrm.Size-L;
while (BinDataEndPos<P2) and (not B) do begin
Inc(BinDataEndPos);
TempStrm.Position:=BinDataEndPos;
I:=1;
B:=True;
while (I<=L) and (B) do begin
if (TempStrm.Read(Buffer,1)=1) then begin
B:=(sDelimiter[I]=Buffer);
end;
Inc(I);
end;
end;
FileSize := BinDataEndPos - BinDataStartPos;
MemStrm := TMemoryStream.Create;
GetMem(DataBuffer, FileSize);
try
TempStrm.Position := BinDataStartPos;
TempStrm.Read(DataBuffer^,FileSize);
MemStrm.Write(DataBuffer^,FileSize);
TempStrm.Position := BinDataEndPos;
SFields:='';
while (TempStrm.Position<TempStrm.Size) do begin
if (TempStrm.Read(Buffer,1)=1) then SFields:=SFields+Buffer;
end;
if (ISAPI_EXPORT_PATH<>'') then MemStrm.SaveToFile(ISAPI_EXPORT_PATH + FileName);
TempStrm.LoadFromStream(MemStrm);
for I:=0 to SL.Count-1 do begin
S:='"'+SL[I]+'&quot

[André Stahl]

Hallo,

ich habe den o.g. "Plan B" inzwischen etwas erweitert und an mein Projekt angepasst. Falls es für jemanden von Interesse ist, hänge ich den Quelltext an. Vielleicht ist manches nicht genial gelöst, aber es funktioniert soweit.

Die Änderungen sind:
- neben dem UploadFile werden auch anzugebende Formularfelder ausgelesen
- das UploadFile ist nicht länger als das Original
- das UploadFile wird im Stream zurückgegeben
- nur wenn ein Speicherordner angegeben wird, wird das UploadFile dorthin geschrieben

Weiterhin wird
- das UploadFile (Jpg) gleich noch in ein Interbase-Blobfeld "BildGross" gespeichert
- und dann noch einmal minimiert in das Feld "BildKlein"

Mein Problem ist nur noch, dass es mir nicht gelingt, dias hochgeladene Jpg ohne Zwischenspeicherung auf die Platte in die Datenbank zu speichern. Assign und LoadFromStream führt immer zu Fehlern. Ansonsten funktioniert das sehr gut.

Vielleicht kann es mal jemand brauchen.

Gruß André

---------------------schnipp-----------------------
<PRE>
procedure JpgResize(J:TJPEGImage;MaxWidth,MaxHeight:Integer) ;
var B1,B2:TBitmap;
Fouble;
begin
if (MaxWidth&gt;0) or (MaxHeight&gt;0) then begin
if (MaxWidth&lt;=0) then begin
F:=J.Height/MaxHeight;
MaxWidth:=Round(J.Width/F);
end;
if (MaxHeight&lt;=0) then begin
F:=J.Width/MaxWidth;
MaxHeight:=Round(J.Height/F);
end;
B1:=TBitmap.Create;
try
B1.Assign(J);
B2:=TBitmap.Create;
try
with B2 do begin
Width:=MaxWidth ;
Height:=MaxHeight;
Canvas.StretchDraw(Rect(0,0,MaxWidth,MaxHeight),B1 );
end;
J.Assign(B2);
finally
B2.Free;
end;
finally
B1.Free;
end;
end;
end;

function ExtractFileNameFromHTTPHeader(sHeaderData : string) : string;
begin
Result := Copy(sHeaderData,Pos('filename="',sHeaderData) + 10,
Length(sHeaderData));
Result := ExtractFileName(Copy(Result,1,Pos('"',Result)-1));
end;

procedure RemoveHTTPHeaders(TempStrm:TMemoryStream; SL:TStringList; ISAPI_EXPORT_PATH:String);
var
sHeaderData : String;
sDelimiter : String;
Buffer : Char;
BinDataStartPos : Integer;
BinDataEndPos : Integer;
FileName : String;
MemStrm : TMemoryStream;
FileSize : LongInt;
DataBuffer : PChar;
I,P1,P2,L : Integer;
SFields,S : String;
B : Boolean;
begin
BinDataStartPos:= 0;
TempStrm.Position := 0;
repeat
TempStrm.Read(Buffer,1);
Inc(BinDataStartPos);
sHeaderData := sHeaderData + Buffer;
until (Copy(sHeaderData, Length(sHeaderData)-4, 4) = #13#10#13#10);
Dec(BinDataStartPos,1);
Delete(sHeaderData,Length(sHeaderData)-1,1);
FileName := ExtractFileNameFromHTTPHeader(sHeaderData);
sDelimiter := Copy(sHeaderData, 1, Pos(#13#10,sHeaderData)-1);
BinDataEndPos:=Pred(BinDataStartPos);
B:=False;
L:=Length(sDelimiter);
P2:=TempStrm.Size-L;
while (BinDataEndPos&lt;P2) and (not B) do begin
Inc(BinDataEndPos);
TempStrm.Position:=BinDataEndPos;
I:=1;
B:=True;
while (I&lt;=L) and (B) do begin
if (TempStrm.Read(Buffer,1)=1) then begin
B:=(sDelimiter[I]=Buffer);
end;
Inc(I);
end;
end;
FileSize := BinDataEndPos - BinDataStartPos;
MemStrm := TMemoryStream.Create;
GetMem(DataBuffer, FileSize);
try
TempStrm.Position := BinDataStartPos;
TempStrm.Read(DataBuffer^,FileSize);
MemStrm.Write(DataBuffer^,FileSize);
TempStrm.Position := BinDataEndPos;
SFields:='';
while (TempStrm.Position&lt;TempStrm.Size) do begin
if (TempStrm.Read(Buffer,1)=1) then SFields:=SFields+Buffer;
end;
if (ISAPI_EXPORT_PATH&lt;&gt;'') then MemStrm.SaveToFile(ISAPI_EXPORT_PATH + FileName);
TempStrm.LoadFromStream(MemStrm);
for I:=0 to SL.Count-1 do

[André Stahl]

Hallo,

ich habe den o.g. "Plan B" inzwischen etwas erweitert und an mein Projekt angepasst. Falls es für jemanden von Interesse ist, hänge ich den Quelltext an. Vielleicht ist manches nicht genial gelöst, aber es funktioniert soweit.

Die Änderungen sind:

- neben dem UploadFile werden auch anzugebende Formularfelder ausgelesen

- das UploadFile ist nicht länger als das Original

- das UploadFile wird im Stream zurückgegeben

- nur wenn ein Speicherordner angegeben wird, wird das UploadFile dorthin geschrieben

Weiterhin wird

- das UploadFile (Jpg) gleich noch in ein Interbase-Blobfeld "BildGross" gespeichert

- und dann noch einmal minimiert in das Feld "BildKlein"

Mein Problem ist nur noch, dass es mir nicht gelingt, dias hochgeladene Jpg ohne Zwischenspeicherung auf die Platte in die Datenbank zu speichern. Assign und LoadFromStream führt immer zu Fehlern. Ansonsten funktioniert das sehr gut.

Vielleicht kann es mal jemand brauchen.

Gruß André

---------------------schnipp-----------------------
<PRE>
procedure JpgResize(J:TJPEGImage;MaxWidth,MaxHeight:Integer) ;
var B1,B2:TBitmap;
Fouble;
begin
if (MaxWidth&gt;0) or (MaxHeight&gt;0) then begin
if (MaxWidth&lt;=0) then begin
F:=J.Height/MaxHeight;
MaxWidth:=Round(J.Width/F);
end;
if (MaxHeight&lt;=0) then begin
F:=J.Width/MaxWidth;
MaxHeight:=Round(J.Height/F);
end;
B1:=TBitmap.Create;
try
B1.Assign(J);
B2:=TBitmap.Create;
try
with B2 do begin
Width:=MaxWidth ;
Height:=MaxHeight;
Canvas.StretchDraw(Rect(0,0,MaxWidth,MaxHeight),B1 );
end;
J.Assign(B2);
finally
B2.Free;
end;
finally
B1.Free;
end;
end;
end;

function ExtractFileNameFromHTTPHeader(sHeaderData : string) : string;
begin
Result := Copy(sHeaderData,Pos('filename="',sHeaderData) + 10,
Length(sHeaderData));
Result := ExtractFileName(Copy(Result,1,Pos('"',Result)-1));
end;

</PRE>

Fortsetzung folgt..

[André Stahl]

...Fortsetzung:
<PRE>
procedure RemoveHTTPHeaders(TempStrm:TMemoryStream; SL:TStringList; ISAPI_EXPORT_PATH:String);
var
sHeaderData : String;
sDelimiter : String;
Buffer : Char;
BinDataStartPos : Integer;
BinDataEndPos : Integer;
FileName : String;
MemStrm : TMemoryStream;
FileSize : LongInt;
DataBuffer : PChar;
I,P1,P2,L : Integer;
SFields,S : String;
B : Boolean;
begin
BinDataStartPos:= 0;
TempStrm.Position := 0;
repeat
TempStrm.Read(Buffer,1);
Inc(BinDataStartPos);
sHeaderData := sHeaderData + Buffer;
until (Copy(sHeaderData, Length(sHeaderData)-4, 4) = #13#10#13#10);
Dec(BinDataStartPos,1);
Delete(sHeaderData,Length(sHeaderData)-1,1);
FileName := ExtractFileNameFromHTTPHeader(sHeaderData);
sDelimiter := Copy(sHeaderData, 1, Pos(#13#10,sHeaderData)-1);
BinDataEndPos:=Pred(BinDataStartPos);
B:=False;
L:=Length(sDelimiter);
P2:=TempStrm.Size-L;
while (BinDataEndPos&lt;P2) and (not B) do begin
Inc(BinDataEndPos);
TempStrm.Position:=BinDataEndPos;
I:=1;
B:=True;
while (I&lt;=L) and (B) do begin
if (TempStrm.Read(Buffer,1)=1) then begin
B:=(sDelimiter[I]=Buffer);
end;
Inc(I);
end;
end;
FileSize := BinDataEndPos - BinDataStartPos;
MemStrm := TMemoryStream.Create;
GetMem(DataBuffer, FileSize);
try
TempStrm.Position := BinDataStartPos;
TempStrm.Read(DataBuffer^,FileSize);
MemStrm.Write(DataBuffer^,FileSize);
TempStrm.Position := BinDataEndPos;
SFields:='';
while (TempStrm.Position&lt;TempStrm.Size) do begin
if (TempStrm.Read(Buffer,1)=1) then SFields:=SFields+Buffer;
end;
if (ISAPI_EXPORT_PATH&lt;&gt;'') then MemStrm.SaveToFile(ISAPI_EXPORT_PATH + FileName);
TempStrm.LoadFromStream(MemStrm);
for I:=0 to SL.Count-1 do begin
S:='"'+SL[I]+'"';
P1:=Pos(S,SFields)+Length(S)+4;
P2:=PosEx(sDelimiter,SFields,P1)-1;
SL[I]:=SL[I]+'='+Copy(SFields,P1,P2-P1-1);
end;
finally
MemStrm.Free;
FreeMem(DataBuffer, FileSize);
end;
end;

</PRE>
Fortsetzung folgt..

[André Stahl]

...Fortsetzung:

<PRE>
procedure TWebModuleSpd.WebModuleSpdWebActionItemSetEigeneDa tenBildLadenAction(
Sender: TObject; Request: TWebRequest; Response: TWebResponse;
var Handled: Boolean);
const
BufferSize = 8192;
var
TotalBytes : DWORD;
AvailableBytes : DWORD;
ExtraBytes : DWORD;
ExtraBytesRead : Integer;
pBuffer : PChar;
extBuffer : PChar;
Strm : TMemoryStream;
Jpg : TJPEGImage;
NutzerId,BildNr : String;
SL : TStringList;
Marke : String;
begin
try
Marke:='';
TotalBytes := Request.ContentLength;
GetMem(pBuffer, TotalBytes + 2);
pBuffer^ := Char(0);
Strm := TMemoryStream.Create;
SL:=TStringList.Create;
Jpg:=TJPEGImage.Create;
try
AvailableBytes := TISAPIRequest(Request).ECB.cbAvailable;
// Inhalt aus Request.Content nach pBuffer übernehmen
pBuffer := TISAPIRequest(Request).ECB.lpbData;
Strm.Write(pBuffer^,AvailableBytes);
// HTTP Content &gt; Request.Content ? ( &gt; 48 kByte?)
if TotalBytes &gt; AvailableBytes then
begin
ExtraBytes := TotalBytes - AvailableBytes;
GetMem(extBuffer, ExtraBytes + 2);
extBuffer^ := Chr(0);
repeat
ExtraBytesRead := Request.ReadClient(extBuffer^,BufferSize);
Strm.Write(extBuffer^,ExtraBytesRead);
until ExtraBytesRead = -1;
end;
// Daten speichern
SL.Add('H_NutzerId');
SL.Add('H_Passwort');
SL.Add('H_BildNr');
RemoveHTTPHeaders(Strm,SL,'');
//
NutzerId:=SL.Values['H_NutzerId'];
BildNr:=SL.Values['H_BildNr'];
Marke:='Marke_Bild'+BildNr;
//
Strm.SaveToFile(Pfad_spd+NutzerId+BildNr+Marke+'+. jpg');
Jpg.LoadFromFile(Pfad_spd+NutzerId+BildNr+Marke+'+ .jpg');
//
JpgResize(Jpg,0,210);
Jpg.CompressionQuality:=50;
Jpg.Compress;
Jpg.SaveToFile(Pfad_spd+NutzerId+BildNr+Marke+'-.jpg');
//
IBQuerySet.Close;
IBQuerySet.SQL.Clear;
IBQuerySet.SQL.Add('insert into T_BILDER (nutzer, bildnr, bildgross, bildklein, sollfrei, istfrei)');
IBQuerySet.SQL.Add('values (:NUTZER, :BILDNR, :BILDGROSS, :BILDKLEIN, 0,0)');
IBQuerySet.ParamByName('NUTZER').AsString:=NutzerI d;
IBQuerySet.ParamByName('BILDNR').AsString:=BildNr;
IBQuerySet.ParamByName('BILDGROSS').LoadFromFile(P fad_spd+NutzerId+BildNr+Marke+'+.jpg',ftBlob);
IBQuerySet.ParamByName('BILDKLEIN').LoadFromFile(P fad_spd+NutzerId+BildNr+Marke+'-.jpg',ftBlob);
IBQuerySet.ExecSQL;
IBQuerySet.Close;
//
DeleteFile(Pfad_spd+NutzerId+BildNr+Marke+'+.jpg') ;
DeleteFile(Pfad_spd+NutzerId+BildNr+Marke+'-.jpg');
finally
SL.Free;
Jpg.Free;
Strm.Free;
end;
except
SetFehler('FEHLER! (SetEigeneDatenBildLaden)');
// SetInfo('FEHLER! (SetEigeneDatenBildLaden)');
end;
Response.Content:=GetMainSeite('eigene Daten','EigeneDaten',NutzerId,Marke,gvInfo);
end;
</PRE>
---------------------schnapp----------------------

[André Stahl]

Hallo zusammen,

ich habe die Funktion inzwischen noch einmal überarbeitet, da es Probleme beim Laden größerer Bilder (>45kb) gab. Die Daten passan dann nicht in den Content und müssen blockweise nachgeladen werden. Der Quelltext ist recht umfangreich. Wer Interesse hat, kann sich gern an mich wenden: [email protected].

Gruß Andr&#233